Overview
Context
Changes
Modified Makefile
from [9e38198024]
to [d81b5d1a03].
︙ | | |
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
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
|
-
+
+
-
+
-
+
|
cookie.scm mutils.scm mtargs.scm apimod.scm \
configfmod.scm commonmod.scm dbmod.scm rmtmod.scm \
debugprint.scm mtver.scm csv-xml.scm servermod.scm \
hostinfo.scm adjutant.scm processmod.scm testsmod.scm \
itemsmod.scm keysmod.scm mtmod.scm rmtmod.scm \
tasksmod.scm pgdb.scm launchmod.scm runsmod.scm \
portloggermod.scm archivemod.scm ezstepsmod.scm \
subrunmod.scm bigmod.scm testsmod.scm
subrunmod.scm bigmod.scm testsmod.scm vgmod.scm
GUISRCF = dashboard-context-menu.scm dashboard-tests.scm \
dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm \
dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm
vg.scm
OFILES = $(SRCFILES:%.scm=%.o)
GOFILES = $(GUISRCF:%.scm=%.o)
MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
# compiled import files
MOIMPFILES = $(MSRCFILES:%.scm=%.import.o)
%.import.o : %.import.scm
csc $(CSCOPTS) -unit $*.import -c $*.import.scm -o $*.import.o
mofiles/%.o : %.scm
|
︙ | | |
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
|
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
|
-
+
+
+
|
install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
$(HELPERS) $(PREFIX)/bin/nbfake \
$(PREFIX)/bin/serialize-env \
$(PREFIX)/bin/nbfind $(PREFIX)/bin/mtrunner $(PREFIX)/bin/mt_xterm \
$(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
$(PREFIX)/share/db/mt-pg.sql \
$(PREFIX)/share/js/jquery-3.1.0.slim.min.js
$(PREFIX)/share/js/jquery-3.1.0.slim.min.js \
$(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard \
$(PREFIX)/bin/serialize-env
$(PREFIX)/bin/.$(ARCHSTR) :
mkdir -p $(PREFIX)/bin/.$(ARCHSTR)
mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib
test: tests/tests.scm
cd tests;csi -I .. -b -n tests.scm
|
︙ | | |
Modified build-assist/ck5-eggs.list
from [c1fba7745a]
to [4ccb4f5090].
︙ | | |
18
19
20
21
22
23
24
25
26
27
28
29
30
31
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
+
|
postgresql
queues
regex
regex-case
rfc3339
s11n
sha1
simple-exceptions
slice
sparse-vectors
spiffy
spiffy-directory-listing
spiffy-request-vars
sql-de-lite
sqlite3
|
︙ | | |
Added build-assist/other-stuff version [e66fa17472].
|
1
2
|
+
+
|
cd megatest/dbi;chicken-install
|
|
Modified dashboard-context-menu.scm
from [48947370a7]
to [12ecddc7c4].
︙ | | |
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
|
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
|
-
+
-
-
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
+
+
+
+
+
+
+
+
+
-
+
|
;;======================================================================
;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================
(use format fmt)
(import format fmt)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw)
(import srfi-1
chicken.file.posix
(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))
regex regex-case srfi-69
(prefix sqlite3 sqlite3:))
(declare (unit dashboard-context-menu))
(declare (uses common))
(declare (uses db))
(declare (uses commonmod))
(declare (uses dbmod))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
(declare (uses rmtmod))
(declare (uses ezstepsmod))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
(declare (uses subrunmod))
(declare (uses debugprint))
(import commonmod
dbmod
rmtmod
ezstepsmod
subrunmod
debugprint
)
(include "common_records.scm")
;; (include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(define (dboard:launch-testpanel run-id test-id)
(let* ((dboardexe (common:find-local-megatest "dashboard"))
(cmd (conc dboardexe
" -test " run-id "," test-id
|
︙ | | |
Modified dashboard-guimonitor.scm
from [9920d4908c]
to [cc16a02e38].
︙ | | |
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
|
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
|
-
+
-
-
-
+
+
+
-
-
+
+
-
-
-
-
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
|
;;
;;======================================================================
;;======================================================================
;; Test info panel
;;======================================================================
(use format)
(import format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw)
(import
srfi-1
(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
chicken.file.posix regex regex-case srfi-69
(prefix sqlite3 sqlite3:))
(declare (unit dashboard-guimonitor))
(declare (uses common))
(declare (uses keys))
(declare (uses db))
(declare (uses tasks))
(declare (uses commonmod))
(declare (uses keysmod))
(declare (uses dbmod))
(declare (uses tasksmod))
(declare (uses debugprint))
(include "common_records.scm")
;; (include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(import
commonmod
keysmod
dbmod
tasksmod
debugprint
)
(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"
|
︙ | | |
Modified dashboard-tests.scm
from [4ccafc8c2c]
to [23e63d3822].
︙ | | |
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
|
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
|
-
+
-
-
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
+
-
+
+
+
+
+
+
+
+
+
+
|
;;======================================================================
;;======================================================================
;; Test info panel
;;======================================================================
(use format fmt)
(import format fmt)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw)
(import srfi-1
chicken.file.posix
(use srfi-1 posix regex regex-case srfi-69)
(use (prefix sqlite3 sqlite3:))
regex regex-case srfi-69
(prefix sqlite3 sqlite3:))
(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses db))
(declare (uses commonmod))
(declare (uses dbmod))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
(declare (uses rmtmod))
(declare (uses ezstepsmod))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
(declare (uses subrunmod))
(declare (uses debugprint))
(include "common_records.scm")
;; (include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(import
commonmod
dbmod
rmtmod
ezstepsmod
subrunmod
debugprint
)
;;======================================================================
;; C O M M O N
;;======================================================================
(define *dashboard-comment-share-slot* #f)
|
︙ | | |
Modified dashboard.scm
from [a0c2faaa50]
to [441252a2cc].
︙ | | |
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
|
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
|
-
+
+
+
-
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(use format)
(import format)
(declare (uses ducttape-lib))
(declare (uses bigmod))
(declare (uses debugprint))
(require-library iup)
(import (prefix iup iup:))
(import canvas-draw)
(import canvas-draw)
;; (import canvas-draw-iup)
(import ducttape-lib)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct
(import (prefix sqlite3 sqlite3:))
;; (import canvas-draw-iup)
(import ducttape-lib
bigmod)
(import (prefix sqlite3 sqlite3:)
srfi-1
chicken.file.posix
chicken.string
chicken.process-context
regex regex-case srfi-69
typed-records
sparse-vectors)
(declare (uses commonmod))
(declare (uses mtargs))
;; (declare (uses keys))
(declare (uses itemsmod))
(declare (uses configfmod))
(declare (uses dashboard-context-menu))
(declare (uses dashboard-guimonitor))
(declare (uses dashboard-tests))
(declare (uses dbmod))
(declare (uses configfmod))
(declare (uses process))
(declare (uses launch))
(declare (uses runs))
(declare (uses dashboard-tests))
(declare (uses dashboard-guimonitor))
(declare (uses tree))
(declare (uses dcommon))
(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
(declare (uses dcommon))
(declare (uses itemsmod))
(declare (uses launchmod))
(declare (uses mtmod))
(declare (uses mtargs))
(declare (uses mtver))
(declare (uses processmod))
(declare (uses runsmod))
(declare (uses subrunmod))
(declare (uses tree))
(declare (uses vgmod))
(declare (uses bigmod.import))
(declare (uses debugprint.import))
;; (declare (uses dashboard-main))
(declare (uses mt))
(declare (uses mtver))
(include "common_records.scm")
;; (include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")
(import commonmod
mtargs
itemsmod
dbmod
configfmod
)
(import
commonmod
configfmod
dbmod
debugprint
itemsmod
launchmod
(prefix mtargs args:)
mtmod
mtver
processmod
runsmod
subrunmod
vgmod
)
(define help (conc
"Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright (C) Matt Welland 2012-2017
Usage: dashboard [options]
|
︙ | | |
Modified dcommon.scm
from [f7b53bbe68]
to [bca8b5dbe9].
︙ | | |
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
|
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
|
-
-
+
+
-
-
+
+
-
+
-
+
-
+
-
+
+
+
+
+
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(use format)
(require-library iup)
(import format)
(import iup)
(import (prefix iup iup:))
(import canvas-draw)
;; (import canvas-draw-iup)
(use regex typed-records matchable)
(import regex typed-records matchable srfi-69)
(declare (unit dcommon))
(declare (uses gutils))
(declare (uses db))
(declare (uses dbmod))
(declare (uses mtver))
;; (declare (uses synchash))
(declare (uses debugprint))
;; (include "megatest-version.scm")
(include "common_records.scm")
;; (include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
(import mtver)
(import
mtver
dbmod
debugprint
)
;; yes, this is non-ideal
(define dashboard:update-summary-tab #f)
(define dashboard:update-servers-table #f)
;;======================================================================
;; C O M M O N D A T A S T R U C T U R E
|
︙ | | |
Modified gutils.scm
from [455c3c7ee1]
to [2c48b3925f].
︙ | | |
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
-
-
-
+
+
-
+
+
|
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import (prefix iup iup:)
canvas-draw)
(use srfi-1 regex regex-case srfi-69)
(import srfi-1 regex regex-case srfi-69)
(declare (unit gutils))
;; NOTE: These functions will move to iuputils
(define (gutils:colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
|
︙ | | |
Modified index-tree.scm
from [10c620fbfc]
to [278bba416b].
︙ | | |
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
|
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
|
+
-
-
+
+
-
+
-
-
-
-
+
+
+
+
-
+
|
;;
;;======================================================================
;;======================================================================
;; Tests
;;======================================================================
(import
(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
(import (prefix sqlite3 sqlite3:))
srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils
(prefix sqlite3 sqlite3:))
(declare (unit tests))
(declare (unit testsmod))
(declare (uses lock-queue))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses dbmod))
(declare (uses commonmod))
(declare (uses itemsmod))
(declare (uses runconfigmod))
(include "common_records.scm")
;; (include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
;; Populate the links tree with index.html files
;;
|
︙ | | |
Modified monitor.scm
from [3df55c85ea]
to [28d2068289].
︙ | | |
22
23
24
25
26
27
28
29
30
31
32
33
|
22
23
24
25
26
27
28
29
30
31
32
33
|
-
+
|
(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(include "common_records.scm")
;; (include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
|
Modified tree.scm
from [d2f3133988]
to [70a5af29b9].
︙ | | |
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
|
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
|
-
+
-
+
+
+
+
+
+
-
+
|
chicken.file.posix
regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))
(declare (unit tree))
(declare (uses mtargs))
(declare (uses mtver))
(declare (uses launch))
(declare (uses launchmod))
;; (declare (uses megatest-version))
(declare (uses gutils))
(declare (uses dbmod))
(declare (uses servermod))
;; (declare (uses synchash))
(declare (uses dcommon))
(import mtver)
(import mtver
launchmod
dbmod
servermod
)
;; (include "megatest-version.scm")
(include "common_records.scm")
;; (include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
;;======================================================================
;; T R E E S T U F F
;;======================================================================
|
︙ | | |
Modified vg_records.scm
from [67dafc9ef0]
to [fd7139b2bc].
︙ | | |
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
|
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
|
-
+
-
+
-
+
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
(use simple-exceptions)
(import simple-exceptions)
(define vg:lib-exn (make-exception "wrong record type, expected vg:lib." 'assert))
(define (pmake-vg:lib . params)(let ((v (if (null? params)(make-vector 2)(apply vector 'vg:lib params)))) v))
(define (make-vg:lib #!key
(comps #f)
)
(vector 'vg:lib comps))
(define-inline (vg:lib-comps vec)(if (eq? (vector-ref vec 0) 'vg:lib)(vector-ref vec 1)(raise (vg:lib-exn 'vg:lib-comps 'xpr))))
(define-inline (vg:lib-comps-set! vec val)(if (eq? (vector-ref vec 0) 'vg:lib)(vector-set! vec 1 val)(raise (vg:lib-exn 'comps))))
;; Generated using make-vector-record -safe vg comp objs name file
(use simple-exceptions)
(import simple-exceptions)
(define vg:comp-exn (make-exception "wrong record type, expected vg:comp." 'assert))
(define (pmake-vg:comp . params)(let ((v (if (null? params)(make-vector 4)(apply vector 'vg:comp params)))) v))
(define (make-vg:comp #!key
(objs #f)
(name #f)
(file #f)
)
(vector 'vg:comp objs name file))
(define-inline (vg:comp-objs vec)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-ref vec 1)(raise (vg:comp-exn 'vg:comp-objs 'xpr))))
(define-inline (vg:comp-name vec)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-ref vec 2)(raise (vg:comp-exn 'vg:comp-name 'xpr))))
(define-inline (vg:comp-file vec)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-ref vec 3)(raise (vg:comp-exn 'vg:comp-file 'xpr))))
(define-inline (vg:comp-objs-set! vec val)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-set! vec 1 val)(raise (vg:comp-exn 'objs))))
(define-inline (vg:comp-name-set! vec val)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-set! vec 2 val)(raise (vg:comp-exn 'name))))
(define-inline (vg:comp-file-set! vec val)(if (eq? (vector-ref vec 0) 'vg:comp)(vector-set! vec 3 val)(raise (vg:comp-exn 'file))))
;; Generated using make-vector-record -safe vg obj type pts fill-color text line-color call-back angle font attrib extents proc
(use simple-exceptions)
(import simple-exceptions)
(define vg:obj-exn (make-exception "wrong record type, expected vg:obj." 'assert))
(define (pmake-vg:obj . params)(let ((v (if (null? params)(make-vector 12)(apply vector 'vg:obj params)))) v))
(define (make-vg:obj #!key
(type #f)
(pts #f)
(fill-color #f)
(text #f)
|
︙ | | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
-
+
|
(define-inline (vg:obj-angle-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 7 val)(raise (vg:obj-exn 'angle))))
(define-inline (vg:obj-font-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 8 val)(raise (vg:obj-exn 'font))))
(define-inline (vg:obj-attrib-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 9 val)(raise (vg:obj-exn 'attrib))))
(define-inline (vg:obj-extents-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 10 val)(raise (vg:obj-exn 'extents))))
(define-inline (vg:obj-proc-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 11 val)(raise (vg:obj-exn 'proc))))
;; Generated using make-vector-record -safe vg inst libname compname theta xoff yoff scalex scaley mirrx mirry call-back cache
(use simple-exceptions)
(import simple-exceptions)
(define vg:inst-exn (make-exception "wrong record type, expected vg:inst." 'assert))
(define (pmake-vg:inst . params)(let ((v (if (null? params)(make-vector 12)(apply vector 'vg:inst params)))) v))
(define (make-vg:inst #!key
(libname #f)
(compname #f)
(theta #f)
(xoff #f)
|
︙ | | |
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
-
+
|
(define-inline (vg:inst-scaley-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 7 val)(raise (vg:inst-exn 'scaley))))
(define-inline (vg:inst-mirrx-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 8 val)(raise (vg:inst-exn 'mirrx))))
(define-inline (vg:inst-mirry-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 9 val)(raise (vg:inst-exn 'mirry))))
(define-inline (vg:inst-call-back-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 10 val)(raise (vg:inst-exn 'call-back))))
(define-inline (vg:inst-cache-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 11 val)(raise (vg:inst-exn 'cache))))
;; Generated using make-vector-record -safe vg drawing libs insts scalex scaley xoff yoff cnv cache
(use simple-exceptions)
(import simple-exceptions)
(define vg:drawing-exn (make-exception "wrong record type, expected vg:drawing." 'assert))
(define (pmake-vg:drawing . params)(let ((v (if (null? params)(make-vector 9)(apply vector 'vg:drawing params)))) v))
(define (make-vg:drawing #!key
(libs #f)
(insts #f)
(scalex #f)
(scaley #f)
|
︙ | | |
Modified vgmod.scm
from [2e376f7175]
to [13261795fe].
︙ | | |
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
-
-
-
+
+
+
+
+
+
+
+
+
-
|
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(declare (unit vgmod))
(module vgmod
*
(import scheme chicken data-structures extras ports)
(use canvas-draw iup)
(use typed-records srfi-1 srfi-69)
(import scheme
chicken.base
chicken.bitwise
chicken.string
chicken.random
)
(import canvas-draw iup)
(import typed-records srfi-1 srfi-69)
(import canvas-draw-iup)
(include "vg_records.scm")
;; ;; structs
;; ;;
;; (defstruct vg:lib comps)
;; (defstruct vg:comp objs name file)
|
︙ | | |
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
|
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
|
-
-
-
+
+
+
-
+
-
-
-
+
+
+
|
(arithmetic-shift r 16)
(arithmetic-shift g 8)
b))
;; Obsolete function
;;
(define (vg:generate-color)
(vg:rgb->number (random 255)
(random 255)
(random 255)))
(vg:rgb->number (pseudo-random-integer 255)
(pseudo-random-integer 255)
(pseudo-random-integer 255)))
;; Need to return a string of random iup-color for graph
;; Need to return a string of pseudo-random-integer iup-color for graph
;;
(define (vg:generate-color-rgb)
(conc (number->string (random 255)) " "
(number->string (random 255)) " "
(number->string (random 255))))
(conc (number->string (pseudo-random-integer 255)) " "
(number->string (pseudo-random-integer 255)) " "
(number->string (pseudo-random-integer 255))))
(define (vg:iup-color->number iup-color)
(apply vg:rgb->number (map string->number (string-split iup-color))))
;;======================================================================
;; graphing
;;======================================================================
|
︙ | | |