161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
(define-record data
cfgdat ;; data from ~/.megatest/<group>.dat
areas ;; hash of areaname -> area-rec
current-window-id ;;
current-tab-id ;;
update-needed ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately
tabs ;; hash of tab-id -> areaname (??) should be of type "tab"
)
;; all the components of an area display, all fits into a tab but
;; parts may be swapped in/out as needed
;;
(define-record tab
tree
|
>
|
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
(define-record data
cfgdat ;; data from ~/.megatest/<group>.dat
areas ;; hash of areaname -> area-rec
current-window-id ;;
current-tab-id ;;
update-needed ;; flag to indicate that the tab pointed to by current tab id needs refreshing immediately
tabs ;; hash of tab-id -> areaname (??) should be of type "tab"
groupn ;;
)
;; all the components of an area display, all fits into a tab but
;; parts may be swapped in/out as needed
;;
(define-record tab
tree
|
515
516
517
518
519
520
521
522
523
524
525
526
527
528
|
;; (dboard:clear-matrix current-matrix used-cols used-rows touched) ;; clear all
;;======================================================================
;; D A S H B O A R D
;;======================================================================
(define (dashboard:area-panel aname data window-id)
(let* ((apath (configf:lookup (data-cfgdat data) aname "path")) ;; (hash-table-ref (dboard:data-cfgdat data) area-name))
;; (hash-table-ref (dboard:data-cfgdat data) aname))
(area-dat (dashboard:init-area data aname apath))
(tb (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
(ad (dashboard:main-matrix data area-dat window-id))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
|
;; (dboard:clear-matrix current-matrix used-cols used-rows touched) ;; clear all
;;======================================================================
;; D A S H B O A R D
;;======================================================================
;; The main menu
(define (dcommon:main-menu data)
(iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
(iup:menu-item "Files" (iup:menu ;; Note that you can use either #:action or action: for options
(iup:menu-item "Open" action: (lambda (obj)
(let* ((area-name (iup:textbox #:expand "HORIZONTAL"))
(fd (iup:file-dialog #:dialogtype "DIR"))
(top (iup:show fd #:modal? "YES")))
(iup:attribute-set! source-tb "VALUE"
(iup:attribute fd "VALUE"))
(iup:destroy! fd))))
(iup:menu-item "Open area" action: (lambda (obj)
(let* ((area-name (iup:textbox #:expand "HORIZONTAL"))
(fd (iup:file-dialog #:dialogtype "DIR"))
(top (iup:show fd #:modal? "YES"))
;;(source-tb (iup:textbox #:expand "HORIZONTAL"))
(cfgdat (data-cfgdat data))
(fname (conc (getenv "HOME") "/.megatest/" (data-groupn data) ".dat"))
)
;;(iup:attribute-set! source-tb "VALUE"
;; (iup:attribute fd "VALUE"))
(configf:set-section-var cfgdat "lvqa" "path" (iup:attribute fd "VALUE"))
(configf:write-alist cfgdat fname)
(iup:destroy! fd))))
(iup:menu-item "Save" #:action (lambda (obj)(print "File->save " obj)))
(iup:menu-item "Exit" #:action (lambda (obj)(exit)))))
(iup:menu-item "Tools" (iup:menu
(iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah")))
;; (iup:menu-item "Show dialog" #:action (lambda (obj)
;; (show message-window
;; #:modal? #t
;; ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current
;; ;; #:x 'mouse
;; ;; #:y 'mouse
;; )
))))
(define (dashboard:area-panel aname data window-id)
(let* ((apath (configf:lookup (data-cfgdat data) aname "path")) ;; (hash-table-ref (dboard:data-cfgdat data) area-name))
;; (hash-table-ref (dboard:data-cfgdat data) aname))
(area-dat (dashboard:init-area data aname apath))
(tb (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data)
(ad (dashboard:main-matrix data area-dat window-id))
|
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
|
;; Main Panel
;;
(define (dashboard:main-panel data window-id)
(iup:dialog
#:title "Megatest Control Panel"
;; #:menu (dcommon:main-menu data)
|
|
|
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
|
;; Main Panel
;;
(define (dashboard:main-panel data window-id)
(iup:dialog
#:title "Megatest Control Panel"
#:menu (dcommon:main-menu data)
#:shrink "YES"
(iup:vbox
(let* ((area-names (hash-table-keys (data-cfgdat data)))
(area-panels (map (lambda (aname)
(dashboard:area-panel aname data window-id))
area-names))
(tabtop (apply iup:tabs
|
769
770
771
772
773
774
775
776
777
778
779
780
781
782
|
(data (make-data
cfgdat ;; this is the data from ~/.megatest for the selected group
(make-hash-table) ;; areaname -> area-rec
0 ;; current window id
0 ;; current tab id
#f ;; redraw needed for current tab id
(make-hash-table) ;; tab-id -> areaname
)))
(hash-table-set! *windows* window-id data)
(iup:show (dashboard:main-panel data window-id))
(iup:main-loop)))
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
|
>
|
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
|
(data (make-data
cfgdat ;; this is the data from ~/.megatest for the selected group
(make-hash-table) ;; areaname -> area-rec
0 ;; current window id
0 ;; current tab id
#f ;; redraw needed for current tab id
(make-hash-table) ;; tab-id -> areaname
groupn
)))
(hash-table-set! *windows* window-id data)
(iup:show (dashboard:main-panel data window-id))
(iup:main-loop)))
;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
|