29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
(declare (uses tasks))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(define (control-panel db keys)
(let* ((var-params (make-hash-table)) ;; register all the widgets here for querying on run, rollup, remove?
(key-params (make-hash-table))
(monitordat '()) ;; list of monitor records
(keyentries (iup:frame
#:title "Keys"
(apply
iup:vbox
|
|
|
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
(declare (uses tasks))
(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(define (control-panel db tdb keys)
(let* ((var-params (make-hash-table)) ;; register all the widgets here for querying on run, rollup, remove?
(key-params (make-hash-table))
(monitordat '()) ;; list of monitor records
(keyentries (iup:frame
#:title "Keys"
(apply
iup:vbox
|
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
(iup:hbox
(iup:frame
#:title "Runs"
(iup:hbox
(iup:button "Start"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(tasks:add-from-params db "run" keys key-params var-params)
(print "Launch Run")))
(iup:button "Remove"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(print "Remove Run")))))
(iup:frame
#:title "Misc"
(iup:hbox
(iup:button "Quit"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(sqlite3:finalize! db)
(exit))))))))
(monitors (iup:textbox
#:expand "YES" ; HORIZONTAL"
; #:size "x40"
#:multiline "YES"
#:font "Courier New, -10"
#:value "None..............................................."))
(actions (iup:textbox
#:expand "YES"
#:multiline "YES"
#:font "Courier New, -10"
#:value "None..............................................."))
(lastmodtime 0)
(next-touch 0) ;; the last time the "last_update" field was updated
(refreshdat (lambda ()
(let ((modtime (file-modification-time (conc *toppath* "/megatest.db")))
(megatestdbpath (conc *toppath* "/megatest.db")))
;; do stuff here when the db is updated by some other process
(if (> modtime lastmodtime)
(let ((tlst (tasks:get-tasks db '() '()))
(mlst (tasks:get-monitors db)))
(set! tasksdat tlst)
(set! monitorsdat mlst)
(iup:attribute-set! monitors "VALUE" (tasks:monitors->text-table mlst))
(iup:attribute-set! actions "VALUE" (tasks:tasks->text tlst))
(tasks:process-queue db megatestdbpath)
(set! lastmodtime modtime)
(tasks:reset-stuck-tasks db)))
;; stuff to do every 10 seconds
(if (> (current-seconds) next-touch)
(begin
;; (tasks:process-queue db megatestdbpath)
;; (tasks:monitors-update db)
(tasks:reset-stuck-tasks db)
(set! monitorsdat (tasks:get-monitors db))
(set! next-touch (+ (current-seconds) 10))
)))))
(topdialog #f))
(set! topdialog (iup:dialog
#:close_cb (lambda (a)(exit))
#:title "Run Controls"
(iup:vbox
|
|
>
|
|
>
>
|
|
|
|
>
|
|
|
|
|
|
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
(iup:hbox
(iup:frame
#:title "Runs"
(iup:hbox
(iup:button "Start"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(tasks:add-from-params tdb "run" keys key-params var-params)
(print "Launch Run")))
(iup:button "Remove"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(print "Remove Run")))))
(iup:frame
#:title "Misc"
(iup:hbox
(iup:button "Quit"
#:expand "HORIZONTAL"
#:action (lambda (obj)
(sqlite3:finalize! db)
(sqlite3:finalize! tdb)
(exit))))))))
(monitors (iup:textbox
#:expand "YES" ; HORIZONTAL"
; #:size "x40"
#:multiline "YES"
#:font "Courier New, -10"
#:value "None..............................................."))
(actions (iup:textbox
#:expand "YES"
#:multiline "YES"
#:font "Courier New, -10"
#:value "None..............................................."))
(lastmodtime 0)
(next-touch 0) ;; the last time the "last_update" field was updated
(refreshdat (lambda ()
(let* ((monitordbpath (conc *toppath* "/monitor.db"))
(megatestdbpath (conc *toppath* "/megatest.db"))
(modtime (max (file-modification-time megatestdbpath)
(file-modification-time monitordbpath))))
;; do stuff here when the db is updated by some other process
(if (> modtime lastmodtime)
(let ((tlst (tasks:get-tasks tdb '() '()))
(mlst (tasks:get-monitors tdb)))
(set! tasksdat tlst)
(set! monitorsdat mlst)
(iup:attribute-set! monitors "VALUE" (tasks:monitors->text-table mlst))
(iup:attribute-set! actions "VALUE" (tasks:tasks->text tlst))
(tasks:process-queue db tdb)
(set! lastmodtime (max (file-modification-time megatestdbpath)
(file-modification-time monitordbpath)))
(tasks:reset-stuck-tasks tdb)))
;; stuff to do every 10 seconds
(if (> (current-seconds) next-touch)
(begin
;; (tasks:process-queue db tdb monitordbpath)
(tasks:monitors-update tdb)
(tasks:reset-stuck-tasks tdb)
(set! monitorsdat (tasks:get-monitors tdb))
(set! next-touch (+ (current-seconds) 10))
)))))
(topdialog #f))
(set! topdialog (iup:dialog
#:close_cb (lambda (a)(exit))
#:title "Run Controls"
(iup:vbox
|
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
(iup:attribute-set! tabtop "TABTITLE0" "Setup")
(iup:attribute-set! tabtop "TABTITLE1" "Collateral")
(iup:attribute-set! tabtop "TABTITLE2" "Fossil")
(iup:attribute-set! tabtop "TABTITLE3" "Tools")
tabtop))))
(on-exit (lambda ()
(let ((db (open-db)))
(print "On-exit called")
(tasks:remove-monitor-record db)
(sqlite3:finalize! db))))
(define (gui-monitor db)
(let ((keys (get-keys db)))
(tasks:register-monitor db) ;;; let the other monitors know we are here
(control-panel db keys)
;(tasks:remove-monitor-record db)
;(sqlite3:finalize! db)
))
|
|
|
|
|
>
|
|
|
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
(iup:attribute-set! tabtop "TABTITLE0" "Setup")
(iup:attribute-set! tabtop "TABTITLE1" "Collateral")
(iup:attribute-set! tabtop "TABTITLE2" "Fossil")
(iup:attribute-set! tabtop "TABTITLE3" "Tools")
tabtop))))
(on-exit (lambda ()
(let ((tdb (tasks:open-db)))
(print "On-exit called")
(tasks:remove-monitor-record tdb)
(sqlite3:finalize! tdb))))
(define (gui-monitor db)
(let ((keys (get-keys db))
(tdb (tasks:open-db)))
(tasks:register-monitor db tdb) ;;; let the other monitors know we are here
(control-panel db tdb keys)
;(tasks:remove-monitor-record db)
;(sqlite3:finalize! db)
))
|