Random Bits of Open Code

Check-in [772dfc1869]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added megatest colors support to iuputils (as good a place as any).
Timelines: family | ancestors | descendants | both | trunk | worked-at-home
Files: files | file ages | folders
SHA1:772dfc186910f1efc86334ad96c4c56f95cc8764
User & Date: matt 2018-05-02 06:06:16
Context
2018-05-02
22:39
Iterate over areas (not 100% sure this is a good idea). check-in: a76a9c267b user: matt tags: trunk
06:06
Added megatest colors support to iuputils (as good a place as any). check-in: 772dfc1869 user: matt tags: trunk, worked-at-home
2018-05-01
23:44
Added get-mindata check-in: ef7a0d02fc user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to mtutils/iuputils/iuputils.scm.

16
17
18
19
20
21
22

23
24
25
26






27
28
29
30
31
32
33
...
120
121
122
123
124
125
126
127



128






























































;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(module iuputils
    (

     tree-find-node
     tree-node->path
     tree-add-node
     tree-delete-node






     )

(import scheme chicken srfi-13 data-structures)

(use format)
(use (prefix iup iup:))

................................................................................
	  (loop (+ currnode 1)
		newpath)))))

(define (tree-delete-node obj top node-path) ;; node-path is a list of strings
  (let ((id  (tree-find-node obj (cons top node-path))))
    (print "Found node to remove " id " for path " top " " node-path)
    (iup:attribute-set! obj (conc "DELNODE" id) "SELECTED")))
	



)





































































>




>
>
>
>
>
>







 







|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(module iuputils
    (
     ;; tree stuff
     tree-find-node
     tree-node->path
     tree-add-node
     tree-delete-node

     ;; megatest color stuff
     get-color-for-state-status
     get-color-spec
     colors-similar?
     colors
     )

(import scheme chicken srfi-13 data-structures)

(use format)
(use (prefix iup iup:))

................................................................................
	  (loop (+ currnode 1)
		newpath)))))

(define (tree-delete-node obj top node-path) ;; node-path is a list of strings
  (let ((id  (tree-find-node obj (cons top node-path))))
    (print "Found node to remove " id " for path " top " " node-path)
    (iup:attribute-set! obj (conc "DELNODE" id) "SELECTED")))

;;======================================================================
;;  M E G A T E S T   S T U F F
;;======================================================================

(define (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))))

(define colors
  '((PASS . "70 249 73")
    (FAIL . "253 33 49")
    (SKIP . "230 230 0")))

(define (get-color-spec effective-state)
  (or (alist-ref effective-state colors)
      (alist-ref 'FAIL colors)))

;; BBnote - state status dashboard button color / text defined here
(define (get-color-for-state-status state status);; #!key (get-label #f))
  ;; ((if get-label cadr car)
  (case (string->symbol state)
    ((COMPLETED) ;; ARCHIVED)
     (case (string->symbol status)
       ((PASS)                        (list "70  249 73" status))
       ((PREQ_FAIL PREQ_DISCARDED)    (list "255 127 127" status))
       ((WARN WAIVED)                 (list "255 172 13" status))
       ((SKIP)                        (list (get-color-spec 'SKIP) status))
       ((ABORT)                       (list "198 36 166" status))
       (else                          (list "253 33 49" status))))
    ((ARCHIVED)
     (case (string->symbol status)
       ((PASS)                         (list "70  170 73" status))
       ((WARN WAIVED)                  (list "200 130 13" status))
       ((SKIP)                         (list (get-color-spec 'SKIP) status))
       (else                           (list "180 33 49" status))))
    ;;      (if (equal? status "PASS")
    ;;	  '("70 249 73" "PASS")
    ;;	  (if (or (equal? status "WARN")
    ;;		  (equal? status "WAIVED"))
    ;;	      (list "255 172 13" status)
    ;;	      (list "223 33 49"  status)))) ;; greenish orangeish redish
    ((LAUNCHED)                              (list "101 123 142"  state))
    ((CHECK)                                 (list "255 100 50"   state))
    ((REMOTEHOSTSTART)                       (list "50 130 195"   state))
    ((RUNNING STARTED)                       (list "9 131 232"    state))
    ((KILLREQ)                               (list "39 82 206"    state))
    ((KILLED)                                (list "234 101 17"   state))
    ((NOT_STARTED)      (case (string->symbol status)
			  ((CHECK STARTED)   (list (get-color-spec 'SKIP) state))
			  (else              (list "240 240 240"                 state))))
    ;; for xor mode below
    ;;
    ((CLEAN)
     (case (string->symbol status)
       ((CLEAN-FAIL CLEAN-CHECK CLEAN-ABORT) (list "200 130 13" status)) ;; orange requested for these
       (else                                 (list "60  235 63" status))))
    ((DIRTY-BETTER)                          (list "160  255 153" status))
    ((DIRTY-WORSE)                           (list "165 42  42" status))
    ((BOTH-BAD)                              (list "180 33 49" status))
    (else                                    (list "192 192 192"  state))))



)