Canvas Draw

Check-in [6de509cbc5]
Login

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

Overview
Comment:Added make-cells-draw-cb support procedure for code using the IUP cells widget
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 6de509cbc5a10ca7ff59a4d8094ef8c774a0f9ca
User & Date: murphy 2011-03-23 19:21:37
Context
2011-03-23
19:30
Documented make-cells-draw-cb check-in: 567c93425d user: murphy tags: trunk
19:21
Added make-cells-draw-cb support procedure for code using the IUP cells widget check-in: 6de509cbc5 user: murphy tags: trunk
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
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

1
2
3
4
5
6
7
8
9
10
11
..
25
26
27
28
29
30
31





32
33
34
(require-library canvas-draw-base)

(module canvas-draw-iup
	(context:iup make-canvas-action)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

(foreign-declare
	"#include <cd.h>\n"
	"#include <cdiup.h>\n")
................................................................................

(define (make-canvas-action proc)
	(let ([canvas #f])
		(lambda (handle x y)
			(unless canvas (set! canvas (make-canvas context:iup handle)))
			(call-with-canvas canvas (cut proc <> x y)))))






;; }}}

)



|







 







>
>
>
>
>



1
2
3
4
5
6
7
8
9
10
11
..
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
(require-library canvas-draw-base)

(module canvas-draw-iup
	(context:iup make-canvas-action make-cells-draw-cb)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

(foreign-declare
	"#include <cd.h>\n"
	"#include <cdiup.h>\n")
................................................................................

(define (make-canvas-action proc)
	(let ([canvas #f])
		(lambda (handle x y)
			(unless canvas (set! canvas (make-canvas context:iup handle)))
			(call-with-canvas canvas (cut proc <> x y)))))

(define (make-cells-draw-cb proc)
	(let ([wrap (pointer->canvas #t)])
		(lambda (handle i j x-min x-max y-min y-max canvas)
			(call-with-canvas (wrap canvas) (cut proc handle i j x-min x-max y-min y-max <>)))))

;; }}}

)

Changes to racket/iup.rkt.

25
26
27
28
29
30
31




32
33
34
35

(define (make-canvas-action proc)
  (let ([canvas #f])
    (λ (handle x y)
      (unless canvas (set! canvas (make-canvas context:iup handle)))
      (call-with-canvas canvas (cut proc <> x y)))))





(provide
 make-canvas-action)

;; }}}







>
>
>
>

|


25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

(define (make-canvas-action proc)
  (let ([canvas #f])
    (λ (handle x y)
      (unless canvas (set! canvas (make-canvas context:iup handle)))
      (call-with-canvas canvas (cut proc <> x y)))))

(define (make-cells-draw-cb proc)
  (lambda (handle i j x-min x-max y-min y-max canvas)
    (call-with-canvas (cast canvas _pointer _canvas) (cut proc handle i j x-min x-max y-min y-max <>))))

(provide
 make-canvas-action make-cells-draw-cb)

;; }}}