Canvas Draw

Check-in [33bf933593]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Changed with-canvas-mode into call-with-canvas-in-mode
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 33bf93359307b97701634526a6b6212d9397e04e
User & Date: murphy 2010-10-22 02:35:02
Context
2011-01-30
23:39
Setup script now allows feature no-library-checks to disable checks using find-library check-in: d704525ebe user: murphy tags: trunk
2010-10-22
02:35
Changed with-canvas-mode into call-with-canvas-in-mode check-in: 33bf933593 user: murphy tags: trunk
2010-10-20
20:06
Moved context+ initialization from the base module to the native module check-in: acecf54f4f user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to api/primitives.wiki.

272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
<h3><a id="canvas-text-box"><code><nowiki>(canvas-text-box [canvas canvas?] [x integer?] [y integer?] [text string?]) → (values integer? integer? integer? integer?)</nowiki></code></a></h3>

Computes the bounding box of the given text when drawn on the given canvas.
Returns the minimum and maximum x and y coordinates.

<h2>Vertices</h2>

<h3><a id="with-canvas-mode"><code><nowiki>(with-canvas-mode [canvas canvas?] [mode symbol?] [thunk (-> any)]) → any</nowiki></code></a></h3>

Calls <code>thunk</code> with the given canvas is ready to receive vertex data
in the given mode. Returns whatever <code>thunk</code> returns.

Possible modes are

  *  <code>'open-lines</code>
  *  <code>'closed-lines</code>
  *  <code>'fill</code>
  *  <code>'clip</code>







|

|
|







272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
<h3><a id="canvas-text-box"><code><nowiki>(canvas-text-box [canvas canvas?] [x integer?] [y integer?] [text string?]) → (values integer? integer? integer? integer?)</nowiki></code></a></h3>

Computes the bounding box of the given text when drawn on the given canvas.
Returns the minimum and maximum x and y coordinates.

<h2>Vertices</h2>

<h3><a id="call-with-canvas-in-mode"><code><nowiki>(call-with-canvas-in-mode [canvas canvas?] [mode symbol?] [proc (-> canvas? any)]) → any</nowiki></code></a></h3>

Calls <code>proc</code> with the given canvas and ready to receive vertex data
in the given mode. Returns whatever <code>proc</code> returns.

Possible modes are

  *  <code>'open-lines</code>
  *  <code>'closed-lines</code>
  *  <code>'fill</code>
  *  <code>'clip</code>

Changes to chicken/canvas-draw-primitives.scm.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
...
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
...
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
	 canvas-fill-mode canvas-fill-mode-set!
	 canvas-interior-style canvas-interior-style-set!
	 canvas-text!
	 canvas-font canvas-font-set!
	 canvas-text-alignment canvas-text-alignment-set!
	 canvas-text-orientation canvas-text-orientation-set!
	 canvas-font-dimensions canvas-text-size canvas-text-box
	 with-canvas-mode canvas-path-set!
	 canvas-vertex!)
	(import scheme chicken foreign data-structures srfi-4 canvas-draw-base)

;; {{{ Data types

(foreign-declare
	"#include <cd.h>\n")
................................................................................
	  	  (canvas-text-box/raw canvas x y text (location x0) (location x1) (location y0) (location y1))
	  	  (values x0 x1 y0 y1)))))

;; }}}

