Overview
| Comment: | Oops, dropped new file |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | dev |
| Files: | files | file ages | folders |
| SHA1: |
79e9017edb6165d63bc23c52b719668e |
| 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
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
;; )
))))
|