Megatest

Changes On Branch 76e3f02bac497b21
Login

Changes In Branch broken-vg-xaxis-stuff Excluding Merge-Ins

This is equivalent to a diff from e9d9853fb0 to 76e3f02bac

2016-07-21
00:33
refactored rundat from vector to defstruct check-in: f52adb7de7 user: matt tags: v1.61
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
00:01
Try to calc text size for extents. Not getting the data in time to be able to use it check-in: a6fb3c351e user: matt tags: v1.61

Modified vg.scm from [ac9ebc351c] to [2cf42ae80c].

337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
    (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))))

;;======================================================================
;; graphing
;;======================================================================

(define (vg:make-xaxis drawing component x1 y1 x2 y2 startnum endnum scaleproc)
  (let ((obj (vg:make-xaxis-obj x1 y1 x2 y2)))
    #f))

;;======================================================================
;; Unravel and draw the objects
;;======================================================================

;; with get-extents = #t return the extents
;; with draw = #f don't actually draw the object
;;







<
<
<
<
<
<
<
<







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
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
541
542
543
544
545
546
547
;; 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))
	 (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))

    (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)))







|









>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







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)))