;; {{{ Vertex functions

(define with-canvas-mode
	(letrec ([canvas-modes
	          (list
	          	(cons
	          		'open-lines
	          		(foreign-value "CD_OPEN_LINES" int))
	          	(cons
	          		'closed-lines
................................................................................
	          	(cons
	          		'path
	          		(foreign-value "CD_PATH" int)))]
	         [canvas-begin
	          (foreign-lambda void "cdCanvasBegin" nonnull-canvas int)]
	         [canvas-end
	          (foreign-lambda void "cdCanvasEnd" nonnull-canvas)])
	  (lambda (canvas canvas-mode thunk)
	  	(let ([canvas-mode
	  	       (cond
	  	       	 [(assq canvas-mode canvas-modes) => cdr]
	  	       	 [else (error 'with-canvas-mode "unknown canvas mode" canvas-mode)])])
				(dynamic-wind
					(cut canvas-begin canvas canvas-mode)
					thunk
					(cut canvas-end canvas))))))

(define canvas-path-set!
	(letrec ([path-actions
	          (list
	          	(cons
	          		'new







|







 







|







 







|






|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
...
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
...
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
	 canvas-fill-mode canvas-fill-mode-set!
	 canvas-interior-style canvas-interior-style-set!
	 canvas-text!
	 canvas-font canvas-font-set!
	 canvas-text-alignment canvas-text-alignment-set!
	 canvas-text-orientation canvas-text-orientation-set!
	 canvas-font-dimensions canvas-text-size canvas-text-box
	 call-with-canvas-in-mode canvas-path-set!
	 canvas-vertex!)
	(import scheme chicken foreign data-structures srfi-4 canvas-draw-base)

;; {{{ Data types

(foreign-declare
	"#include <cd.h>\n")
................................................................................
	  	  (canvas-text-box/raw canvas x y text (location x0) (location x1) (location y0) (location y1))
	  	  (values x0 x1 y0 y1)))))

;; }}}

;; {{{ Vertex functions

(define call-with-canvas-in-mode
	(letrec ([canvas-modes
	          (list
	          	(cons
	          		'open-lines
	          		(foreign-value "CD_OPEN_LINES" int))
	          	(cons
	          		'closed-lines
................................................................................
	          	(cons
	          		'path
	          		(foreign-value "CD_PATH" int)))]
	         [canvas-begin
	          (foreign-lambda void "cdCanvasBegin" nonnull-canvas int)]
	         [canvas-end
	          (foreign-lambda void "cdCanvasEnd" nonnull-canvas)])
	  (lambda (canvas canvas-mode proc)
	  	(let ([canvas-mode
	  	       (cond
	  	       	 [(assq canvas-mode canvas-modes) => cdr]
	  	       	 [else (error 'with-canvas-mode "unknown canvas mode" canvas-mode)])])
				(dynamic-wind
					(cut canvas-begin canvas canvas-mode)
					(cut proc canvas)
					(cut canvas-end canvas))))))

(define canvas-path-set!
	(letrec ([path-actions
	          (list
	          	(cons
	          		'new

Changes to racket/primitives.rkt.

455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
...
486
487
488
489
490
491
492
493
494
495
496
;; {{{ Vertex functions

(define _canvas-mode
  (_enum
   '(fill open-lines closed-lines clip bezier region path)
   _fixint))

(define with-canvas-mode
  (letrec ([canvas-begin/raw
            (get-ffi-obj
             "cdCanvasBegin" libcd
             (_fun [canvas : _canvas] [canvas-mode : _canvas-mode] -> _void))]
           [canvas-end/raw
            (get-ffi-obj
             "cdCanvasEnd" libcd
             (_fun [canvas : _canvas] -> _void))])
    (λ (canvas canvas-mode thunk)
      (dynamic-wind
       (cut canvas-begin/raw canvas canvas-mode)
       thunk
       (cut canvas-end/raw canvas)))))

(define _path-action
  (_enum
   '(new move-to line-to arc curve-to close fill stroke fill+stroke clip)
   _fixint))

................................................................................

(define canvas-vertex!
  (get-ffi-obj
   "cdfCanvasVertex" libcd
   (_fun [canvas : _canvas] [x : _double*] [y : _double*] -> _void)))

(provide
 with-canvas-mode canvas-path-set!
 canvas-vertex!)

;; }}}







|








|


|







 







|



455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
...
486
487
488
489
490
491
492
493
494
495
496
;; {{{ Vertex functions

(define _canvas-mode
  (_enum
   '(fill open-lines closed-lines clip bezier region path)
   _fixint))

(define call-with-canvas-in-mode
  (letrec ([canvas-begin/raw
            (get-ffi-obj
             "cdCanvasBegin" libcd
             (_fun [canvas : _canvas] [canvas-mode : _canvas-mode] -> _void))]
           [canvas-end/raw
            (get-ffi-obj
             "cdCanvasEnd" libcd
             (_fun [canvas : _canvas] -> _void))])
    (λ (canvas canvas-mode proc)
      (dynamic-wind
       (cut canvas-begin/raw canvas canvas-mode)
       (cut proc canvas)
       (cut canvas-end/raw canvas)))))

(define _path-action
  (_enum
   '(new move-to line-to arc curve-to close fill stroke fill+stroke clip)
   _fixint))

................................................................................

(define canvas-vertex!
  (get-ffi-obj
   "cdfCanvasVertex" libcd
   (_fun [canvas : _canvas] [x : _double*] [y : _double*] -> _void)))

(provide
 call-with-canvas-in-mode canvas-path-set!
 canvas-vertex!)

;; }}}