Artifact
bf05c399dd006e903d88d9f9b21b4b72e04d1267:
0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 72 65 71 ==========..(req
01e0: 75 69 72 65 2d 6c 69 62 72 61 72 79 20 69 75 70 uire-library iup
01f0: 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 ).(import (prefi
0200: 78 20 69 75 70 20 69 75 70 3a 29 29 0a 28 75 73 x iup iup:)).(us
0210: 65 20 63 61 6e 76 61 73 2d 64 72 61 77 29 0a 0a e canvas-draw)..
0220: 28 75 73 65 20 73 72 66 69 2d 31 20 72 65 67 65 (use srfi-1 rege
0230: 78 20 72 65 67 65 78 2d 63 61 73 65 20 73 72 66 x regex-case srf
0240: 69 2d 36 39 29 0a 28 64 65 63 6c 61 72 65 20 28 i-69).(declare (
0250: 75 6e 69 74 20 67 75 74 69 6c 73 29 29 0a 0a 28 unit gutils))..(
0260: 64 65 66 69 6e 65 20 28 67 75 74 69 6c 73 3a 63 define (gutils:c
0270: 6f 6c 6f 72 73 2d 73 69 6d 69 6c 61 72 3f 20 63 olors-similar? c
0280: 6f 6c 6f 72 31 20 63 6f 6c 6f 72 32 29 0a 20 20 olor1 color2).
0290: 28 6c 65 74 2a 20 28 28 63 31 20 28 6d 61 70 20 (let* ((c1 (map
02a0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
02b0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f 6c string-split col
02c0: 6f 72 31 29 29 29 0a 09 20 28 63 32 20 28 6d 61 or1))).. (c2 (ma
02d0: 70 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 p string->number
02e0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 (string-split c
02f0: 6f 6c 6f 72 32 29 29 29 0a 09 20 28 64 65 6c 74 olor2))).. (delt
0300: 61 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 a (map (lambda (
0310: 61 20 62 29 28 61 62 73 20 28 2d 20 61 20 62 29 a b)(abs (- a b)
0320: 29 29 20 63 31 20 63 32 29 29 29 0a 20 20 20 20 )) c1 c2))).
0330: 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 (null? (filter (
0340: 6c 61 6d 62 64 61 20 28 78 29 28 3e 20 78 20 33 lambda (x)(> x 3
0350: 29 29 20 64 65 6c 74 61 29 29 29 29 0a 0a 28 64 )) delta))))..(d
0360: 65 66 69 6e 65 20 67 75 74 69 6c 73 3a 63 6f 6c efine gutils:col
0370: 6f 72 73 0a 20 20 27 28 28 50 41 53 53 20 2e 20 ors. '((PASS .
0380: 22 37 30 20 32 34 39 20 37 33 22 29 0a 20 20 20 "70 249 73").
0390: 20 28 46 41 49 4c 20 2e 20 22 32 35 33 20 33 33 (FAIL . "253 33
03a0: 20 34 39 22 29 0a 20 20 20 20 28 53 4b 49 50 20 49"). (SKIP
03b0: 2e 20 22 32 33 30 20 32 33 30 20 30 22 29 29 29 . "230 230 0")))
03c0: 0a 0a 28 64 65 66 69 6e 65 20 28 67 75 74 69 6c ..(define (gutil
03d0: 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d 73 70 65 63 s:get-color-spec
03e0: 20 65 66 66 65 63 74 69 76 65 2d 73 74 61 74 65 effective-state
03f0: 29 0a 20 20 28 6f 72 20 28 61 6c 69 73 74 2d 72 ). (or (alist-r
0400: 65 66 20 65 66 66 65 63 74 69 76 65 2d 73 74 61 ef effective-sta
0410: 74 65 20 67 75 74 69 6c 73 3a 63 6f 6c 6f 72 73 te gutils:colors
0420: 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d 72 ). (alist-r
0430: 65 66 20 27 46 41 49 4c 20 67 75 74 69 6c 73 3a ef 'FAIL gutils:
0440: 63 6f 6c 6f 72 73 29 29 29 0a 0a 3b 3b 20 42 42 colors)))..;; BB
0450: 6e 6f 74 65 20 2d 20 73 74 61 74 65 20 73 74 61 note - state sta
0460: 74 75 73 20 64 61 73 68 62 6f 61 72 64 20 62 75 tus dashboard bu
0470: 74 74 6f 6e 20 63 6f 6c 6f 72 20 2f 20 74 65 78 tton color / tex
0480: 74 20 64 65 66 69 6e 65 64 20 68 65 72 65 0a 28 t defined here.(
0490: 64 65 66 69 6e 65 20 28 67 75 74 69 6c 73 3a 67 define (gutils:g
04a0: 65 74 2d 63 6f 6c 6f 72 2d 66 6f 72 2d 73 74 61 et-color-for-sta
04b0: 74 65 2d 73 74 61 74 75 73 20 73 74 61 74 65 20 te-status state
04c0: 73 74 61 74 75 73 29 3b 3b 20 23 21 6b 65 79 20 status);; #!key
04d0: 28 67 65 74 2d 6c 61 62 65 6c 20 23 66 29 29 0a (get-label #f)).
04e0: 20 20 3b 3b 20 28 28 69 66 20 67 65 74 2d 6c 61 ;; ((if get-la
04f0: 62 65 6c 20 63 61 64 72 20 63 61 72 29 0a 20 20 bel cadr car).
0500: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
0510: 79 6d 62 6f 6c 20 73 74 61 74 65 29 0a 20 20 20 ymbol state).
0520: 20 28 28 43 4f 4d 50 4c 45 54 45 44 29 20 3b 3b ((COMPLETED) ;;
0530: 20 41 52 43 48 49 56 45 44 29 0a 20 20 20 20 20 ARCHIVED).
0540: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
0550: 79 6d 62 6f 6c 20 73 74 61 74 75 73 29 0a 20 20 ymbol status).
0560: 20 20 20 20 20 28 28 50 41 53 53 29 20 20 20 20 ((PASS)
0570: 20 20 20 20 28 6c 69 73 74 20 22 37 30 20 20 32 (list "70 2
0580: 34 39 20 37 33 22 20 73 74 61 74 75 73 29 29 0a 49 73" status)).
0590: 20 20 20 20 20 20 20 28 28 50 52 45 51 5f 46 41 ((PREQ_FA
05a0: 49 4c 20 50 52 45 51 5f 44 49 53 43 41 52 44 45 IL PREQ_DISCARDE
05b0: 44 29 20 28 6c 69 73 74 20 22 32 35 35 20 31 32 D) (list "255 12
05c0: 37 20 31 32 37 22 20 73 74 61 74 75 73 29 29 0a 7 127" status)).
05d0: 20 20 20 20 20 20 20 28 28 57 41 52 4e 20 57 41 ((WARN WA
05e0: 49 56 45 44 29 20 28 6c 69 73 74 20 22 32 35 35 IVED) (list "255
05f0: 20 31 37 32 20 31 33 22 20 73 74 61 74 75 73 29 172 13" status)
0600: 29 0a 20 20 20 20 20 20 20 28 28 53 4b 49 50 29 ). ((SKIP)
0610: 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 28 67 (list (g
0620: 75 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d utils:get-color-
0630: 73 70 65 63 20 27 53 4b 49 50 29 20 73 74 61 74 spec 'SKIP) stat
0640: 75 73 29 29 0a 20 20 20 20 20 20 20 28 28 41 42 us)). ((AB
0650: 4f 52 54 29 20 20 20 20 20 20 20 28 6c 69 73 74 ORT) (list
0660: 20 22 31 39 38 20 33 36 20 31 36 36 22 20 73 74 "198 36 166" st
0670: 61 74 75 73 29 29 0a 20 20 20 20 20 20 20 28 65 atus)). (e
0680: 6c 73 65 20 28 6c 69 73 74 20 22 32 35 33 20 33 lse (list "253 3
0690: 33 20 34 39 22 20 73 74 61 74 75 73 29 29 29 29 3 49" status))))
06a0: 0a 20 20 20 20 28 28 41 52 43 48 49 56 45 44 29 . ((ARCHIVED)
06b0: 0a 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 . (case (str
06c0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 74 61 74 ing->symbol stat
06d0: 75 73 29 0a 20 20 20 20 20 20 20 28 28 50 41 53 us). ((PAS
06e0: 53 29 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 S) (list
06f0: 22 37 30 20 20 31 37 30 20 37 33 22 20 73 74 61 "70 170 73" sta
0700: 74 75 73 29 29 0a 20 20 20 20 20 20 20 28 28 57 tus)). ((W
0710: 41 52 4e 20 57 41 49 56 45 44 29 20 28 6c 69 73 ARN WAIVED) (lis
0720: 74 20 22 32 30 30 20 31 33 30 20 31 33 22 20 73 t "200 130 13" s
0730: 74 61 74 75 73 29 29 0a 20 20 20 20 20 20 20 28 tatus)). (
0740: 28 53 4b 49 50 29 20 20 20 20 20 20 20 20 28 6c (SKIP) (l
0750: 69 73 74 20 28 67 75 74 69 6c 73 3a 67 65 74 2d ist (gutils:get-
0760: 63 6f 6c 6f 72 2d 73 70 65 63 20 27 53 4b 49 50 color-spec 'SKIP
0770: 29 20 73 74 61 74 75 73 29 29 0a 20 20 20 20 20 ) status)).
0780: 20 20 28 65 6c 73 65 20 28 6c 69 73 74 20 22 31 (else (list "1
0790: 38 30 20 33 33 20 34 39 22 20 73 74 61 74 75 73 80 33 49" status
07a0: 29 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 )))). ;;
07b0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 (if (equal? sta
07c0: 74 75 73 20 22 50 41 53 53 22 29 0a 20 20 20 20 tus "PASS").
07d0: 3b 3b 09 20 20 27 28 22 37 30 20 32 34 39 20 37 ;;. '("70 249 7
07e0: 33 22 20 22 50 41 53 53 22 29 0a 20 20 20 20 3b 3" "PASS"). ;
07f0: 3b 09 20 20 28 69 66 20 28 6f 72 20 28 65 71 75 ;. (if (or (equ
0800: 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 52 4e al? status "WARN
0810: 22 29 0a 20 20 20 20 3b 3b 09 09 20 20 28 65 71 "). ;;.. (eq
0820: 75 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 49 ual? status "WAI
0830: 56 45 44 22 29 29 0a 20 20 20 20 3b 3b 09 20 20 VED")). ;;.
0840: 20 20 20 20 28 6c 69 73 74 20 22 32 35 35 20 31 (list "255 1
0850: 37 32 20 31 33 22 20 73 74 61 74 75 73 29 0a 20 72 13" status).
0860: 20 20 20 3b 3b 09 20 20 20 20 20 20 28 6c 69 73 ;;. (lis
0870: 74 20 22 32 32 33 20 33 33 20 34 39 22 20 20 73 t "223 33 49" s
0880: 74 61 74 75 73 29 29 29 29 20 3b 3b 20 67 72 65 tatus)))) ;; gre
0890: 65 6e 69 73 68 20 6f 72 61 6e 67 65 69 73 68 20 enish orangeish
08a0: 72 65 64 69 73 68 0a 20 20 20 20 28 28 4c 41 55 redish. ((LAU
08b0: 4e 43 48 45 44 29 20 20 20 20 20 20 20 20 20 28 NCHED) (
08c0: 6c 69 73 74 20 22 31 30 31 20 31 32 33 20 31 34 list "101 123 14
08d0: 32 22 20 20 73 74 61 74 65 29 29 0a 20 20 20 20 2" state)).
08e0: 28 28 43 48 45 43 4b 29 20 20 20 20 20 20 20 20 ((CHECK)
08f0: 20 20 20 20 28 6c 69 73 74 20 22 32 35 35 20 31 (list "255 1
0900: 30 30 20 35 30 22 20 20 20 73 74 61 74 65 29 29 00 50" state))
0910: 0a 20 20 20 20 28 28 52 45 4d 4f 54 45 48 4f 53 . ((REMOTEHOS
0920: 54 53 54 41 52 54 29 20 20 28 6c 69 73 74 20 22 TSTART) (list "
0930: 35 30 20 31 33 30 20 31 39 35 22 20 20 20 73 74 50 130 195" st
0940: 61 74 65 29 29 0a 20 20 20 20 28 28 52 55 4e 4e ate)). ((RUNN
0950: 49 4e 47 20 53 54 41 52 54 45 44 29 20 20 20 20 ING STARTED)
0960: 20 20 20 20 20 20 28 6c 69 73 74 20 22 39 20 31 (list "9 1
0970: 33 31 20 32 33 32 22 20 20 20 20 73 74 61 74 65 31 232" state
0980: 29 29 0a 20 20 20 20 28 28 4b 49 4c 4c 52 45 51 )). ((KILLREQ
0990: 29 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 ) (list
09a0: 20 22 33 39 20 38 32 20 32 30 36 22 20 20 20 20 "39 82 206"
09b0: 73 74 61 74 65 29 29 0a 20 20 20 20 28 28 4b 49 state)). ((KI
09c0: 4c 4c 45 44 29 20 20 20 20 20 20 20 20 20 20 20 LLED)
09d0: 28 6c 69 73 74 20 22 32 33 34 20 31 30 31 20 31 (list "234 101 1
09e0: 37 22 20 20 20 73 74 61 74 65 29 29 0a 20 20 20 7" state)).
09f0: 20 28 28 4e 4f 54 5f 53 54 41 52 54 45 44 29 20 ((NOT_STARTED)
0a00: 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 (case (stri
0a10: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 74 61 74 75 ng->symbol statu
0a20: 73 29 0a 09 09 09 20 20 28 28 43 48 45 43 4b 20 s).... ((CHECK
0a30: 53 54 41 52 54 45 44 29 28 6c 69 73 74 20 28 67 STARTED)(list (g
0a40: 75 74 69 6c 73 3a 67 65 74 2d 63 6f 6c 6f 72 2d utils:get-color-
0a50: 73 70 65 63 20 27 53 4b 49 50 29 20 73 74 61 74 spec 'SKIP) stat
0a60: 65 29 29 0a 09 09 09 20 20 28 65 6c 73 65 20 20 e)).... (else
0a70: 20 28 6c 69 73 74 20 22 32 34 30 20 32 34 30 20 (list "240 240
0a80: 32 34 30 22 20 20 20 20 20 20 20 20 20 20 20 20 240"
0a90: 20 20 20 20 20 73 74 61 74 65 29 29 29 29 0a 20 state)))).
0aa0: 20 20 20 3b 3b 20 66 6f 72 20 78 6f 72 20 6d 6f ;; for xor mo
0ab0: 64 65 20 62 65 6c 6f 77 0a 20 20 20 20 3b 3b 0a de below. ;;.
0ac0: 20 20 20 20 28 28 43 4c 45 41 4e 29 0a 20 20 20 ((CLEAN).
0ad0: 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
0ae0: 3e 73 79 6d 62 6f 6c 20 73 74 61 74 75 73 29 0a >symbol status).
0af0: 20 20 20 20 20 20 20 28 28 43 4c 45 41 4e 2d 46 ((CLEAN-F
0b00: 41 49 4c 20 43 4c 45 41 4e 2d 43 48 45 43 4b 20 AIL CLEAN-CHECK
0b10: 43 4c 45 41 4e 2d 41 42 4f 52 54 29 20 20 28 6c CLEAN-ABORT) (l
0b20: 69 73 74 20 22 32 30 30 20 31 33 30 20 31 33 22 ist "200 130 13"
0b30: 20 73 74 61 74 75 73 29 29 20 3b 3b 20 6f 72 61 status)) ;; ora
0b40: 6e 67 65 20 72 65 71 75 65 73 74 65 64 20 66 6f nge requested fo
0b50: 72 20 74 68 65 73 65 0a 20 20 20 20 20 20 20 28 r these. (
0b60: 65 6c 73 65 20 20 28 6c 69 73 74 20 22 36 30 20 else (list "60
0b70: 20 32 33 35 20 36 33 22 20 73 74 61 74 75 73 29 235 63" status)
0b80: 29 29 29 0a 20 20 20 20 28 28 44 49 52 54 59 2d ))). ((DIRTY-
0b90: 42 45 54 54 45 52 29 20 20 20 20 20 28 6c 69 73 BETTER) (lis
0ba0: 74 20 22 31 36 30 20 20 32 35 35 20 31 35 33 22 t "160 255 153"
0bb0: 20 73 74 61 74 75 73 29 29 0a 20 20 20 20 28 28 status)). ((
0bc0: 44 49 52 54 59 2d 57 4f 52 53 45 29 20 20 20 20 DIRTY-WORSE)
0bd0: 20 20 28 6c 69 73 74 20 22 31 36 35 20 34 32 20 (list "165 42
0be0: 20 34 32 22 20 73 74 61 74 75 73 29 29 0a 20 20 42" status)).
0bf0: 20 20 28 28 42 4f 54 48 2d 42 41 44 29 20 20 20 ((BOTH-BAD)
0c00: 20 20 20 20 20 20 28 6c 69 73 74 20 22 31 38 30 (list "180
0c10: 20 33 33 20 34 39 22 20 73 74 61 74 75 73 29 29 33 49" status))
0c20: 0a 0a 20 20 20 20 28 65 6c 73 65 20 20 20 20 20 .. (else
0c30: 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 (list
0c40: 22 31 39 32 20 31 39 32 20 31 39 32 22 20 20 73 "192 192 192" s
0c50: 74 61 74 65 29 29 29 29 0a 0a tate))))..