Megatest

Check-in [79e9017edb]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Oops, dropped new file
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: 79e9017edb6165d63bc23c52b719668eec763ccb
User & Date: mrwellan on 2013-07-02 00:35:13
Other Links: branch diff | manifest | tags
Context
2013-07-02
11:00
Improved info page layout check-in: c9f0aef620 user: mrwellan tags: dev
00:35
Oops, dropped new file check-in: 79e9017edb user: mrwellan tags: dev
00:31
Added summary tab, functional but not polished check-in: 285cbc7663 user: mrwellan tags: dev
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added dcommon.scm version [7faf98a5d2]. 





























































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
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
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
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

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)

(declare (unit dcommon))

(declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
(declare (uses synchash))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")

;;======================================================================
;; D A T A   T A B L E S
;;======================================================================

;; Table of keys
(define (dcommon:keys-matrix rawconfig)
  (let* ((curr-row-num 1)
	 (key-vals     (configf:section-vars rawconfig "fields"))
	 (keys-matrix  (iup:matrix
			#:alignment1 "ALEFT"
			#:expand "HORIZONTAL" ;; "VERTICAL"
			;; #:scrollbar "YES"
			#:numcol 1
			#:numlin (length key-vals)
			#:numcol-visible 1
			#:numlin-visible 5
			#:click-cb (lambda (obj lin col status)
				     (print "obj: " obj " lin: " lin " col: " col " status: " status)))))
    (iup:attribute-set! keys-matrix "0:0" "Run Keys")
    (iup:attribute-set! keys-matrix "0:1" "Key Name")
    (iup:attribute-set! keys-matrix "WIDTH1" "100")
    ;; fill in keys
    (for-each 
     (lambda (var)
       ;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
       (iup:attribute-set! keys-matrix (conc curr-row-num ":0") curr-row-num)
       (iup:attribute-set! keys-matrix (conc curr-row-num ":1") var)
       (set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
     key-vals)
    keys-matrix))

;; Section to table
(define (dcommon:section-matrix rawconfig sectionname varcolname valcolname #!key (title #f))
  (let* ((curr-row-num    1)
	 (key-vals        (configf:section-vars rawconfig sectionname))
	 (section-matrix  (iup:matrix
			   #:alignment1 "ALEFT"
			   #:expand "HORIZONTAL" ;; "YES"
			   #:numcol 1
			   #:numlin (length key-vals)
			   #:numcol-visible 1
			   #:numlin-visible 5
			   #:scrollbar "YES")))
    (iup:attribute-set! section-matrix "0:0" varcolname)
    (iup:attribute-set! section-matrix "0:1" valcolname)
    (iup:attribute-set! section-matrix "WIDTH1" "300")
    ;; fill in keys
    (for-each 
     (lambda (var)
       ;; (iup:attribute-set! keys-matrix "ADDLIN" (conc curr-row-num))
       (iup:attribute-set! section-matrix (conc curr-row-num ":0") var)
       (iup:attribute-set! section-matrix (conc curr-row-num ":1") (configf:lookup rawconfig sectionname var))
       (set! curr-row-num (+ 1 curr-row-num))) ;; (config-lookup *configdat* "fields" var)))
     key-vals)
    (iup:vbox
     (iup:label (if title title (conc "Settings from [" sectionname "]"))  
		#:size   "5x"
		#:expand "HORIZONTAL")
     section-matrix)))
    
;; General data
;;
(define (dcommon:general-info)
  (let ((general-matrix (iup:matrix
			 #:alignment1 "ALEFT"
			 #:expand "HORIZONTAL" ;; "YES"
			 #:numcol 1
			 #:numlin 3
			 #:numcol-visible 1
			 #:numlin-visible 3)))
    (iup:attribute-set! general-matrix "WIDTH1" "300")
    (iup:attribute-set! general-matrix "0:1" "About this Megatest area") 
    ;; User (this is not always obvious - it is common to run as a different user
    (iup:attribute-set! general-matrix "1:0" "User")
    (iup:attribute-set! general-matrix "1:1" (current-user-name))
    ;; Megatest area
    (iup:attribute-set! general-matrix "2:0" "Megatest area")
    (iup:attribute-set! general-matrix "2:1" *toppath*)
    ;; Megatest version
    (iup:attribute-set! general-matrix "3:0" "Megatest version")
    (iup:attribute-set! general-matrix "3:1" megatest-version)
    general-matrix))

(define (dcommon:run-stats)
  (let* ((run-stats    (mt:get-run-stats))
	 (indices      (common:sparse-list-generate-index run-stats)) ;;  proc: set-cell))
	 (max-row      (apply max (map cadr (car indices))))
	 (max-col      (apply max (map cadr (cadr indices))))
	 (stats-matrix (iup:matrix
			#:alignment1 "ALEFT"
			#:expand "HORIZONTAL"
			#:numcol max-col 
			#:numlin (if (< max-row 20) 20 max-row) ;; min of 20
			#:numcol-visible max-col
			#:numlin-visible (if (> max-row 20) 20 max-row)))
	 (numrows      1)
	 (numcols      1)
	 (set-cell     (lambda (rnum cnum rname cname v) ;; rownum colnum value
			 (print "proc called: " rnum " " cnum " " rname " " cname " " v)
			 (if (> rnum numrows)
			     (begin 
			       ;; add rows numrows to r
			       (debug:print 0 "Extending matrix from " numrows " to " rnum)
			       (iup:attribute-set! stats-matrix  "ADDLIN" (conc numrows "-" (- rnum numrows)))
			       (set! numrows rnum)))
			 (if (> cnum numcols)
			     (begin 
			       ;; add rows numrows to r
			       (debug:print 0 "Extending matrix from " numcols " to " cnum)
			       (iup:attribute-set! stats-matrix  "ADDLIN" (conc numcols "-" (- rnum numcols)))
			       (set! numcols cnum)))
			 (debug:print 0 "Setting row " rnum ", col " cnum " to " v)
			 (iup:attribute-set! stats-matrix (conc rnum ":" cnum) v)))
	 (row-indices  (car indices))
	 (col-indices  (cadr indices)))
    ;; Row labels
    (for-each (lambda (ind)
		(let ((name (car ind))
		      (num  (cadr ind)))
		  (iup:attribute-set! stats-matrix (conc num ":0") name)))
	      row-indices)
    ;; Col labels
    (for-each (lambda (ind)
		(let ((name (car ind))
		      (num  (cadr ind)))
		  (iup:attribute-set! stats-matrix (conc "0:" num) name)))
	      col-indices)
    ;; Cell contents
    (for-each (lambda (entry)
		(let* ((row-name (car entry))
		       (col-name (cadr entry))
		       (value    (caddr entry))
		       (row-num  (cadr (assoc row-name row-indices)))
		       (col-num  (cadr (assoc col-name col-indices))))
		  (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value)))
	      run-stats)
    (iup:vbox
     (iup:label "Run statistics" #:expand "HORIZONTAL")
     stats-matrix)))

;; The main menu
(define (dcommon:main-menu)
  (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)
							(iup:show (iup:file-dialog))
							(print "File->open " obj)))
		       (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
		       ;;  )					     
		       ))))














This page was generated in about
0.114s by
Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00