Overview
Comment:Re-ran configure in ffcall and imported canvas-draw source
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ed10f826ffe027cbf00b2e1e49dc3bc81a9a386a
User & Date: matt on 2011-01-30 17:39:09
Other Links: manifest | tags
Context
2011-01-30
19:14
Added canvas-draw build to makefile and tweaked canvas-draw.setup to allow building on Windows check-in: 8ca036fa3c user: matt tags: trunk
17:39
Re-ran configure in ffcall and imported canvas-draw source check-in: ed10f826ff user: matt tags: trunk
17:11
Adding ffcall (and built files) check-in: 24d3bc4776 user: matt tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added canvas-draw/LICENSE.txt version [0f326ce34f]. 





















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

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

Copyright (C) 2010 Thomas Chust <chust@web.de>.  All rights reserved.

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the Software),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.








Added canvas-draw/api/base.wiki version [01dd0798b9].

































































































































































































































































































































































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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349

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

<h1><tt>base</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/base))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-base)</code></td>
	</tr>
</table>

Basic CD library support. Initializes the CD library when loaded.

<h2>Data Types</h2>

<h3><a id="canvas_"><code><nowiki>(canvas? [v any/c]) → boolean?</nowiki></code></a></h3>

Check whether a value is a CD canvas.

<h3><a id="context_"><code><nowiki>(context? [v any/c]) → boolean?</nowiki></code></a></h3>

Check whether a value is a CD driver context.

<h3><a id="state_"><code><nowiki>(state? [v any/c]) → boolean?</nowiki></code></a></h3>

Check whether a value is a CD canvas state.

<h2>Canvas Management</h2>

<h3><a id="context-capabilities"><code><nowiki>(context-capabilities [context context?]) → (listof symbol?)</nowiki></code></a></h3>

Returns a list of flags describing the capabilities supported by the given
context.

The following flags may show up in the list:
  *  <code>'flush</code>
  *  <code>'clear</code>
  *  <code>'play</code>
  *  <code>'y-axis</code>
  *  <code>'clip-area</code>
  *  <code>'clip-polygon</code>
  *  <code>'region</code>
  *  <code>'rectangle</code>
  *  <code>'chord</code>
  *  <code>'image/rgb</code>
  *  <code>'image/rgba</code>
  *  <code>'image/map</code>
  *  <code>'get-image/rgb</code>
  *  <code>'image/server</code>
  *  <code>'background</code>
  *  <code>'background-opacity</code>
  *  <code>'write-mode</code>
  *  <code>'line-style</code>
  *  <code>'line-width</code>
  *  <code>'fprimtives</code>
  *  <code>'hatch</code>
  *  <code>'stipple</code>
  *  <code>'pattern</code>
  *  <code>'font</code>
  *  <code>'font-dimensions</code>
  *  <code>'text-size</code>
  *  <code>'text-orientation</code>
  *  <code>'palette</code>
  *  <code>'line-cap</code>
  *  <code>'line-join</code>
  *  <code>'path</code>
  *  <code>'bezier</code>

<h3><a id="use-context_"><code><nowiki>[use-context+ (parameter/c any)]</nowiki></code></a></h3>

A parameter determining whether calls to <code>[#make-canvas|make-canvas]</code>
should use extended variants of the passed context drivers.

Defaults to <code>#f</code>.

<h3><a id="make-canvas"><code><nowiki>(make-canvas [context context?] [data (or/c string? pointer?)]) → canvas?</nowiki></code></a></h3>

Creates a new canvas with the given driver context. The <code>data</code> is
context specific and is either a string describing the setup of the new canvas
or a pointer to some native data object.

<h3><a id="call-with-canvas"><code>
	<nowiki>(call-with-canvas [canvas canvas?] [proc (-> canvas? any)]) → any</nowiki><br>
	<nowiki>(call-with-canvas [context context?] [data (or/c string? pointer?)] [proc (-> canvas? any)]) → any</nowiki>
</code></a></h3>

Calls the given procedure with the given canvas and makes sure the canvas is
synchronized with external resources around the call.

If called in the three argument form, a fresh canvas is created using the given
context and is automatically destroyed upon return from the given procedure.

<h3><a id="canvas-context"><code><nowiki>(canvas-context [canvas canvas?]) → context?</nowiki></code></a></h3>

Retrieves the context from a given canvas.

<h3><a id="canvas-simulate_"><code><nowiki>(canvas-simulate! [canvas canvas?] [flags (listof symbol?)]) → (listof symbol?)</nowiki></code></a></h3>

Sets flags determining which operations should be simulated by the given canvas.
Returns the previous set of flags.

The following flags may show up in the list:
  *  <code>'line</code>
  *  <code>'rectangle</code>
  *  <code>'box</code>
  *  <code>'arc</code>
  *  <code>'sector</code>
  *  <code>'chord</code>
  *  <code>'polyline</code>
  *  <code>'polygon</code>
  *  <code>'text</code>
  *  <code>'all</code>
  *  <code>'lines</code>
  *  <code>'fills</code>

<h3><a id="canvas-attribute"><code><nowiki>(canvas-attribute [canvas canvas?] [name (or/c symbol? string?)]) → (or/c string? #f)</nowiki></code></a></h3>

Retrieves the value of a context specific canvas attribute.

<h3><a id="canvas-attribute-set_"><code>
	<nowiki>(canvas-attribute-set! [canvas canvas?] [name (or/c symbol? string?)] [value (or/c string? #f)]) → void?</nowiki><br>
	<nowiki>(set! (canvas-attribute [canvas canvas?] [name (or/c symbol? string?)]) [value (or/c string? #f)]) → void?</nowiki>
</code></a></h3>

Sets the value of a context specific canvas attribute.

<h3><a id="canvas-state"><code><nowiki>(canvas-state [canvas canvas?]) → state?</nowiki></code></a></h3>

Extracts a representation of the current state from a canvas.

<h3><a id="canvas-state-set_"><code>
	<nowiki>(canvas-state-set! [canvas canvas?] [state state?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-state [canvas canvas?]) [state state?]) → void?</nowiki>
</code></a></h3>

Restores the given state of a canvas.

<h3><a id="canvas-clear_"><code><nowiki>(canvas-clear! [canvas canvas?]) → void?</nowiki></code></a></h3>

Clears a canvas to the background color.

<h3><a id="canvas-flush"><code><nowiki>(canvas-flush [canvas canvas?]) → void?</nowiki></code></a></h3>

Flushes all pending drawing operations in a canvas to its backend.

<h2>Coordinate System</h2>

<h3><a id="canvas-size"><code><nowiki>(canvas-size [canvas canvas?]) → (values integer? integer? real? real?)</nowiki></code></a></h3>

Retrieves the width and height of the given canvas in pixels and millimeters.

<h3><a id="canvas-mm->px"><code><nowiki>(canvas-mm->px [canvas canvas?] [x/mm real?] [y/mm real?]) → (values integer? integer?)</nowiki></code></a></h3>

Converts a position given in millimeters into a pixel position in the given
canvas.

<h3><a id="canvas-px->mm"><code><nowiki>(canvas-px->mm [canvas canvas?] [x/px integer?] [y/px integer?]) → (values real? real?)</nowiki></code></a></h3>

Converts a position given in pixels into a physical position in the given
canvas.

<h3><a id="canvas-origin"><code><nowiki>(canvas-origin [canvas canvas?]) → (values integer? integer?)</nowiki></code></a></h3>

Retrieves the position of the canvas' origin.

<h3><a id="canvas-origin-set_"><code><nowiki>(canvas-origin-set! [canvas canvas?] [x integer?] [y integer?]) → void?</nowiki></code></a></h3>

Defines the position of the canvas' origin.

<h3><a id="canvas-transform"><code><nowiki>(canvas-transform [canvas canvas?]) → (or/c (-> real? real? (values integer? integer?)) #f)</nowiki></code></a></h3>

Retrieves the active coordinate transformation of the given canvas.

<h3><a id="canvas-transform-set_"><code>
	<nowiki>(canvas-transform-set! [canvas canvas?] [proc (or/c (-> real? real? (values integer? integer?)) #f)]) → void?</nowiki><br>
	<nowiki>(set! (canvas-transform [canvas canvas?]) [proc (or/c (-> real? real? (values integer? integer?)) #f)]) → void?</nowiki>
</code></a></h3>

Defines the active coordinate transformation for the given canvas. The given
procedure must represent a linear transformation.

<h3><a id="canvas-transform-compose_"><code><nowiki>(canvas-transform-compose! [canvas canvas?] [proc (-> real? real? (values integer? integer?))]) → void?</nowiki></code></a></h3>

Modifies the active coordinate transformation for the given canvas by
left-multiplication with the given transformation. The given procedure must
represent a linear transformation.

<h3><a id="canvas-transform-translate_"><code><nowiki>(canvas-transform-translate! [canvas canvas?] [dx real?] [dy real?]) → void?</nowiki></code></a></h3>

Modifies the active coordinate transformation for the given canvas applying
a translation.

<h3><a id="canvas-transform-scale!"><code><nowiki>(canvas-transform-scale! [canvas canvas?] [sx real?] [sy real?]) → void?</nowiki></code></a></h3>

Modifies the active coordinate transformation for the given canvas applying
a scaling.

<h3><a id="canvas-transform-rotate!"><code><nowiki>(canvas-transform-rotate! [canvas canvas?] [alpha real?]) → void?</nowiki></code></a></h3>

Modifies the active coordinate transformation for the given canvas applying
a rotation around the origin.

<h2>General Attributes</h2>

<h3><a id="canvas-foreground"><code><nowiki>(canvas-foreground [canvas canvas?]) → integer?</nowiki></code></a></h3>

Retrieves the foreground color of the given canvas.

<h3><a id="canvas-foreground-set_"><code>
	<nowiki>(canvas-foreground-set! [canvas canvas?] [color integer?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-foreground [canvas canvas?]) [color integer?]) → void?</nowiki>
</code></a></h3>

Sets the foreground color of the given canvas.

<h3><a id="canvas-background"><code><nowiki>(canvas-background [canvas canvas?]) → integer?</nowiki></code></a></h3>

Retrieves the background color of the given canvas.

<h3><a id="canvas-background-set_"><code>
	<nowiki>(canvas-background-set! [canvas canvas?] [color integer?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-background [canvas canvas?]) [color integer?]) → void?</nowiki>
</code></a></h3>

Sets the background color of the given canvas.

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

Retrieves the write mode of the given canvas.

The mode may be one of the following symbols:
  *  <code>'replace</code>
  *  <code>'xor</code>
  *  <code>'not-xor</code>

<h3><a id="canvas-write-mode-set_"><code>
	<nowiki>(canvas-write-mode-set! [canvas canvas?] [mode symbol?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-write-mode [canvas canvas?]) [mode symbol?]) → void?</nowiki>
</code></a></h3>

Sets the write mode of the given canvas.

<h2>Clipping</h2>

<h3><a id="canvas-clip-mode"><code><nowiki>(canvas-clip-mode [canvas canvas?]) → (or/c symbol? #f)</nowiki></code></a></h3>

Retrieves the clipping mode of the given canvas.

The mode may be one of the following values:
  *  <code>'area</code>
  *  <code>'polygon</code>
  *  <code>'region</code>
  *  <code>#f</code>

In fact, <code>#t</code> is never returned but may be used when setting the
clipping mode.

<h3><a id="canvas-clip-mode-set_"><code>
	<nowiki>(canvas-clip-mode-set! [canvas canvas?] [mode (or/c symbol? #f)]) → void?</nowiki><br>
	<nowiki>(set! (canvas-clip-mode [canvas canvas?]) [mode (or/c symbol? #f)]) → void?</nowiki>
</code></a></h3>

Sets the clipping mode of the given canvas.

<h3><a id="canvas-clip-area"><code><nowiki>(canvas-clip-area [canvas canvas?]) → (values real? real? real? real?)</nowiki></code></a></h3>

Retrieves the current rectangular clipping area of the given canvas.

<h3><a id="canvas-clip-area-set_"><code><nowiki>(canvas-clip-area-set! [canvas canvas?] [x0 double?] [x1 double?] [y0 double?] [y1 double?]) → void?</nowiki></code></a></h3>

Sets the current rectangular clipping area of the given canvas.

<h2>Racket Specifics</h2>

<h3><a id="_canvas"><code>
	<nowiki>[_canvas ctype?]</nowiki><br>
	<nowiki>[_canvas/null ctype?]</nowiki><br>
</code></a></h3>

Foreign type of CD canvasses, which may optionally be <code>NULL</code>.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.

<h3><a id="_context"><code>
	<nowiki>[_context ctype?]</nowiki><br>
	<nowiki>[_context/null ctype?]</nowiki><br>
</code></a></h3>

Foreign type of CD contexts, which may optionally be <code>NULL</code>.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.

<h3><a id="_state"><code>
	<nowiki>[_state ctype?]</nowiki><br>
	<nowiki>[_state/null ctype?]</nowiki><br>
</code></a></h3>

Foreign type of CD states, which may optionally be <code>NULL</code>.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.

<h2>CHICKEN Specifics</h2>

The <tt>base</tt> module only exports checking type conversion functions
instead of foreign types since the latter cannot be exported. To define
the types <code>canvas</code>, <code>nonnull-canvas</code>,
<code>context</code>, <code>nonnull-context</code>, <code>state</code> and
<code>nonnull-state</code> in your own module, include the file
<tt>"canvas-draw-types.scm"</tt>.

<h3><a id="canvas-_pointer"><code><nowiki>((canvas->pointer [nonnull? any/c]) [canvas (or/c canvas? #f)]) → (or/c pointer? #f)</nowiki></code></a></h3>

Checking conversion from canvasses to pointers.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.

<h3><a id="pointer-_canvas"><code><nowiki>((pointer->canvas [nonnull? any/c]) [canvas (or/c pointer? #f)]) → (or/c canvas? #f)</nowiki></code></a></h3>

Checking conversion from pointers to canvasses.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.

<h3><a id="context-_pointer"><code><nowiki>((context->pointer [nonnull? any/c]) [context (or/c context? #f)]) → (or/c pointer? #f)</nowiki></code></a></h3>

Checking conversion from contexts to pointers.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.

<h3><a id="pointer-_context"><code><nowiki>((pointer->context [nonnull? any/c]) [context (or/c pointer? #f)]) → (or/c context? #f)</nowiki></code></a></h3>

Checking conversion from pointers to contexts.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.

<h3><a id="state-_pointer"><code><nowiki>((state->pointer [nonnull? any/c]) [state (or/c state? #f)]) → (or/c pointer? #f)</nowiki></code></a></h3>

Checking conversion from states to pointers.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.

<h3><a id="pointer-_state"><code><nowiki>((pointer->state [nonnull? any/c]) [state (or/c pointer? #f)]) → (or/c state? #f)</nowiki></code></a></h3>

Checking conversion from pointers to states.

Not re-exported from the <tt>[./main.wiki|main]</tt> module.








Added canvas-draw/api/cgm.wiki version [2b71cdedb4].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>cgm</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/cgm))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-cgm)</code></td>
	</tr>
</table>

CGM context support.

<h2>Context Types</h2>

<h3><a id="context:cgm"><code><nowiki>[context:cgm context?]</nowiki></code></a></h3>

Context type for CGM files.








Added canvas-draw/api/client.wiki version [239992612e].















































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

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

<h1><tt>client</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/client))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-client)</code></td>
	</tr>
</table>

Client context support.

<h2>Context Types</h2>

<h3><a id="context:image"><code><nowiki>[context:image context?]</nowiki></code></a></h3>

Context type for client side pixel buffers.

<h3><a id="context:double-buffer"><code><nowiki>[context:double-buffer context?]</nowiki></code></a></h3>

Context type for client side double buffers.

<h2>Auxiliary Functions<h2>

<h3><a id="canvas-image_rgb"><code><nowiki>(canvas-image/rgb [canvas canvas?] [x integer?] [y integer?] [width integer?] [height integer?]) → blob?</nowiki></code></a></h3>

Retrieve a region of the given canvas as an RGB image.

<h3><a id="canvas-image-put_rgb_"><code>
	<nowiki>(canvas-image-put/rgb! [canvas canvas?] [x integer?] [y integer?] [width integer?] [height integer?] [data blob?] #:width [dst-width integer? 0] #:height [dst-height integer? 0] #:x0 [src-x0 integer? 0] #:x1 [src-x1 integer? 0] #:y0 [src-y0 integer? 0] #:y1 [src-y1 integer? 0]) → void?</nowiki><br>
	<nowiki>(set! (canvas-image/rgb [canvas canvas?] [x integer?] [y integer?] [width integer?] [height integer?]) [data blob?]) → void?</nowiki>
</code></a></h3>

Replace a region of the given canvas with an RGB image.

<h3><a id="canvas-image-put_rgba_"><code><nowiki>(canvas-image-put/rgba! [canvas canvas?] [x integer?] [y integer?] [width integer?] [height integer?] [data blob?] #:width [dst-width integer? 0] #:height [dst-height integer? 0] #:x0 [src-x0 integer? 0] #:x1 [src-x1 integer? 0] #:y0 [src-y0 integer? 0] #:y1 [src-y1 integer? 0]) → void?</nowiki></code></a></h3>

Replace a region of the given canvas with an RGBA image.








Added canvas-draw/api/clipboard.wiki version [3cffe76749].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>clipboard</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/clipboard))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-clipboard)</code></td>
	</tr>
</table>

Clipboard context support.

<h2>Context Types</h2>

<h3><a id="context:clipboard"><code><nowiki>[context:clipboard context?]</nowiki></code></a></h3>

Context type for the system clipboard.








Added canvas-draw/api/debug.wiki version [e61598f3ec].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>debug</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/debug))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-debug)</code></td>
	</tr>
</table>

Debug log context support.

<h2>Context Types</h2>

<h3><a id="context:debug"><code><nowiki>[context:debug context?]</nowiki></code></a></h3>

Context type for debug log files.








Added canvas-draw/api/dgn.wiki version [d803d2e8b8].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>dgn</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/dgn))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-dgn)</code></td>
	</tr>
</table>

DGN context support.

<h2>Context Types</h2>

<h3><a id="context:dgn"><code><nowiki>[context:dgn context?]</nowiki></code></a></h3>

Context type for DGN files.








Added canvas-draw/api/dxf.wiki version [7456a1e3e9].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>dxf</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/dxf))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-dxf)</code></td>
	</tr>
</table>

DXF context support.

<h2>Context Types</h2>

<h3><a id="context:dxf"><code><nowiki>[context:dxf context?]</nowiki></code></a></h3>

Context type for DXF files.








Added canvas-draw/api/emf.wiki version [f046287334].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>emf</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/emf))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-emf)</code></td>
	</tr>
</table>

EMF context support.

<h2>Context Types</h2>

<h3><a id="context:emf"><code><nowiki>[context:emf context?]</nowiki></code></a></h3>

Context type for EMF files.








Added canvas-draw/api/gl.wiki version [0fb6b8938a].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>gl</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/gl))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-gl)</code></td>
	</tr>
</table>

OpenGL context support.

<h2>Context Types</h2>

<h3><a id="context:gl"><code><nowiki>[context:gl context?]</nowiki></code></a></h3>

Context type for OpenGL rendering.








Added canvas-draw/api/iup.wiki version [f2ac6fadac].

































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

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

<h1><tt>iup</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/iup))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-iup)</code></td>
	</tr>
</table>

IUP context support.

<h2>Context Types</h2>

<h3><a id="context:iup"><code><nowiki>[context:iup context?]</nowiki></code></a></h3>

Context type for IUP canvas widgets.

<h2>Auxiliary Functions<h2>

<h3><a id="make-canvas-action"><code><nowiki>(make-canvas-action [proc (-> canvas-draw:canvas? integer? integer? any)]) → (-> iup:canvas? integer? integer? any)</nowiki></code></a></h3>

Creates an IUP canvas action callback from a function operating on a Canvas Draw
canvas.








Added canvas-draw/api/main.wiki version [f304938038].


































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

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

<h1><tt>main</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw)</code></td>
	</tr>
</table>

This module re-exports most bindings from the <tt>[./base.wiki|base]</tt>,
<tt>[./play.wiki|play]</tt> and <tt>[./primitives.wiki|primitives]</tt> modules.

To create canvasses you also have to import bindings from at least one of the
context modules: <tt>[./iup.wiki|iup]</tt>, <tt>[./native.wiki|native]</tt>,
<tt>[./gl.wiki|gl]</tt>, <tt>[./clipboard.wiki|clipboard]</tt>,
<tt>[./printer.wiki|printer]</tt>, <tt>[./picture.wiki|picture]</tt>,
<tt>[./server.wiki|server]</tt>, <tt>[./client.wiki|client]</tt>,
<tt>[./pdf.wiki|pdf]</tt>, <tt>[./ps.wiki|ps]</tt>, <tt>[./svg.wiki|svg]</tt>,
<tt>[./metafile.wiki|metafile]</tt>, <tt>[./debug.wiki|debug]</tt>,
<tt>[./cgm.wiki|cgm]</tt>, <tt>[./dgn.wiki|dgn]</tt>, <tt>[./dxf.wiki|dxf]</tt>,
<tt>[./emf.wiki|emf]</tt>, <tt>[./wmf.wiki|wmf]</tt>.

The foreign types and conversion procedures defined in <tt>[./base.wiki|base]</tt>
are not re-exported.








Added canvas-draw/api/metafile.wiki version [cc4eafd9d5].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>metafile</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/metafile))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-metafile)</code></td>
	</tr>
</table>

Canvas Draw metafile context support.

<h2>Context Types</h2>

<h3><a id="context:metafile"><code><nowiki>[context:metafile context?]</nowiki></code></a></h3>

Context type for MF files.








Added canvas-draw/api/native.wiki version [907ab1647b].
































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

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

<h1><tt>native</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/native))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-native)</code></td>
	</tr>
</table>

Native context support. Initializes context+ support when loaded.

<h2>Context Types</h2>

<h3><a id="context:native"><code><nowiki>[context:native context?]</nowiki></code></a></h3>

Context type for native windows.

<h2>Auxiliary Functions<h2>

<h3><a id="screen-size"><code><nowiki>(screen-size) → (values integer? integer? real? real?)</nowiki></code></a></h3>

Determines the width and height of the whole screen in pixels and millimeters.








Added canvas-draw/api/pdf.wiki version [17ab6eed22].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>pdf</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/pdf))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-pdf)</code></td>
	</tr>
</table>

PDF context support.

<h2>Context Types</h2>

<h3><a id="context:pdf"><code><nowiki>[context:pdf context?]</nowiki></code></a></h3>

Context type for PDF files.








Added canvas-draw/api/picture.wiki version [242f6b8a92].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>picture</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/picture))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-picture)</code></td>
	</tr>
</table>

Picture context support.

<h2>Context Types</h2>

<h3><a id="context:picture"><code><nowiki>[context:picture context?]</nowiki></code></a></h3>

Context type for in-memory pictures.








Added canvas-draw/api/play.wiki version [06ca7a82a6].



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

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

<h1><tt>play</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/play))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-play)</code></td>
	</tr>
</table>

Replay functionality.

<h2>Context Content Replay</h2>

<h3><a id="canvas-play_"><code><nowiki>(canvas-play! [canvas canvas?] [context context?] [x0 integer?] [x1 integer?] [y0 integer?] [y1 integer?] [data (or/c string? pointer?)]) → void?</nowiki></code></a></h3>

Replays the drawing contained in the context with the given data in the given
canvas.








Added canvas-draw/api/primitives.wiki version [36cfca72a5].




























































































































































































































































































































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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312

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

<h1><tt>primitives</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/primitives))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-primitives)</code></td>
	</tr>
</table>

Drawing primitives.

<h2>Points</h2>

<h3><a id="canvas-pixel_"><code><nowiki>(canvas-pixel! [canvas canvas?] [x integer?] [y integer?] [color integer? (canvas-foreground canvas)]) → void?</nowiki></code></a></h3>

Draws a single pixel of the given color on the given canvas.

<h3><a id="canvas-mark!"><code><nowiki>(canvas-mark! [canvas canvas?] [x integer?] [y integer?]) → void?</nowiki></code></a></h3>

Draws a marker symbol on the given canvas.

<h3><a id="canvas-mark-type"><code><nowiki>(canvas-mark-type [canvas canvas?]) → symbol?</nowiki></code></a></h3>

