135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
;;======================================================================
;; get extents, use knowledge of type ...
;;
(define (vg:obj-get-extents drawing obj)
(let ((type (vg:obj-type obj)))
(case type
((r)(vg:rect-get-extents obj))
((t)(vg:draw-text drawing obj draw: #f))
(else #f))))
(define (vg:rect-get-extents obj)
(vg:obj-pts obj)) ;; extents are just the points for a rectangle
|
>
|
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
;;======================================================================
;; get extents, use knowledge of type ...
;;
(define (vg:obj-get-extents drawing obj)
(let ((type (vg:obj-type obj)))
(case type
((l)(vg:rect-get-extents obj))
((r)(vg:rect-get-extents obj))
((t)(vg:draw-text drawing obj draw: #f))
(else #f))))
(define (vg:rect-get-extents obj)
(vg:obj-pts obj)) ;; extents are just the points for a rectangle
|
386
387
388
389
390
391
392
393
394
395
396
397
398
399
|
;; with get-extents = #t return the extents
;; with draw = #f don't actually draw the object
;;
(define (vg:draw-obj drawing obj #!key (draw #t))
;; (print "obj type: " (vg:obj-type obj))
(case (vg:obj-type obj)
((r)(vg:draw-rect drawing obj draw: draw))
((t)(vg:draw-text drawing obj draw: draw))))
;; given a rect obj draw it on the canvas applying first the drawing
;; scale and offset
;;
(define (vg:draw-rect drawing obj #!key (draw #t))
|
>
|
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
|
;; with get-extents = #t return the extents
;; with draw = #f don't actually draw the object
;;
(define (vg:draw-obj drawing obj #!key (draw #t))
;; (print "obj type: " (vg:obj-type obj))
(case (vg:obj-type obj)
((l)(vg:draw-line drawing obj draw: draw))
((r)(vg:draw-rect drawing obj draw: draw))
((t)(vg:draw-text drawing obj draw: draw))))
;; given a rect obj draw it on the canvas applying first the drawing
;; scale and offset
;;
(define (vg:draw-rect drawing obj #!key (draw #t))
|
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
|
(let ((prev-background-color (canvas-background cnv))
(prev-foreground-color (canvas-foreground cnv)))
;; (if fill-color
;; (begin
;; (canvas-foreground-set! cnv fill-color)
;; (canvas-box! cnv llx ulx lly uly))) ;; docs are all over the place on this one.;; w h)
(if line-color
(canvas-foreground-set! cnv line-color)
(if fill-color
(canvas-foreground-set! cnv prev-foreground-color)))
(canvas-line! cnv llx ulx lly uly)
(canvas-foreground-set! cnv prev-foreground-color)
(if text
(let* ((prev-font (canvas-font cnv))
(font-changed (and font (not (equal? font prev-font)))))
(if font-changed (canvas-font-set! cnv font))
(canvas-text! cnv (+ 2 llx)(+ 2 lly) text)
(let-values (((xmax ymax)(canvas-text-size cnv text)))
|
|
|
|
|
|
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
|
(let ((prev-background-color (canvas-background cnv))
(prev-foreground-color (canvas-foreground cnv)))
;; (if fill-color
;; (begin
;; (canvas-foreground-set! cnv fill-color)
;; (canvas-box! cnv llx ulx lly uly))) ;; docs are all over the place on this one.;; w h)
(if line-color
(canvas-foreground-set! cnv line-color))
;; (if fill-color
;; (canvas-foreground-set! cnv prev-foreground-color)))
(canvas-line! cnv llx lly ulx uly)
(canvas-foreground-set! cnv prev-foreground-color)
(if text
(let* ((prev-font (canvas-font cnv))
(font-changed (and font (not (equal? font prev-font)))))
(if font-changed (canvas-font-set! cnv font))
(canvas-text! cnv (+ 2 llx)(+ 2 lly) text)
(let-values (((xmax ymax)(canvas-text-size cnv text)))
|