IUP

Changes On Branch simple-draw
Login
Home Timeline Branches Tags Tickets Wiki
Hide Diff Patch Side-by-Side Diff

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

Changes In Branch simple-draw Excluding Merge-Ins

This is equivalent to a diff from 72be863a1b to a1fa8c5f4f

2010-10-01
00:17
Maintenance checkpoint for CHICKEN check-in: 4ef9e4a448 user: murphy tags: trunk
00:11
Implemented the draw module in CHICKEN Leaf check-in: a1fa8c5f4f user: murphy tags: simple-draw
2010-09-30
23:53
Added cases for different callback argument and return types in the CHICKEN callback_entry trampoline check-in: 72be863a1b user: murphy tags: trunk
23:03
Documented the upcoming draw module check-in: 010b970f22 user: murphy tags: trunk

Changes to api/draw.wiki.

︙
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42

28
29
30
31
32
33
34

35
36
37
38
39
40
41
42








-
+








Create a simple drawing canvas from a canvas control.

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

Calls the given procedure with the given simple drawing canvas and ensures that
the canvas is synchronized with the underlying control.

<h3><a id="make-canvas-action"><code><nowiki>(make-canvas-action [proc (-> icanvas? any)]) → (-> ihandle? any)</nowiki></code></a></h3>
<h3><a id="make-canvas-action"><code><nowiki>(make-canvas-action [proc (-> icanvas? real? real? any)]) → (-> ihandle? real? real? any)</nowiki></code></a></h3>

Creates a procedure that is suitable as an action callback for a canvas control.
The resulting procedure creates a fresh simple drawing canvas when it is first
called and runs <code>(call-with-canvas canvas proc)</code> every time it is
called. The result of the call to <code>proc</code> is also the result of
the new procedure.
︙
83
84
85
86
87
88
89
90

91
92
93




83
84
85
86
87
88
89

90
91
92
93
94
95
96








-
+



+
+
+

vertical coordinates alternate in the vector <code>points</code>.

<h3><a id="draw-text"><code><nowiki>(draw-text [canvas icanvas?] [text string?] [x integer?] [y integer?] [r integer?] [g integer?] [b integer?]) → void?</nowiki></code></a></h3>

Draws the given string with its top left corner at the given coordinates using
the given color.

<h3><a id="draw-image"><code><nowiki>(draw-image [canvas icanvas?] [name (or/c symbol? string?)] [make-inactive? any/c] [x integer?] [y integer?]) → void?</nowiki></code></a></h3>
<h3><a id="draw-image"><code><nowiki>(draw-image [canvas icanvas?] [name (or/c symbol? string?)] [inactive? any/c] [x integer?] [y integer?]) → void?</nowiki></code></a></h3>

Draws the image identified by the given name with its top left corner at the
given coordinates.

If <code>inactive?</code> is true, the image is drawn in an inactive style, ie.
with a superimposed gray shadow.

Added chicken/iup-draw.scm. 



















































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

(require-library lolevel data-structures srfi-4 iup-base)