Retrieves the current marker symbol type for the given canvas. Possible values
are

  *  <code>'+</code> or <code>'plus</code>
  *  <code>'*</code> or <code>'star</code>
  *  <code>'0</code> or <code>'circle</code>
  *  <code>'O</code> or <code>'hollow-circle</code>
  *  <code>'X</code> or <code>'x</code>
  *  <code>'box</code>
  *  <code>'hollow-box</code>
  *  <code>'diamond</code>
  *  <code>'hollow-diamond</code>

<h3><a id="canvas-mark-type-set_"><code>
	<nowiki>(canvas-mark-type-set! [canvas canvas?] [mark-type symbol?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-mark-type [canvas canvas?]) [mark-type symbol?]) → void?</nowiki>
</code></a></h3>

Sets the current marker symbol type for the given canvas.

<h3><a id="canvas-mark-size"><code><nowiki>(canvas-mark-size [canvas canvas?]) → integer?</nowiki></code></a></h3>

Retrieves the current marker symbol size for the given canvas.

<h3><a id="canvas-mark-size-set_"><code>
	<nowiki>(canvas-mark-size-set! [canvas canvas?] [size integer?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-mark-size [canvas canvas?]) [size integer?]) → void?</nowiki>
</code></a></h3>

Sets the current marker symbol size for the given canvas.

<h2>Lines</h2>

<h3><a id="canvas-line_"><code><nowiki>(canvas-line! [canvas canvas?] [x0 real?] [y0 real?] [x1 real?] [y1 real?]) → void?</nowiki></code></a></h3>

Draws a line on the given canvas.

<h3><a id="canvas-rectangle_"><code><nowiki>(canvas-rectangle! [canvas canvas?] [x0 real?] [x1 real?] [y0 real?] [y1 real?]) → void?</nowiki></code></a></h3>

Draws a hollow rectangle on the given canvas.

<h3><a id="canvas-arc_"><code><nowiki>(canvas-arc! [canvas canvas?] [x real?] [y real?] [width real?] [height real?] [alpha0 real?] [alpha1 real?]) → void?</nowiki></code></a></h3>

Draws a hollow ellipsis segment on the given canvas.

<h3><a id="canvas-line-style"><code><nowiki>(canvas-line-style [canvas canvas?]) → symbol?</nowiki></code></a></h3>

Retrieves the current line style of the given canvas. Possible values are

  *  <code>'continuous</code>
  *  <code>'dashed</code>
  *  <code>'dotted</code>
  *  <code>'dash-dotted</code>
  *  <code>'dash-dot-dotted</code>
  *  <code>'custom</code>

<h3><a id="canvas-line-style-set_"><code>
	<nowiki>(canvas-line-style-set! [canvas canvas?] [line-style (or/c symbol? list?)]) → symbol?</nowiki><br>
	<nowiki>(set! (canvas-line-style [canvas canvas?]) [line-style (or/c symbol? list?)]) → symbol?</nowiki>
</code></a></h3>

Sets the current line style of the given canvas and returns the previous value.

In addition to the possible return values of <code>[#canvas-line-style|canvas-line-style]</code>
a custom <code>line-style</code> can be fully specified using the form
<code><nowiki>(list 'custom [len integer?] ...)</nowiki></code>.

<h3><a id="canvas-line-width"><code><nowiki>(canvas-line-width [canvas canvas?]) → integer?</nowiki></code></a></h3>

Retrieves the current line width of the given canvas.

<h3><a id="canvas-line-width-set_"><code>
	<nowiki>(canvas-line-width-set! [canvas canvas?] [line-width integer?]) → integer?</nowiki><br>
	<nowiki>(set! (canvas-line-width [canvas canvas?]) [line-width integer?]) → integer?</nowiki>
</code></a></h3>

Sets the current line width of the given canvas and returns the previous value.

<h3><a id="canvas-line-join"><code><nowiki>(canvas-line-join [canvas canvas?]) → symbol?</nowiki></code></a></h3>

Retrieves the current line join style of the given canvas. Possible values are

  *  <code>'miter</code>
  *  <code>'bevel</code>
  *  <code>'round</code>

<h3><a id="canvas-line-join-set_"><code>
	<nowiki>(canvas-line-join-set! [canvas canvas?] [line-join symbol?]) → symbol?</nowiki><br>
	<nowiki>(set! (canvas-line-join [canvas canvas?]) [line-join symbol?]) → symbol?</nowiki>
</code></a></h3>

Sets the current line join style of the given canvas and returns the previous
value.

<h3><a id="canvas-line-cap"><code><nowiki>(canvas-line-cap [canvas canvas?]) → symbol?</nowiki></code></a></h3>

Retrieves the current line cap style of the given canvas.

  *  <code>'flat</code>
  *  <code>'square</code>
  *  <code>'round</code>

<h3><a id="canvas-line-cap-set_"><code>
	<nowiki>(canvas-line-cap-set! [canvas canvas?] [line-cap symbol?]) → symbol?</nowiki><br>
	<nowiki>(set! (canvas-line-cap [canvas canvas?]) [line-cap symbol?]) → symbol?</nowiki>
</code></a></h3>

Sets the current line cap style of the given canvas and returns the previous
value.

<h2>Filled Areas</h2>

<h3><a id="canvas-box_"><code><nowiki>(canvas-box! [canvas canvas?] [x0 real?] [x1 real?] [y0 real?] [y1 real?]) → void?</nowiki></code></a></h3>

Draws a filled rectangle on the given canvas.

<h3><a id="canvas-sector_"><code><nowiki>(canvas-sector! [canvas canvas?] [x real?] [y real?] [width real?] [height real?] [alpha0 real?] [alpha1 real?]) → void?</nowiki></code></a></h3>

Draws a filled ellipsis sector on the given canvas.

<h3><a id="canvas-chord_"><code><nowiki>(canvas-chord! [canvas canvas?] [x real?] [y real?] [width real?] [height real?] [alpha0 real?] [alpha1 real?]) → void?</nowiki></code></a></h3>

Draws a filled ellipsis arc on the given canvas.

<h3><a id="canvas-background-opacity"><code><nowiki>(canvas-background-opacity [canvas canvas?]) → symbol?</nowiki></code></a></h3>

Retrieves the current background opacity of the given canvas. Possible values
are

  *  <code>'transparent</code>
  *  <code>'opaque</code>

<h3><a id="canvas-background-opacity-set_"><code>
	<nowiki>(canvas-background-opacity-set! [canvas canvas?] [background-opacity symbol?]) → symbol?</nowiki><br>
	<nowiki>(set! (canvas-background-opacity-set! [canvas canvas?]) [background-opacity symbol?]) → symbol?</nowiki>
</code></a></h3>

Sets the current background opacity of the given canvas and returns the previous
value.

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

Retrieves the current polygon fill mode of the given canvas. Possible values are

  *  <code>'even-odd</code>
  *  <code>'winding</code>

<h3><a id="canvas-fill-mode-set_"><code>
	<nowiki>(canvas-fill-mode-set! [canvas canvas?] [fill-mode symbol?]) → symbol?</nowiki><br>
	<nowiki>(set! (canvas-fill-mode [canvas canvas?]) [fill-mode symbol?]) → symbol?</nowiki>
</code></a></h3>

Sets the current polygon fill mode of the given canvas and returns the previous
value.

<h3><a id="canvas-interior-style"><code><nowiki>(canvas-interior-style [canvas canvas?]) → (or/c symbol? list?)</nowiki></code></a></h3>

Retrieves the current interior style of the given canvas. Possible values are

  *  <code>'solid</code>
  *  <code>'(hatch horizontal)</code>
  *  <code>'(hatch vertical)</code>
  *  <code>'(hatch forward-diagonal)</code>
  *  <code>'(hatch backward-diagonal)</code>
  *  <code>'(hatch cross)</code>
  *  <code>'(hatch diagonal-cross)</code>
  *  <code><nowiki>(list 'stipple [width integer?] [height integer?] [data blob?])</nowiki></code>
  *  <code><nowiki>(list 'pattern/rgb [width integer?] [height integer?] [data blob?])</nowiki></code>
  *  <code><nowiki>(list 'pattern/rgba [width integer?] [height integer?] [data blob?])</nowiki></code>
  *  <code>#f</code>

<h3><a id="canvas-interior-style-set_"><code>
	<nowiki>(canvas-interior-style-set! [canvas canvas?] [interior-style (or/c symbol? list?)]) → void?</nowiki><br>
	<nowiki>(set! (canvas-interior-style [canvas canvas?]) [interior-style (or/c symbol? list?)]) → void?</nowiki>
</code></a></h3>

Sets the current interior style of the given canvas and returns the previous
value.

<h2>Text</h2>

<h3><a id="canvas-text_"><code><nowiki>(canvas-text! [canvas canvas?] [x real?] [y real?] [text string?]) → void?</nowiki></code></a></h3>

Draws a string of text on the given canvas.

<h3><a id="canvas-font"><code><nowiki>(canvas-font [canvas canvas?]) → string?</nowiki></code></a></h3>

Retrieves the current font of the given canvas.

<h3><a id="canvas-font-set_"><code>
	<nowiki>(canvas-font-set! [canvas canvas?] [font string?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-font [canvas canvas?]) [font string?]) → void?</nowiki>
</code></a></h3>

Sets the current font of the given canvas and returns the previous value.

<h3><a id="canvas-text-alignment"><code><nowiki>(canvas-text-alignment [canvas canvas?]) → symbol?</nowiki></code></a></h3>

Retrieves the current text alignment of the given canvas. Possible values are

  *  <code>'north</code>
  *  <code>'south</code>
  *  <code>'east</code>
  *  <code>'west</code>
  *  <code>'north-east</code>
  *  <code>'north-west</code>
  *  <code>'south-east</code>
  *  <code>'south-west</code>
  *  <code>'center</code>
  *  <code>'base-left</code>
  *  <code>'base-center</code>
  *  <code>'base-right</code>

<h3><a id="canvas-text-alignment-set_"><code>
	<nowiki>(canvas-text-alignment-set! [canvas canvas?] [text-alignment symbol?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-text-alignment [canvas canvas?]) [text-alignment symbol?]) → void?</nowiki>
</code></a></h3>

Sets the current text alignment of the given canvas and returns the previous
value.

<h3><a id="canvas-text-orientation"><code><nowiki>(canvas-text-orientation [canvas canvas?]) → real?</nowiki></code></a></h3>

Retrieves the current text orientation of the given canvas.

<h3><a id="canvas-text-orientation-set_"><code>
	<nowiki>(canvas-text-orientation-set! [canvas canvas?] [orientation real?]) → void?</nowiki><br>
	<nowiki>(set! (canvas-text-orientation [canvas canvas?]) [orientation real?]) → void?</nowiki>
</code></a></h3>

Sets the current text orientation of the given canvas and returns the previous
value.

<h3><a id="canvas-font-dimensions"><code><nowiki>(canvas-font-dimensions [canvas canvas?]) → (values integer? integer? integer? integer?)</nowiki></code></a></h3>

Returns the maximum width, height, ascent and descent of the current font
of the given canvas.

<h3><a id="canvas-text-size"><code><nowiki>(canvas-text-size [canvas canvas?] [text string?]) → (values integer? integer?)</nowiki></code></a></h3>

Computes the width and height of the given text when drawn on the given canvas.

<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>
  *  <code>'bezier</code>
  *  <code>'region</code>
  *  <code>'path</code>

<h3><a id="canvas-path-set!"><code><nowiki>(canvas-path-set! [canvas canvas?] [path-action symbol?]) → void?</nowiki></code></a></h3>

Configures the action between sequences of vertex data sent to the given canvas.
Possible actions are

  *  <code>'new</code>
  *  <code>'move-to</code>
  *  <code>'line-to</code>
  *  <code>'arc</code>
  *  <code>'curve-to</code>
  *  <code>'close</code>
  *  <code>'fill</code>
  *  <code>'stroke</code>
  *  <code>'fill+stroke</code>
  *  <code>'clip</code>

<h3><a id="canvas-vertex!"><code><nowiki>(canvas-vertex! [canvas canvas?] [x real?] [y real?]) → void?</nowiki></code></a></h3>

Sends a vertex to the given canvas.








Added canvas-draw/api/printer.wiki version [4f3bac13f7].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>printer</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/printer))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-printer)</code></td>
	</tr>
</table>

Printer context support.

<h2>Context Types</h2>

<h3><a id="context:printer"><code><nowiki>[context:printer context?]</nowiki></code></a></h3>

Context type for a system printer.








Added canvas-draw/api/ps.wiki version [534b9c3356].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>ps</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/ps))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-ps)</code></td>
	</tr>
</table>

PostScript context support.

<h2>Context Types</h2>

<h3><a id="context:ps"><code><nowiki>[context:ps context?]</nowiki></code></a></h3>

Context type for PS files.








Added canvas-draw/api/server.wiki version [1fc6ea53d8].






























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

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

<h1><tt>server</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/server))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-server)</code></td>
	</tr>
</table>

Server context support.

<h2>Context Types</h2>

<h3><a id="context:image"><code><nowiki>[context:image context?]</nowiki></code></a></h3>

Context type for server side pixel buffers.

<h3><a id="context:double-buffer"><code><nowiki>[context:double-buffer context?]</nowiki></code></a></h3>

Context type for server side double buffers.








Added canvas-draw/api/svg.wiki version [3cffd2303f].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>svg</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/svg))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-svg)</code></td>
	</tr>
</table>

Scalable vector graphics context support.

<h2>Context Types</h2>

<h3><a id="context:svg"><code><nowiki>[context:svg context?]</nowiki></code></a></h3>

Context type for SVG files.








Added canvas-draw/api/wmf.wiki version [8976c2a3fb].


























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

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

<h1><tt>wmf</tt> Module</h1>

<h2>Synopsis</h2>

<table>
	<tr>
		<th>Racket</th>
		<td><code>(require (planet murphy/canvas-draw:1:0/wmf))</code></td>
	</tr>
	<tr>
		<th>CHICKEN</th>
		<td><code>(require-extension canvas-draw-wmf)</code></td>
	</tr>
</table>

WMF context support.

<h2>Context Types</h2>

<h3><a id="context:wmf"><code><nowiki>[context:wmf context?]</nowiki></code></a></h3>

Context type for WMF files.








Added canvas-draw/chicken/canvas-draw-base.scm version [a398b8328d].














































































































































































































































































































































































































































































































































































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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
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
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
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
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
541
542
543
544
545
546
547
548
549
550
551
552
553
554

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

(require-library lolevel data-structures srfi-1 srfi-4 srfi-13)

