Index: vg-test.scm
==================================================================
--- vg-test.scm
+++ vg-test.scm
@@ -4,23 +4,24 @@
(load "vg.scm")
(define d1 (vg:drawing-new))
(define l1 (vg:lib-new))
(define c1 (vg:comp-new))
-(let ((r1 (vg:make-rect 10 10 100 80))
- (r2 (vg:make-rect 100 80 190 150)))
+(let ((r1 (vg:make-rect 20 20 40 40))
+ (r2 (vg:make-rect 40 40 80 80)))
(vg:add-objs-to-comp c1 r1 r2))
;; add the c1 component to lib l1 with name firstcomp
(vg:add-comp-to-lib l1 "firstcomp" c1)
;; add the l1 lib to drawing with name firstlib
(vg:add-lib d1 "firstlib" l1)
;; instantiate firstlib/firstcomp as inst1 in drawing d1 at 0,0
-(vg:instantiate d1 "firstlib" "firstcomp" "inst1" 0 0 0)
-(vg:instantiate d1 "firstlib" "firstcomp" "inst2" 200 200 0)
+(vg:instantiate d1 "firstlib" "firstcomp" "inst1" 0 0)
+(vg:instantiate d1 "firstlib" "firstcomp" "inst2" 200 200)
+;; (vg:drawing-scalex-set! d1 2)
(define cnv #f)
(define the-cnv (canvas
#:size "500x400"
#:expand "YES"
Index: vg.scm
==================================================================
--- vg.scm
+++ vg.scm
@@ -18,12 +18,12 @@
;; structs
;;
(defstruct vg:lib comps)
(defstruct vg:comp objs name file)
(defstruct vg:obj type pts fill-color text line-color call-back font)
-(defstruct vg:inst libname compname theta xoff yoff scalex scaley mirrx mirry call-back)
-(defstruct vg:drawing libs insts scalex scaley xoff yoff cnv) ;; libs: hash of name->lib, insts: hash of instname->inst
+(defstruct vg:inst libname compname theta xoff yoff scalex scaley mirrx mirry call-back cache)
+(defstruct vg:drawing libs insts scalex scaley xoff yoff cnv cache) ;; libs: hash of name->lib, insts: hash of instname->inst
;; inits
;;
(define (vg:comp-new)
(make-vg:comp objs: '() name: #f file: #f))
@@ -30,18 +30,25 @@
(define (vg:lib-new)
(make-vg:lib comps: (make-hash-table)))
(define (vg:drawing-new)
- (make-vg:drawing scalex: 1 scaley: 1 xoff: 0 yoff: 0 libs: (make-hash-table) insts: (make-hash-table)))
+ (make-vg:drawing scalex: 1
+ scaley: 1
+ xoff: 0
+ yoff: 0
+ libs: (make-hash-table)
+ insts: (make-hash-table)
+ cache: '()))
;;======================================================================
;; scaling and offsets
;;======================================================================
(define-inline (vg:scale-offset val s o)
(+ o (* val s)))
+ ;; (* (+ o val) s))
;; apply scale and offset to a list of x y values
;;
(define (vg:scale-offset-xy lstxy sx sy ox oy)
(if (> (length lstxy) 1) ;; have at least one xy pair
@@ -78,13 +85,17 @@
(vg:inst-yoff inst)))
;; apply both drawing and instance scaling to a list of xy points
;;
(define (vg:drawing-inst-apply-scale-offset drawing inst lstxy)
- (vg:inst-apply-scale
- inst
- (vg:drawing-apply-scale drawing lstxy)))
+ (vg:drawing-apply-scale
+ drawing
+ (vg:inst-apply-scale inst lstxy)))
+
+;; (vg:inst-apply-scale
+;; inst
+;; (vg:drawing-apply-scale drawing lstxy)))
;; make a rectangle obj
;;
(define (vg:make-rect x1 y1 x2 y2 #!key (line-color #f)(fill-color #f))
(make-vg:obj type: 'r pts: (list x1 y1 x2 y2) text: #f line-color: line-color fill-color: fill-color))
@@ -118,12 +129,12 @@
(define (vg:add-comp-to-lib lib compname comp)
(hash-table-set! (vg:lib-comps lib) compname comp))
;; instanciate component in drawing
;;
-(define (vg:instantiate drawing libname compname instname xoff yoff t #!key (scalex 1)(scaley 1)(mirrx #f)(mirry #f))
- (let ((inst (make-vg:inst libname: libname compname: compname xoff: xoff yoff: yoff theta: t scalex: scalex scaley: scaley mirrx: mirrx mirry: mirry)) )
+(define (vg:instantiate drawing libname compname instname xoff yoff #!key (theta 0)(scalex 1)(scaley 1)(mirrx #f)(mirry #f))
+ (let ((inst (make-vg:inst libname: libname compname: compname xoff: xoff yoff: yoff theta: theta scalex: scalex scaley: scaley mirrx: mirrx mirry: mirry)) )
(hash-table-set! (vg:drawing-insts drawing) instname inst)))
;; get component from drawing (look in apropriate lib) given libname and compname
(define (vg:get-component drawing libname compname)
(let* ((lib (hash-table-ref (vg:drawing-libs drawing) libname))
@@ -191,10 +202,11 @@
text: (vg:obj-text obj)
line-color: (vg:obj-line-color obj)
font: (vg:obj-font obj)))
(pts (vg:obj-pts obj)))
(vg:obj-pts-set! res (vg:drawing-inst-apply-scale-offset drawing inst pts))
+ (vg:drawing-cache-set! drawing (cons res (vg:drawing-cache drawing) ))
res))
;;======================================================================
;; Unravel and draw the objects
;;======================================================================
@@ -202,14 +214,22 @@
(define (vg:draw-obj drawing obj)
(print "obj type: " (vg:obj-type obj))
(case (vg:obj-type obj)
((r)(vg:draw-rect drawing obj))))
+;; given a rect obj draw it on the canvas applying first the drawing
+;; scale and offset
+;;
(define (vg:draw-rect drawing obj)
(let* ((cnv (vg:drawing-cnv drawing))
- (pts (vg:drawing-apply-scale drawing (vg:obj-pts obj))))
- (apply canvas-rectangle! cnv pts)))
+ (pts (vg:drawing-apply-scale drawing (vg:obj-pts obj)))
+ (llx (car pts))
+ (lly (cadr pts))
+ (ulx (caddr pts))
+ (uly (cadddr pts)))
+ (print "pts: " pts)
+ (canvas-rectangle! cnv llx ulx lly uly)))
(define (vg:draw drawing)
(let ((insts (vg:drawing-insts drawing)))
(for-each
(lambda (inst)
@@ -217,9 +237,11 @@
(compname (vg:inst-compname inst))
(comp (vg:get-component drawing libname compname)))
(print "comp: " comp)
(for-each
(lambda (obj)
- (print "obj: " obj)
- (vg:draw-obj drawing (vg:map-obj drawing inst obj)))
+ (print "obj: " (vg:obj-pts obj))
+ (let ((obj-xfrmd (vg:map-obj drawing inst obj)))
+ (print "obj-xfrmd: " (vg:obj-pts obj-xfrmd))
+ (vg:draw-obj drawing obj-xfrmd))) ;;
(vg:comp-objs comp))))
(hash-table-values insts))))