14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(use srfi-1 regex regex-case srfi-69)
(declare (unit gutils))
;; NOTE: These functions will move to iuputils
(define (gutils:colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
(delta (map (lambda (a b)(abs (- a b))) c1 c2)))
(null? (filter (lambda (x)(> x 3)) delta))))
|
>
|
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(declare (unit gutils))
(module gutils
(iuplistbox-fill-list
message-window
gutils:colors-similar?
gutils:colors
gutils:get-color-for-state-status
)
(import (prefix iup iup:)
canvas-draw)
(import scheme
chicken.base
chicken.condition
chicken.string
chicken.pretty-print
chicken.sort
chicken.time
chicken.file
chicken.file.posix
chicken.process
chicken.process-context
chicken.process-context.posix)
(import srfi-1 regex regex-case srfi-69)
(define (iuplistbox-fill-list lb items #!key (selected-item #f))
(let ((i 1))
(for-each (lambda (item)
(iup:attribute-set! lb (number->string i) item)
(if selected-item
(if (equal? selected-item item)
(iup:attribute-set! lb "VALUE" i))) ;; (number->string i))))
(set! i (+ i 1)))
items)
;; (iup:attribute-set! lb "VALUE" (if selected-item selected-item ""))
i))
(define (message-window msg)
(iup:show
(iup:dialog
(iup:vbox
(iup:label msg #:margin "40x40")))))
;; NOTE: These functions will move to iuputils
(define (gutils:colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
(delta (map (lambda (a b)(abs (- a b))) c1 c2)))
(null? (filter (lambda (x)(> x 3)) delta))))
|
86
87
88
89
90
91
92
|
((BOTH-BAD) (list "180 33 49" status))
(else (list
;; "192 192 192"
"222 222 221"
state))))
|
>
|
127
128
129
130
131
132
133
134
|
((BOTH-BAD) (list "180 33 49" status))
(else (list
;; "192 192 192"
"222 222 221"
state))))
)
|