Megatest

Check-in [a6fb3c351e]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Try to calc text size for extents. Not getting the data in time to be able to use it
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: a6fb3c351e54c9c0216d19bb1b81607dc4bc1783
User & Date: matt on 2016-07-20 00:01:45
Other Links: branch diff | manifest | tags
Context
2016-07-20
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
2016-07-19
23:34
Cleaned up display of itemized tests in temporal view check-in: bbfb2fb767 user: matt tags: v1.61
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified vg-test.scm from [3919a2488e] to [d9e064ef72].

︙
9
10
11
12
13
14
15


16
17
18
19

20
21
22
23
24
25
26

9
10
11
12
13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28








+
+



-
+








 vg:grow-rect
 vg:components-get-extents)

(define d1 (vg:drawing-new))
(define l1 (vg:lib-new))
(define c1 (vg:comp-new))
(define c2 (vg:comp-new))
(define bt1 (vg:make-rect 10 40 20 50 text: "A long piece of text" font: "Helvetica, -10"))

(let ((r1 (vg:make-rect 20 20 30 30 text: "r1" font: "Helvetica, -20"))
      (r2 (vg:make-rect 30 30 60 60 text: "r2" font: "Helvetica, -10"))
      (t1 (vg:make-text 60 60 "The middle" font: "Helvetica, -10")))
  (vg:add-objs-to-comp c1 r1 r2 t1))
  (vg:add-objs-to-comp c1 r1 r2 t1 bt1))

;; add the c1 component to lib l1 with name firstcomp
(vg:add-comp-to-lib l1 "firstcomp" c1)
(vg:add-comp-to-lib l1 "secondcomp" c2)

;; add the l1 lib to drawing with name firstlib
(vg:add-lib d1 "firstlib" l1)
︙
37
38
39
40
41
42
43




44
45
46
47
48
49
50

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56








+
+
+
+








;; 	       1.1 1.1 -2 -2))

;; get extents of c1 and put a rectange around it
;;
(define xtnts (apply vg:grow-rect 10 10 (vg:components-get-extents d1 c1)))
(vg:add-objs-to-comp c1 (apply vg:make-rect xtnts))

(define bt1xt (vg:obj-get-extents d1 bt1))
(print "bt1xt: " bt1xt)
(vg:add-objs-to-comp c1 (apply vg:make-rect bt1xt))

;; get extents of all objects and put rectangle around it
;;
(define big-xtnts (vg:instances-get-extents d1))
(vg:add-objs-to-comp c2 (apply vg:make-rect big-xtnts))
(vg:instantiate d1 "firstlib" "secondcomp" "inst3" 0 0)

(vg:drawing-scalex-set! d1 1.5)
︙

Modified vg.scm from [350c9e115f] to [d7b0b0b2cd].

︙
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29

15
16
17
18
19
20
21

22
23
24
25
26
27
28
29








-
+








(declare (unit vg))
(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 angle font attrib)
(defstruct vg:obj     type pts fill-color text line-color call-back angle font attrib extents)
(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))
︙
98
99
100
101
102
103
104
105

106
107
108
109
110
111
112

98
99
100
101
102
103
104

105
106
107
108
109
110
111
112








-
+








;;   (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)(text #f)(font #f))
  (make-vg:obj type: 'r pts: (list x1 y1 x2 y2) text: text font: font line-color: line-color fill-color: fill-color))
  (make-vg:obj type: 'r pts: (list x1 y1 x2 y2) text: text font: font line-color: line-color fill-color: fill-color extents: #f))

;; make a text obj
;;
(define (vg:make-text x1 y1 text #!key (line-color #f)(fill-color #f)
		      (angle #f)(scale-with-zoom #f)(font #f)
		      (font-size #f))
  (make-vg:obj type: 't pts: (list x1 y1) text: text
︙
328
329
330
331
332
333
334
335



336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353


354



355
356
357
358
359
360
361
362
















363
364
365
366
367
368
369

328
329
330
331
332
333
334

335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361








362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384








-
+
+
+


















+
+

+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








	 (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)))
	 (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-rectangle! 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 cnv
	    (let-values (((xmax ymax)(canvas-text-size cnv text)))
	      (list llx lly
		    (max ulx (+ llx xmax))
		    (max uly (+ lly ymax))))
	    pts)))) ;; return extents 
	(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)))
︙

This page was generated in about 0.125s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00