Overview
| Comment: | vg stuff that mysteriously breaks draw |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | broken-vg-xaxis-stuff |
| Files: | files | file ages | folders |
| SHA1: |
76e3f02bac497b21af3ab24c44aeeadf |
| User & Date: | matt on 2016-07-20 08:15:33 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-07-20
| ||
| 08:15 | vg stuff that mysteriously breaks draw Closed-Leaf check-in: 76e3f02bac user: matt tags: broken-vg-xaxis-stuff | |
| 08:03 | Added line and xaxis (neither is finished) and changed make obj to include -obj as part of the name check-in: e9d9853fb0 user: matt tags: v1.61 | |
Changes
Modified vg.scm from [ac9ebc351c] to [2cf42ae80c].
| ︙ | ︙ | |||
337 338 339 340 341 342 343 |
(arithmetic-shift r 16)
(arithmetic-shift g 8)
b))
(define (vg:iup-color->number iup-color)
(apply vg:rgb->number (map string->number (string-split iup-color))))
| < < < < < < < < | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 |
(arithmetic-shift r 16)
(arithmetic-shift g 8)
b))
(define (vg:iup-color->number iup-color)
(apply vg:rgb->number (map string->number (string-split iup-color))))
;;======================================================================
;; Unravel and draw the objects
;;======================================================================
;; with get-extents = #t return the extents
;; with draw = #f don't actually draw the object
;;
|
| ︙ | ︙ | |||
484 485 486 487 488 489 490 | ;; scale and offset ;; (define (vg:draw-xaxis drawing obj #!key (draw #t)) (let* ((cnv (vg:drawing-cnv drawing)) (pts (vg:drawing-apply-scale drawing (vg:obj-pts obj))) ;; (fill-color (vg:obj-fill-color obj)) (line-color (vg:obj-line-color obj)) | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 |
;; scale and offset
;;
(define (vg:draw-xaxis drawing obj #!key (draw #t))
(let* ((cnv (vg:drawing-cnv drawing))
(pts (vg:drawing-apply-scale drawing (vg:obj-pts obj)))
;; (fill-color (vg:obj-fill-color obj))
(line-color (vg:obj-line-color obj))
(text (vg:obj-text obj)) ;; use for units and label? e.g. Radius (m)
(font (vg:obj-font obj))
(llx (car pts))
(lly (cadr pts))
(ulx (caddr pts))
(uly (cadddr pts))
(w (- ulx llx))
(h (- uly lly))
(text-xmax #f)
(text-ymax #f))
(let-values (((scalef per-grad unitname)(proc w)))
(if draw
(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)))
(set! text-xmax xmax)(set! text-ymax ymax))
(if font-changed (canvas-font-set! cnv prev-font))))))
(print "text-xmax: " text-xmax " text-ymax: " text-ymax)
(if (vg:obj-extents obj)
(vg:obj-extents obj)
(if (not text)
pts
(if (and text-xmax text-ymax)
(let ((xt (list llx lly
(max ulx (+ llx text-xmax))
(max uly (+ lly text-ymax)))))
(vg:obj-extents-set! obj xt)
xt)
(if cnv
(let-values (((xmax ymax)(canvas-text-size cnv text)))
(let ((xt (list llx lly
(max ulx (+ llx xmax))
(max uly (+ lly ymax)))))
(vg:obj-extents-set! obj xt)
xt))
pts))))))) ;; return extents
;; given a rect obj draw it on the canvas applying first the drawing
;; scale and offset
;;
(define (vg:draw-text drawing obj #!key (draw #t))
(let* ((cnv (vg:drawing-cnv drawing))
(pts (vg:drawing-apply-scale drawing (vg:obj-pts obj)))
|
| ︙ | ︙ |