Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -43,11 +43,11 @@
configfmod.scm processmod.scm servermod.scm megatestmod.scm \
stml2.scm fsmod.scm cpumod.scm mtmod.scm odsmod.scm \
pkts.scm testsmod.scm pgdb.scm cookie.scm launchmod.scm \
subrunmod.scm runsmod.scm tasksmod.scm archivemod.scm \
ezstepsmod.scm mtbody.scm envmod.scm genexample.scm mutils.scm \
- diff-report.scm tdb.scm
+ diff-report.scm tdb.scm vg.scm
transport-mode.scm : transport-mode.scm.template
cp transport-mode.scm.template transport-mode.scm
dashboard-transport-mode.scm : dashboard-transport-mode.scm.template
@@ -93,12 +93,11 @@
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \
# mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm \
# rmtmod.scm apimod.scm
GUISRCF = dashboard-context-menu.scm dashboard-tests.scm \
- dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm \
- vg.scm
+ dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm
OFILES = $(SRCFILES:%.scm=%.o)
GOFILES = $(GUISRCF:%.scm=%.o)
MOFILES = $(addprefix mofiles/,$(MSRCFILES:%.scm=%.o))
@@ -237,11 +236,11 @@
mofiles/dbfile.o : mofiles/commonmod.o
# mofiles/stml2.o : mofiles/cookie.o
# configf.o : mofiles/commonmod.o
-vg.o dashboard.o : vg_records.scm megatest-version.scm
+vg.o dashboard.o : megatest-version.scm
dcommon.o : run_records.scm
mofiles/stml2.o : mofiles/cookie.o
@@ -449,68 +448,10 @@
tcmt ftail.import.scm readline-fix.scm serialize-env \
dboard dboard.o megatest.o dashboard.o \
megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o
rm -rf share
-#======================================================================
-# Make the records files
-#======================================================================
-
-# vg_records.scm : records.sh
-# ./records.sh
-
-#======================================================================
-# Deploy section (not complete yet)
-#======================================================================
-
-$(DEPLOYHELPERS) : utils/mt_*
- $(INSTALL) $< $@
- chmod a+X $@
-
-deploytarg/apropos.so : Makefile
- chicken-install -p deploytarg -deploy -keep-installed $(EGGS)
-
-deploy : deploytarg/mtest deploytarg/dboard $(DEPLOYHELPERS) deploytarg/nbfake deploytarg/remrun deploytarg/viewsceen deploytarg/nbfind deploytarg/apropos.so
-
-# puts deployed megatest in directory "megatest"
-deploytarg/mtest : $(OFILES) megatest.o deploytarg/apropos.so
- csc -deploy $(CSCOPTS) $(OFILES) megatest.scm -o deploytarg
- mv deploytarg/deploytarg deploytarg/mtest
-
-deploytarg/dboard : $(OFILES) $(GOFILES) dashboard.scm deploytarg/apropos.so
- csc -deploy $(OFILES) $(GOFILES) dashboard.scm -o deploytarg
- mv deploytarg/deploytarg deploytarg/dboard
-
-datashare-testing/sd : datashare.scm $(OFILES)
- csc $(CSCOPTS) datashare.scm $(OFILES) -o datashare-testing/sd
-
-datashare-testing/sdat: sharedat.scm $(OFILES)
- csc $(CSCOPTS) sharedat.scm $(OFILES) -o datashare-testing/sdat
-
-sd : datashare-testing/sd
- mkdir -p /tmp/$(USER)/datashare/disk1 /tmp/$(USER)/basepath
-
-xterm : sd
- (export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &)
-
-datashare-testing/spublish : spublish.scm $(OFILES) megatest-version.scm
- csc $(CSCOPTS) spublish.scm margs.o process.o common.o -o datashare-testing/spublish
-
-datashare-testing/sretrieve : sretrieve.scm $(OFILES) megatest-version.scm
- csc $(CSCOPTS) sretrieve.scm margs.o process.o common.o -o datashare-testing/sretrieve
-
-
-datashare-testing/sauthorize : sauthorize.scm $(OFILES) megatest-version.scm
- csc $(CSCOPTS) sauthorize.scm margs.o process.o common.o -o datashare-testing/sauthorize
-
-sauth-init:
- mkdir -p datashare-testing
- rm datashare-testing/sauthorize
- rm datashare-testing/sretrieve
- rm datashare-testing/spublish
-
-sauth : sauth-init datashare-testing/sauthorize datashare-testing/sretrieve datashare-testing/spublish
readline-fix.scm :
if [[ $(shell chicken-status | grep readline | awk '{print $4}' | cut -d. -f1) -gt 3 ]];then \
echo "(define *use-new-readline* #f)" > readline-fix.scm; \
else \
Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -105,19 +105,19 @@
stml2
megatestmod
tasksmod
runsmod
testsmod
+ vg
)
(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")
;; set some parameters here - these need to be put in something that can be loaded from other
;; executables such as dashboard and mtutil
;;
(include "dashboard-transport-mode.scm")
Index: vg.scm
==================================================================
--- vg.scm
+++ vg.scm
@@ -16,17 +16,206 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
-(use typed-records srfi-1)
-
(declare (unit vg))
-(use canvas-draw iup)
-(import canvas-draw-iup)
+
+(module vg
+ *
+
+(import scheme
+ chicken
+
+ data-structures
+ extras
+ typed-records
+ srfi-1
+ srfi-69
+ canvas-draw iup
+ )
+
+
+;;======================================================================
+;; vg_records.scm
+;;======================================================================
+;; Created by records.sh. DO NOT EDIT THIS FILE. Edit records.sh instead
+;; Generated using make-vector-record -safe vg lib comps
+
+;; Copyright 2006-2017, Matthew Welland.
+;;
+;; This file is part of Megatest.
+;;
+;; Megatest is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Megatest is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; 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 .
+;;
+
+(use 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 (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 (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)
+(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 (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 (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 (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 (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 (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 (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)
+(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)
+ (line-color #f)
+ (call-back #f)
+ (angle #f)
+ (font #f)
+ (attrib #f)
+ (extents #f)
+ (proc #f)
+ )
+ (vector 'vg:obj type pts fill-color text line-color call-back angle font attrib extents proc))
+
+(define (vg:obj-type vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 1)(raise (vg:obj-exn 'vg:obj-type 'xpr))))
+(define (vg:obj-pts vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 2)(raise (vg:obj-exn 'vg:obj-pts 'xpr))))
+(define (vg:obj-fill-color vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 3)(raise (vg:obj-exn 'vg:obj-fill-color 'xpr))))
+(define (vg:obj-text vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 4)(raise (vg:obj-exn 'vg:obj-text 'xpr))))
+(define (vg:obj-line-color vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 5)(raise (vg:obj-exn 'vg:obj-line-color 'xpr))))
+(define (vg:obj-call-back vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 6)(raise (vg:obj-exn 'vg:obj-call-back 'xpr))))
+(define (vg:obj-angle vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 7)(raise (vg:obj-exn 'vg:obj-angle 'xpr))))
+(define (vg:obj-font vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 8)(raise (vg:obj-exn 'vg:obj-font 'xpr))))
+(define (vg:obj-attrib vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 9)(raise (vg:obj-exn 'vg:obj-attrib 'xpr))))
+(define (vg:obj-extents vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 10)(raise (vg:obj-exn 'vg:obj-extents 'xpr))))
+(define (vg:obj-proc vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 11)(raise (vg:obj-exn 'vg:obj-proc 'xpr))))
+
+(define (vg:obj-type-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 1 val)(raise (vg:obj-exn 'type))))
+(define (vg:obj-pts-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 2 val)(raise (vg:obj-exn 'pts))))
+(define (vg:obj-fill-color-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 3 val)(raise (vg:obj-exn 'fill-color))))
+(define (vg:obj-text-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 4 val)(raise (vg:obj-exn 'text))))
+(define (vg:obj-line-color-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 5 val)(raise (vg:obj-exn 'line-color))))
+(define (vg:obj-call-back-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 6 val)(raise (vg:obj-exn 'call-back))))
+(define (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 (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 (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 (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 (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)
+(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)
+ (yoff #f)
+ (scalex #f)
+ (scaley #f)
+ (mirrx #f)
+ (mirry #f)
+ (call-back #f)
+ (cache #f)
+ )
+ (vector 'vg:inst libname compname theta xoff yoff scalex scaley mirrx mirry call-back cache))
+
+(define (vg:inst-libname vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 1)(raise (vg:inst-exn 'vg:inst-libname 'xpr))))
+(define (vg:inst-compname vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 2)(raise (vg:inst-exn 'vg:inst-compname 'xpr))))
+(define (vg:inst-theta vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 3)(raise (vg:inst-exn 'vg:inst-theta 'xpr))))
+(define (vg:inst-xoff vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 4)(raise (vg:inst-exn 'vg:inst-xoff 'xpr))))
+(define (vg:inst-yoff vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 5)(raise (vg:inst-exn 'vg:inst-yoff 'xpr))))
+(define (vg:inst-scalex vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 6)(raise (vg:inst-exn 'vg:inst-scalex 'xpr))))
+(define (vg:inst-scaley vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 7)(raise (vg:inst-exn 'vg:inst-scaley 'xpr))))
+(define (vg:inst-mirrx vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 8)(raise (vg:inst-exn 'vg:inst-mirrx 'xpr))))
+(define (vg:inst-mirry vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 9)(raise (vg:inst-exn 'vg:inst-mirry 'xpr))))
+(define (vg:inst-call-back vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 10)(raise (vg:inst-exn 'vg:inst-call-back 'xpr))))
+(define (vg:inst-cache vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 11)(raise (vg:inst-exn 'vg:inst-cache 'xpr))))
+
+(define (vg:inst-libname-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 1 val)(raise (vg:inst-exn 'libname))))
+(define (vg:inst-compname-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 2 val)(raise (vg:inst-exn 'compname))))
+(define (vg:inst-theta-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 3 val)(raise (vg:inst-exn 'theta))))
+(define (vg:inst-xoff-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 4 val)(raise (vg:inst-exn 'xoff))))
+(define (vg:inst-yoff-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 5 val)(raise (vg:inst-exn 'yoff))))
+(define (vg:inst-scalex-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 6 val)(raise (vg:inst-exn 'scalex))))
+(define (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 (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 (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 (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 (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)
+(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)
+ (xoff #f)
+ (yoff #f)
+ (cnv #f)
+ (cache #f)
+ )
+ (vector 'vg:drawing libs insts scalex scaley xoff yoff cnv cache))
+
+(define (vg:drawing-libs vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 1)(raise (vg:drawing-exn 'vg:drawing-libs 'xpr))))
+(define (vg:drawing-insts vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 2)(raise (vg:drawing-exn 'vg:drawing-insts 'xpr))))
+(define (vg:drawing-scalex vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 3)(raise (vg:drawing-exn 'vg:drawing-scalex 'xpr))))
+(define (vg:drawing-scaley vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 4)(raise (vg:drawing-exn 'vg:drawing-scaley 'xpr))))
+(define (vg:drawing-xoff vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 5)(raise (vg:drawing-exn 'vg:drawing-xoff 'xpr))))
+(define (vg:drawing-yoff vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 6)(raise (vg:drawing-exn 'vg:drawing-yoff 'xpr))))
+(define (vg:drawing-cnv vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 7)(raise (vg:drawing-exn 'vg:drawing-cnv 'xpr))))
+(define (vg:drawing-cache vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 8)(raise (vg:drawing-exn 'vg:drawing-cache 'xpr))))
+
+(define (vg:drawing-libs-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 1 val)(raise (vg:drawing-exn 'libs))))
+(define (vg:drawing-insts-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 2 val)(raise (vg:drawing-exn 'insts))))
+(define (vg:drawing-scalex-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 3 val)(raise (vg:drawing-exn 'scalex))))
+(define (vg:drawing-scaley-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 4 val)(raise (vg:drawing-exn 'scaley))))
+(define (vg:drawing-xoff-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 5 val)(raise (vg:drawing-exn 'xoff))))
+(define (vg:drawing-yoff-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 6 val)(raise (vg:drawing-exn 'yoff))))
+(define (vg:drawing-cnv-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 7 val)(raise (vg:drawing-exn 'cnv))))
+(define (vg:drawing-cache-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 8 val)(raise (vg:drawing-exn 'cache))))
-(include "vg_records.scm")
+;;======================================================================
+;; end vg_records
+;;======================================================================
+
;; ;; structs
;; ;;
;; (defstruct vg:lib comps)
;; (defstruct vg:comp objs name file)
@@ -56,11 +245,11 @@
;;======================================================================
;; scaling and offsets
;;======================================================================
-(define-inline (vg:scale-offset val s o)
+(define (vg:scale-offset val s o)
(+ o (* val s)))
;; (* (+ o val) s))
;; apply scale and offset to a list of x y values
;;
@@ -662,5 +851,6 @@
(vg:draw-inst drawing inst draw-mode: draw-mode prev-extents: res)
res)))
(if (null? tal)
newres
(loop (car tal)(cdr tal) newres)))))))
+)
DELETED vg_records.scm
Index: vg_records.scm
==================================================================
--- vg_records.scm
+++ /dev/null
@@ -1,171 +0,0 @@
-;; Created by records.sh. DO NOT EDIT THIS FILE. Edit records.sh instead
-;; Generated using make-vector-record -safe vg lib comps
-
-;; Copyright 2006-2017, Matthew Welland.
-;;
-;; This file is part of Megatest.
-;;
-;; Megatest is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-;;
-;; Megatest is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; 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 .
-;;
-
-(use 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)
-(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)
-(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)
- (line-color #f)
- (call-back #f)
- (angle #f)
- (font #f)
- (attrib #f)
- (extents #f)
- (proc #f)
- )
- (vector 'vg:obj type pts fill-color text line-color call-back angle font attrib extents proc))
-
-(define-inline (vg:obj-type vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 1)(raise (vg:obj-exn 'vg:obj-type 'xpr))))
-(define-inline (vg:obj-pts vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 2)(raise (vg:obj-exn 'vg:obj-pts 'xpr))))
-(define-inline (vg:obj-fill-color vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 3)(raise (vg:obj-exn 'vg:obj-fill-color 'xpr))))
-(define-inline (vg:obj-text vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 4)(raise (vg:obj-exn 'vg:obj-text 'xpr))))
-(define-inline (vg:obj-line-color vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 5)(raise (vg:obj-exn 'vg:obj-line-color 'xpr))))
-(define-inline (vg:obj-call-back vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 6)(raise (vg:obj-exn 'vg:obj-call-back 'xpr))))
-(define-inline (vg:obj-angle vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 7)(raise (vg:obj-exn 'vg:obj-angle 'xpr))))
-(define-inline (vg:obj-font vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 8)(raise (vg:obj-exn 'vg:obj-font 'xpr))))
-(define-inline (vg:obj-attrib vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 9)(raise (vg:obj-exn 'vg:obj-attrib 'xpr))))
-(define-inline (vg:obj-extents vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 10)(raise (vg:obj-exn 'vg:obj-extents 'xpr))))
-(define-inline (vg:obj-proc vec)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-ref vec 11)(raise (vg:obj-exn 'vg:obj-proc 'xpr))))
-
-(define-inline (vg:obj-type-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 1 val)(raise (vg:obj-exn 'type))))
-(define-inline (vg:obj-pts-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 2 val)(raise (vg:obj-exn 'pts))))
-(define-inline (vg:obj-fill-color-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 3 val)(raise (vg:obj-exn 'fill-color))))
-(define-inline (vg:obj-text-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 4 val)(raise (vg:obj-exn 'text))))
-(define-inline (vg:obj-line-color-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 5 val)(raise (vg:obj-exn 'line-color))))
-(define-inline (vg:obj-call-back-set! vec val)(if (eq? (vector-ref vec 0) 'vg:obj)(vector-set! vec 6 val)(raise (vg:obj-exn 'call-back))))
-(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)
-(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)
- (yoff #f)
- (scalex #f)
- (scaley #f)
- (mirrx #f)
- (mirry #f)
- (call-back #f)
- (cache #f)
- )
- (vector 'vg:inst libname compname theta xoff yoff scalex scaley mirrx mirry call-back cache))
-
-(define-inline (vg:inst-libname vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 1)(raise (vg:inst-exn 'vg:inst-libname 'xpr))))
-(define-inline (vg:inst-compname vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 2)(raise (vg:inst-exn 'vg:inst-compname 'xpr))))
-(define-inline (vg:inst-theta vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 3)(raise (vg:inst-exn 'vg:inst-theta 'xpr))))
-(define-inline (vg:inst-xoff vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 4)(raise (vg:inst-exn 'vg:inst-xoff 'xpr))))
-(define-inline (vg:inst-yoff vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 5)(raise (vg:inst-exn 'vg:inst-yoff 'xpr))))
-(define-inline (vg:inst-scalex vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 6)(raise (vg:inst-exn 'vg:inst-scalex 'xpr))))
-(define-inline (vg:inst-scaley vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 7)(raise (vg:inst-exn 'vg:inst-scaley 'xpr))))
-(define-inline (vg:inst-mirrx vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 8)(raise (vg:inst-exn 'vg:inst-mirrx 'xpr))))
-(define-inline (vg:inst-mirry vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 9)(raise (vg:inst-exn 'vg:inst-mirry 'xpr))))
-(define-inline (vg:inst-call-back vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 10)(raise (vg:inst-exn 'vg:inst-call-back 'xpr))))
-(define-inline (vg:inst-cache vec)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-ref vec 11)(raise (vg:inst-exn 'vg:inst-cache 'xpr))))
-
-(define-inline (vg:inst-libname-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 1 val)(raise (vg:inst-exn 'libname))))
-(define-inline (vg:inst-compname-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 2 val)(raise (vg:inst-exn 'compname))))
-(define-inline (vg:inst-theta-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 3 val)(raise (vg:inst-exn 'theta))))
-(define-inline (vg:inst-xoff-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 4 val)(raise (vg:inst-exn 'xoff))))
-(define-inline (vg:inst-yoff-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 5 val)(raise (vg:inst-exn 'yoff))))
-(define-inline (vg:inst-scalex-set! vec val)(if (eq? (vector-ref vec 0) 'vg:inst)(vector-set! vec 6 val)(raise (vg:inst-exn 'scalex))))
-(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)
-(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)
- (xoff #f)
- (yoff #f)
- (cnv #f)
- (cache #f)
- )
- (vector 'vg:drawing libs insts scalex scaley xoff yoff cnv cache))
-
-(define-inline (vg:drawing-libs vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 1)(raise (vg:drawing-exn 'vg:drawing-libs 'xpr))))
-(define-inline (vg:drawing-insts vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 2)(raise (vg:drawing-exn 'vg:drawing-insts 'xpr))))
-(define-inline (vg:drawing-scalex vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 3)(raise (vg:drawing-exn 'vg:drawing-scalex 'xpr))))
-(define-inline (vg:drawing-scaley vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 4)(raise (vg:drawing-exn 'vg:drawing-scaley 'xpr))))
-(define-inline (vg:drawing-xoff vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 5)(raise (vg:drawing-exn 'vg:drawing-xoff 'xpr))))
-(define-inline (vg:drawing-yoff vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 6)(raise (vg:drawing-exn 'vg:drawing-yoff 'xpr))))
-(define-inline (vg:drawing-cnv vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 7)(raise (vg:drawing-exn 'vg:drawing-cnv 'xpr))))
-(define-inline (vg:drawing-cache vec)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-ref vec 8)(raise (vg:drawing-exn 'vg:drawing-cache 'xpr))))
-
-(define-inline (vg:drawing-libs-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 1 val)(raise (vg:drawing-exn 'libs))))
-(define-inline (vg:drawing-insts-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 2 val)(raise (vg:drawing-exn 'insts))))
-(define-inline (vg:drawing-scalex-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 3 val)(raise (vg:drawing-exn 'scalex))))
-(define-inline (vg:drawing-scaley-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 4 val)(raise (vg:drawing-exn 'scaley))))
-(define-inline (vg:drawing-xoff-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 5 val)(raise (vg:drawing-exn 'xoff))))
-(define-inline (vg:drawing-yoff-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 6 val)(raise (vg:drawing-exn 'yoff))))
-(define-inline (vg:drawing-cnv-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 7 val)(raise (vg:drawing-exn 'cnv))))
-(define-inline (vg:drawing-cache-set! vec val)(if (eq? (vector-ref vec 0) 'vg:drawing)(vector-set! vec 8 val)(raise (vg:drawing-exn 'cache))))