(module canvas-draw-base
	(canvas? canvas->pointer pointer->canvas
	 context? context->pointer pointer->context
	 state? state->pointer pointer->state
	 context-capabilities
	 use-context+ make-canvas call-with-canvas
	 canvas-context
	 canvas-simulate!
	 canvas-attribute canvas-attribute-set!
	 canvas-state canvas-state-set!
	 canvas-clear! canvas-flush
	 canvas-size
	 canvas-mm->px canvas-px->mm
	 canvas-origin canvas-origin-set!
	 canvas-transform canvas-transform-set!
	 canvas-transform-compose!
	 canvas-transform-translate!
	 canvas-transform-scale!
	 canvas-transform-rotate!
	 canvas-foreground canvas-foreground-set!
	 canvas-background canvas-background-set!
	 canvas-write-mode canvas-write-mode-set!
	 canvas-clip-mode canvas-clip-mode-set!
	 canvas-clip-area canvas-clip-area-set!)
	(import
		scheme chicken foreign
		lolevel data-structures srfi-1 srfi-4 srfi-13)

;; {{{ Data types

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

(define *canvas-tag* "cdCanvas")
(define canvas? (cut tagged-pointer? <> *canvas-tag*))

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

(define (pointer->canvas nonnull?)
	(if nonnull?
		(lambda (canvas)
			(tag-pointer canvas *canvas-tag*))
		(lambda (canvas)
			(and canvas (tag-pointer canvas *canvas-tag*)))))

(define *context-tag* "cdContext")
(define context? (cut tagged-pointer? <> *context-tag*))

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

(define (pointer->context nonnull?)
	(if nonnull?
		(lambda (context)
			(tag-pointer context *context-tag*))
		(lambda (context)
			(and context (tag-pointer context *context-tag*)))))

(define *state-tag* "cdState")
(define state? (cut tagged-pointer? <> *state-tag*))

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

(define (pointer->state nonnull?)
	(if nonnull?
		(lambda (state)
			(tag-pointer state *state-tag*))
		(lambda (state)
			(and state (tag-pointer state *state-tag*)))))

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Canvas management

(define context-capabilities
	(letrec ([context-capabilities/raw
			      (foreign-lambda int "cdContextCaps" nonnull-context)]
	         [capabilities
	          (list
	          	(cons
	          		'flush
	          		(foreign-value "CD_CAP_FLUSH" int))
	          	(cons
	          		'clear
	          		(foreign-value "CD_CAP_CLEAR" int))
	          	(cons
	          		'play
	          		(foreign-value "CD_CAP_PLAY" int))
	          	(cons
	          		'y-axis
	          		(foreign-value "CD_CAP_YAXIS" int))
	          	(cons
	          		'clip-area
	          		(foreign-value "CD_CAP_CLIPAREA" int))
	          	(cons
	          		'clip-polygon
	          		(foreign-value "CD_CAP_CLIPPOLY" int))
	          	(cons
	          		'region
	          		(foreign-value "CD_CAP_REGION" int))
	          	(cons
	          		'rectangle
	          		(foreign-value "CD_CAP_RECT" int))
	          	(cons
	          		'chord
	          		(foreign-value "CD_CAP_CHORD" int))
	          	(cons
	          		'image/rgb
	          		(foreign-value "CD_CAP_IMAGERGB" int))
	          	(cons
	          		'image/rgba
	          		(foreign-value "CD_CAP_IMAGERGBA" int))
	          	(cons
	          		'image/map
	          		(foreign-value "CD_CAP_IMAGEMAP" int))
	          	(cons
	          		'get-image/rgb
	          		(foreign-value "CD_CAP_GETIMAGERGB" int))
	          	(cons
	          		'image/server
	          		(foreign-value "CD_CAP_IMAGESRV" int))
	          	(cons
	          		'background
	          		(foreign-value "CD_CAP_BACKGROUND" int))
	          	(cons
	          		'background-opacity
	          		(foreign-value "CD_CAP_BACKOPACITY" int))
	          	(cons
	          		'write-mode
	          		(foreign-value "CD_CAP_WRITEMODE" int))
	          	(cons
	          		'line-style
	          		(foreign-value "CD_CAP_LINESTYLE" int))
	          	(cons
	          		'line-width
	          		(foreign-value "CD_CAP_LINEWITH" int))
	          	(cons
	          		'fprimtives
	          		(foreign-value "CD_CAP_FPRIMTIVES" int))
	          	(cons
	          		'hatch
	          		(foreign-value "CD_CAP_HATCH" int))
	          	(cons
	          		'stipple
	          		(foreign-value "CD_CAP_STIPPLE" int))
	          	(cons
	          		'pattern
	          		(foreign-value "CD_CAP_PATTERN" int))
	          	(cons
	          		'font
	          		(foreign-value "CD_CAP_FONT" int))
	          	(cons
	          		'font-dimensions
	          		(foreign-value "CD_CAP_FONTDIM" int))
	          	(cons
	          		'text-size
	          		(foreign-value "CD_CAP_TEXTSIZE" int))
	          	(cons
	          		'text-orientation
	          		(foreign-value "CD_CAP_TEXTORIENTATION" int))
	          	(cons
	          		'palette
	          		(foreign-value "CD_CAP_PALETTE" int))
	          	(cons
	          		'line-cap
	          		(foreign-value "CD_CAP_LINECAP" int))
	          	(cons
	          		'line-join
	          		(foreign-value "CD_CAP_LINEJOIN" int))
	          	(cons
	          		'path
	          		(foreign-value "CD_CAP_PATH" int))
	          	(cons
	          		'bezier
	          		(foreign-value "CD_CAP_BEZIER" int)))])
	  (lambda (context)
	  	(let ([capabilities/raw (context-capabilities/raw context)])
				(filter-map
					(lambda (info)
						(let ([mask (cdr info)])
							(and (= (bitwise-and mask capabilities/raw) mask) (car info))))
					capabilities)))))

(define use-context+
	(make-parameter #f))

(define make-canvas/ptr
	(foreign-lambda* canvas ([nonnull-context context] [bool plus] [c-pointer data])
		"cdUseContextPlus(plus);\n"
		"C_return(cdCreateCanvas(context, data));"))

(define make-canvas/string
	(foreign-lambda* canvas ([nonnull-context context] [bool plus] [c-string data])
		"cdUseContextPlus(plus);\n"
		"C_return(cdCreateCanvas(context, (void *)data));"))

(define canvas-kill!
	(foreign-lambda void "cdKillCanvas" nonnull-canvas))

(define canvas-activate!
	(foreign-lambda void "cdCanvasActivate" nonnull-canvas))

(define canvas-deactivate!
	(foreign-lambda void "cdCanvasDeactivate" nonnull-canvas))

(define (make-canvas context data)
	(let ([make-canvas/data (if (string? data) make-canvas/string make-canvas/ptr)])
		(cond
			[(make-canvas/data context (use-context+) data)
			 => (cut set-finalizer! <> canvas-kill!)]
			[else
			 (error 'make-canvas "failed to create canvas")])))

(define call-with-canvas
	(case-lambda
		[(canvas proc)
		 (dynamic-wind
		 	 (cut canvas-activate! canvas)
		 	 (cut proc canvas)
		 	 (cut canvas-deactivate! canvas))]
		[(context data proc)
		 (let* ([make-canvas/data (if (string? data) make-canvas/string make-canvas/ptr)]
		 		    [canvas (make-canvas/data context (use-context+) data)])
		 	 (unless canvas (error 'call-with-canvas "failed to create canvas"))
			 (dynamic-wind
			 	 (cut canvas-activate! canvas)
			 	 (cut proc canvas)
			 	 (lambda ()
			 	 	 (when canvas
						 (canvas-kill! canvas)
						 (set! canvas #f)))))]))

(define canvas-context
	(foreign-lambda nonnull-context "cdCanvasGetContext" nonnull-canvas))

(define canvas-simulate!
	(letrec ([canvas-simulate/raw!
	          (foreign-lambda int "cdCanvasSimulate" nonnull-canvas int)]
	         [flags
	          (list
	          	(cons
	          		'line
	          		(foreign-value "CD_SIM_LINE" int))
	          	(cons
	          		'rectangle
	          		(foreign-value "CD_SIM_RECT" int))
	          	(cons
	          		'box
	          		(foreign-value "CD_SIM_BOX" int))
	          	(cons
	          		'arc
	          		(foreign-value "CD_SIM_ARC" int))
	          	(cons
	          		'sector
	          		(foreign-value "CD_SIM_SECTOR" int))
	          	(cons
	          		'chord
	          		(foreign-value "CD_SIM_CHORD" int))
	          	(cons
	          		'polyline
	          		(foreign-value "CD_SIM_POLYLINE" int))
	          	(cons
	          		'polygon
	          		(foreign-value "CD_SIM_POLYGON" int))
	          	(cons
	          		'text
	          		(foreign-value "CD_SIM_TEXT" int))
	          	(cons
	          		'all
	          		(foreign-value "CD_SIM_ALL" int))
	          	(cons
	          		'lines
	          		(foreign-value "CD_SIM_LINES" int))
	          	(cons
	          		'fills
	          		(foreign-value "CD_SIM_FILLS" int)))])
	  (lambda (canvas flags-in)
	  	(let ([flags-out
	  	       (canvas-simulate/raw!
	  	       	 canvas
	  	       	 (fold
	  	       	 	 bitwise-ior 0
	  	       	 	 (map
	  	       	 	 	 (lambda (flag)
	  	       	 	 	 	 (cond
	  	       	 	 	 	 	 [(assq flag flags) => cdr]
	  	       	 	 	 	 	 [else (error 'canvas-simulate! "unknown flag" flag)]))
	  	       	 	 	 flags-in)))])
	  	  (filter-map
	  	  	(lambda (info)
	  	  		(let ([mask (cdr info)])
							(and (= (bitwise-and mask flags-out) mask) (car info))))
	  	  	flags)))))

(define (name->string name)
	(cond
		[(symbol? name)
		 (string-upcase (string-translate (symbol->string name) #\- #\_))]
		[else
		 name]))

(define canvas-attribute-set!
	(letrec ([canvas-attribute-set/raw! (foreign-lambda void "cdCanvasSetAttribute" nonnull-canvas nonnull-c-string c-string)])
		(lambda (canvas name value)
			(canvas-attribute-set/raw! canvas (name->string name) value))))

(define canvas-attribute
	(letrec ([canvas-attribute/raw (foreign-lambda c-string "cdCanvasGetAttribute" nonnull-canvas nonnull-c-string)])
		(getter-with-setter
			(lambda (canvas name)
				(canvas-attribute/raw canvas (name->string name)))
			canvas-attribute-set!)))

(define canvas-state-set!
	(foreign-lambda void "cdCanvasRestoreState" nonnull-canvas nonnull-state))

(define canvas-state
	(letrec ([save-state (foreign-lambda nonnull-state "cdCanvasSaveState" nonnull-canvas)]
	         [release-state! (foreign-lambda void "cdReleaseState" nonnull-state)])
		(getter-with-setter
			(lambda (canvas)
				(set-finalizer! (save-state canvas) release-state!))
			canvas-state-set!)))

(define canvas-clear!
	(foreign-lambda void "cdCanvasClear" nonnull-canvas))

(define canvas-flush
	(foreign-lambda void "cdCanvasFlush" nonnull-canvas))

;; }}}

;; {{{ Coordinate system

(define canvas-size
	(letrec ([canvas-size/raw (foreign-lambda void "cdCanvasGetSize" nonnull-canvas (c-pointer int) (c-pointer int) (c-pointer double) (c-pointer double))])
		(lambda (canvas)
			(let-location ([width/px int 0] [height/px int 0]
			               [width/mm double 0] [height/mm double 0])
			  (canvas-size/raw
			  	canvas
			  	(location width/px) (location height/px)
			  	(location width/mm) (location height/mm))
			  (values
			  	width/px height/px
			  	width/mm height/mm)))))

(define canvas-mm->px
	(letrec ([canvas-mm->px/raw (foreign-lambda void "cdCanvasMM2Pixel" nonnull-canvas double double (c-pointer int) (c-pointer int))])
		(lambda (canvas x/mm y/mm)
			(let-location ([x/px int 0] [y/px int 0])
				(canvas-mm->px/raw canvas x/mm y/mm (location x/px) (location y/px))
				(values x/px y/px)))))

(define canvas-px->mm
	(letrec ([canvas-mm->px/raw (foreign-lambda void "cdCanvasPixel2MM" nonnull-canvas int int (c-pointer double) (c-pointer double))])
		(lambda (canvas x/px y/px)
			(let-location ([x/mm double +nan.0] [y/mm double +nan.0])
				(canvas-mm->px/raw canvas x/px y/px (location x/mm) (location y/mm))
				(values x/mm y/mm)))))

(define canvas-origin-set!
	(foreign-lambda void "cdCanvasOrigin" nonnull-canvas int int))

(define canvas-origin
	(letrec ([canvas-origin/raw (foreign-lambda void "cdCanvasGetOrigin" nonnull-canvas (c-pointer int) (c-pointer int))])
		(lambda (canvas)
			(let-location ([x int 0] [y int 0])
				(canvas-origin/raw canvas (location x) (location y))
				(values x y)))))

(define (transform->f64vector proc)
	(let ([v (make-f64vector 6)])
		(let-values ([(dx dy) (proc 0 0)])
			(f64vector-set! v 4 dx)
			(f64vector-set! v 5 dy)
			(let-values ([(x y) (proc 1 0)])
				(f64vector-set! v 0 (- x dx))
				(f64vector-set! v 1 (- y dy)))
			(let-values ([(x y) (proc 0 1)])
				(f64vector-set! v 2 (- x dx))
				(f64vector-set! v 3 (- y dy))))
		v))

(define ((f64vector->transform v) x y)
	(values
		(+ (* (f64vector-ref v 0) x) (* (f64vector-ref v 2) y) (f64vector-ref v 4))
		(+ (* (f64vector-ref v 1) x) (* (f64vector-ref v 3) y) (f64vector-ref v 5))))

(define canvas-transform-set!
	(letrec ([canvas-transform-set/raw! (foreign-lambda void "cdCanvasTransform" nonnull-canvas f64vector)])
		(lambda (canvas proc)
			(canvas-transform-set/raw! canvas (and proc (transform->f64vector proc))))))

(define canvas-transform
	(letrec ([canvas-transform/raw
	          (foreign-lambda* bool ([nonnull-canvas canvas] [nonnull-f64vector v])
	          	"double *w = cdCanvasGetTransform(canvas);\n"
	          	"if (w) memcpy(v, w, 6 * sizeof(double));\n"
	          	"C_return(w);")])
		(getter-with-setter
			(lambda (canvas)
				(let ([v (make-f64vector 6)])
					(and (canvas-transform/raw canvas v) (f64vector->transform v))))
			canvas-transform-set!)))

(define canvas-transform-compose!
	(letrec ([canvas-transform-compose/raw! (foreign-lambda void "cdCanvasTransformMultiply" nonnull-canvas nonnull-f64vector)])
		(lambda (canvas proc)
			(canvas-transform-compose/raw! canvas (transform->f64vector proc)))))

(define canvas-transform-translate!
	(foreign-lambda void "cdCanvasTransformTranslate" nonnull-canvas double double))

(define canvas-transform-scale!
	(foreign-lambda void "cdCanvasTransformScale" nonnull-canvas double double))

(define canvas-transform-rotate!
	(foreign-lambda void "cdCanvasTransformRotate" nonnull-canvas double))

;; }}}

;; {{{ General attributes

(define canvas-foreground-set!
	(foreign-lambda void "cdCanvasSetForeground" nonnull-canvas unsigned-long))

(define canvas-foreground
	(getter-with-setter
		(foreign-lambda* unsigned-long ([nonnull-canvas canvas])
			"C_return(cdCanvasForeground(canvas, CD_QUERY));")
		canvas-foreground-set!))

(define canvas-background-set!
	(foreign-lambda void "cdCanvasSetBackground" nonnull-canvas unsigned-long))

(define canvas-background
	(getter-with-setter
		(foreign-lambda* unsigned-long ([nonnull-canvas canvas])
			"C_return(cdCanvasBackground(canvas, CD_QUERY));")
		canvas-background-set!))

(define-values (canvas-write-mode canvas-write-mode-set!)
	(letrec ([write-modes
	          (list
	          	(cons
	          		'replace
	          		(foreign-value "CD_REPLACE" int))
	          	(cons
	          		'xor
	          		(foreign-value "CD_XOR" int))
	          	(cons
	          		'not-xor
	          		(foreign-value "CD_NOT_XOR" int)))]
	         [canvas-write-mode-set/raw!
	          (foreign-lambda void "cdCanvasWriteMode" nonnull-canvas int)]
	         [canvas-write-mode-set!
	          (lambda (canvas write-mode)
	          	(canvas-write-mode-set/raw!
	          		canvas
	          		(cond
	          			[(assq write-mode write-modes) => cdr]
	          			[else (error 'canvas-write-mode-set! "unknown write mode" write-mode)])))]
	         [canvas-write-mode/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasWriteMode(canvas, CD_QUERY));")]
	         [canvas-write-mode
	          (lambda (canvas)
	          	(let ([write-mode (canvas-write-mode/raw canvas)])
	          		(cond
	          			[(rassoc write-mode write-modes) => car]
	          			[else (error 'canvas-write-mode "unknown write mode" write-mode)])))])
	  (values
	  	(getter-with-setter canvas-write-mode canvas-write-mode-set!)
	  	canvas-write-mode-set!)))

;; }}}

;; {{{ Clipping

(define-values (canvas-clip-mode canvas-clip-mode-set!)
	(letrec ([clip-modes
	          (list
	          	(cons
	          		'area
	          		(foreign-value "CD_CLIPAREA" int))
	          	(cons
	          		'polygon
	          		(foreign-value "CD_CLIPPOLYGON" int))
	          	(cons
	          		'region
	          		(foreign-value "CD_CLIPREGION" int))
	          	(cons
	          		#f
	          		(foreign-value "CD_CLIPOFF" int)))]
	         [canvas-clip-mode-set/raw!
	          (foreign-lambda void "cdCanvasClip" nonnull-canvas int)]
	         [canvas-clip-mode-set!
	          (lambda (canvas clip-mode)
	          	(canvas-clip-mode-set/raw!
	          		canvas
	          		(cond
	          			[(assq clip-mode clip-modes) => cdr]
	          			[else (error 'canvas-clip-mode-set! "unknown clip mode" clip-mode)])))]
	         [canvas-clip-mode/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasClip(canvas, CD_QUERY));")]
	         [canvas-clip-mode
	          (lambda (canvas)
	          	(let ([clip-mode (canvas-clip-mode/raw canvas)])
	          		(cond
	          			[(rassoc clip-mode clip-modes) => car]
	          			[else (error 'canvas-write-mode "unknown clip mode" clip-mode)])))])
	  (values
	  	(getter-with-setter canvas-clip-mode canvas-clip-mode-set!)
	  	canvas-clip-mode-set!)))

(define canvas-clip-area-set!
	(foreign-lambda void "cdfCanvasClipArea" nonnull-canvas double double double double))

(define canvas-clip-area
	(letrec ([canvas-clip-area/raw (foreign-lambda void "cdfCanvasGetClipArea" nonnull-canvas (c-pointer double) (c-pointer double) (c-pointer double) (c-pointer double))])
		(lambda (canvas)
			(let-location ([x0 double 0] [x1 double 0] [y0 double 0] [y1 double 0])
				(canvas-clip-area/raw canvas (location x0) (location x1) (location y0) (location y1))
				(values x0 x1 y0 y1)))))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-cgm.scm version [a689b8a73f].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-cgm
	(context:cgm)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:cgm
	(foreign-value "CD_CGM" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-client.scm version [b7d557a7f8].

















































































































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

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

(require-library canvas-draw-base)

(module canvas-draw-client
	(context:image context:double-buffer
	 canvas-image/rgb canvas-image-put/rgb! canvas-image-put/rgba!)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:image
	(foreign-value "CD_IMAGERGB" nonnull-context))

(define context:double-buffer
	(foreign-value "CD_DBUFFERRGB" nonnull-context))

;; }}}

;; {{{ Auxiliary functions

(define canvas-image-put/rgb!
	(letrec ([canvas-image-set/rgb/raw!
	          (foreign-lambda* void ([nonnull-canvas canvas] [int dst_x] [int dst_y]
	                                 [int src_width] [int src_height] [nonnull-blob data]
	                                 [int dst_width] [int dst_height]
	                                 [int src_x0] [int src_x1] [int src_y0] [int src_y1])
	            "const int nchans = 3;\n"
	          	"unsigned char chans[nchans][src_width * src_height];\n"
	          	"int i;\n"
	          	"\n"
	          	"for (i = 0; i < nchans * src_width * src_height; ++i)\n"
	          	"	chans[i % nchans][i / nchans] = data[i];\n"
	          	"\n"
	          	"cdCanvasPutImageRectRGB(\n"
	          	"	canvas, src_width, src_height,\n"
	          	"	chans[0], chans[1], chans[2],\n"
	          	"	dst_x, dst_y, dst_width, dst_height,"
	          	"	src_x0, src_x1, src_y0, src_y1"
	          	");")])
	  (lambda (canvas dst-x dst-y src-width src-height data
	           #!key [width 0] [height 0] [x0 0] [x1 0] [y0 0] [y1 0])
	  	(unless (= (blob-size data) (* 3 src-width src-height))
	  		(error 'canvas-image-set/rgb! "bad image size" (blob-size data) (* 3 src-width src-height)))
	  	(canvas-image-set/rgb/raw!
	  		canvas dst-x dst-y src-width src-height data
	  		width height x0 x1 y0 y1))))

(define canvas-image-put/rgba!
	(letrec ([canvas-image-set/rgba/raw!
	          (foreign-lambda* void ([nonnull-canvas canvas] [int dst_x] [int dst_y]
	                                 [int src_width] [int src_height] [nonnull-blob data]
	                                 [int dst_width] [int dst_height]
	                                 [int src_x0] [int src_x1] [int src_y0] [int src_y1])
	            "const int nchans = 4;\n"
	          	"unsigned char chans[nchans][src_width * src_height];\n"
	          	"int i;\n"
	          	"\n"
	          	"for (i = 0; i < nchans * src_width * src_height; ++i)\n"
	          	"	chans[i % nchans][i / nchans] = data[i];\n"
	          	"\n"
	          	"cdCanvasPutImageRectRGBA(\n"
	          	"	canvas, src_width, src_height,\n"
	          	"	chans[0], chans[1], chans[2], chans[3],\n"
	          	"	dst_x, dst_y, dst_width, dst_height,"
	          	"	src_x0, src_x1, src_y0, src_y1"
	          	");")])
	  (lambda (canvas dst-x dst-y src-width src-height data
	           #!key [width 0] [height 0] [x0 0] [x1 0] [y0 0] [y1 0])
	  	(unless (= (blob-size data) (* 4 src-width src-height))
	  		(error 'canvas-image-set/rgba! "bad image size" (blob-size data) (* 4 src-width src-height)))
	  	(canvas-image-set/rgba/raw!
	  		canvas dst-x dst-y src-width src-height data
	  		width height x0 x1 y0 y1))))

(define canvas-image/rgb
	(getter-with-setter
		(letrec ([canvas-image/rgb/raw
							(foreign-lambda* void ([nonnull-canvas canvas] [int x] [int y]
							                       [int width] [int height]  [nonnull-blob data])
							  "const int nchans = 3;\n"
							  "unsigned char chans[nchans][width * height];\n"
							  "int i;\n"
							  "\n"
							  "cdCanvasGetImageRGB(\n"
							  "	canvas,\n"
							  "	chans[0], chans[1], chans[2],\n"
							  "	x, y, width, height\n"
							  ");\n"
							  "\n"
							  "for (i = 0; i < nchans * width * height; ++i)\n"
							  "	data[i] = chans[i % nchans][i / nchans];\n")])
			(lambda (canvas x y width height)
				(let ([data (make-blob (* 3 width height))])
					(canvas-image/rgb/raw canvas x y width height data)
					data)))
		canvas-image-put/rgb!))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-clipboard.scm version [e0d6041291].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-clipboard
	(context:clipboard)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:clipboard
	(foreign-value "CD_CLIPBOARD" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-debug.scm version [d0e3d96272].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-debug
	(context:debug)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:debug
	(foreign-value "CD_DEBUG" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-dgn.scm version [561a4a7057].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-dgn
	(context:dgn)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:dgn
	(foreign-value "CD_DGN" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-dxf.scm version [461f2e8836].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-dxf
	(context:dxf)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:dxf
	(foreign-value "CD_DXF" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-emf.scm version [057c88a2dd].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-emf
	(context:emf)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:emf
	(foreign-value "CD_EMF" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-gl.scm version [b3ceb42ae9].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-gl
	(context:gl)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:gl
	(foreign-value "CD_GL" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-iup.scm version [9b1370885d].






































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

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

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:iup
	(foreign-value "CD_IUP" nonnull-context))

;; }}}

;; {{{ Auxiliary functions

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

;; }}}

)








Added canvas-draw/chicken/canvas-draw-metafile.scm version [dff4d2cf55].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-metafile
	(context:metafile)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:metafile
	(foreign-value "CD_METAFILE" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-native.scm version [54e46d244f].



















































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

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

(require-library canvas-draw-base)

(module canvas-draw-native
	(context:native-window
	 screen-size)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:native-window
	(foreign-value "CD_NATIVEWINDOW" nonnull-context))

;; }}}

;; {{{ Auxiliary functions

(define screen-size
	(letrec ([screen-size/raw (foreign-lambda void "cdGetScreenSize" (c-pointer int) (c-pointer int) (c-pointer double) (c-pointer double))])
		(lambda ()
			(let-location ([width/px int 0] [height/px int 0]
			               [width/mm double 0] [height/mm double 0])
			  (screen-size/raw
			  	(location width/px) (location height/px)
			  	(location width/mm) (location height/mm))
			  (values
			  	width/px height/px
			  	width/mm height/mm)))))

;; }}}

;; {{{ Library initialization

(foreign-code "cdInitContextPlus();")

;; }}}

)








Added canvas-draw/chicken/canvas-draw-pdf.scm version [2ecd6081ed].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-pdf
	(context:pdf)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:pdf
	(foreign-value "CD_PDF" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-picture.scm version [401583817f].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-picture
	(context:picture)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:picture
	(foreign-value "CD_PICTURE" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-play.scm version [1da93abfbc].



































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

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

(require-library canvas-draw-base)

(module canvas-draw-play
	(canvas-play!)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context content playback

(define canvas-play/ptr!
	(foreign-lambda int "cdCanvasPlay" nonnull-canvas nonnull-context int int int int c-pointer))

(define canvas-play/string!
	(foreign-lambda int "cdCanvasPlay" nonnull-canvas nonnull-context int int int int c-string))

(define (canvas-play! canvas context x0 x1 y0 y1 data)
	(let ([canvas-play/data! (if (string? data) canvas-play/string! canvas-play/ptr!)])
		(unless (zero? (canvas-play/data! canvas context x0 x1 y0 y1 data))
			(error 'canvas-play! "failed to replay graphics"))))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-primitives.scm version [188fe57c8d].






































































































































































































































































































































































































































































































































































































































































































































































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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
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
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
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
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
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738

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

(require-library data-structures srfi-4 canvas-draw-base)

(module canvas-draw-primitives
	(canvas-pixel!
	 canvas-mark!
	 canvas-mark-type canvas-mark-type-set!
	 canvas-mark-size canvas-mark-size-set!
	 canvas-line! canvas-rectangle! canvas-arc!
	 canvas-line-style canvas-line-style-set!
	 canvas-line-width canvas-line-width-set!
	 canvas-line-join canvas-line-join-set!
	 canvas-line-cap canvas-line-cap-set!
	 canvas-box! canvas-sector! canvas-chord!
	 canvas-background-opacity canvas-background-opacity-set!
	 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")

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Point drawing functions

(define canvas-pixel!
	(letrec ([canvas-pixel/raw!
	          (foreign-lambda void "cdCanvasPixel" nonnull-canvas int int unsigned-long)])
	  (lambda (canvas x y #!optional [color (canvas-foreground canvas)])
	  	(canvas-pixel/raw! canvas x y color))))

(define canvas-mark!
	(foreign-lambda void "cdCanvasMark" nonnull-canvas int int))

(define-values (canvas-mark-type canvas-mark-type-set!)
	(letrec ([mark-types
	          (list
	          	(cons
	          		'+
	          		(foreign-value "CD_PLUS" int))
	          	(cons
	          		'plus
	          		(foreign-value "CD_PLUS" int))
	          	(cons
	          		'*
	          		(foreign-value "CD_STAR" int))
	          	(cons
	          		'star
	          		(foreign-value "CD_STAR" int))
	          	(cons
	          		'0
	          		(foreign-value "CD_CIRCLE" int))
	          	(cons
	          		'circle
	          		(foreign-value "CD_CIRCLE" int))
	          	(cons
	          		'O
	          		(foreign-value "CD_HOLLOW_CIRCLE" int))
	          	(cons
	          		'hollow-circle
	          		(foreign-value "CD_HOLLOW_CIRCLE" int))
	          	(cons
	          		'X
	          		(foreign-value "CD_X" int))
	          	(cons
	          		'x
	          		(foreign-value "CD_X" int))
	          	(cons
	          		'box
	          		(foreign-value "CD_BOX" int))
	          	(cons
	          		'hollow-box
	          		(foreign-value "CD_HOLLOW_BOX" int))
	          	(cons
	          		'diamond
	          		(foreign-value "CD_DIAMOND" int))
	          	(cons
	          		'hollow-diamond
	          		(foreign-value "CD_HOLLOW_DIAMOND" int)))]
	         [canvas-mark-type-set/raw!
	          (foreign-lambda void "cdCanvasMarkType" nonnull-canvas int)]
	         [canvas-mark-type-set!
	          (lambda (canvas mark-type)
							(canvas-mark-type-set/raw!
								canvas
								(cond
									[(assq mark-type mark-types) => cdr]
									[else (error 'canvas-mark-type-set! "unknown mark type" mark-type)])))]
	         [canvas-mark-type/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasMarkType(canvas, CD_QUERY));")]
	         [canvas-mark-type
	          (lambda (canvas)
	          	(let ([mark-type (canvas-mark-type/raw canvas)])
								(cond
									[(rassoc mark-type mark-types) => car]
									[else (error 'canvas-mark-type "unknown mark type" mark-type)])))])
	  (values
	  	(getter-with-setter canvas-mark-type canvas-mark-type-set!)
	  	canvas-mark-type-set!)))

(define canvas-mark-size-set!
	(foreign-lambda void "cdCanvasMarkSize" nonnull-canvas int))

(define canvas-mark-size
	(getter-with-setter
		(foreign-lambda* int ([nonnull-canvas canvas])
			"C_return(cdCanvasMarkSize(canvas, CD_QUERY));")
		canvas-mark-size-set!))

;; }}}

;; {{{ Line functions

(define canvas-line!
	(foreign-lambda void "cdfCanvasLine" nonnull-canvas double double double double))

(define canvas-rectangle!
	(foreign-lambda void "cdfCanvasRect" nonnull-canvas double double double double))

(define canvas-arc!
	(foreign-lambda void "cdfCanvasArc" nonnull-canvas double double double double double double))

(define-values (canvas-line-style canvas-line-style-set!)
	(letrec ([line-styles
	          (list
	          	(cons
	          		'continuous
	          		(foreign-value "CD_CONTINUOUS" int))
	          	(cons
	          		'dashed
	          		(foreign-value "CD_DASHED" int))
	          	(cons
	          		'dotted
	          		(foreign-value "CD_DOTTED" int))
	          	(cons
	          		'dash-dotted
	          		(foreign-value "CD_DASH_DOT" int))
	          	(cons
	          		'dash-dot-dotted
	          		(foreign-value "CD_DASH_DOT_DOT" int))
	          	(cons
	          		'custom
	          		(foreign-value "CD_CUSTOM" int)))]
	         [canvas-line-style-set/raw!
	          (foreign-lambda void "cdCanvasLineStyle" nonnull-canvas int)]
	         [canvas-line-style-dashes-set/raw!
	          (foreign-lambda void "cdCanvasLineStyleDashes" nonnull-canvas nonnull-s32vector int)]
	         [canvas-line-style-set!
	          (lambda (canvas line-style)
	          	(cond
	          		[(and (pair? line-style) (eq? (car line-style) 'custom))
	          		 (let ([dashes (list->s32vector (cdr line-style))])
	          		 	 (canvas-line-style-dashes-set/raw! canvas dashes (s32vector-length dashes))
	          		 	 (canvas-line-style-set/raw! canvas (cdr (assq 'custom line-styles))))]
	          		[else
	          		 (canvas-line-style-set/raw!
	          		 	 canvas
	          		 	 (cond
	          		 	 	 [(assq line-style line-styles) => cdr]
	          		 	 	 [else (error 'canvas-line-style-set! "unknown line style" line-style)]))]))]
	         [canvas-line-style/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasLineStyle(canvas, CD_QUERY));")]
	         [canvas-line-style
	          (lambda (canvas)
	          	(let ([line-style (canvas-line-style/raw canvas)])
	          		(cond
									[(rassoc line-style line-styles) => car]
									[else (error 'canvas-line-style "unknown line style" line-style)])))])
	  (values
	  	(getter-with-setter canvas-line-style canvas-line-style-set!)
	  	canvas-line-style-set!)))

(define canvas-line-width-set!
	(foreign-lambda int "cdCanvasLineWidth" nonnull-canvas int))

(define canvas-line-width
	(getter-with-setter
		(foreign-lambda* int ([nonnull-canvas canvas])
			"C_return(cdCanvasLineWidth(canvas, CD_QUERY));")
		canvas-line-width-set!))

(define-values (canvas-line-join canvas-line-join-set!)
	(letrec ([line-joins
	          (list
	          	(cons
	          		'miter
	          		(foreign-value "CD_MITER" int))
	          	(cons
	          		'bevel
	          		(foreign-value "CD_BEVEL" int))
	          	(cons
	          		'round
	          		(foreign-value "CD_ROUND" int)))]
	         [canvas-line-join-set/raw!
	          (foreign-lambda void "cdCanvasLineJoin" nonnull-canvas int)]
	         [canvas-line-join-set!
	          (lambda (canvas line-join)
							(canvas-line-join-set/raw!
								canvas
								(cond
									[(assq line-join line-joins) => cdr]
									[else (error 'canvas-line-join-set! "unknown line join" line-join)])))]
	         [canvas-line-join/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasLineJoin(canvas, CD_QUERY));")]
	         [canvas-line-join
	          (lambda (canvas)
	          	(let ([line-join (canvas-line-join/raw canvas)])
	          		(cond
									[(rassoc line-join line-joins) => car]
									[else (error 'canvas-line-join "unknown line join" line-join)])))])
		(values
			(getter-with-setter canvas-line-join canvas-line-join-set!)
			canvas-line-join-set!)))

(define-values (canvas-line-cap canvas-line-cap-set!)
	(letrec ([line-caps
	          (list
	          	(cons
	          		'flat
	          		(foreign-value "CD_CAPFLAT" int))
	          	(cons
	          		'square
	          		(foreign-value "CD_CAPSQUARE" int))
	          	(cons
	          		'round
	          		(foreign-value "CD_CAPROUND" int)))]
	         [canvas-line-cap-set/raw!
	          (foreign-lambda void "cdCanvasLineCap" nonnull-canvas int)]
	         [canvas-line-cap-set!
	          (lambda (canvas line-cap)
							(canvas-line-cap-set/raw!
								canvas
								(cond
									[(assq line-cap line-caps) => cdr]
									[else (error 'canvas-line-cap-set! "unknown line cap" line-cap)])))]
	         [canvas-line-cap/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasLineCap(canvas, CD_QUERY));")]
	         [canvas-line-cap
	          (lambda (canvas)
	          	(let ([line-cap (canvas-line-cap/raw canvas)])
								(cond
									[(rassoc line-cap line-caps) => car]
									[else (error 'canvas-line-cap "unknown line cap" line-cap)])))])
		(values
			(getter-with-setter canvas-line-cap canvas-line-cap-set!)
			canvas-line-cap-set!)))

;; }}}

;; {{{ Filled area functions

(define canvas-box!
	(foreign-lambda void "cdfCanvasBox" nonnull-canvas double double double double))

(define canvas-sector!
	(foreign-lambda void "cdfCanvasSector" nonnull-canvas double double double double double double))

(define canvas-chord!
	(foreign-lambda void "cdfCanvasChord" nonnull-canvas double double double double double double))

(define-values (canvas-background-opacity canvas-background-opacity-set!)
	(letrec ([opacities
	          (list
	          	(cons
	          		'opaque
	          		(foreign-value "CD_OPAQUE" int))
	          	(cons
	          		'transparent
	          		(foreign-value "CD_TRANSPARENT" int)))]
	         [canvas-background-opacity-set/raw!
	          (foreign-lambda void "cdCanvasBackOpacity" nonnull-canvas int)]
	         [canvas-background-opacity-set!
	          (lambda (canvas opacity)
							(canvas-background-opacity-set/raw!
								canvas
								(cond
									[(assq opacity opacities) => cdr]
									[else (error 'canvas-background-opacity-set! "unknown line cap" opacity)])))]
	         [canvas-background-opacity/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasBackOpacity(canvas, CD_QUERY));")]
	         [canvas-background-opacity
	          (lambda (canvas)
	          	(let ([opacity (canvas-background-opacity/raw canvas)])
	          		(cond
									[(rassoc opacity opacities) => car]
									[else (error 'canvas-background-opacity "unknown opacity" opacity)])))])
		(values
			(getter-with-setter canvas-background-opacity canvas-background-opacity-set!)
			canvas-background-opacity-set!)))

(define-values (canvas-fill-mode canvas-fill-mode-set!)
	(letrec ([fill-modes
	          (list
	          	(cons
	          		'even-odd
	          		(foreign-value "CD_EVENODD" int))
	          	(cons
	          		'winding
	          		(foreign-value "CD_WINDING" int)))]
	         [canvas-fill-mode-set/raw!
	          (foreign-lambda void "cdCanvasFillMode" nonnull-canvas int)]
	         [canvas-fill-mode-set!
	          (lambda (canvas fill-mode)
							(canvas-fill-mode-set/raw!
								canvas
								(cond
									[(assq fill-mode fill-modes) => cdr]
									[else (error 'canvas-fill-mode-set! "unknown fill mode" fill-mode)])))]
	         [canvas-fill-mode/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasFillMode(canvas, CD_QUERY));")]
	         [canvas-fill-mode
	          (lambda (canvas)
	          	(let ([fill-mode (canvas-fill-mode/raw canvas)])
								(cond
									[(rassoc fill-mode fill-modes) => car]
									[else (error 'canvas-fill-mode "unknown fill mode" fill-mode)])))])
		(values
			(getter-with-setter canvas-fill-mode canvas-fill-mode-set!)
			canvas-fill-mode-set!)))

(define-values (canvas-interior-style canvas-interior-style-set!)
	(letrec ([interior-styles
	          (list
	          	(cons
	          		'solid
	          		(foreign-value "CD_SOLID" int))
	          	(cons
	          		'hollow
	          		(foreign-value "CD_HOLLOW" int))
	          	(cons
	          		'hatch
	          		(foreign-value "CD_HATCH" int))
	          	(cons
	          		'stipple
	          		(foreign-value "CD_STIPPLE" int))
	          	(cons
	          		'pattern
	          		(foreign-value "CD_PATTERN" int)))]
	         [hatch-styles
	          (list
	          	(cons
	          		'horizontal
	          		(foreign-value "CD_HORIZONTAL" int))
	          	(cons
	          		'vertical
	          		(foreign-value "CD_VERTICAL" int))
	          	(cons
	          		'forward-diagonal
	          		(foreign-value "CD_FDIAGONAL" int))
	          	(cons
	          		'backward-diagonal
	          		(foreign-value "CD_BDIAGONAL" int))
	          	(cons
	          		'cross
	          		(foreign-value "CD_CROSS" int))
	          	(cons
	          		'diagonal-cross
	          		(foreign-value "CD_DIAGCROSS" int)))]
	         [canvas-hatch-style-set/raw!
	          (foreign-lambda int "cdCanvasHatch" nonnull-canvas int)]
	         [canvas-hatch-style/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasHatch(canvas, CD_QUERY));")]
	         [canvas-stipple-set/raw!
	          (foreign-lambda* void ([nonnull-canvas canvas] [int width] [int height] [nonnull-blob data])
	          	"unsigned char mask[width * height];\n"
	          	"int i, j;\n"
	          	"\n"
	          	"for (j = 0; j < height; ++j) {\n"
	          	"	for (i = 0; i < width; ++i) {\n"
	          	"		const int ofs = (j * width) + i;\n"
	          	"		mask[ofs] = (data[ofs / 8] >> (ofs % 8)) & 1;\n"
	          	"	}\n"
	          	"}\n"
	          	"cdCanvasStipple(canvas, width, height, mask);\n")]
	         [canvas-stipple/raw
	          (foreign-lambda* void ([nonnull-canvas canvas] [(c-pointer int) pwidth] [(c-pointer int) pheight] [blob data])
	          	"unsigned char *mask = cdCanvasGetStipple(canvas, pwidth, pheight);\n"
	          	"\n"
	          	"if (data) {\n"
	          	"	int width = *pwidth, height = *pheight;\n"
	          	"	int i, j;\n"
	          	"	\n"
	          	"	for (j = 0; j < height; ++j) {\n"
	          	"		for (i = 0; i < width; ++i) {\n"
	          	"			const int ofs = (j * width) + i;\n"
	          	"			const int vofs = ofs / 8, bofs = ofs % 8;\n"
	          	"			const unsigned char bit = mask[ofs] & 1;\n"
	          	"			\n"
	          	"			if (bofs > 0)\n"
	          	"				data[vofs] |= bit << bofs;\n"
	          	"			else\n"
	          	"				data[vofs] = bit;\n"
	          	"		}\n"
	          	"	}\n"
	          	"}\n")]
	         [canvas-pattern-set/rgb/raw!
	          (foreign-lambda* void ([nonnull-canvas canvas] [int width] [int height] [nonnull-blob data])
	          	"long color[width * height];\n"
	          	"int i, j;\n"
	          	"\n"
	          	"for (j = 0; j < height; ++j) {\n"
	          	"	for (i = 0; i < width; ++i, data += 3) {\n"
	          	"		color[(j * width) + i] =\n"
	          	"			(data[0] << 16) | (data[1] << 8) | (data[2]);\n"
	          	"	}\n"
	          	"}\n"
	          	"cdCanvasPattern(canvas, width, height, color);\n")]
	         [canvas-pattern-set/rgba/raw!
	          (foreign-lambda* void ([nonnull-canvas canvas] [int width] [int height] [nonnull-blob data])
	          	"long color[width * height];\n"
	          	"int i, j;\n"
	          	"\n"
	          	"for (j = 0; j < height; ++j) {\n"
	          	"	for (i = 0; i < width; ++i, data += 4) {\n"
	          	"		color[(j * width) + i] =\n"
	          	"			((0xff - data[3]) << 24) | (data[0] << 16) | (data[1] << 8) | (data[2]);\n"
	          	"	}\n"
	          	"}\n"
	          	"cdCanvasPattern(canvas, width, height, color);\n")]
	         [canvas-pattern/rgba/raw
	          (foreign-lambda* void ([nonnull-canvas canvas] [(c-pointer int) pwidth] [(c-pointer int) pheight] [blob data])
	          	"long *color = cdCanvasGetPattern(canvas, pwidth, pheight);\n"
	          	"\n"
	          	"if (data) {\n"
	          	"	int width = *pwidth, height = *pheight;\n"
	          	"	int i, j;\n"
	          	"	\n"
	          	"	for (j = 0; j < height; ++j) {\n"
	          	"		for (i = 0; i < width; ++i, data += 4) {\n"
	          	"			long c = color[(j * width) + i];\n"
	          	"			data[3] = 0xff - ((c >> 24) & 0xff);\n"
	          	"			data[0] = (c >> 16) & 0xff;\n"
	          	"			data[1] = (c >> 8) & 0xff;\n"
	          	"			data[2] = c & 0xff;\n"
	          	"		}\n"
	          	"	}\n"
	          	"}\n")]
	         [canvas-interior-style-set/raw!
	          (foreign-lambda void "cdCanvasInteriorStyle" nonnull-canvas int)]
	         [canvas-interior-style-set!
	          (lambda (canvas interior-style)
							(case (and (pair? interior-style) (car interior-style))
								[(hatch)
								 (let ([hatch-style (cadr interior-style)])
									 (canvas-hatch-style-set/raw!
										 canvas
										 (cond
										 	 [(assq hatch-style hatch-styles) => cdr]
										 	 [else (error 'canvas-interior-style-set! "unknown hatch style" hatch-style)]))
									 (canvas-interior-style-set/raw! canvas (cdr (assq 'hatch interior-styles))))]
								[(stipple)
								 (let ([width (cadr interior-style)]
											 [height (caddr interior-style)]
											 [data (cadddr interior-style)])
									 (unless (= (blob-size data) (ceiling (/ (* width height) 8)))
										 (error 'canvas-interior-style-set! "bad stipple data length" (blob-size data) (ceiling (/ (* width height) 8))))
									 (canvas-stipple-set/raw! canvas width height data)
									 (canvas-interior-style-set/raw! canvas (cdr (assq 'stipple interior-styles))))]
								[(pattern/rgb)
								 (let ([width (cadr interior-style)]
											 [height (caddr interior-style)]
											 [data (cadddr interior-style)])
									 (unless (= (blob-size data) (* 3 width height))
										 (error 'canvas-interior-style-set! "bad pattern data length" (blob-size data) (* 3 width height)))
									 (canvas-pattern-set/rgb/raw! canvas width height data)
									 (canvas-interior-style-set/raw! canvas (cdr (assq 'pattern interior-styles))))]
								[(pattern/rgba)
								 (let ([width (cadr interior-style)]
											 [height (caddr interior-style)]
											 [data (cadddr interior-style)])
									 (unless (= (blob-size data) (* 4 width height))
										 (error 'canvas-interior-style-set! "bad pattern data length" (blob-size data) (* 4 width height)))
									 (canvas-pattern-set/rgba/raw! canvas width height data)
									 (canvas-interior-style-set/raw! canvas (cdr (assq 'pattern interior-styles))))]
								[else
								 (canvas-interior-style-set/raw!
									 canvas
									 (cond
									 	 [(assq interior-style interior-styles) => cdr]
									 	 [else (error 'canvas-interior-style-set! "unknown interior style" interior-style)]))]))]
	         [canvas-interior-style/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasInteriorStyle(canvas, CD_QUERY));")]
	         [canvas-interior-style
	          (lambda (canvas)
	          	(let* ([interior-style (canvas-interior-style/raw canvas)]
	          	       [interior-style
	          	       (cond
	          	       	 [(rassoc interior-style interior-styles) => car]
	          	       	 [else (error 'canvas-interior-style "unknown interior style" interior-style)])])
								(case interior-style
									[(hatch)
									 (let ([hatch-style (canvas-hatch-style/raw canvas)])
										 (list
											 'hatch
											 (cond
												 [(rassoc hatch-style hatch-styles) => car]
												 [else (error 'canvas-interior-style "unknown hatch style" hatch-style)])))]
									[(stipple)
									 (let-location ([width int 0] [height int 0])
									 	 (canvas-stipple/raw canvas (location width) (location height) #f)
										 (let ([data (make-blob (inexact->exact (ceiling (/ (* width height) 8))))])
											 (canvas-stipple/raw canvas (location width) (location height) data)
											 (list 'stipple width height data)))]
									[(pattern)
									 (let-location ([width int 0] [height int 0])
									 	 (canvas-pattern/rgba/raw canvas (location width) (location height) #f)
										 (let ([data (make-blob (* 4 width height))])
											 (canvas-pattern/rgba/raw canvas (location width) (location height) data)
											 (list 'pattern/rgba width height data)))]
									[else
									 interior-style])))])
		(values
			(getter-with-setter canvas-interior-style canvas-interior-style-set!)
			canvas-interior-style-set!)))

;; }}}

;; {{{ Text functions

(define canvas-text!
	(foreign-lambda void "cdfCanvasText" nonnull-canvas double double nonnull-c-string))

(define canvas-font-set!
	(foreign-lambda c-string "cdCanvasNativeFont" nonnull-canvas nonnull-c-string))

(define canvas-font
	(getter-with-setter
		(foreign-lambda* c-string ([nonnull-canvas canvas])
			"C_return(cdCanvasNativeFont(canvas, NULL));")
		canvas-font-set!))

(define-values (canvas-text-alignment canvas-text-alignment-set!)
	(letrec ([alignments
	          (list
	          	(cons
	          		'north
	          		(foreign-value "CD_NORTH" int))
	          	(cons
	          		'south
	          		(foreign-value "CD_SOUTH" int))
	          	(cons
	          		'east
	          		(foreign-value "CD_EAST" int))
	          	(cons
	          		'west
	          		(foreign-value "CD_WEST" int))
	          	(cons
	          		'north-east
	          		(foreign-value "CD_NORTH_EAST" int))
	          	(cons
	          		'north-west
	          		(foreign-value "CD_NORTH_WEST" int))
	          	(cons
	          		'south-east
	          		(foreign-value "CD_SOUTH_EAST" int))
	          	(cons
	          		'south-west
	          		(foreign-value "CD_SOUTH_WEST" int))
	          	(cons
	          		'center
	          		(foreign-value "CD_CENTER" int))
	          	(cons
	          		'base-left
	          		(foreign-value "CD_BASE_LEFT" int))
	          	(cons
	          		'base-center
	          		(foreign-value "CD_BASE_CENTER" int))
	          	(cons
	          		'base-right
	          		(foreign-value "CD_BASE_RIGHT" int)))]
	         [canvas-text-alignment-set/raw!
	          (foreign-lambda void "cdCanvasTextAlignment" nonnull-canvas int)]
	         [canvas-text-alignment-set!
	          (lambda (canvas alignment)
							(canvas-text-alignment-set/raw!
								canvas
								(cond
									[(assq alignment alignments) => cdr]
									[else (error 'canvas-text-alignment-set! "unknown alignment" alignment)])))]
	         [canvas-text-alignment/raw
	          (foreign-lambda* int ([nonnull-canvas canvas])
	          	"C_return(cdCanvasTextAlignment(canvas, CD_QUERY));")]
	         [canvas-text-alignment
	          (lambda (canvas)
	          	(let ([alignment (canvas-text-alignment/raw canvas)])
								(cond
									[(rassoc alignment alignments) => car]
									[else (error 'canvas-text-alignment "unknown alignment" alignment)])))])
		(values
			(getter-with-setter canvas-text-alignment canvas-text-alignment-set!)
			canvas-text-alignment-set!)))

(define canvas-text-orientation-set!
	(foreign-lambda void "cdCanvasTextOrientation" nonnull-canvas double))

(define canvas-text-orientation
	(getter-with-setter
		(foreign-lambda* double ([nonnull-canvas canvas])
			"C_return(cdCanvasTextOrientation(canvas, CD_QUERY));")
		canvas-text-orientation-set!))

(define canvas-font-dimensions
	(letrec ([canvas-font-dimensions/raw
	          (foreign-lambda void "cdCanvasGetFontDim" nonnull-canvas (c-pointer int) (c-pointer int) (c-pointer int) (c-pointer int))])
	  (lambda (canvas)
	  	(let-location ([max-width int 0]
	  	               [height int 0]
	  	               [ascent int 0]
	  	               [descent int 0])
	  	  (canvas-font-dimensions/raw canvas (location max-width) (location height) (location ascent) (location descent))
	  	  (values max-width height ascent descent)))))

(define canvas-text-size
	(letrec ([canvas-text-size/raw
	          (foreign-lambda void "cdCanvasGetTextSize" nonnull-canvas nonnull-c-string (c-pointer int) (c-pointer int))])
	  (lambda (canvas text)
	  	(let-location ([width int 0] [height int 0])
	  		(canvas-text-size/raw canvas text (location width) (location height))
	  		(values width height)))))

(define canvas-text-box
	(letrec ([canvas-text-box/raw
	          (foreign-lambda void "cdCanvasGetTextBox" nonnull-canvas int int nonnull-c-string (c-pointer int) (c-pointer int) (c-pointer int) (c-pointer int))])
	  (lambda (canvas x y text)
	  	(let-location ([x0 int 0] [x1 int 0]
	  	               [y0 int 0] [y1 int 0])
	  	  (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
	          		(foreign-value "CD_CLOSED_LINES" int))
	          	(cons
	          		'fill
	          		(foreign-value "CD_FILL" int))
	          	(cons
	          		'clip
	          		(foreign-value "CD_CLIP" int))
	          	(cons
	          		'bezier
	          		(foreign-value "CD_BEZIER" int))
	          	(cons
	          		'region
	          		(foreign-value "CD_REGION" int))
	          	(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
	          		(foreign-value "CD_PATH_NEW" int))
	          	(cons
	          		'move-to
	          		(foreign-value "CD_PATH_MOVETO" int))
	          	(cons
	          		'line-to
	          		(foreign-value "CD_PATH_LINETO" int))
	          	(cons
	          		'arc
	          		(foreign-value "CD_PATH_ARC" int))
	          	(cons
	          		'curve-to
	          		(foreign-value "CD_PATH_CURVETO" int))
	          	(cons
	          		'close
	          		(foreign-value "CD_PATH_CLOSE" int))
	          	(cons
	          		'fill
	          		(foreign-value "CD_PATH_FILL" int))
	          	(cons
	          		'stroke
	          		(foreign-value "CD_PATH_STROKE" int))
	          	(cons
	          		'fill+stroke
	          		(foreign-value "CD_PATH_FILLSTROKE" int))
	          	(cons
	          		'clip
	          		(foreign-value "CD_PATH_CLIP" int)))]
	         [canvas-path-set/raw!
	          (foreign-lambda void "cdCanvasPathSet" nonnull-canvas int)])
	  (lambda (canvas path-action)
	  	(canvas-path-set/raw!
	  		canvas
	  		(cond
	  			[(assq path-action path-actions) => cdr]
	  			[else (error 'canvas-path-set! "unknown path action" path-action)])))))

(define canvas-vertex!
	(foreign-lambda void "cdfCanvasVertex" nonnull-canvas double double))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-printer.scm version [663846f624].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-printer
	(context:printer)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:printer
	(foreign-value "CD_PRINTER" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-ps.scm version [a5eb1aed85].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-ps
	(context:ps)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:ps
	(foreign-value "CD_PS" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-server.scm version [eb1228217e].
































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

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

(require-library canvas-draw-base)

(module canvas-draw-server
	(context:image context:double-buffer)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:image
	(foreign-value "CD_IMAGE" nonnull-context))

(define context:double-buffer
	(foreign-value "CD_DBUFFER" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-svg.scm version [d20d221b42].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-svg
	(context:svg)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:svg
	(foreign-value "CD_SVG" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw-types.scm version [63aba3e3b8].



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

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

(define-foreign-type canvas (c-pointer "cdCanvas")
	(canvas->pointer #f)
	(pointer->canvas #f))

(define-foreign-type nonnull-canvas (nonnull-c-pointer "cdCanvas")
	(canvas->pointer #t)
	(pointer->canvas #t))

(define-foreign-type context (c-pointer "cdContext")
	(context->pointer #f)
	(pointer->context #f))

(define-foreign-type nonnull-context (nonnull-c-pointer "cdContext")
	(context->pointer #t)
	(pointer->context #t))

(define-foreign-type state (c-pointer "cdState")
	(state->pointer #f)
	(pointer->state #f))

(define-foreign-type nonnull-state (nonnull-c-pointer "cdState")
	(state->pointer #t)
	(pointer->state #t))








Added canvas-draw/chicken/canvas-draw-wmf.scm version [840e4fc7fc].




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

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

(require-library canvas-draw-base)

(module canvas-draw-wmf
	(context:wmf)
	(import scheme chicken foreign canvas-draw-base)

;; {{{ Data types

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

(include "canvas-draw-types.scm")

;; }}}

;; {{{ Context types

(define context:wmf
	(foreign-value "CD_WMF" nonnull-context))

;; }}}

)








Added canvas-draw/chicken/canvas-draw.meta version [b9b1e49fad].









1
2
3
4
5

+
+
+
+
+

((category graphics)
 (license "BSD")
 (author "Thomas Chust")
 (synopsis "Bindings to the CD graphics library")
 (documentation "http://www.chust.org/fossils/canvas-draw"))








Added canvas-draw/chicken/canvas-draw.scm version [a2bd02e214].

















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

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

(require-library
	canvas-draw-base canvas-draw-primitives canvas-draw-play)

(module canvas-draw
	()
	(import scheme chicken)
	(reexport
		(except canvas-draw-base
		        canvas->pointer pointer->canvas
		        context->pointer pointer->context
		        state->pointer pointer->state)
		canvas-draw-primitives
		canvas-draw-play))








Added canvas-draw/chicken/canvas-draw.setup version [901a63a1f8].





























































































































































































































































































































































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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345

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

(if (find-library "cd" "cdCreateCanvas")
	(begin
		(compile -s -O2 -d1 "canvas-draw-base.scm" -j canvas-draw-base "-lcd")
		(compile -c -O2 -d1 "canvas-draw-base.scm" -j canvas-draw-base -unit canvas-draw-base)
		(compile -s -O2 -d0 "canvas-draw-base.import.scm")
		
		(install-extension
		 'canvas-draw-base
		 '("canvas-draw-base.so" "canvas-draw-base.o" "canvas-draw-base.import.so" "canvas-draw-types.scm")
		 '((version 1.0.0)
			 (static "canvas-draw-base.o")
			 (static-options "-lcd")))
		
		(compile -s -O2 -d1 "canvas-draw-primitives.scm" -j canvas-draw-primitives "-lcd")
		(compile -c -O2 -d1 "canvas-draw-primitives.scm" -j canvas-draw-primitives -unit canvas-draw-primitives)
		(compile -s -O2 -d0 "canvas-draw-primitives.import.scm")
		
		(install-extension
		 'canvas-draw-primitives
		 '("canvas-draw-primitives.so" "canvas-draw-primitives.o" "canvas-draw-primitives.import.so" "canvas-draw-types.scm")
		 '((version 1.0.0)
			 (static "canvas-draw-primitives.o")
			 (static-options "-lcd")))
		
		(compile -s -O2 -d1 "canvas-draw-play.scm" -j canvas-draw-play "-lcd")
		(compile -c -O2 -d1 "canvas-draw-play.scm" -j canvas-draw-play -unit canvas-draw-play)
		(compile -s -O2 -d0 "canvas-draw-play.import.scm")
		
		(install-extension
		 'canvas-draw-play
		 '("canvas-draw-play.so" "canvas-draw-play.o" "canvas-draw-play.import.so" "canvas-draw-types.scm")
		 '((version 1.0.0)
			 (static "canvas-draw-play.o")
			 (static-options "-lcd")))
		
		(if (find-library "iupcd" "cdContextIup")
			(begin
				(compile -s -O2 -d1 "canvas-draw-iup.scm" -j canvas-draw-iup "-liupcd")
				(compile -c -O2 -d1 "canvas-draw-iup.scm" -j canvas-draw-iup -unit canvas-draw-iup)
				(compile -s -O2 -d0 "canvas-draw-iup.import.scm")
				
				(install-extension
				 'canvas-draw-iup
				 '("canvas-draw-iup.so" "canvas-draw-iup.o" "canvas-draw-iup.import.so")
				 '((version 1.0.0)
					 (static "canvas-draw-iup.o")
					 (static-options "-liupcd"))))
			(warning "CD IUP driver not found, some bindings cannot be compiled"))
		
		(cond
			[(find-library "cdx11" "cdContextNativeWindow")
			 (compile -s -O2 -d1 "canvas-draw-native.scm" -j canvas-draw-native "-lcdx11 -lcdcontextplus")
			 (compile -c -O2 -d1 "canvas-draw-native.scm" -j canvas-draw-native -unit canvas-draw-native)
			 (compile -s -O2 -d0 "canvas-draw-native.import.scm")
			 
			 (install-extension
				'canvas-draw-native
				'("canvas-draw-native.so" "canvas-draw-native.o" "canvas-draw-native.import.so")
				'((version 1.0.0)
					(static "canvas-draw-native.o")
					(static-options "-lcdx11 -lcdcontextplus")))]
			[(find-library "cd" "cdContextNativeWindow")
			 (compile -s -O2 -d1 "canvas-draw-native.scm" -j canvas-draw-native "-lcd -lcdcontextplus")
			 (compile -c -O2 -d1 "canvas-draw-native.scm" -j canvas-draw-native -unit canvas-draw-native)
			 (compile -s -O2 -d0 "canvas-draw-native.import.scm")
			 
			 (install-extension
				'canvas-draw-native
				'("canvas-draw-native.so" "canvas-draw-native.o" "canvas-draw-native.import.so")
				'((version 1.0.0)
					(static "canvas-draw-native.o")
					(static-options "-lcd -lcdcontextplus")))]
			[else
			 (warning "CD native window driver not found, some bindings cannot be compiled")])
		
		(if (find-library "cdgl" "cdContextGL")
			(begin
				(compile -s -O2 -d1 "canvas-draw-gl.scm" -j canvas-draw-gl "-lcdgl")
				(compile -c -O2 -d1 "canvas-draw-gl.scm" -j canvas-draw-gl -unit canvas-draw-gl)
				(compile -s -O2 -d0 "canvas-draw-gl.import.scm")
				
				(install-extension
				 'canvas-draw-gl
				 '("canvas-draw-gl.so" "canvas-draw-gl.o" "canvas-draw-gl.import.so")
				 '((version 1.0.0)
					 (static "canvas-draw-gl.o")
					 (static-options "-lcdgl"))))
			(warning "CD OpenGL driver not found, some bindings cannot be compiled"))
		
		(cond
			[(find-library "cdx11" "cdContextClipboard")
			 (compile -s -O2 -d1 "canvas-draw-clipboard.scm" -j canvas-draw-clipboard "-lcdx11")
			 (compile -c -O2 -d1 "canvas-draw-clipboard.scm" -j canvas-draw-clipboard -unit canvas-draw-clipboard)
			 (compile -s -O2 -d0 "canvas-draw-clipboard.import.scm")
			 
			 (install-extension
				'canvas-draw-clipboard
				'("canvas-draw-clipboard.so" "canvas-draw-clipboard.o" "canvas-draw-clipboard.import.so")
				'((version 1.0.0)
					(static "canvas-draw-clipboard.o")
					(static-options "-lcdx11")))]
			[(find-library "cd" "cdContextClipboard")
			 (compile -s -O2 -d1 "canvas-draw-clipboard.scm" -j canvas-draw-clipboard "-lcd")
			 (compile -c -O2 -d1 "canvas-draw-clipboard.scm" -j canvas-draw-clipboard -unit canvas-draw-clipboard)
			 (compile -s -O2 -d0 "canvas-draw-clipboard.import.scm")
			 
			 (install-extension
				'canvas-draw-clipboard
				'("canvas-draw-clipboard.so" "canvas-draw-clipboard.o" "canvas-draw-clipboard.import.so")
				'((version 1.0.0)
					(static "canvas-draw-clipboard.o")
					(static-options "-lcd")))]
			[else
			 (warning "CD clipboard driver not found, some bindings cannot be compiled")])
		
		(cond
			[(find-library "cdx11" "cdContextPrinter")
			 (compile -s -O2 -d1 "canvas-draw-printer.scm" -j canvas-draw-printer "-lcdx11")
			 (compile -c -O2 -d1 "canvas-draw-printer.scm" -j canvas-draw-printer -unit canvas-draw-printer)
			 (compile -s -O2 -d0 "canvas-draw-printer.import.scm")
			 
			 (install-extension
				'canvas-draw-printer
				'("canvas-draw-printer.so" "canvas-draw-printer.o" "canvas-draw-printer.import.so")
				'((version 1.0.0)
					(static "canvas-draw-printer.o")
					(static-options "-lcdx11")))]
			[(find-library "cd" "cdContextPrinter")
			 (compile -s -O2 -d1 "canvas-draw-printer.scm" -j canvas-draw-printer "-lcd")
			 (compile -c -O2 -d1 "canvas-draw-printer.scm" -j canvas-draw-printer -unit canvas-draw-printer)
			 (compile -s -O2 -d0 "canvas-draw-printer.import.scm")
			 
			 (install-extension
				'canvas-draw-printer
				'("canvas-draw-printer.so" "canvas-draw-printer.o" "canvas-draw-printer.import.so")
				'((version 1.0.0)
					(static "canvas-draw-printer.o")
					(static-options "-lcd")))]
			[else
			 (warning "CD printer driver not found, some bindings cannot be compiled")])
		
		(if (find-library "cd" "cdContextPicture")
			(begin
				(compile -s -O2 -d1 "canvas-draw-picture.scm" -j canvas-draw-picture "-lcd")
				(compile -c -O2 -d1 "canvas-draw-picture.scm" -j canvas-draw-picture -unit canvas-draw-picture)
				(compile -s -O2 -d0 "canvas-draw-picture.import.scm")
				
				(install-extension
				 'canvas-draw-picture
				 '("canvas-draw-picture.so" "canvas-draw-picture.o" "canvas-draw-picture.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-picture.o")
				   (static-options "-lcd"))))
			(warning "CD picture driver not found, some bindings cannot be compiled"))
		
		(cond
			[(find-library "cdx11" "cdContextImage")
			 (compile -s -O2 -d1 "canvas-draw-server.scm" -j canvas-draw-server "-lcdx11")
			 (compile -c -O2 -d1 "canvas-draw-server.scm" -j canvas-draw-server -unit canvas-draw-server)
			 (compile -s -O2 -d0 "canvas-draw-server.import.scm")
			 
			 (install-extension
				'canvas-draw-server
				'("canvas-draw-server.so" "canvas-draw-server.o" "canvas-draw-server.import.so")
				'((version 1.0.0)
					(static "canvas-draw-server.o")
					(static-options "-lcdx11")))]
			[(find-library "cd" "cdContextImage")
			 (compile -s -O2 -d1 "canvas-draw-server.scm" -j canvas-draw-server "-lcd")
			 (compile -c -O2 -d1 "canvas-draw-server.scm" -j canvas-draw-server -unit canvas-draw-server)
			 (compile -s -O2 -d0 "canvas-draw-server.import.scm")
			 
			 (install-extension
				'canvas-draw-server
				'("canvas-draw-server.so" "canvas-draw-server.o" "canvas-draw-server.import.so")
				'((version 1.0.0)
					(static "canvas-draw-server.o")
					(static-options "-lcd")))]
			[else
			 (warning "CD server image driver not found, some bindings cannot be compiled")])
		
		(if (find-library "cd" "cdContextImageRGB")
			(begin
				(compile -s -O2 -d1 "canvas-draw-client.scm" -j canvas-draw-client "-lcd")
				(compile -c -O2 -d1 "canvas-draw-client.scm" -j canvas-draw-client -unit canvas-draw-client)
				(compile -s -O2 -d0 "canvas-draw-client.import.scm")
				
				(install-extension
				 'canvas-draw-client
				 '("canvas-draw-client.so" "canvas-draw-client.o" "canvas-draw-client.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-client.o")
				   (static-options "-lcd"))))
			(warning "CD client image driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cdpdf" "cdContextPDF")
			(begin
				(compile -s -O2 -d1 "canvas-draw-pdf.scm" -j canvas-draw-pdf "-lcdpdf")
				(compile -c -O2 -d1 "canvas-draw-pdf.scm" -j canvas-draw-pdf -unit canvas-draw-pdf)
				(compile -s -O2 -d0 "canvas-draw-pdf.import.scm")
				
				(install-extension
				 'canvas-draw-pdf
				 '("canvas-draw-pdf.so" "canvas-draw-pdf.o" "canvas-draw-pdf.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-pdf.o")
				   (static-options "-lcdpdf"))))
			(warning "CD PDF driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextPS")
			(begin
				(compile -s -O2 -d1 "canvas-draw-ps.scm" -j canvas-draw-ps "-lcd")
				(compile -c -O2 -d1 "canvas-draw-ps.scm" -j canvas-draw-ps -unit canvas-draw-ps)
				(compile -s -O2 -d0 "canvas-draw-ps.import.scm")
				
				(install-extension
				 'canvas-draw-ps
				 '("canvas-draw-ps.so" "canvas-draw-ps.o" "canvas-draw-ps.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-ps.o")
				   (static-options "-lcd"))))
			(warning "CD PostScript driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextSVG")
			(begin
				(compile -s -O2 -d1 "canvas-draw-svg.scm" -j canvas-draw-svg "-lcd")
				(compile -c -O2 -d1 "canvas-draw-svg.scm" -j canvas-draw-svg -unit canvas-draw-svg)
				(compile -s -O2 -d0 "canvas-draw-svg.import.scm")
				
				(install-extension
				 'canvas-draw-svg
				 '("canvas-draw-svg.so" "canvas-draw-svg.o" "canvas-draw-svg.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-svg.o")
				   (static-options "-lcd"))))
			(warning "CD SVG driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextMetafile")
			(begin
				(compile -s -O2 -d1 "canvas-draw-metafile.scm" -j canvas-draw-metafile "-lcd")
				(compile -c -O2 -d1 "canvas-draw-metafile.scm" -j canvas-draw-metafile -unit canvas-draw-metafile)
				(compile -s -O2 -d0 "canvas-draw-metafile.import.scm")
				
				(install-extension
				 'canvas-draw-metafile
				 '("canvas-draw-metafile.so" "canvas-draw-metafile.o" "canvas-draw-metafile.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-metafile.o")
				   (static-options "-lcd"))))
			(warning "CD metafile driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextDebug")
			(begin
				(compile -s -O2 -d1 "canvas-draw-debug.scm" -j canvas-draw-debug "-lcd")
				(compile -c -O2 -d1 "canvas-draw-debug.scm" -j canvas-draw-debug -unit canvas-draw-debug)
				(compile -s -O2 -d0 "canvas-draw-debug.import.scm")
				
				(install-extension
				 'canvas-draw-debug
				 '("canvas-draw-debug.so" "canvas-draw-debug.o" "canvas-draw-debug.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-debug.o")
				   (static-options "-lcd"))))
			(warning "CD debug driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextCGM")
			(begin
				(compile -s -O2 -d1 "canvas-draw-cgm.scm" -j canvas-draw-cgm "-lcd")
				(compile -c -O2 -d1 "canvas-draw-cgm.scm" -j canvas-draw-cgm -unit canvas-draw-cgm)
				(compile -s -O2 -d0 "canvas-draw-cgm.import.scm")
				
				(install-extension
				 'canvas-draw-cgm
				 '("canvas-draw-cgm.so" "canvas-draw-cgm.o" "canvas-draw-cgm.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-cgm.o")
				   (static-options "-lcd"))))
			(warning "CD CGM driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextDGN")
			(begin
				(compile -s -O2 -d1 "canvas-draw-dgn.scm" -j canvas-draw-dgn "-lcd")
				(compile -c -O2 -d1 "canvas-draw-dgn.scm" -j canvas-draw-dgn -unit canvas-draw-dgn)
				(compile -s -O2 -d0 "canvas-draw-dgn.import.scm")
				
				(install-extension
				 'canvas-draw-dgn
				 '("canvas-draw-dgn.so" "canvas-draw-dgn.o" "canvas-draw-dgn.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-dgn.o")
				   (static-options "-lcd"))))
			(warning "CD DGN driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextDXF")
			(begin
				(compile -s -O2 -d1 "canvas-draw-dxf.scm" -j canvas-draw-dxf "-lcd")
				(compile -c -O2 -d1 "canvas-draw-dxf.scm" -j canvas-draw-dxf -unit canvas-draw-dxf)
				(compile -s -O2 -d0 "canvas-draw-dxf.import.scm")
				
				(install-extension
				 'canvas-draw-dxf
				 '("canvas-draw-dxf.so" "canvas-draw-dxf.o" "canvas-draw-dxf.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-dxf.o")
				   (static-options "-lcd"))))
			(warning "CD DXF driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextEMF")
			(begin
				(compile -s -O2 -d1 "canvas-draw-emf.scm" -j canvas-draw-emf "-lcd")
				(compile -c -O2 -d1 "canvas-draw-emf.scm" -j canvas-draw-emf -unit canvas-draw-emf)
				(compile -s -O2 -d0 "canvas-draw-emf.import.scm")
				
				(install-extension
				 'canvas-draw-emf
				 '("canvas-draw-emf.so" "canvas-draw-emf.o" "canvas-draw-emf.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-emf.o")
				   (static-options "-lcd"))))
			(warning "CD EMF driver not found, some bindings cannot be compiled"))
		
		(if (find-library "cd" "cdContextWMF")
			(begin
				(compile -s -O2 -d1 "canvas-draw-wmf.scm" -j canvas-draw-wmf "-lcd")
				(compile -c -O2 -d1 "canvas-draw-wmf.scm" -j canvas-draw-wmf -unit canvas-draw-wmf)
				(compile -s -O2 -d0 "canvas-draw-wmf.import.scm")
				
				(install-extension
				 'canvas-draw-wmf
				 '("canvas-draw-wmf.so" "canvas-draw-wmf.o" "canvas-draw-wmf.import.so")
				 '((version 1.0.0)
				   (static "canvas-draw-wmf.o")
				   (static-options "-lcd"))))
			(warning "CD WMF driver not found, some bindings cannot be compiled"))
		
		(compile -s -O2 -d1 "canvas-draw.scm" -j canvas-draw)
		(compile -c -O2 -d1 "canvas-draw.scm" -j canvas-draw -unit canvas-draw)
		(compile -s -O2 -d0 "canvas-draw.import.scm")
		
		(install-extension
		 'canvas-draw
		 '("canvas-draw.so" "canvas-draw.o" "canvas-draw.import.so")
		 '((version 1.0.0)
			 (static "canvas-draw.o"))))
	(error "CD not found, none of the bindings can be compiled"))








Added canvas-draw/manifest version [33bf933593].

















































































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

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

C Changed\swith-canvas-mode\sinto\scall-with-canvas-in-mode
D 2010-10-22T02:35:02
F LICENSE.txt 0f326ce34f5e3196925dcb3937b90d96971e17d6
F api/base.wiki 01dd0798b9c4453ce6282feeb5e1503cee26ae1c
F api/cgm.wiki 2b71cdedb4227aaf72723673a575641cd0d1a2c3
F api/client.wiki 239992612ebc61eeab4170181248f71be3e245a4
F api/clipboard.wiki 3cffe76749de3ef0e14b4223d470a595174c78f1
F api/debug.wiki e61598f3ec7b96a7e62c0b56f4b42040a4ed446d
F api/dgn.wiki d803d2e8b886fbc5563cf9186d04dd9d47ca2f44
F api/dxf.wiki 7456a1e3e96f7dbf39aec7cd99cb7b0fb6bef284
F api/emf.wiki f046287334295eff404a8e5b29d5054abf1afbca
F api/gl.wiki 0fb6b8938a4ee8ffd2e56d9761499d55afe35bef
F api/iup.wiki f2ac6fadac1035fa2ef8dbb829cf310c3dc7e578
F api/main.wiki f30493803812062cec5e65b89b376476b755d790
F api/metafile.wiki cc4eafd9d5f948afcddcc4b1c2caa5d731a7cc4a
F api/native.wiki 907ab1647b4a587464b836acefdd6f73b021117c
F api/pdf.wiki 17ab6eed22b52fab61a48b963f5c8e7831d40ff2
F api/picture.wiki 242f6b8a92d5b46ca1cbe14e3f10d9acf0fcb852
F api/play.wiki 06ca7a82a61fef85ace33c80d677822977232a88
F api/primitives.wiki 36cfca72a54c325c13954fa0e6e9152aac432a16
F api/printer.wiki 4f3bac13f70c5b43b4b08c4dcd1b6c2a0d94ebe0
F api/ps.wiki 534b9c33560d082cc8501e6c5899f409d4f26e80
F api/server.wiki 1fc6ea53d8526211e902e1a43b1f2f1a13e96710
F api/svg.wiki 3cffd2303f1e2c34468d16bcaae111d70bc95f38
F api/wmf.wiki 8976c2a3fbd25bb0ecf0008e19ae8ad7b79e4248
F chicken/canvas-draw-base.scm a398b8328d3370f893d185c7b4a4e3ec2c88ed63
F chicken/canvas-draw-cgm.scm a689b8a73f0ec69e6c134b6baa1cbcebc174d6bf
F chicken/canvas-draw-client.scm b7d557a7f82f5b22cba521bc83bc4c5d8618d720
F chicken/canvas-draw-clipboard.scm e0d6041291334a9530a5611840f93c4aed75418e
F chicken/canvas-draw-debug.scm d0e3d962720987a7ca47c6b269e8e23085186352
F chicken/canvas-draw-dgn.scm 561a4a7057f70a9bddcdb89b3b61ae5d7afee586
F chicken/canvas-draw-dxf.scm 461f2e8836d6f57d8c0755bbce572d6ce13b6150
F chicken/canvas-draw-emf.scm 057c88a2dd79d619bdaa350ce5a0e4ed349198f1
F chicken/canvas-draw-gl.scm b3ceb42ae9205318196aa218dd7c453d2815a190
F chicken/canvas-draw-iup.scm 9b1370885d4e6b704b76640180802dbbb64de2bb
F chicken/canvas-draw-metafile.scm dff4d2cf55f2f16907dcc954aff0a1d6d3eca440
F chicken/canvas-draw-native.scm 54e46d244fdec7ea2e53e685a7891d98090bf795
F chicken/canvas-draw-pdf.scm 2ecd6081ed3dc94062363a9fa6f5bbebe679f549
F chicken/canvas-draw-picture.scm 401583817f5579edc979ba5a27baccab5fec87b4
F chicken/canvas-draw-play.scm 1da93abfbca5dcacebac2d2d7ca04e92e566dca3
F chicken/canvas-draw-primitives.scm 188fe57c8d275ad747e64921281199c09cb47c01
F chicken/canvas-draw-printer.scm 663846f6249066674ff1afca289f68ab1e499dfb
F chicken/canvas-draw-ps.scm a5eb1aed85d1db9283f069cc59d02f6e4663b2ef
F chicken/canvas-draw-server.scm eb1228217e7d9f91e6cddc7993e9af2a8924102d
F chicken/canvas-draw-svg.scm d20d221b427dbf2098d342cf5e533e22ed807772
F chicken/canvas-draw-types.scm 63aba3e3b863e40c4b6ba08fd6892cce6fc71b1b
F chicken/canvas-draw-wmf.scm 840e4fc7fc554a20f25e3aa227cbee478c683e19
F chicken/canvas-draw.meta b9b1e49fadca38a134afe7c7ac8c36b39c693090
F chicken/canvas-draw.scm a2bd02e214c70ad6b978e5f84379582047956032
F chicken/canvas-draw.setup 901a63a1f85c529a15c0dbb6e0810c7f6d13c77d
F racket/base.rkt 90a071f77daa2e97eb1576112d98d411484c62b3
F racket/cgm.rkt 450ed8492b949db1d3338716d9c9ae509534c260
F racket/client.rkt 1a260d97ea8351f86874a0479dfbcdcb87257715
F racket/clipboard.rkt ea82433da2d8c221147bdd0764d71869ddbf51db
F racket/debug.rkt e12561359f155699f1f97a887609e534e2ee786a
F racket/dgn.rkt 0f7fe3de34d385ada742a1b06aa42e522cda7951
F racket/dxf.rkt 6c38a90ce75f2b18bc961fd96d8e333e36526736
F racket/emf.rkt daeb9e090c57f92481ecb8876fa7ccf686a9e3ef
F racket/gl.rkt b2f08fa5b6b063528c00f716006e19457f7945df
F racket/info.rkt 32fcbd61f85f5cdbe26978840aa76df25cabb8c0
F racket/iup.rkt cde98249f51821b0038afe248dc5c460101425c8
F racket/main.rkt 92e540e2fff6fba7b8d33465343259ceab7c3c6f
F racket/metafile.rkt 7c81a9e55c72ad608411ed1af54d42a9955761dc
F racket/native.rkt c102ec574f10efe8711167f1f2856e42e0d88dca
F racket/pdf.rkt 75e477e6d1a4d8d6ff583937a5c8299477f03937
F racket/picture.rkt 1d85f63ef04a9550045ece803c5ddc16887474c9
F racket/play.rkt 799196508db45b0bf23e1c8b4d7d316faa22b1b0
F racket/primitives.rkt ed1ac7e149327202a2533bbced8ecfd6163a1a63
F racket/printer.rkt 5a4515ba82414f18d45ccb4df530545eb5aec406
F racket/ps.rkt fc8e7865424b549146a89d991b554fb0c558fd57
F racket/server.rkt b01bbbfe5d1e59f2eefa0494a2a03590046ddada
F racket/svg.rkt 36d0f855de7190e184a5eef27db71f37b1eaf95c
F racket/wmf.rkt 52ea848f8b60748809e3d9ffad603ace915a5354
P acecf54f4fcf8950fbfce3e4df9d575e4623db76
R 6d34495bd98f29b23f00e3b02170c376
U murphy
Z 0ec981d3607579245a2d8668e79d0222








Added canvas-draw/manifest.uuid version [0ac2daad7b].





1

+

33bf93359307b97701634526a6b6212d9397e04e








Added canvas-draw/racket/base.rkt version [90a071f77d].


















































































































































































































































































































































































































































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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
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
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430

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

#lang racket
(require
 srfi/2
 srfi/17
 srfi/26
 ffi/unsafe
 ffi/unsafe/cvector
 ffi/unsafe/alloc
 ffi/unsafe/atomic)

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Data types

(define-cpointer-type _canvas)

(define-cpointer-type _context)

(define-cpointer-type _state)

(provide
 _canvas _canvas/null canvas?
 _context _context/null context?
 _state _state/null state?)

;; }}}

;; {{{ Canvas management

(define _capability-mask
  (_bitmask
   '(flush              = #x00000001
     clear              = #x00000002
     play               = #x00000004
     y-axis             = #x00000008
     clip-area          = #x00000010
     clip-polygon       = #x00000020
     region             = #x00000040
     rectangle          = #x00000080
     chord              = #x00000100
     image/rgb          = #x00000200
     image/rgba         = #x00000400
     image/map          = #x00000800
     get-image/rgb      = #x00001000
     image/server       = #x00002000
     background         = #x00004000
     background-opacity = #x00008000
     write-mode         = #x00010000
     line-style         = #x00020000
     line-width         = #x00040000
     fprimitives        = #x00080000
     hatch              = #x00100000
     stipple            = #x00200000
     pattern            = #x00400000
     font               = #x00800000
     font-dimensions    = #x01000000
     text-size          = #x02000000
     text-orientation   = #x04000000
     palette            = #x08000000
     line-cap           = #x10000000
     line-join          = #x20000000
     path               = #x40000000
     bezier             = #x80000000)
   _int))

(define context-capabilities
  (get-ffi-obj
   "cdContextCaps" libcd
   (_fun [context : _context] -> [capabilities : _capability-mask])))

(define use-context+
  (make-parameter #f))

(define use-context+!
  (get-ffi-obj
   "cdUseContextPlus" libcd
   (_fun [plus? : _bool = (use-context+)] -> _void)))

(define make-canvas/ptr
  (get-ffi-obj
   "cdCreateCanvas" libcd
   (_fun [context : _context] [data : _pointer] -> [canvas : _canvas/null])))

(define make-canvas/string
  (get-ffi-obj
   "cdCreateCanvas" libcd
   (_fun [context : _context] [data : _string/utf-8] -> [canvas : _canvas/null])))

(define canvas-kill
  ((deallocator)
   (get-ffi-obj
    "cdKillCanvas" libcd
    (_fun [canvas : _canvas] -> _void))))

(define canvas-activate!
  (get-ffi-obj
   "cdCanvasActivate" libcd
   (_fun [canvas : _canvas] -> _void)))

(define canvas-deactivate!
  (get-ffi-obj
   "cdCanvasDeactivate" libcd
   (_fun [canvas : _canvas] -> _void)))

(define make-canvas
  ((allocator canvas-kill)
   (λ (context data)
     (let ([make-canvas/data (if (string? data) make-canvas/string make-canvas/ptr)])
       (use-context+!)
       (cond
         [(make-canvas/data context data) => values]
         [else (error 'make-canvas "failed to create canvas")])))))

(define call-with-canvas
  (case-lambda
    [(canvas proc)
     (dynamic-wind
      (cut canvas-activate! canvas)
      (cut proc canvas)
      (cut canvas-deactivate! canvas))]
    [(context data proc)
     (let* ([make-canvas/data
             (if (string? data) make-canvas/string make-canvas/ptr)]
            [canvas
             (call-as-atomic
              (λ ()
                (use-context+!)
                (make-canvas/data context data)))])
       (unless canvas (error 'call-with-canvas "failed to create canvas"))
       (dynamic-wind
        (cut canvas-activate! canvas)
        (cut proc canvas)
        (λ ()
          (when canvas
            (canvas-kill canvas)
            (set! canvas #f)))))]))

(define canvas-context
  (get-ffi-obj
   "cdCanvasGetContext" libcd
   (_fun [canvas : _canvas] -> [context : _context])))

(define _simulation-mask
  (_bitmask
   '(none      = #x0000
     line      = #x0001
     rectangle = #x0002
     box       = #x0004
     arc       = #x0008
     sector    = #x0010
     chord     = #x0020
     polyline  = #x0040
     polygon   = #x0080
     text      = #x0100
     all       = #xFFFF
     lines     = #x004B
     fills     = #x00B4)
   _int))

(define canvas-simulate!
  (get-ffi-obj
   "cdCanvasSimulate" libcd
   (_fun [canvas : _canvas] [simulate : _simulation-mask] -> [simulate : _simulation-mask])))

(define _name
  (make-ctype
   _string/utf-8
   (λ (name)
     (cond
       [(symbol? name)
        (string-upcase (regexp-replace* #rx"-" (symbol->string name) "_"))]
       [else
        name]))
   #f))

(define canvas-attribute-set!
  (get-ffi-obj
   "cdCanvasSetAttribute" libcd
   (_fun [canvas : _canvas] [name : _name] [value : _string/utf-8] -> _void)))

(define canvas-attribute
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasGetAttribute" libcd
    (_fun [canvas : _canvas] [name : _name] -> [value : _string/utf-8]))
   canvas-attribute-set!))

(define canvas-state-set!
  (get-ffi-obj
   "cdCanvasRestoreState" libcd
   (_fun [canvas : _canvas] [state : _state] -> _void)))

(define state-release
  ((deallocator)
   (get-ffi-obj
    "cdReleaseState" libcd
    (_fun [state : _state] -> _void))))

(define canvas-state
  (getter-with-setter
   ((allocator state-release)
    (get-ffi-obj
     "cdCanvasSaveState" libcd
     (_fun [canvas : _canvas] -> [state : _state])))
   canvas-state-set!))

(define canvas-clear!
  (get-ffi-obj
   "cdCanvasClear" libcd
   (_fun [canvas : _canvas] -> _void)))

(define canvas-flush
  (get-ffi-obj
   "cdCanvasFlush" libcd
   (_fun [canvas : _canvas] -> _void)))

(provide
 context-capabilities
 use-context+ make-canvas call-with-canvas
 canvas-context
 canvas-simulate!
 canvas-attribute canvas-attribute-set!
 canvas-state canvas-state-set!
 canvas-clear! canvas-flush)

;; }}}

;; {{{ Coordinate system

(define canvas-size
  (get-ffi-obj
   "cdCanvasGetSize" libcd
   (_fun [canvas : _canvas]
         [width/px : (_ptr o _int)] [height/px : (_ptr o _int)]
         [width/mm : (_ptr o _double)] [height/mm : (_ptr o _double)]
         -> _void
         -> (values
             width/px height/px
             width/mm height/mm))))

(define canvas-mm->px
  (get-ffi-obj
   "cdCanvasMM2Pixel" libcd
   (_fun [canvas : _canvas]
         [x/mm : _double*] [y/mm : _double*]
         [x/px : (_ptr o _int)] [y/px : (_ptr o _int)]
         -> _void
         -> (values x/px y/px))))

(define canvas-px->mm
  (get-ffi-obj
   "cdCanvasPixel2MM" libcd
   (_fun [canvas : _canvas]
         [x/px : _int] [y/px : _int]
         [x/mm : (_ptr o _double)] [y/mm : (_ptr o _double)]
         -> _void
         -> (values x/mm y/mm))))

(define canvas-origin-set!
  (get-ffi-obj
   "cdCanvasOrigin" libcd
   (_fun [canvas : _canvas] [x : _int] [y : _int] -> _void)))

(define canvas-origin
  (get-ffi-obj
   "cdCanvasGetOrigin" libcd
   (_fun [canvas : _canvas] [x : (_ptr o _int)] [y : (_ptr o _int)]
         -> _void
         -> (values x y))))

(define _transform
  (make-ctype
   _gcpointer
   (λ (proc)
     (and
      proc
      (let* ([v (make-cvector _double* 6)])
        (let-values ([(dx dy) (proc 0 0)])
          (cvector-set! v 4 dx)
          (cvector-set! v 5 dy)
          (let-values ([(x y) (proc 1 0)])
            (cvector-set! v 0 (- x dx))
            (cvector-set! v 1 (- y dy)))
          (let-values ([(x y) (proc 0 1)])
            (cvector-set! v 2 (- x dx))
            (cvector-set! v 3 (- y dy))))
        (cvector-ptr v))))
   (λ (v)
     (and-let* ([v (and v (make-cvector* v _double* 6))])
       (let ([sx0 (cvector-ref v 0)] [sx1 (cvector-ref v 1)]
             [sy0 (cvector-ref v 2)] [sy1 (cvector-ref v 3)]
             [dx (cvector-ref v 4)] [dy (cvector-ref v 5)])
         (λ (x y)
           (values
            (+ (* sx0 x) (* sy0 y) dx)
            (+ (* sx1 x) (* sy1 y) dy))))))))

(define canvas-transform-set!
  (get-ffi-obj
   "cdCanvasTransform" libcd
   (_fun [canvas : _canvas] [transform : _transform] -> _void)))

(define canvas-transform
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasGetTransform" libcd
    (_fun [canvas : _canvas] -> [transform : _transform]))
   canvas-transform-set!))

(define canvas-transform-compose!
  (get-ffi-obj
   "cdCanvasTransformMultiply" libcd
   (_fun [canvas : _canvas] [transform : _transform] -> _void)))

(define canvas-transform-translate!
  (get-ffi-obj
   "cdCanvasTransformTranslate" libcd
   (_fun [canvas : _canvas] [dx : _double*] [dy : _double*] -> _void)))

(define canvas-transform-scale!
  (get-ffi-obj
   "cdCanvasTransformScale" libcd
   (_fun [canvas : _canvas] [sx : _double*] [sy : _double*] -> _void)))

(define canvas-transform-rotate!
  (get-ffi-obj
   "cdCanvasTransformRotate" libcd
   (_fun [canvas : _canvas] [alpha : _double*] -> _void)))

(provide
 canvas-size
 canvas-mm->px canvas-px->mm
 canvas-origin canvas-origin-set!
 canvas-transform canvas-transform-set!
 canvas-transform-compose!
 canvas-transform-translate!
 canvas-transform-scale!
 canvas-transform-rotate!)

;; }}}

;; {{{ General attributes

(define canvas-foreground-set!
  (get-ffi-obj
   "cdCanvasSetForeground" libcd
   (_fun [canvas : _canvas] [color : _ulong] -> _void)))

(define canvas-foreground
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasForeground" libcd
    (_fun [canvas : _canvas] [query : _long = -1] -> [color : _ulong]))
   canvas-foreground-set!))

(define canvas-background-set!
  (get-ffi-obj
   "cdCanvasSetBackground" libcd
   (_fun [canvas : _canvas] [color : _ulong] -> _void)))

(define canvas-background
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasBackground" libcd
    (_fun [canvas : _canvas] [query : _long = -1] -> [color : _ulong]))
   canvas-background-set!))

(define _write-mode
  (_enum '(replace xor not-xor)))

(define canvas-write-mode-set!
  (get-ffi-obj
   "cdCanvasWriteMode" libcd
   (_fun [canvas : _canvas] [mode : _write-mode] -> _void)))

(define canvas-write-mode
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasWriteMode" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> [mode : _write-mode]))
   canvas-write-mode-set!))

(provide
 canvas-foreground canvas-foreground-set!
 canvas-background canvas-background-set!
 canvas-write-mode canvas-write-mode-set!)

;; }}}

;; {{{ Clipping

(define _clip-mode
  (_enum '(#f area polygon region)))

(define canvas-clip-mode-set!
  (get-ffi-obj
   "cdCanvasClip" libcd
   (_fun [canvas : _canvas] [mode : _clip-mode] -> _void)))

(define canvas-clip-mode
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasClip" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> [mode : _clip-mode]))
   canvas-clip-mode-set!))

(define canvas-clip-area-set!
  (get-ffi-obj
   "cdfCanvasClipArea" libcd
   (_fun [canvas : _canvas] [x0 : _double*] [x1 : _double*] [y0 : _double*] [y1 : _double*] -> _void)))

(define canvas-clip-area
  (get-ffi-obj
   "cdfCanvasGetClipArea" libcd
   (_fun [canvas : _canvas]
         [x0 : (_ptr o _double)] [x1 : (_ptr o _double)]
         [y0 : (_ptr o _double)] [y1 : (_ptr o _double)]
         -> _void
         -> (values x0 x1 y0 y1))))

(provide
 canvas-clip-mode canvas-clip-mode-set!
 canvas-clip-area canvas-clip-area-set!)

;; }}}








Added canvas-draw/racket/cgm.rkt version [450ed8492b].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:cgm
  ((get-ffi-obj "cdContextCGM" libcd (_fun -> [context : _context]))))

(provide
 context:cgm)

;; }}}








Added canvas-draw/racket/client.rkt version [1a260d97ea].










































































































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

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

#lang racket
(require
 srfi/17
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:image
  ((get-ffi-obj "cdContextImageRGB" libcd (_fun -> [context : _context]))))

(define context:double-buffer
  ((get-ffi-obj "cdContextDBufferRGB" libcd (_fun -> [context : _context]))))

(provide
 context:image context:double-buffer)

;; }}}

;; {{{ Auxiliary functions

(define (bytes-slice bstr n k slen)
  (let ([blen (bytes-length bstr)])
    (unless (= blen (* n slen))
      (error 'bytes-slice "data length mismatch (actual ~s, required ~s)" blen (* n slen)))
    (let ([slice (make-bytes slen)])
      (for ([bi (in-range k blen n)] [si (in-range slen)])
        (bytes-set! slice si (bytes-ref bstr bi)))
      slice)))

(define (bytes-mix slice0 . slice*)
  (let* ([n (add1 (length slice*))]
         [blen (* n (bytes-length slice0))]
         [bstr (make-bytes blen)])
    (for ([slice (in-cycle (in-value slice0) (in-list slice*))]
          [bi (in-range blen)] #:when #t [si (in-value (quotient bi n))])
      (bytes-set! bstr bi (bytes-ref slice si)))
    bstr))

(define canvas-image-put/rgb!
  (get-ffi-obj
   "cdCanvasPutImageRectRGB" libcd
   (_fun (canvas dst-x dst-y src-width src-height data
          #:width [dst-width 0] #:height [dst-height 0]
          #:x0 [src-x0 0] #:x1 [src-x1 0]
          #:y0 [src-y0 0] #:y1 [src-y1 0])
         :: [canvas : _canvas]
            [src-width : _int] [src-height : _int]
            [red : _bytes = (bytes-slice data 3 0 (* src-width src-height))]
            [green : _bytes = (bytes-slice data 3 1 (* src-width src-height))]
            [blue : _bytes = (bytes-slice data 3 2 (* src-width src-height))]
            [dst-x : _int] [dst-y : _int]
            [dst-width : _int] [dst-height : _int]
            [src-x0 : _int] [src-x1 : _int]
            [src-y0 : _int] [src-y1 : _int]
         -> _void)))

(define canvas-image-put/rgba!
  (get-ffi-obj
   "cdCanvasPutImageRectRGBA" libcd
   (_fun (canvas dst-x dst-y src-width src-height data
          #:width [dst-width 0] #:height [dst-height 0]
          #:x0 [src-x0 0] #:x1 [src-x1 0]
          #:y0 [src-y0 0] #:y1 [src-y1 0])
         :: [canvas : _canvas]
            [src-width : _int] [src-height : _int]
            [red : _bytes = (bytes-slice data 4 0 (* src-width src-height))]
            [green : _bytes = (bytes-slice data 4 1 (* src-width src-height))]
            [blue : _bytes = (bytes-slice data 4 2 (* src-width src-height))]
            [alpha : _bytes = (bytes-slice data 4 3 (* src-width src-height))]
            [dst-x : _int] [dst-y : _int]
            [dst-width : _int] [dst-height : _int]
            [src-x0 : _int] [src-x1 : _int]
            [src-y0 : _int] [src-y1 : _int]
         -> _void)))

(define canvas-image/rgb
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasGetImageRGB" libcd
    (_fun (canvas x y width height)
          :: [canvas : _canvas]
             [red : (_bytes o (* width height))]
             [green : (_bytes o (* width height))]
             [blue : (_bytes o (* width height))]
             [x : _int] [y : _int]
             [width : _int] [height : _int]
          -> _void
          -> (bytes-mix red green blue)))
   canvas-image-put/rgb!))

(provide
 canvas-image/rgb canvas-image-put/rgb! canvas-image-put/rgba!)

;; }}}








Added canvas-draw/racket/clipboard.rkt version [ea82433da2].



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd-native
  (case (system-type 'os)
    [(unix macosx)
     (ffi-lib "libcdx11")]
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:clipboard
  ((get-ffi-obj "cdContextClipboard" libcd-native (_fun -> [context : _context]))))

(provide
 context:clipboard)

;; }}}








Added canvas-draw/racket/debug.rkt version [e12561359f].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:debug
  ((get-ffi-obj "cdContextDebug" libcd (_fun -> [context : _context]))))

(provide
 context:debug)

;; }}}








Added canvas-draw/racket/dgn.rkt version [0f7fe3de34].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:dgn
  ((get-ffi-obj "cdContextDGN" libcd (_fun -> [context : _context]))))

(provide
 context:dgn)

;; }}}








Added canvas-draw/racket/dxf.rkt version [6c38a90ce7].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:dxf
  ((get-ffi-obj "cdContextDXF" libcd (_fun -> [context : _context]))))

(provide
 context:dxf)

;; }}}








Added canvas-draw/racket/emf.rkt version [daeb9e090c].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:emf
  ((get-ffi-obj "cdContextEMF" libcd (_fun -> [context : _context]))))

(provide
 context:emf)

;; }}}








Added canvas-draw/racket/gl.rkt version [b2f08fa5b6].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd-gl
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cdgl")]
    [else
     (ffi-lib "libcdgl")]))

;; {{{ Context types

(define context:gl
  ((get-ffi-obj "cdContextGL" libcd-gl (_fun -> [context : _context]))))

(provide
 context:gl)

;; }}}








Added canvas-draw/racket/info.rkt version [32fcbd61f8].






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

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

#lang setup/infotab
(define name
  "Canvas Draw")
(define blurb
  '("Bindings to the CD graphics library"))
(define categories
  '(graphics))
(define repositories
  '("4.x"))
(define version
  "1.0")
(define release-notes
  '((dl
     (dt "1.0") (dd "Initial release"))))
(define primary-file
  "main.rkt")
(define homepage
  "http://www.chust.org/fossils/canvas-draw")








Added canvas-draw/racket/iup.rkt version [cde98249f5].







































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

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

#lang racket
(require
 srfi/26
 ffi/unsafe
 "base.rkt")

(define libiup-cd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "iupcd")]
    [else
     (ffi-lib "libiupcd")]))

;; {{{ Context types

(define context:iup
  ((get-ffi-obj "cdContextCGM" libiup-cd (_fun -> [context : _context]))))

(provide
 context:iup)

;; }}}

;; {{{ Auxiliary functions

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

;; }}}








Added canvas-draw/racket/main.rkt version [92e540e2ff].















1
2
3
4
5
6
7
8
9
10
11

+
+
+
+
+
+
+
+
+
+
+

#lang racket/base
(require
 "base.rkt" "primitives.rkt" "play.rkt")

(provide
 (except-out (all-from-out "base.rkt")
             _canvas _canvas/null
             _context _context/null
             _state _state/null)
 (all-from-out "primitives.rkt")
 (all-from-out "play.rkt"))








Added canvas-draw/racket/metafile.rkt version [7c81a9e55c].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:metafile
  ((get-ffi-obj "cdContextMetafile" libcd (_fun -> [context : _context]))))

(provide
 context:metafile)

;; }}}








Added canvas-draw/racket/native.rkt version [c102ec574f].



























































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

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

#lang racket
(require
 ffi/unsafe
 "base.rkt")

(define libcd-native
  (case (system-type 'os)
    [(unix macosx)
     (ffi-lib "libcdx11")]
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

(define libcd-context+
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cdcontextplus")]
    [else
     (ffi-lib "libcdcontextplus")]))

;; {{{ Context types

(define context:native-window
  ((get-ffi-obj "cdContextNativeWindow" libcd-native (_fun -> [context : _context]))))

(provide
 context:native-window)

;; }}}

;; {{{ Auxiliary functions

(define screen-size
  (get-ffi-obj
   "cdGetScreenSize" libcd-native
   (_fun [width/px : (_ptr o _int)] [height/px : (_ptr o _int)]
         [width/mm : (_ptr o _double)] [height/mm : (_ptr o _double)]
         -> _void
         -> (values
             width/px height/px
             width/mm height/mm))))

(provide
 screen-size)

;; }}}

;; {{{ Library initialization

((get-ffi-obj
  "cdInitContextPlus" libcd-context+
  (_fun -> _void)))

;; }}}








Added canvas-draw/racket/pdf.rkt version [75e477e6d1].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd-pdf
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cdpdf")]
    [else
     (ffi-lib "libcdpdf")]))

;; {{{ Context types

(define context:pdf
  ((get-ffi-obj "cdContextPDF" libcd-pdf (_fun -> [context : _context]))))

(provide
 context:pdf)

;; }}}








Added canvas-draw/racket/picture.rkt version [1d85f63ef0].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:picture
  ((get-ffi-obj "cdContextPicture" libcd (_fun -> [context : _context]))))

(provide
 context:picture)

;; }}}








Added canvas-draw/racket/play.rkt version [799196508d].











































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

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

#lang racket
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context content playback

(define canvas-play/ptr!
  (get-ffi-obj
   "cdCanvasPlay" libcd
   (_fun [canvas : _canvas] [context : _context]
         [x0 : _int] [x1 : _int] [y0 : _int] [y1 : _int]
         [data : _pointer]
         -> [rc : _int])))

(define canvas-play/string!
  (get-ffi-obj
   "cdCanvasPlay" libcd
   (_fun [canvas : _canvas] [context : _context]
         [x0 : _int] [x1 : _int] [y0 : _int] [y1 : _int]
         [data : _string/utf-8]
         -> [rc : _int])))

(define (canvas-play! canvas context x0 x1 y0 y1 data)
  (let ([canvas-play/data! (if (string? data) canvas-play/string! canvas-play/ptr!)])
    (unless (zero? (canvas-play/data! canvas context x0 x1 y0 y1 data))
      (error 'canvas-play! "failed to replay graphics"))))

(provide
 canvas-play!)

;; }}}








Added canvas-draw/racket/primitives.rkt version [ed1ac7e149].




















































































































































































































































































































































































































































































































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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
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
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
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
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496

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

#lang racket
(require
 srfi/17
 srfi/26
 ffi/unsafe
 ffi/unsafe/cvector
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Point drawing functions

(define canvas-pixel!
  (get-ffi-obj
   "cdCanvasPixel" libcd
   (_fun (canvas x y [color (canvas-foreground canvas)])
         :: [canvas : _canvas] [x : _int] [y : _int] [color : _ulong] -> _void)))

(define canvas-mark!
  (get-ffi-obj
   "cdCanvasMark" libcd
   (_fun [canvas : _canvas] [x : _int] [y : _int] -> _void)))

(define _mark-type
  (_enum
   '(+ = 0 plus = 0
     * = 1 star = 1
     0 = 2 circle = 2
     X = 3 x = 3
     box
     diamond
     O = 6 hollow-circle = 6
     hollow-box
     hollow-diamond)
   _fixint))

(define canvas-mark-type-set!
  (get-ffi-obj
   "cdCanvasMarkType" libcd
   (_fun [canvas : _canvas] [mark-type : _mark-type] -> _void)))

(define canvas-mark-type
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasMarkType" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> [mark-type : _mark-type]))
   canvas-mark-type-set!))

(define canvas-mark-size-set!
  (get-ffi-obj
   "cdCanvasMarkSize" libcd
   (_fun [canvas : _canvas] [size : _int] -> _void)))

(define canvas-mark-size
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasMarkSize" libcd
    (_fun [canvas : _canvas] [query : _int = -1] -> [size : _int]))
   canvas-mark-size-set!))

(provide
 canvas-pixel!
 canvas-mark!
 canvas-mark-type canvas-mark-type-set!
 canvas-mark-size canvas-mark-size-set!)

;; }}}

;; {{{ Line functions

(define canvas-line!
  (get-ffi-obj
   "cdfCanvasLine" libcd
   (_fun [canvas : _canvas] [x0 : _double*] [y0 : _double*] [x1 : _double*] [y1 : _double*] -> _void)))

(define canvas-rectangle!
  (get-ffi-obj
   "cdfCanvasRect" libcd
   (_fun [canvas : _canvas] [x0 : _double*] [x1 : _double*] [y0 : _double*] [y1 : _double*] -> _void)))

(define canvas-arc!
  (get-ffi-obj
   "cdfCanvasArc" libcd
   (_fun [canvas : _canvas]
         [x : _double*] [y : _double*] [width : _double*] [height : _double*]
         [alpha0 : _double*] [alpha1 : _double*]
         -> _void)))

(define _line-style
  (_enum
   '(continuous dashed dotted dash-dotted dash-dot-dotted custom)
   _fixint))

(define canvas-line-style-set!
  (letrec ([canvas-line-style-set/raw!
            (get-ffi-obj
             "cdCanvasLineStyle" libcd
             (_fun [canvas : _canvas] [line-style : _line-style] -> _void))]
           [canvas-line-style-dashes-set/raw!
            (get-ffi-obj
             "cdCanvasLineStyleDashes" libcd
             (_fun [canvas : _canvas] [dashes : _cvector] [len : _int = (cvector-length dashes)] -> _void))])
    (λ (canvas line-style)
      (match line-style
        [(list-rest 'custom dashes)
         (canvas-line-style-dashes-set/raw! canvas (list->cvector dashes _int))
         (canvas-line-style-set/raw! canvas 'dashes)]
        [_
         (canvas-line-style-set/raw! canvas line-style)]))))

(define canvas-line-style
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasLineStyle" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> [line-style : _line-style]))
   canvas-line-style-set!))

(define canvas-line-width-set!
  (get-ffi-obj
   "cdCanvasLineWidth" libcd
   (_fun [canvas : _canvas] [width : _int] -> _void)))

(define canvas-line-width
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasLineWidth" libcd
    (_fun [canvas : _canvas] [query : _int = -1] -> [width : _int]))
   canvas-line-width-set!))

(define _line-join
  (_enum
   '(miter bevel round)
   _fixint))

(define canvas-line-join-set!
  (get-ffi-obj
   "cdCanvasLineJoin" libcd
   (_fun [canvas : _canvas] [line-join : _line-join] -> _void)))

(define canvas-line-join
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasLineJoin" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> _void))
   canvas-line-join-set!))

(define _line-cap
  (_enum
   '(flat square round)
   _fixint))

(define canvas-line-cap-set!
  (get-ffi-obj
   "cdCanvasLineCap" libcd
   (_fun [canvas : _canvas] [line-cap : _line-cap] -> _void)))

(define canvas-line-cap
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasLineCap" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> [line-cap : _line-cap]))
   canvas-line-cap-set!))

(provide
 canvas-line! canvas-rectangle! canvas-arc!
 canvas-line-style canvas-line-style-set!
 canvas-line-width canvas-line-width-set!
 canvas-line-join canvas-line-join-set!
 canvas-line-cap canvas-line-cap-set!)

;; }}}

;; {{{ Filled area functions

(define canvas-box!
  (get-ffi-obj
   "cdfCanvasBox" libcd
   (_fun [canvas : _canvas] [x0 : _double*] [x1 : _double*] [y0 : _double*] [y1 : _double*] -> _void)))

(define canvas-sector!
  (get-ffi-obj
   "cdfCanvasSector" libcd
   (_fun [canvas : _canvas]
         [x : _double*] [y : _double*] [width : _double*] [height : _double*]
         [alpha0 : _double*] [alpha1 : _double*]
         -> _void)))

(define canvas-chord!
  (get-ffi-obj
   "cdfCanvasChord" libcd
   (_fun [canvas : _canvas]
         [x : _double*] [y : _double*] [width : _double*] [height : _double*]
         [alpha0 : _double*] [alpha1 : _double*]
         -> _void)))

(define _opacity
  (_enum
   '(opaque transparent)
   _fixint))

(define canvas-background-opacity-set!
  (get-ffi-obj
   "cdCanvasBackOpacity" libcd
   (_fun [canvas : _canvas] [opacity : _opacity] -> _void)))

(define canvas-background-opacity
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasBackOpacity" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> [opacity : _opacity]))
   canvas-background-opacity-set!))

(define _fill-mode
  (_enum
   '(even-odd winding)
   _fixint))

(define canvas-fill-mode-set!
  (get-ffi-obj
   "cdCanvasFillMode" libcd
   (_fun [canvas : _canvas] [fill-mode : _fill-mode] -> _void)))

(define canvas-fill-mode
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasFillMode" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> [fill-mode : _fill-mode]))
   canvas-fill-mode-set!))

(define _interior-style
  (_enum
   '(solid hatch stipple pattern #f)
   _fixint))

(define _hatch-style
  (_enum
   '(horizontal vertical forward-diagonal backward-diagonal cross diagonal-cross)
   _fixint))

(define canvas-interior-style-set!
  (letrec ([canvas-interior-style-set/raw!
            (get-ffi-obj
             "cdCanvasInteriorStyle" libcd
             (_fun [canvas : _canvas] [interior-style : _interior-style] -> _void))]
           [canvas-hatch-style-set/raw!
            (get-ffi-obj
             "cdCanvasHatch" libcd
             (_fun [canvas : _canvas] [hatch-style : _hatch-style] -> _void))]
           [canvas-stipple-set/raw!
            (get-ffi-obj
             "cdCanvasStipple" libcd
             (_fun [canvas : _canvas] [width : _int] [height : _int] [data* : _cvector] -> _void))]
           [canvas-pattern-set/raw!
            (get-ffi-obj
             "cdCanvasPattern" libcd
             (_fun [canvas : _canvas] [width : _int] [height : _int] [data* : _cvector] -> _void))])
    (λ (canvas interior-style)
      (match interior-style
        [(list 'hatch hatch-style)
         (canvas-hatch-style-set/raw! canvas hatch-style)
         (canvas-interior-style-set/raw! canvas 'hatch)]
        [(list 'stipple width height data)
         (let ([data* (make-cvector _ubyte (* width height))])
           (for* ([j (in-range height)] [i (in-range width)]
                  [ofs* (in-value (+ (* j width) i))]
                  [vofs (in-value (quotient ofs* 8))]
                  [bofs (in-value (remainder ofs* 8))])
             (cvector-set! data* ofs* (bitwise-bit-field (bytes-ref data vofs) bofs (add1 bofs))))
           (canvas-stipple-set/raw! canvas width height data*))
         (canvas-interior-style-set/raw! canvas 'stipple)]
        [(list 'pattern/rgb width height data)
         (let ([data* (make-cvector _ulong (* width height))])
           (for* ([j (in-range height)] [i (in-range width)]
                  [ofs* (in-value (+ (* j width) i))]
                  [ofs (in-value (* 3 ofs*))])
             (cvector-set! data* ofs*
               (bitwise-ior
                (arithmetic-shift (bytes-ref data ofs) 16)
                (arithmetic-shift (bytes-ref data (+ ofs 1)) 8)
                (bytes-ref data (+ ofs 2)))))
           (canvas-pattern-set/raw! canvas width height data*))
         (canvas-interior-style-set/raw! canvas 'pattern)]
        [(list 'pattern/rgba width height data)
         (let* ([data* (make-cvector _ulong (* width height))]
                [elt-set! (cut ptr-set! data* _long <> <>)])
           (for* ([j (in-range height)] [i (in-range width)]
                  [ofs* (in-value (+ (* j width) i))]
                  [ofs (in-value (* 4 ofs*))])
             (cvector-set! data* ofs*
               (bitwise-ior
                (arithmetic-shift (- #xff (bytes-ref data (+ ofs 3))) 24)
                (arithmetic-shift (bytes-ref data ofs) 16)
                (arithmetic-shift (bytes-ref data (+ ofs 1)) 8)
                (bytes-ref data (+ ofs 2)))))
           (canvas-pattern-set/raw! canvas width height data*))
         (canvas-interior-style-set/raw! canvas 'pattern)]
        [_
         (canvas-interior-style-set/raw! canvas interior-style)]))))

(define canvas-interior-style
  (getter-with-setter
   (letrec ([canvas-interior-style/raw
             (get-ffi-obj
              "cdCanvasInteriorStyle" libcd
              (_fun [canvas : _canvas] [query : _fixint = -1] -> [interior-style : _interior-style]))]
            [canvas-hatch-style/raw
             (get-ffi-obj
              "cdCanvasHatch" libcd
              (_fun [canvas : _canvas] [query : _fixint = -1] -> [hatch-style : _hatch-style]))]
            [canvas-stipple/raw
             (get-ffi-obj
              "cdCanvasGetStipple" libcd
              (_fun [canvas : _canvas] [width : (_ptr o _int)] [height : (_ptr o _int)]
                    -> [data : _gcpointer]
                    -> (values width height data)))]
            [canvas-pattern/raw
             (get-ffi-obj
              "cdCanvasGetPattern" libcd
              (_fun [canvas : _canvas] [width : (_ptr o _int)] [height : (_ptr o _int)]
                    -> [data : _gcpointer]
                    -> (values width height data)))])
     (λ (canvas)
       (let ([interior-style (canvas-interior-style/raw canvas)])
         (case interior-style
           [(hatch)
            (list 'hatch (canvas-hatch-style/raw canvas))]
           [(stipple)
            (let*-values ([(width height data*) (canvas-stipple/raw canvas)]
                          [(data*) (make-cvector* data* _ubyte (* width height))]
                          [(data) (make-bytes (ceiling (/ (* width height) 8)) 0)])
              (for* ([j (in-range height)] [i (in-range width)]
                     [ofs* (in-value (+ (* j width) i))]
                     [vofs (in-value (quotient ofs* 8))]
                     [bofs (in-value (remainder ofs* 8))])
                (bytes-set! data vofs
                  (bitwise-ior
                   (bytes-ref data vofs)
                   (arithmetic-shift (bitwise-and (cvector-ref data* ofs*) 1) bofs))))
              (list 'stipple width height data))]
           [(pattern)
            (let*-values ([(width height data*) (canvas-pattern/raw canvas)]
                          [(data*) (make-cvector* data* _ulong (* width height))]
                          [(data) (make-bytes (* 4 width height))])
              (for* ([j (in-range height)] [i (in-range width)]
                     [ofs* (in-value (+ (* j width) i))]
                     [ofs (in-value (* 4 ofs*))]
                     [col (in-value (cvector-ref data* ofs*))])
                (bytes-set! data ofs (bitwise-bit-field col 16 24))
                (bytes-set! data (+ ofs 1) (bitwise-bit-field col 8 16))
                (bytes-set! data (+ ofs 2) (bitwise-bit-field col 0 8))
                (bytes-set! data (+ ofs 3) (- #xff (bitwise-bit-field col 24 32))))
              (list 'pattern/rgba width height data))]
           [else
            interior-style]))))
   canvas-interior-style-set!))

(provide
 canvas-box! canvas-sector! canvas-chord!
 canvas-background-opacity canvas-background-opacity-set!
 canvas-fill-mode canvas-fill-mode-set!
 canvas-interior-style canvas-interior-style-set!)

;; }}}

;; {{{ Text functions

(define canvas-text!
  (get-ffi-obj
   "cdfCanvasText" libcd
   (_fun [canvas : _canvas] [x : _double*] [y : _double*] [text : _string/utf-8] -> _void)))

(define canvas-font-set!
  (get-ffi-obj
   "cdCanvasNativeFont" libcd
   (_fun [canvas : _canvas] [font : _string/utf-8] -> _void)))

(define canvas-font
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasNativeFont" libcd
    (_fun [canvas : _canvas] [query : _pointer = #f] -> [font : _string/utf-8]))
   canvas-font-set!))

(define _alignment
  (_enum
   '(north south east west north-east north-west south-east south-west center base-left base-center base-right)
   _fixint))

(define canvas-text-alignment-set!
  (get-ffi-obj
   "cdCanvasTextAlignment" libcd
   (_fun [canvas : _canvas] [alignment : _alignment] -> _void)))

(define canvas-text-alignment
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasTextAlignment" libcd
    (_fun [canvas : _canvas] [query : _fixint = -1] -> [alignment : _alignment]))
   canvas-text-alignment-set!))

(define canvas-text-orientation-set!
  (get-ffi-obj
   "cdCanvasTextOrientation" libcd
   (_fun [canvas : _canvas] [orientation : _double*] -> _void)))

(define canvas-text-orientation
  (getter-with-setter
   (get-ffi-obj
    "cdCanvasTextOrientation" libcd
    (_fun [canvas : _canvas] [query : _double = -1.0] -> [orientation : _double]))
   canvas-text-orientation-set!))

(define canvas-font-dimensions
  (get-ffi-obj
   "cdCanvasGetFontDim" libcd
   (_fun [canvas : _canvas]
         [max-width : (_ptr o _int)] [height : (_ptr o _int)]
         [ascent : (_ptr o _int)] [descent : (_ptr o _int)]
         -> _void
         -> (values
             max-width height
             ascent descent))))

(define canvas-text-size
  (get-ffi-obj
   "cdCanvasGetTextSize" libcd
   (_fun [canvas : _canvas] [text : _string/utf-8]
         [width : (_ptr o _int)] [height : (_ptr o _int)]
         -> _void
         -> (values width height))))

(define canvas-text-box
  (get-ffi-obj
   "cdCanvasGetTextBox" libcd
   (_fun [canvas : _canvas] [x : _int] [y : _int] [text : _string/utf-8]
         [x0 : (_ptr o _int)] [x1 : (_ptr o _int)]
         [y0 : (_ptr o _int)] [y1 : (_ptr o _int)]
         -> _void
         -> (values x0 x1 y0 y1))))

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

;; }}}

;; {{{ 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-path-set!
  (get-ffi-obj
   "cdCanvasPathSet" libcd
   (_fun [canvas : _canvas] [path-action : _path-action] -> _void)))

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

;; }}}








Added canvas-draw/racket/printer.rkt version [5a4515ba82].



























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd-native
  (case (system-type 'os)
    [(unix macosx)
     (ffi-lib "libcdx11")]
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:printer
  ((get-ffi-obj "cdContextPrinter" libcd-native (_fun -> [context : _context]))))

(provide
 context:printer)

;; }}}








Added canvas-draw/racket/ps.rkt version [fc8e786542].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:ps
  ((get-ffi-obj "cdContextPS" libcd (_fun -> [context : _context]))))

(provide
 context:ps)

;; }}}








Added canvas-draw/racket/server.rkt version [b01bbbfe5d].






























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

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd-native
  (case (system-type 'os)
    [(unix macosx)
     (ffi-lib "libcdx11")]
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:image
  ((get-ffi-obj "cdContextImage" libcd-native (_fun -> [context : _context]))))

(define context:double-buffer
  ((get-ffi-obj "cdContextDBuffer" libcd-native (_fun -> [context : _context]))))

(provide
 context:image context:double-buffer)

;; }}}








Added canvas-draw/racket/svg.rkt version [36d0f855de].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:svg
  ((get-ffi-obj "cdContextSVG" libcd (_fun -> [context : _context]))))

(provide
 context:svg)

;; }}}








Added canvas-draw/racket/wmf.rkt version [52ea848f8b].

























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

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

#lang racket/base
(require
 ffi/unsafe
 "base.rkt")

(define libcd
  (case (system-type 'os)
    [(windows)
     (ffi-lib "cd")]
    [else
     (ffi-lib "libcd")]))

;; {{{ Context types

(define context:wmf
  ((get-ffi-obj "cdContextWMF" libcd (_fun -> [context : _context]))))

(provide
 context:wmf)

;; }}}








Modified ffcall/Makefile
from [df81be9375]
to [6c8063d20d].



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5

6
7
8
9
10
11
12
13






-
+








# Makefile for ffcall

#### Start of system configuration section. ####

# Directories used by "make install":
prefix = /mylibs/iup
prefix = C:/mylibs/iup
local_prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
includedir = ${prefix}/include
mandir = ${prefix}/man

# Programs used by "make":




︙







Modified ffcall/avcall/Makefile
from [c78eea1be9]
to [6d0d393f1d].



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

14
15
16
17
18
19
20

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

13
14
15
16
17
18
19
20













-
+








# Makefile for avcall

#### Start of system configuration section. ####

HOST = i686-pc-mingw32
CPU = i386
OS = mingw32

# Directories used by "make":
srcdir = .

# Directories used by "make install":
prefix = /mylibs/iup
prefix = C:/mylibs/iup
local_prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
includedir = ${prefix}/include
mandir = ${prefix}/man
datadir = ${prefix}/share
htmldir = $(datadir)/html




︙







Modified ffcall/avcall/config.log
from [84eff90b64]
to [e6fe6f6333].



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by configure, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=.
  $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=.

## --------- ##
## Platform. ##
## --------- ##

hostname = hermes
uname -m = i686




︙


34
35
36
37
38
39
40

41
42
43
44
45
46
47

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+








PATH: /c/Program Files/Common Files/Microsoft Shared/Windows Live
PATH: /c/windows/SYSTEM32
PATH: /c/windows
PATH: /c/windows/SYSTEM32/WBEM
PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/
PATH: /mingw/bin
PATH: /c/chicken/bin
PATH: /c/mylibs/iup
PATH: /c/Program Files/Windows Live/Shared


## ----------- ##
## Core tests. ##
## ----------- ##





︙


521
522
523
524
525
526
527
528
529


530
531
532
533
534
535
536

522
523
524
525
526
527
528


529
530
531
532
533
534
535
536
537








-
-
+
+








configure:8036: gcc -o conftest.exe -g -O2   conftest.c  >&5
conftest.c: In function 'main':
conftest.c:28:34: warning: function called through a non-compatible type
conftest.c:28:34: note: if this code is reached, the program will abort
conftest.c:29:3: warning: incompatible implicit declaration of built-in function 'exit'
configure:8039: $? = 0
configure:8041: ./conftest.exe
configure:8044: $? = 255
configure: program exited with status 255
configure:8044: $? = 29
configure: program exited with status 29
configure: failed program was:
| /* confdefs.h.  */
| 
| #define PACKAGE_NAME ""
| #define PACKAGE_TARNAME ""
| #define PACKAGE_VERSION ""
| #define PACKAGE_STRING ""




︙


726
727
728
729
730
731
732
733

734
735
736
737
738
739
740

727
728
729
730
731
732
733

734
735
736
737
738
739
740
741








-
+








includedir='${prefix}/include'
infodir='${prefix}/info'
libdir='${exec_prefix}/lib'
libexecdir='${exec_prefix}/libexec'
localstatedir='${prefix}/var'
mandir='${prefix}/man'
oldincludedir='/usr/include'
prefix='/mylibs/iup'
prefix='C:/mylibs/iup'
program_transform_name='s,x,x,'
sbindir='${exec_prefix}/sbin'
sharedstatedir='${prefix}/com'
sysconfdir='${prefix}/etc'
target_alias=''

## ----------- ##




︙







Modified ffcall/avcall/config.status
from [d73b5484aa]
to [17b46769eb].




︙


296
297
298
299
300
301
302
303

304
305
306
307
308
309
310

296
297
298
299
300
301
302

303
304
305
306
307
308
309
310








-
+








Configuration headers:
$config_headers

Report bugs to <bug-autoconf@gnu.org>."
ac_cs_version="\
config.status
configured by ./configure, generated by GNU Autoconf 2.59,
  with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"
  with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=.
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.




︙


374
375
376
377
378
379
380
381
382


383
384
385
386
387
388
389

374
375
376
377
378
379
380


381
382
383
384
385
386
387
388
389








-
-
+
+









if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

if $ac_cs_recheck; then
  echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
  echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
fi

for ac_config_target in $ac_config_targets
do
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;




︙


443
444
445
446
447
448
449
450

451
452
453
454
455
456
457

443
444
445
446
447
448
449

450
451
452
453
454
455
456
457








-
+








s,@PATH_SEPARATOR@,:,;t t
s,@PACKAGE_NAME@,,;t t
s,@PACKAGE_TARNAME@,,;t t
s,@PACKAGE_VERSION@,,;t t
s,@PACKAGE_STRING@,,;t t
s,@PACKAGE_BUGREPORT@,,;t t
s,@exec_prefix@,${prefix},;t t
s,@prefix@,/mylibs/iup,;t t
s,@prefix@,C:/mylibs/iup,;t t
s,@program_transform_name@,s,x,x,,;t t
s,@bindir@,${exec_prefix}/bin,;t t
s,@sbindir@,${exec_prefix}/sbin,;t t
s,@libexecdir@,${exec_prefix}/libexec,;t t
s,@datadir@,${prefix}/share,;t t
s,@sysconfdir@,${prefix}/etc,;t t
s,@sharedstatedir@,${prefix}/com,;t t




︙







Modified ffcall/callback/Makefile
from [13dfef388d]
to [749b7a9b94].



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

13
14
15
16
17
18
19

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19












-
+








# Makefile for callback

#### Start of system configuration section. ####

HOST = i686-pc-mingw32
CPU = i386

# Directories used by "make":
srcdir = .

# Directories used by "make install":
prefix = /mylibs/iup
prefix = C:/mylibs/iup
local_prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
includedir = ${prefix}/include
mandir = ${prefix}/man
datadir = ${prefix}/share
htmldir = $(datadir)/html




︙







Modified ffcall/callback/config.log
from [1140f0e25e]
to [cc9fee331f].



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by configure, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=.
  $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=.

## --------- ##
## Platform. ##
## --------- ##

hostname = hermes
uname -m = i686




︙


34
35
36
37
38
39
40

41
42
43
44
45
46
47

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+








PATH: /c/Program Files/Common Files/Microsoft Shared/Windows Live
PATH: /c/windows/SYSTEM32
PATH: /c/windows
PATH: /c/windows/SYSTEM32/WBEM
PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/
PATH: /mingw/bin
PATH: /c/chicken/bin
PATH: /c/mylibs/iup
PATH: /c/Program Files/Windows Live/Shared


## ----------- ##
## Core tests. ##
## ----------- ##





︙


474
475
476
477
478
479
480
481

482
483

484
485
486
487
488
489
490

475
476
477
478
479
480
481

482
483

484
485
486
487
488
489
490
491








-
+

-
+








  CONFIG_COMMANDS = 
  $ ./config.status 

on hermes

config.status:657: creating Makefile
configure:8840: configuring in vacall_r
configure:8957: running /bin/sh './configure' --prefix=/mylibs/iup  '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' --cache-file=/dev/null --srcdir=.
configure:8957: running /bin/sh './configure' --prefix=C:/mylibs/iup  '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' --cache-file=/dev/null --srcdir=.
configure:8840: configuring in trampoline_r
configure:8957: running /bin/sh './configure' --prefix=/mylibs/iup  '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' --cache-file=/dev/null --srcdir=.
configure:8957: running /bin/sh './configure' --prefix=C:/mylibs/iup  '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' --cache-file=/dev/null --srcdir=.

## ---------------- ##
## Cache variables. ##
## ---------------- ##

ac_cv_build=i686-pc-mingw32
ac_cv_build_alias=i686-pc-mingw32




︙


614
615
616
617
618
619
620
621

622
623
624
625
626
627
628

615
616
617
618
619
620
621

622
623
624
625
626
627
628
629








-
+








includedir='${prefix}/include'
infodir='${prefix}/info'
libdir='${exec_prefix}/lib'
libexecdir='${exec_prefix}/libexec'
localstatedir='${prefix}/var'
mandir='${prefix}/man'
oldincludedir='/usr/include'
prefix='/mylibs/iup'
prefix='C:/mylibs/iup'
program_transform_name='s,x,x,'
sbindir='${exec_prefix}/sbin'
sharedstatedir='${prefix}/com'
subdirs=' vacall_r trampoline_r'
sysconfdir='${prefix}/etc'
target_alias=''





︙







Modified ffcall/callback/config.status
from [d0f96fdf71]
to [9ea70f0cdd].




︙


290
291
292
293
294
295
296
297

298
299
300
301
302
303
304

290
291
292
293
294
295
296

297
298
299
300
301
302
303
304








-
+








Configuration files:
$config_files

Report bugs to <bug-autoconf@gnu.org>."
ac_cs_version="\
config.status
configured by ./configure, generated by GNU Autoconf 2.59,
  with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"
  with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=.
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.




︙


368
369
370
371
372
373
374
375
376


377
378
379
380
381
382
383

368
369
370
371
372
373
374


375
376
377
378
379
380
381
382
383








-
-
+
+









if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

if $ac_cs_recheck; then
  echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
  echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
fi

for ac_config_target in $ac_config_targets
do
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;




︙


435
436
437
438
439
440
441
442

443
444
445
446
447
448
449

435
436
437
438
439
440
441

442
443
444
445
446
447
448
449








-
+








s,@PATH_SEPARATOR@,:,;t t
s,@PACKAGE_NAME@,,;t t
s,@PACKAGE_TARNAME@,,;t t
s,@PACKAGE_VERSION@,,;t t
s,@PACKAGE_STRING@,,;t t
s,@PACKAGE_BUGREPORT@,,;t t
s,@exec_prefix@,${prefix},;t t
s,@prefix@,/mylibs/iup,;t t
s,@prefix@,C:/mylibs/iup,;t t
s,@program_transform_name@,s,x,x,,;t t
s,@bindir@,${exec_prefix}/bin,;t t
s,@sbindir@,${exec_prefix}/sbin,;t t
s,@libexecdir@,${exec_prefix}/libexec,;t t
s,@datadir@,${prefix}/share,;t t
s,@sysconfdir@,${prefix}/etc,;t t
s,@sharedstatedir@,${prefix}/com,;t t




︙







Modified ffcall/callback/trampoline_r/Makefile
from [38a2fd8272]
to [542add0e3a].



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

14
15
16
17
18
19
20

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

13
14
15
16
17
18
19
20













-
+








# Makefile for trampoline

#### Start of system configuration section. ####

HOST = i686-pc-mingw32
CPU = i386
OS = mingw32

# Directories used by "make":
srcdir = .

# Directories used by "make install":
prefix = /mylibs/iup
prefix = C:/mylibs/iup
local_prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
includedir = ${prefix}/include
mandir = ${prefix}/man
datadir = ${prefix}/share
htmldir = $(datadir)/html




︙







Modified ffcall/callback/trampoline_r/config.log
from [99330059e5]
to [2c41e31beb].



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by configure, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=. --cache-file=/dev/null --srcdir=.
  $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=. --cache-file=/dev/null --srcdir=.

## --------- ##
## Platform. ##
## --------- ##

hostname = hermes
uname -m = i686




︙


34
35
36
37
38
39
40

41
42
43
44
45
46
47

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+








PATH: /c/Program Files/Common Files/Microsoft Shared/Windows Live
PATH: /c/windows/SYSTEM32
PATH: /c/windows
PATH: /c/windows/SYSTEM32/WBEM
PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/
PATH: /mingw/bin
PATH: /c/chicken/bin
PATH: /c/mylibs/iup
PATH: /c/Program Files/Windows Live/Shared


## ----------- ##
## Core tests. ##
## ----------- ##





︙


506
507
508
509
510
511
512
513
514
515



516
517
518
519
520
521
522

507
508
509
510
511
512
513



514
515
516
517
518
519
520
521
522
523








-
-
-
+
+
+








configure:8355: $? = 0
configure:8358: test -s conftest.o
configure:8361: $? = 0
configure:8378: result: 
         extern int getpagesize (void);
configure:8540: checking for vm_allocate
configure:8562: gcc -o conftest.exe -g -O2   conftest.c  >&5
C:\Users\matt\AppData\Local\Temp\ccPqD3og.o: In function `main':
c:\mylibs\src\ffcall-1.10\callback\trampoline_r/conftest.c:32: undefined reference to `vm_allocate'
c:\mylibs\src\ffcall-1.10\callback\trampoline_r/conftest.c:32: undefined reference to `task_self'
C:\Users\matt\AppData\Local\Temp\ccdI2c3e.o: In function `main':
c:\Users\matt\data\chicken-iup\ffcall\callback\trampoline_r/conftest.c:32: undefined reference to `vm_allocate'
c:\Users\matt\data\chicken-iup\ffcall\callback\trampoline_r/conftest.c:32: undefined reference to `task_self'
collect2: ld returned 1 exit status
configure:8568: $? = 1
configure: failed program was:
| /* confdefs.h.  */
| 
| #define PACKAGE_NAME ""
| #define PACKAGE_TARNAME ""




︙


1048
1049
1050
1051
1052
1053
1054
1055

1056
1057
1058
1059
1060
1061
1062

1049
1050
1051
1052
1053
1054
1055

1056
1057
1058
1059
1060
1061
1062
1063








-
+








includedir='${prefix}/include'
infodir='${prefix}/info'
libdir='${exec_prefix}/lib'
libexecdir='${exec_prefix}/libexec'
localstatedir='${prefix}/var'
mandir='${prefix}/man'
oldincludedir='/usr/include'
prefix='/mylibs/iup'
prefix='C:/mylibs/iup'
program_transform_name='s,x,x,'
sbindir='${exec_prefix}/sbin'
sharedstatedir='${prefix}/com'
sysconfdir='${prefix}/etc'
target_alias=''

## ----------- ##




︙







Modified ffcall/callback/trampoline_r/config.status
from [7f6f78f55d]
to [66e403ac52].




︙


296
297
298
299
300
301
302
303

304
305
306
307
308
309
310

296
297
298
299
300
301
302

303
304
305
306
307
308
309
310








-
+








Configuration headers:
$config_headers

Report bugs to <bug-autoconf@gnu.org>."
ac_cs_version="\
config.status
configured by ./configure, generated by GNU Autoconf 2.59,
  with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"
  with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=.
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.




︙


374
375
376
377
378
379
380
381
382


383
384
385
386
387
388
389

374
375
376
377
378
379
380


381
382
383
384
385
386
387
388
389








-
-
+
+









if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

if $ac_cs_recheck; then
  echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
  echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
fi

for ac_config_target in $ac_config_targets
do
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;




︙


443
444
445
446
447
448
449
450

451
452
453
454
455
456
457

443
444
445
446
447
448
449

450
451
452
453
454
455
456
457








-
+








s,@PATH_SEPARATOR@,:,;t t
s,@PACKAGE_NAME@,,;t t
s,@PACKAGE_TARNAME@,,;t t
s,@PACKAGE_VERSION@,,;t t
s,@PACKAGE_STRING@,,;t t
s,@PACKAGE_BUGREPORT@,,;t t
s,@exec_prefix@,${prefix},;t t
s,@prefix@,/mylibs/iup,;t t
s,@prefix@,C:/mylibs/iup,;t t
s,@program_transform_name@,s,x,x,,;t t
s,@bindir@,${exec_prefix}/bin,;t t
s,@sbindir@,${exec_prefix}/sbin,;t t
s,@libexecdir@,${exec_prefix}/libexec,;t t
s,@datadir@,${prefix}/share,;t t
s,@sysconfdir@,${prefix}/etc,;t t
s,@sharedstatedir@,${prefix}/com,;t t




︙







Modified ffcall/callback/vacall_r/Makefile
from [1fb71217e3]
to [e4ddb5dac9].



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

14
15
16
17
18
19
20

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

13
14
15
16
17
18
19
20













-
+








# Makefile for vacall

#### Start of system configuration section. ####

HOST = i686-pc-mingw32
CPU = i386
OS = mingw32

# Directories used by "make":
srcdir = .

# Directories used by "make install":
prefix = /mylibs/iup
prefix = C:/mylibs/iup
local_prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
includedir = ${prefix}/include
mandir = ${prefix}/man
datadir = ${prefix}/share
htmldir = $(datadir)/html




︙







Modified ffcall/callback/vacall_r/config.log
from [8327978ab0]
to [ea7ef3470a].



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by configure, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=. --cache-file=/dev/null --srcdir=.
  $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=. --cache-file=/dev/null --srcdir=.

## --------- ##
## Platform. ##
## --------- ##

hostname = hermes
uname -m = i686




︙


34
35
36
37
38
39
40

41
42
43
44
45
46
47

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+








PATH: /c/Program Files/Common Files/Microsoft Shared/Windows Live
PATH: /c/windows/SYSTEM32
PATH: /c/windows
PATH: /c/windows/SYSTEM32/WBEM
PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/
PATH: /mingw/bin
PATH: /c/chicken/bin
PATH: /c/mylibs/iup
PATH: /c/Program Files/Windows Live/Shared


## ----------- ##
## Core tests. ##
## ----------- ##





︙


521
522
523
524
525
526
527
528
529


530
531
532
533
534
535
536

522
523
524
525
526
527
528


529
530
531
532
533
534
535
536
537








-
-
+
+








configure:8036: gcc -o conftest.exe -g -O2   conftest.c  >&5
conftest.c: In function 'main':
conftest.c:28:34: warning: function called through a non-compatible type
conftest.c:28:34: note: if this code is reached, the program will abort
conftest.c:29:3: warning: incompatible implicit declaration of built-in function 'exit'
configure:8039: $? = 0
configure:8041: ./conftest.exe
configure:8044: $? = 29
configure: program exited with status 29
configure:8044: $? = 255
configure: program exited with status 255
configure: failed program was:
| /* confdefs.h.  */
| 
| #define PACKAGE_NAME ""
| #define PACKAGE_TARNAME ""
| #define PACKAGE_VERSION ""
| #define PACKAGE_STRING ""




︙


738
739
740
741
742
743
744
745

746
747
748
749
750
751
752

739
740
741
742
743
744
745

746
747
748
749
750
751
752
753








-
+








includedir='${prefix}/include'
infodir='${prefix}/info'
libdir='${exec_prefix}/lib'
libexecdir='${exec_prefix}/libexec'
localstatedir='${prefix}/var'
mandir='${prefix}/man'
oldincludedir='/usr/include'
prefix='/mylibs/iup'
prefix='C:/mylibs/iup'
program_transform_name='s,x,x,'
sbindir='${exec_prefix}/sbin'
sharedstatedir='${prefix}/com'
sysconfdir='${prefix}/etc'
target_alias=''

## ----------- ##




︙







Modified ffcall/callback/vacall_r/config.status
from [450cdd2e14]
to [97c325a009].




︙


296
297
298
299
300
301
302
303

304
305
306
307
308
309
310

296
297
298
299
300
301
302

303
304
305
306
307
308
309
310








-
+








Configuration headers:
$config_headers

Report bugs to <bug-autoconf@gnu.org>."
ac_cs_version="\
config.status
configured by ./configure, generated by GNU Autoconf 2.59,
  with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"
  with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=.
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.




︙


374
375
376
377
378
379
380
381
382


383
384
385
386
387
388
389

374
375
376
377
378
379
380


381
382
383
384
385
386
387
388
389








-
-
+
+









if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

if $ac_cs_recheck; then
  echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
  echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
fi

for ac_config_target in $ac_config_targets
do
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;




︙


444
445
446
447
448
449
450
451

452
453
454
455
456
457
458

444
445
446
447
448
449
450

451
452
453
454
455
456
457
458








-
+








s,@PATH_SEPARATOR@,:,;t t
s,@PACKAGE_NAME@,,;t t
s,@PACKAGE_TARNAME@,,;t t
s,@PACKAGE_VERSION@,,;t t
s,@PACKAGE_STRING@,,;t t
s,@PACKAGE_BUGREPORT@,,;t t
s,@exec_prefix@,${prefix},;t t
s,@prefix@,/mylibs/iup,;t t
s,@prefix@,C:/mylibs/iup,;t t
s,@program_transform_name@,s,x,x,,;t t
s,@bindir@,${exec_prefix}/bin,;t t
s,@sbindir@,${exec_prefix}/sbin,;t t
s,@libexecdir@,${exec_prefix}/libexec,;t t
s,@datadir@,${prefix}/share,;t t
s,@sysconfdir@,${prefix}/etc,;t t
s,@sharedstatedir@,${prefix}/com,;t t




︙







Modified ffcall/config.log
from [cbd4c3fbb5]
to [fd1053cbdf].



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by configure, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ ./configure --prefix=/mylibs/iup
  $ ./configure --prefix=C:/mylibs/iup

## --------- ##
## Platform. ##
## --------- ##

hostname = hermes
uname -m = i686




︙


34
35
36
37
38
39
40

41
42
43
44
45
46
47

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+








PATH: /c/Program Files/Common Files/Microsoft Shared/Windows Live
PATH: /c/windows/SYSTEM32
PATH: /c/windows
PATH: /c/windows/SYSTEM32/WBEM
PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/
PATH: /mingw/bin
PATH: /c/chicken/bin
PATH: /c/mylibs/iup
PATH: /c/Program Files/Windows Live/Shared


## ----------- ##
## Core tests. ##
## ----------- ##





︙


62
63
64
65
66
67
68
69

70
71

72
73

74
75

76
77
78
79
80
81
82

63
64
65
66
67
68
69

70
71

72
73

74
75

76
77
78
79
80
81
82
83








-
+

-
+

-
+

-
+








  CONFIG_COMMANDS = 
  $ ./config.status 

on hermes

config.status:626: creating Makefile
configure:2219: configuring in avcall
configure:2336: running /bin/sh './configure' --prefix=/mylibs/iup  '--prefix=/mylibs/iup' --cache-file=/dev/null --srcdir=.
configure:2336: running /bin/sh './configure' --prefix=C:/mylibs/iup  '--prefix=C:/mylibs/iup' --cache-file=/dev/null --srcdir=.
configure:2219: configuring in vacall
configure:2336: running /bin/sh './configure' --prefix=/mylibs/iup  '--prefix=/mylibs/iup' --cache-file=/dev/null --srcdir=.
configure:2336: running /bin/sh './configure' --prefix=C:/mylibs/iup  '--prefix=C:/mylibs/iup' --cache-file=/dev/null --srcdir=.
configure:2219: configuring in trampoline
configure:2336: running /bin/sh './configure' --prefix=/mylibs/iup  '--prefix=/mylibs/iup' --cache-file=/dev/null --srcdir=.
configure:2336: running /bin/sh './configure' --prefix=C:/mylibs/iup  '--prefix=C:/mylibs/iup' --cache-file=/dev/null --srcdir=.
configure:2219: configuring in callback
configure:2336: running /bin/sh './configure' --prefix=/mylibs/iup  '--prefix=/mylibs/iup' --cache-file=/dev/null --srcdir=.
configure:2336: running /bin/sh './configure' --prefix=C:/mylibs/iup  '--prefix=C:/mylibs/iup' --cache-file=/dev/null --srcdir=.

## ---------------- ##
## Cache variables. ##
## ---------------- ##

ac_cv_env_build_alias_set=
ac_cv_env_build_alias_value=




︙


113
114
115
116
117
118
119
120

121
122
123
124
125
126
127

114
115
116
117
118
119
120

121
122
123
124
125
126
127
128








-
+








includedir='${prefix}/include'
infodir='${prefix}/info'
libdir='${exec_prefix}/lib'
libexecdir='${exec_prefix}/libexec'
localstatedir='${prefix}/var'
mandir='${prefix}/man'
oldincludedir='/usr/include'
prefix='/mylibs/iup'
prefix='C:/mylibs/iup'
program_transform_name='s,x,x,'
sbindir='${exec_prefix}/sbin'
sharedstatedir='${prefix}/com'
subdirs=' avcall vacall trampoline callback'
sysconfdir='${prefix}/etc'
target_alias=''





︙







Modified ffcall/config.status
from [3c221272c2]
to [63291fbaef].




︙


290
291
292
293
294
295
296
297

298
299
300
301
302
303
304

290
291
292
293
294
295
296

297
298
299
300
301
302
303
304








-
+








Configuration files:
$config_files

Report bugs to <bug-autoconf@gnu.org>."
ac_cs_version="\
config.status
configured by ./configure, generated by GNU Autoconf 2.59,
  with options \"'--prefix=/mylibs/iup'\"
  with options \"'--prefix=C:/mylibs/iup'\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=.
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.




︙


368
369
370
371
372
373
374
375
376


377
378
379
380
381
382
383

368
369
370
371
372
373
374


375
376
377
378
379
380
381
382
383








-
-
+
+









if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

if $ac_cs_recheck; then
  echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=/mylibs/iup' $ac_configure_extra_args --no-create --no-recursion
  echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=C:/mylibs/iup' $ac_configure_extra_args --no-create --no-recursion
fi

for ac_config_target in $ac_config_targets
do
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;




︙


435
436
437
438
439
440
441
442

443
444
445
446
447
448
449

435
436
437
438
439
440
441

442
443
444
445
446
447
448
449








-
+








s,@PATH_SEPARATOR@,:,;t t
s,@PACKAGE_NAME@,,;t t
s,@PACKAGE_TARNAME@,,;t t
s,@PACKAGE_VERSION@,,;t t
s,@PACKAGE_STRING@,,;t t
s,@PACKAGE_BUGREPORT@,,;t t
s,@exec_prefix@,${prefix},;t t
s,@prefix@,/mylibs/iup,;t t
s,@prefix@,C:/mylibs/iup,;t t
s,@program_transform_name@,s,x,x,,;t t
s,@bindir@,${exec_prefix}/bin,;t t
s,@sbindir@,${exec_prefix}/sbin,;t t
s,@libexecdir@,${exec_prefix}/libexec,;t t
s,@datadir@,${prefix}/share,;t t
s,@sysconfdir@,${prefix}/etc,;t t
s,@sharedstatedir@,${prefix}/com,;t t




︙







Modified ffcall/trampoline/Makefile
from [e4f1a8a27f]
to [f8e43e1785].



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

14
15
16
17
18
19
20

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

13
14
15
16
17
18
19
20













-
+








# Makefile for trampoline

#### Start of system configuration section. ####

HOST = i686-pc-mingw32
CPU = i386
OS = mingw32

# Directories used by "make":
srcdir = .

# Directories used by "make install":
prefix = /mylibs/iup
prefix = C:/mylibs/iup
local_prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
includedir = ${prefix}/include
mandir = ${prefix}/man
datadir = ${prefix}/share
htmldir = $(datadir)/html




︙







Modified ffcall/trampoline/config.log
from [afe0447f9d]
to [264ab2a172].



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by configure, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=.
  $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=.

## --------- ##
## Platform. ##
## --------- ##

hostname = hermes
uname -m = i686




︙


34
35
36
37
38
39
40

41
42
43
44
45
46
47

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+








PATH: /c/Program Files/Common Files/Microsoft Shared/Windows Live
PATH: /c/windows/SYSTEM32
PATH: /c/windows
PATH: /c/windows/SYSTEM32/WBEM
PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/
PATH: /mingw/bin
PATH: /c/chicken/bin
PATH: /c/mylibs/iup
PATH: /c/Program Files/Windows Live/Shared


## ----------- ##
## Core tests. ##
## ----------- ##





︙


318
319
320
321
322
323
324
325
326
327



328
329
330
331
332
333
334

319
320
321
322
323
324
325



326
327
328
329
330
331
332
333
334
335








-
-
-
+
+
+








configure:3508: $? = 0
configure:3511: test -s conftest.o
configure:3514: $? = 0
configure:3531: result: 
         extern int getpagesize (void);
configure:3693: checking for vm_allocate
configure:3715: gcc -o conftest.exe -g -O2   conftest.c  >&5
C:\Users\matt\AppData\Local\Temp\ccCeAdyV.o: In function `main':
c:\mylibs\src\ffcall-1.10\trampoline/conftest.c:29: undefined reference to `vm_allocate'
c:\mylibs\src\ffcall-1.10\trampoline/conftest.c:29: undefined reference to `task_self'
C:\Users\matt\AppData\Local\Temp\cck3AH5m.o: In function `main':
c:\Users\matt\data\chicken-iup\ffcall\trampoline/conftest.c:29: undefined reference to `vm_allocate'
c:\Users\matt\data\chicken-iup\ffcall\trampoline/conftest.c:29: undefined reference to `task_self'
collect2: ld returned 1 exit status
configure:3721: $? = 1
configure: failed program was:
| /* confdefs.h.  */
| 
| #define PACKAGE_NAME ""
| #define PACKAGE_TARNAME ""




︙


818
819
820
821
822
823
824
825

826
827
828
829
830
831
832

819
820
821
822
823
824
825

826
827
828
829
830
831
832
833








-
+








includedir='${prefix}/include'
infodir='${prefix}/info'
libdir='${exec_prefix}/lib'
libexecdir='${exec_prefix}/libexec'
localstatedir='${prefix}/var'
mandir='${prefix}/man'
oldincludedir='/usr/include'
prefix='/mylibs/iup'
prefix='C:/mylibs/iup'
program_transform_name='s,x,x,'
sbindir='${exec_prefix}/sbin'
sharedstatedir='${prefix}/com'
sysconfdir='${prefix}/etc'
target_alias=''

## ----------- ##




︙







Modified ffcall/trampoline/config.status
from [43547011b0]
to [32ba6d3303].




︙


296
297
298
299
300
301
302
303

304
305
306
307
308
309
310

296
297
298
299
300
301
302

303
304
305
306
307
308
309
310








-
+








Configuration headers:
$config_headers

Report bugs to <bug-autoconf@gnu.org>."
ac_cs_version="\
config.status
configured by ./configure, generated by GNU Autoconf 2.59,
  with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"
  with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=.
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.




︙


374
375
376
377
378
379
380
381
382


383
384
385
386
387
388
389

374
375
376
377
378
379
380


381
382
383
384
385
386
387
388
389








-
-
+
+









if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

if $ac_cs_recheck; then
  echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
  echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
fi

for ac_config_target in $ac_config_targets
do
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;




︙


443
444
445
446
447
448
449
450

451
452
453
454
455
456
457

443
444
445
446
447
448
449

450
451
452
453
454
455
456
457








-
+








s,@PATH_SEPARATOR@,:,;t t
s,@PACKAGE_NAME@,,;t t
s,@PACKAGE_TARNAME@,,;t t
s,@PACKAGE_VERSION@,,;t t
s,@PACKAGE_STRING@,,;t t
s,@PACKAGE_BUGREPORT@,,;t t
s,@exec_prefix@,${prefix},;t t
s,@prefix@,/mylibs/iup,;t t
s,@prefix@,C:/mylibs/iup,;t t
s,@program_transform_name@,s,x,x,,;t t
s,@bindir@,${exec_prefix}/bin,;t t
s,@sbindir@,${exec_prefix}/sbin,;t t
s,@libexecdir@,${exec_prefix}/libexec,;t t
s,@datadir@,${prefix}/share,;t t
s,@sysconfdir@,${prefix}/etc,;t t
s,@sharedstatedir@,${prefix}/com,;t t




︙







Modified ffcall/vacall/Makefile
from [4216224d18]
to [0b9a52b851].



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

14
15
16
17
18
19
20

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

13
14
15
16
17
18
19
20













-
+








# Makefile for vacall

#### Start of system configuration section. ####

HOST = i686-pc-mingw32
CPU = i386
OS = mingw32

# Directories used by "make":
srcdir = .

# Directories used by "make install":
prefix = /mylibs/iup
prefix = C:/mylibs/iup
local_prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
includedir = ${prefix}/include
mandir = ${prefix}/man
datadir = ${prefix}/share
htmldir = $(datadir)/html




︙







Modified ffcall/vacall/config.log
from [a357f144d8]
to [ff41411b75].



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by configure, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ ./configure --prefix=/mylibs/iup --prefix=/mylibs/iup --cache-file=/dev/null --srcdir=.
  $ ./configure --prefix=C:/mylibs/iup --prefix=C:/mylibs/iup --cache-file=/dev/null --srcdir=.

## --------- ##
## Platform. ##
## --------- ##

hostname = hermes
uname -m = i686




︙


34
35
36
37
38
39
40

41
42
43
44
45
46
47

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+








PATH: /c/Program Files/Common Files/Microsoft Shared/Windows Live
PATH: /c/windows/SYSTEM32
PATH: /c/windows
PATH: /c/windows/SYSTEM32/WBEM
PATH: /c/windows/SYSTEM32/WINDOWSPOWERSHELL/V1.0/
PATH: /mingw/bin
PATH: /c/chicken/bin
PATH: /c/mylibs/iup
PATH: /c/Program Files/Windows Live/Shared


## ----------- ##
## Core tests. ##
## ----------- ##





︙


502
503
504
505
506
507
508
509

510
511
512
513
514
515
516

503
504
505
506
507
508
509

510
511
512
513
514
515
516
517








-
+








includedir='${prefix}/include'
infodir='${prefix}/info'
libdir='${exec_prefix}/lib'
libexecdir='${exec_prefix}/libexec'
localstatedir='${prefix}/var'
mandir='${prefix}/man'
oldincludedir='/usr/include'
prefix='/mylibs/iup'
prefix='C:/mylibs/iup'
program_transform_name='s,x,x,'
sbindir='${exec_prefix}/sbin'
sharedstatedir='${prefix}/com'
sysconfdir='${prefix}/etc'
target_alias=''

## ----------- ##




︙







Modified ffcall/vacall/config.status
from [88f4340374]
to [9cbde1cf64].




︙


296
297
298
299
300
301
302
303

304
305
306
307
308
309
310

296
297
298
299
300
301
302

303
304
305
306
307
308
309
310








-
+








Configuration headers:
$config_headers

Report bugs to <bug-autoconf@gnu.org>."
ac_cs_version="\
config.status
configured by ./configure, generated by GNU Autoconf 2.59,
  with options \"'--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"
  with options \"'--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.'\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=.
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.




︙


374
375
376
377
378
379
380
381
382


383
384
385
386
387
388
389

374
375
376
377
378
379
380


381
382
383
384
385
386
387
388
389








-
-
+
+









if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

if $ac_cs_recheck; then
  echo "running /bin/sh ./configure " '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
  echo "running /bin/sh ./configure " '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args " --no-create --no-recursion" >&6
  exec /bin/sh ./configure '--prefix=C:/mylibs/iup' '--cache-file=/dev/null' '--srcdir=.' $ac_configure_extra_args --no-create --no-recursion
fi

for ac_config_target in $ac_config_targets
do
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;




︙


444
445
446
447
448
449
450
451

452
453
454
455
456
457
458

444
445
446
447
448
449
450

451
452
453
454
455
456
457
458








-
+








s,@PATH_SEPARATOR@,:,;t t
s,@PACKAGE_NAME@,,;t t
s,@PACKAGE_TARNAME@,,;t t
s,@PACKAGE_VERSION@,,;t t
s,@PACKAGE_STRING@,,;t t
s,@PACKAGE_BUGREPORT@,,;t t
s,@exec_prefix@,${prefix},;t t
s,@prefix@,/mylibs/iup,;t t
s,@prefix@,C:/mylibs/iup,;t t
s,@program_transform_name@,s,x,x,,;t t
s,@bindir@,${exec_prefix}/bin,;t t
s,@sbindir@,${exec_prefix}/sbin,;t t
s,@libexecdir@,${exec_prefix}/libexec,;t t
s,@datadir@,${prefix}/share,;t t
s,@sysconfdir@,${prefix}/etc,;t t
s,@sharedstatedir@,${prefix}/com,;t t




︙