Overview
Comment: | Fixed points handling for rectangles |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.61 |
Files: | files | file ages | folders |
SHA1: |
02b5c6c31cb23c25832afc398ea4044b |
User & Date: | matt on 2016-07-13 23:05:25 |
Other Links: | branch diff | manifest | tags |
Context
2016-07-14
| ||
03:50 | Getting extents check-in: 04f3e0f7d5 user: matt tags: v1.61 | |
2016-07-13
| ||
23:05 | Fixed points handling for rectangles check-in: 02b5c6c31c user: matt tags: v1.61 | |
2016-07-12
| ||
23:01 | Added instance and drawing scale x and y, offset x and y check-in: 2548ff7aad user: matt tags: v1.61 | |
Changes
Modified vg-test.scm from [770e8e286a] to [240549bb15].
1 2 3 4 5 6 7 8 | (use canvas-draw iup) (import canvas-draw-iup) (load "vg.scm") (define d1 (vg:drawing-new)) (define l1 (vg:lib-new)) (define c1 (vg:comp-new)) | | | | | > | 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 | (use canvas-draw iup) (import canvas-draw-iup) (load "vg.scm") (define d1 (vg:drawing-new)) (define l1 (vg:lib-new)) (define c1 (vg:comp-new)) (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) (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" #:scrollbar "YES" #:posx "0.5" |
︙ | ︙ |
Modified vg.scm from [ff6b4c8f1a] to [42cf0e9697].
︙ | ︙ | |||
16 17 18 19 20 21 22 | (use canvas-draw iup) (import canvas-draw-iup) ;; structs ;; (defstruct vg:lib comps) (defstruct vg:comp objs name file) (defstruct vg:obj type pts fill-color text line-color call-back font) | | | | > > > > > > > | 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 | (use canvas-draw iup) (import canvas-draw-iup) ;; 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 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)) (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) 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 (let loop ((x (car lstxy)) (y (cadr lstxy)) |
︙ | ︙ | |||
76 77 78 79 80 81 82 | (vg:inst-scaley inst) (vg:inst-xoff inst) (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) | > > | > > | | | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | (vg:inst-scaley inst) (vg:inst-xoff inst) (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: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)) ;; get extents, use knowledge of type ... |
︙ | ︙ | |||
116 117 118 119 120 121 122 | ;; add comp to lib ;; (define (vg:add-comp-to-lib lib compname comp) (hash-table-set! (vg:lib-comps lib) compname comp)) ;; instanciate component in drawing ;; | | | | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | ;; add comp to lib ;; (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 #!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)) (inst (hash-table-ref (vg:lib-comps lib) compname))) inst)) |
︙ | ︙ | |||
189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 | (let ((res (make-vg:obj type: 'r fill-color: (vg:obj-fill-color obj) 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)) res)) ;;====================================================================== ;; Unravel and draw the objects ;;====================================================================== (define (vg:draw-obj drawing obj) (print "obj type: " (vg:obj-type obj)) (case (vg:obj-type obj) ((r)(vg:draw-rect drawing obj)))) (define (vg:draw-rect drawing obj) (let* ((cnv (vg:drawing-cnv drawing)) | > > > > | > > > > > | | > > | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 | (let ((res (make-vg:obj type: 'r fill-color: (vg:obj-fill-color obj) 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 ;;====================================================================== (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))) (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) (let* ((libname (vg:inst-libname inst)) (compname (vg:inst-compname inst)) (comp (vg:get-component drawing libname compname))) (print "comp: " comp) (for-each (lambda (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)))) |