(module iup-draw
	(icanvas?
	 make-canvas call-with-canvas make-canvas-action
	 canvas-size
	 canvas-clip-rectangle-set! canvas-clip-reset!
	 canvas-flush
	 draw-parent-background
	 draw-line
	 draw-rectangle
	 draw-arc
	 draw-polygon
	 draw-text
	 draw-image)
	(import
		scheme chicken foreign
		lolevel data-structures srfi-4 iup-base)

;; {{{ Data types

(foreign-declare
	"#include <iup.h>\n"
	"typedef struct _IdrawCanvas *IdrawCanvas;\n"
	"IdrawCanvas *iupDrawCreateCanvas(Ihandle *ih);\n"
	"void iupDrawKillCanvas(IdrawCanvas *dc);\n"
	"void iupDrawFlush(IdrawCanvas *dc);\n"
	"void iupDrawUpdateSize(IdrawCanvas *dc);\n"
	"void iupDrawGetSize(IdrawCanvas *dc, int *w, int *h);\n"
	"void iupDrawParentBackground(IdrawCanvas *dc);\n"
	"void iupDrawLine(IdrawCanvas *dc, int x1, int y1, int x2, int y2, unsigned char r, unsigned char g, unsigned char b);\n"
	"void iupDrawRectangle(IdrawCanvas *dc, int x1, int y1, int x2, int y2, unsigned char r, unsigned char g, unsigned char b, int filled);\n"
	"void iupDrawArc(IdrawCanvas *dc, int x1, int y1, int x2, int y2, double a1, double a2, unsigned char r, unsigned char g, unsigned char b, int filled);\n"
	"void iupDrawPolygon(IdrawCanvas *dc, int *points, int count, unsigned char r, unsigned char g, unsigned char b, int filled);\n"
	"void iupDrawText(IdrawCanvas *dc, const char *text, int len, int x, int y, unsigned char r, unsigned char g, unsigned char b);\n"
	"void iupDrawImage(IdrawCanvas *dc, const char *name, int make_inactive, int x, int y);\n"
	"void iupDrawSetClipRect(IdrawCanvas *dc, int x1, int y1, int x2, int y2);\n"
	"void iupDrawResetClip(IdrawCanvas *dc);\n")
	
(include "iup-types.scm")

(define *icanvas-tag* "IdrawCanvas")
(define icanvas? (cut tagged-pointer? <> *icanvas-tag*))

(define (icanvas->pointer nonnull?)
	(if nonnull?
		(lambda (handle)
			(ensure icanvas? handle)
			handle)
		(lambda (handle)
			(ensure (disjoin not icanvas?) handle)
			handle)))

(define (pointer->icanvas nonnull?)
	(if nonnull?
		(lambda (handle)
			(ensure pointer? handle)
			(tag-pointer handle *icanvas-tag*))
		(lambda (handle)
			(and handle (tag-pointer handle *icanvas-tag*)))))

(define-foreign-type icanvas (c-pointer "IdrawCanvas")
	(icanvas->pointer #f)
	(pointer->icanvas #f))

(define-foreign-type nonnull-icanvas (nonnull-c-pointer "IdrawCanvas")
	(icanvas->pointer #t)
	(pointer->icanvas #t))

;; }}}

;; {{{ Canvas management

(define make-canvas
	(letrec ([make-canvas/raw (foreign-lambda nonnull-icanvas "iupDrawCreateCanvas" nonnull-ihandle)]
	         [canvas-kill! (foreign-lambda void "iupDrawKillCanvas" nonnull-icanvas)])
		(lambda (handle)
			(set-finalizer! (make-canvas/raw handle) canvas-kill!))))

(define call-with-canvas
	(letrec ([canvas-update-size! (foreign-lambda void "iupDrawUpdateSize" nonnull-icanvas)])
		(lambda (canvas proc)
			(dynamic-wind
				(cut canvas-update-size! canvas)
				(cut proc canvas)
				(cut canvas-flush canvas)))))

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

(define canvas-size
	(letrec ([canvas-size/raw (foreign-lambda void "iupDrawGetSize" nonnull-icanvas (c-pointer int) (c-pointer int))])
		(lambda (canvas)
			(let-location ([width int -1] [height int -1])
				(canvas-size/raw canvas (location width) (location height))
				(values
					(and (not (negative? width)) width)
					(and (not (negative? height)) height))))))

;; }}}

;; {{{ Drawing functions

(define canvas-clip-rectangle-set!
	(foreign-lambda void "iupDrawSetClipRect" nonnull-icanvas int int int int))

(define canvas-clip-reset!
	(foreign-lambda void "iupDrawResetClip" nonnull-icanvas))

(define canvas-flush
	(foreign-lambda void "iupDrawFlush" nonnull-icanvas))

(define draw-parent-background
	(foreign-lambda void "iupDrawParentBackground" nonnull-icanvas))

(define draw-line
	(foreign-lambda void "iupDrawLine" nonnull-icanvas int int int int unsigned-byte unsigned-byte unsigned-byte))

(define draw-rectangle
	(foreign-lambda void "iupDrawRectangle" nonnull-icanvas int int int int unsigned-byte unsigned-byte unsigned-byte bool))

(define draw-arc
	(foreign-lambda void "iupDrawArc" nonnull-icanvas int int int int double double unsigned-byte unsigned-byte unsigned-byte bool))

(define draw-polygon
	(letrec ([draw-polygon/raw (foreign-lambda void "iupDrawPolygon" nonnull-icanvas s32vector int unsigned-byte unsigned-byte unsigned-byte bool)])
		(lambda (canvas points r g b filled?)
			(let ([count (s32vector-length points)])
				(ensure even? count)
				(draw-polygon/raw canvas points (/ count 2) r g b filled?)))))

(define draw-text
	(letrec ([draw-text/raw (foreign-lambda void "iupDrawText" nonnull-icanvas nonnull-c-string int int int unsigned-byte unsigned-byte unsigned-byte)])
		(lambda (canvas text x y r g b)
			(draw-text/raw canvas text (string-length text) x y r g b))))

(define draw-image
	(foreign-lambda void "iupDrawImage" nonnull-icanvas iname/downcase bool int int))

;; }}}

)








Changes to chicken/iup.setup.



1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35

36
37











38
39
40
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
57
58
59
60
61
62

63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85

86

1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66
67
68
69
70
71
72

73
74
75
76
77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92
93
94
95

96
97













-
+










-
+










-
+


+
+
+
+
+
+
+
+
+
+
+










-
+













-
+











-
+










-
+


(if (and (find-library "callback" "alloc_trampoline_r")
         (find-library "iup" "IupOpen")
         (find-library "iupim" "IupLoadImage")
         (find-library "iupimglib" "IupImageLibOpen"))
	(begin
		(compile -s -O2 -d1 "iup-base.scm" -j iup-base "-lcallback -liup -liupim -liupimglib")
		(compile -c -O2 -d1 "iup-base.scm" -j iup-base -unit iup-base)
		(compile -s -O2 -d0 "iup-base.import.scm")
		
		(install-extension
		 'iup-base
		 '("iup-base.so" "iup-base.o" "iup-base.import.so" "iup-types.scm")
		 '((version 1.0.0)
		 '((version 1.1.0)
			 (static "iup-base.o")
			 (static-options "-lcallback -liup -liupim -liupimglib")))
		
		(compile -s -O2 -d1 "iup-controls.scm" -j iup-controls "-liup -liupcontrols")
		(compile -c -O2 -d1 "iup-controls.scm" -j iup-controls -unit iup-controls)
		(compile -s -O2 -d0 "iup-controls.import.scm")
		
		(install-extension
		 'iup-controls
		 '("iup-controls.so" "iup-controls.o" "iup-controls.import.so")
		 '((version 1.0.0)
		 '((version 1.1.0)
			 (static "iup-controls.o")
			 (static-options "-liup -liupcontrols")))
		
		(compile -s -O2 -d1 "iup-dialogs.scm" -j iup-dialogs "-liup")
		(compile -c -O2 -d1 "iup-dialogs.scm" -j iup-dialogs -unit iup-dialogs)
		(compile -s -O2 -d0 "iup-dialogs.import.scm")
		
		(install-extension
		 'iup-dialogs
		 '("iup-dialogs.so" "iup-dialogs.o" "iup-dialogs.import.so")
		 '((version 1.0.0)
		 '((version 1.1.0)
			 (static "iup-dialogs.o")
			 (static-options "-liup")))
		
		(compile -s -O2 -d1 "iup-draw.scm" -j iup-draw "-liup")
		(compile -c -O2 -d1 "iup-draw.scm" -j iup-draw -unit iup-draw)
		(compile -s -O2 -d0 "iup-draw.import.scm")
		
		(install-extension
		 'iup-draw
		 '("iup-draw.so" "iup-draw.o" "iup-draw.import.so")
		 '((version 1.1.0)
			 (static "iup-draw.o")
			 (static-options "-liup")))
		
		(if (find-library "iupgl" "IupGLCanvasOpen")
			(begin
				(compile -s -O2 -d1 "iup-glcanvas.scm" -j iup-glcanvas "-liup -liupgl")
				(compile -c -O2 -d1 "iup-glcanvas.scm" -j iup-glcanvas -unit iup-glcanvas)
				(compile -s -O2 -d0 "iup-glcanvas.import.scm")
				
				(install-extension
				 'iup-glcanvas
				 '("iup-glcanvas.so" "iup-glcanvas.o" "iup-glcanvas.import.so")
				 '((version 1.0.0)
				 '((version 1.1.0)
					 (static "iup-glcanvas.o")
					 (static-options "-liup -liupgl"))))
			(warning "IUP GLCanvas not found, bindings will not be compiled"))
		
		(if (find-library "iup_pplot" "IupPPlotOpen")
			(begin
				(compile -s -O2 -d1 "iup-pplot.scm" -j iup-pplot "-liup -liup_pplot")
				(compile -c -O2 -d1 "iup-pplot.scm" -j iup-pplot -unit iup-pplot)
				(compile -s -O2 -d0 "iup-pplot.import.scm")
				
				(install-extension
				 'iup-pplot
				 '("iup-pplot.so" "iup-pplot.o" "iup-pplot.import.so")
				 '((version 1.0.0)
				 '((version 1.1.0)
					 (static "iup-pplot.o")
					 (static-options "-liup -liup_pplot"))))
			(warning "IUP PPlot not found, bindings will not be compiled"))
		
		(compile -s -O2 -d1 "iup.scm" -j iup)
		(compile -c -O2 -d1 "iup.scm" -j iup -unit iup)
		(compile -s -O2 -d0 "iup.import.scm")
		
		(install-extension
		 'iup
		 '("iup.so" "iup.o" "iup.import.so")
		 '((version 1.0.0)
		 '((version 1.1.0)
			 (static "iup.o"))))
	(warning "IUP not found, bindings will not be compiled"))

(compile -s -O2 -d1 "iup-dynamic.scm" -j iup-dynamic)
(compile -c -O2 -d1 "iup-dynamic.scm" -j iup-dynamic -unit iup-dynamic)
(compile -s -O2 -d0 "iup-dynamic.import.scm")

(install-extension
 'iup-dynamic
 '("iup-dynamic.so" "iup-dynamic.o" "iup-dynamic.import.so")
 '((version 1.0.0)
 '((version 1.1.0)
   (static "iup-dynamic.o")))













This page was generated in about
0.011s by
Fossil 2.24 [8be0372c10] 2024-04-23 13:25:26