Check-in [342d9b1e94]
Not logged in

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

Overview
Comment:cairo ffi improvements
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 342d9b1e941e4f5eb05775b679d3fdf92914d899
User & Date: aldo 2016-12-15 01:14:13
Context
2017-01-11
16:37
added srfi 113 sets&bags, srfi 128 comparators check-in: 07be5132aa user: aldo tags: trunk
2016-12-15
01:14
cairo ffi improvements check-in: 342d9b1e94 user: aldo tags: trunk
2016-12-14
17:03
updated sdl2 README check-in: c8794bb797 user: aldo tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to cairo.sls.

189
190
191
192
193
194
195
196

197
198
199

200
201
202
203
204
205
206
...
215
216
217
218
219
220
221

222

223
224
225
226
227
228
229
...
238
239
240
241
242
243
244

245

246
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
...
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
  cairo-pdf-surface-create cairo-pdf-surface-create-for-stream
  cairo-pdf-surface-restrict-to-version cairo-pdf-get-versions
  cairo-pdf-version-to-string cairo-pdf-surface-set-size

  cairo-set-source-color
  color-r color-g color-b color-a
  make-color color?


  cairo-bool-t
  cairo-t
  cairo-surface-t

  cairo-device-t
  cairo-matrix-t
  cairo-pattern-t
  cairo-destroy-func-t
  cairo-user-data-key-t
  cairo-status-t
  cairo-content-t
................................................................................
  cairo-line-join-t
  double-array
  cairo-rectangle-t
  cairo-rectangle-list-t
  cairo-scaled-font-t
  cairo-font-face-t
  cairo-glyph-t

  cairo-text-cluster-t

  cairo-text-cluster-flags-t
  cairo-text-extents-t
  cairo-font-extents-t
  cairo-font-slant-t
  cairo-font-weight-t
  cairo-subpixel-order-t
  cairo-hint-style-t
................................................................................
  cairo-path-data-t
  cairo-path-t
  cairo-device-type-t
  cairo-surface-observer-mode-t
  cairo-surface-observer-callback-t
  cairo-surface-type-t
  cairo-raster-source-acquire-func-t

  cairo-raster-source-release-func-t

  cairo-raster-source-snapshot-func-t
  cairo-raster-source-copy-func-t
  cairo-raster-source-finish-func-t
  cairo-pattern-type-t
  cairo-extend-t
  cairo-filter-t
  cairo-region-t
  cairo-region-overlap-t
  cairo-pdf-version-t

					;enums
  cairo-status-enum
  cairo-format
  cairo-operator
  cairo-antialias
  cairo-fill-rule
  cairo-line-cap
................................................................................
  cairo-extend
  cairo-filter
  cairo-region-overlap
  ;; ALLOCATORS	 
  cairo-rectangle-create
  cairo-rectangle-list-create
  cairo-glyph-create

  cairo-text-cluster-create

  cairo-text-extents-create

  cairo-font-extents-create
  cairo-path-create
  double-array-create 
  double-array-create-from-vector

  cairo-matrix-create



  cairo-guardian
  cairo-free-garbage
  cairo-guard-pointer

  with-cairo
  let-struct
  )
 (import (chezscheme) (ffi-utils))
 
 (include "cairo/ffi-utils.ss")

 (define (cairo-library-init . t) (load-shared-object (if (null? t) "libcairo.so.2.11502.0" (car t))))

 (include "cairo/types.ss")

 (define cairo-guardian (make-guardian))
 (define (cairo-guard-pointer obj) 
   (cairo-free-garbage) 
   (cairo-guardian obj)
   obj)

 (define (cairo-free-garbage)
   (let loop ([p (cairo-guardian)])
     (when p
	   (when (ftype-pointer? p)
		 (printf "cairo-free-garbage: freeing memory at ~x\n" p)
		 ;;[(ftype-pointer? usb-device*-array p)
		 (cond 
		  [(ftype-pointer? cairo-t p) (cairo-destroy p)]
		  [(ftype-pointer? cairo-surface-t p) (cairo-surface-destroy p)]
		  [(ftype-pointer? cairo-pattern-t p) (cairo-pattern-destroy p)]
		  [(ftype-pointer? cairo-region-t p) (cairo-region-destroy p)]
		  [(ftype-pointer? cairo-rectangle-list-t p) (cairo-rectangle-list-destroy p)]
		  [(ftype-pointer? cairo-font-options-t p) (cairo-font-options-destroy p)]
		  [(ftype-pointer? cairo-font-face-t p) (cairo-font-face-destroy p)]
		  ;[(ftype-pointer? cairo-scaled-font-t p) (cairo-scaled-font-destroy p)]
		  [(ftype-pointer? cairo-path-t p) (cairo-path-destroy p)]
		  [(ftype-pointer? cairo-device-t p) (cairo-device-destroy p)]


		  [else
		   (foreign-free (ftype-pointer-address p))]
		  ))
	   (loop (cairo-guardian)))))		

(include "cairo/cairo-functions.ss")


(include "cairo/cairo-pdf-functions.ss")

(define-record-type (color mkcolor color?) 
  (fields r g b a))

(define make-color







|
>



>







 







>

>







 







>

>









>







 







>

>

>




<

<
>
>



<







|








|




|





|



|


>
>



|

<
>







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
...
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
...
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
...
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
  cairo-pdf-surface-create cairo-pdf-surface-create-for-stream
  cairo-pdf-surface-restrict-to-version cairo-pdf-get-versions
  cairo-pdf-version-to-string cairo-pdf-surface-set-size

  cairo-set-source-color
  color-r color-g color-b color-a
  make-color color?
  
  unsigned-8*
  cairo-bool-t
  cairo-t
  cairo-surface-t
  cairo-surface-t*
  cairo-device-t
  cairo-matrix-t
  cairo-pattern-t
  cairo-destroy-func-t
  cairo-user-data-key-t
  cairo-status-t
  cairo-content-t
................................................................................
  cairo-line-join-t
  double-array
  cairo-rectangle-t
  cairo-rectangle-list-t
  cairo-scaled-font-t
  cairo-font-face-t
  cairo-glyph-t
  cairo-glyph-t*
  cairo-text-cluster-t
  cairo-text-cluster-t*
  cairo-text-cluster-flags-t
  cairo-text-extents-t
  cairo-font-extents-t
  cairo-font-slant-t
  cairo-font-weight-t
  cairo-subpixel-order-t
  cairo-hint-style-t
................................................................................
  cairo-path-data-t
  cairo-path-t
  cairo-device-type-t
  cairo-surface-observer-mode-t
  cairo-surface-observer-callback-t
  cairo-surface-type-t
  cairo-raster-source-acquire-func-t
  cairo-raster-source-acquire-func-t*
  cairo-raster-source-release-func-t
  cairo-raster-source-release-func-t*
  cairo-raster-source-snapshot-func-t
  cairo-raster-source-copy-func-t
  cairo-raster-source-finish-func-t
  cairo-pattern-type-t
  cairo-extend-t
  cairo-filter-t
  cairo-region-t
  cairo-region-overlap-t
  cairo-pdf-version-t
  cairo-pdf-version-t*
					;enums
  cairo-status-enum
  cairo-format
  cairo-operator
  cairo-antialias
  cairo-fill-rule
  cairo-line-cap
................................................................................
  cairo-extend
  cairo-filter
  cairo-region-overlap
  ;; ALLOCATORS	 
  cairo-rectangle-create
  cairo-rectangle-list-create
  cairo-glyph-create
  cairo-glyph*-create
  cairo-text-cluster-create
  cairo-text-cluster*-create
  cairo-text-extents-create
  cairo-text-cluster-flags-create
  cairo-font-extents-create
  cairo-path-create
  double-array-create 
  double-array-create-from-vector

  cairo-matrix-create

  cairo-int-create
  cairo-void*-create
  cairo-guardian
  cairo-free-garbage
  cairo-guard-pointer

  with-cairo
  let-struct
  )
 (import (chezscheme) (ffi-utils))
 
 (include "cairo/ffi-utils.ss")

 (define (cairo-library-init . t) (load-shared-object (if (null? t) "libcairo.so.2" (car t))))

 (include "cairo/types.ss")

 (define cairo-guardian (make-guardian))
 (define (cairo-guard-pointer obj) 
   (cairo-free-garbage) 
   (cairo-guardian obj)
   obj)
 (include "cairo/cairo-functions.ss")
 (define (cairo-free-garbage)
   (let loop ([p (cairo-guardian)])
     (when p
	   (when (ftype-pointer? p)
		 ;(printf "cairo-free-garbage: freeing memory at ~x\n" p)
		 ;;[(ftype-pointer? usb-device*-array p)
		 (cond 
		  [(ftype-pointer? cairo-t p) (cairo-destroy p)]
		  [(ftype-pointer? cairo-surface-t p) (cairo-surface-destroy p)]
		  [(ftype-pointer? cairo-pattern-t p) (cairo-pattern-destroy p)]
		  [(ftype-pointer? cairo-region-t p) (void)]; (cairo-region-destroy p)]
		  [(ftype-pointer? cairo-rectangle-list-t p) (cairo-rectangle-list-destroy p)]
		  [(ftype-pointer? cairo-font-options-t p) (cairo-font-options-destroy p)]
		  [(ftype-pointer? cairo-font-face-t p) (cairo-font-face-destroy p)]
		  [(ftype-pointer? cairo-scaled-font-t p) (cairo-scaled-font-destroy p)]
		  [(ftype-pointer? cairo-path-t p) (cairo-path-destroy p)]
		  [(ftype-pointer? cairo-device-t p) (cairo-device-destroy p)]
		  [(ftype-pointer? cairo-glyph-t p) (cairo-glyph-free p)]
		  [(ftype-pointer? cairo-text-cluster-t p) (cairo-text-cluster-free p)]
		  [else
		   (foreign-free (ftype-pointer-address p))]
		  ))
	   (loop (cairo-guardian)))))




(include "cairo/cairo-pdf-functions.ss")

(define-record-type (color mkcolor color?) 
  (fields r g b a))

(define make-color

Changes to cairo/cairo-functions.ss.

120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
...
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
...
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
(define-cairo-func cairo-status-t cairo-scaled-font-status ((scaled_font (* cairo-scaled-font-t))) "cairo_scaled_font_status")
(define-cairo-func cairo-font-type-t cairo-scaled-font-get-type ((scaled_font (* cairo-scaled-font-t))) "cairo_scaled_font_get_type")
(define-cairo-func void* cairo-scaled-font-get-user-data ((scaled_font (* cairo-scaled-font-t)) (key (* cairo-user-data-key-t))) "cairo_scaled_font_get_user_data")
(define-cairo-func cairo-status-t cairo-scaled-font-set-user-data ((scaled_font (* cairo-scaled-font-t)) (key (* cairo-user-data-key-t)) (user_data void*) (destroy cairo-destroy-func-t)) "cairo_scaled_font_set_user_data")
(define-cairo-func void cairo-scaled-font-extents ((scaled_font (* cairo-scaled-font-t)) (extents (* cairo-font-extents-t))) "cairo_scaled_font_extents")
(define-cairo-func void cairo-scaled-font-text-extents ((scaled_font (* cairo-scaled-font-t)) (utf8 string) (extents (* cairo-text-extents-t))) "cairo_scaled_font_text_extents")
(define-cairo-func void cairo-scaled-font-glyph-extents ((scaled_font (* cairo-scaled-font-t)) (glyphs (* cairo-glyph-t)) (num_glyphs int) (extents (* cairo-text-extents-t))) "cairo_scaled_font_glyph_extents")
(define-cairo-func cairo-status-t cairo-scaled-font-text-to-glyphs ((scaled_font (* cairo-scaled-font-t)) (x double) (y double) (utf8 string) (utf8_len int) (glyphs (* cairo-glyph-t)) (num_glyphs (* int)) (clusters (* cairo-text-cluster-t)) (num_clusters (* int)) (cluster_flags (* cairo-text-cluster-flags-t))) "cairo_scaled_font_text_to_glyphs")
(define-cairo-func (* cairo-font-face-t) cairo-scaled-font-get-font-face ((scaled_font (* cairo-scaled-font-t))) "cairo_scaled_font_get_font_face")
(define-cairo-func void cairo-scaled-font-get-font-matrix ((scaled_font (* cairo-scaled-font-t)) (font_matrix (* cairo-matrix-t))) "cairo_scaled_font_get_font_matrix")
(define-cairo-func void cairo-scaled-font-get-ctm ((scaled_font (* cairo-scaled-font-t)) (ctm (* cairo-matrix-t))) "cairo_scaled_font_get_ctm")
(define-cairo-func void cairo-scaled-font-get-scale-matrix ((scaled_font (* cairo-scaled-font-t)) (scale_matrix (* cairo-matrix-t))) "cairo_scaled_font_get_scale_matrix")
(define-cairo-func void cairo-scaled-font-get-font-options ((scaled_font (* cairo-scaled-font-t)) (options (* cairo-font-options-t))) "cairo_scaled_font_get_font_options")
(define-cairo-func (* cairo-font-face-t) cairo-toy-font-face-create ((family string) (slant cairo-font-slant-t) (weight cairo-font-weight-t)) "cairo_toy_font_face_create")
(define-cairo-func string cairo-toy-font-face-get-family ((font_face (* cairo-font-face-t))) "cairo_toy_font_face_get_family")
................................................................................
(define-cairo-func cairo-status-t cairo-surface-status ((surface (* cairo-surface-t))) "cairo_surface_status")
(define-cairo-func cairo-surface-type-t cairo-surface-get-type ((surface (* cairo-surface-t))) "cairo_surface_get_type")
(define-cairo-func cairo-content-t cairo-surface-get-content ((surface (* cairo-surface-t))) "cairo_surface_get_content")
(define-cairo-func cairo-status-t cairo-surface-write-to-png ((surface (* cairo-surface-t)) (filename string)) "cairo_surface_write_to_png")
(define-cairo-func cairo-status-t cairo-surface-write-to-png-stream ((surface (* cairo-surface-t)) (write_func (* cairo-write-func-t)) (closure void*)) "cairo_surface_write_to_png_stream")
(define-cairo-func void* cairo-surface-get-user-data ((surface (* cairo-surface-t)) (key (* cairo-user-data-key-t))) "cairo_surface_get_user_data")
(define-cairo-func cairo-status-t cairo-surface-set-user-data ((surface (* cairo-surface-t)) (key (* cairo-user-data-key-t)) (user_data void*) (destroy cairo-destroy-func-t)) "cairo_surface_set_user_data")
(define-cairo-func void cairo-surface-get-mime-data ((surface (* cairo-surface-t)) (mime_type string) (data (* unsigned-8)) (length (* unsigned-long))) "cairo_surface_get_mime_data")
(define-cairo-func cairo-status-t cairo-surface-set-mime-data ((surface (* cairo-surface-t)) (mime_type string) (data (* unsigned-8)) (length unsigned-long) (destroy cairo-destroy-func-t) (closure void*)) "cairo_surface_set_mime_data")
(define-cairo-func cairo-bool-t cairo-surface-supports-mime-type ((surface (* cairo-surface-t)) (mime_type string)) "cairo_surface_supports_mime_type")
(define-cairo-func void cairo-surface-get-font-options ((surface (* cairo-surface-t)) (options (* cairo-font-options-t))) "cairo_surface_get_font_options")
(define-cairo-func void cairo-surface-flush ((surface (* cairo-surface-t))) "cairo_surface_flush")
(define-cairo-func void cairo-surface-mark-dirty ((surface (* cairo-surface-t))) "cairo_surface_mark_dirty")
(define-cairo-func void cairo-surface-mark-dirty-rectangle ((surface (* cairo-surface-t)) (x int) (y int) (width int) (height int)) "cairo_surface_mark_dirty_rectangle")
(define-cairo-func void cairo-surface-set-device-scale ((surface (* cairo-surface-t)) (x_scale double) (y_scale double)) "cairo_surface_set_device_scale")
................................................................................
(define-cairo-func (* cairo-surface-t) cairo-recording-surface-create ((content cairo-content-t) (extents (* cairo-rectangle-t))) "cairo_recording_surface_create")
(define-cairo-func void cairo-recording-surface-ink-extents ((surface (* cairo-surface-t)) (x0 (* double)) (y0 (* double)) (width (* double)) (height (* double))) "cairo_recording_surface_ink_extents")
(define-cairo-func cairo-bool-t cairo-recording-surface-get-extents ((surface (* cairo-surface-t)) (extents (* cairo-rectangle-t))) "cairo_recording_surface_get_extents")
(define-cairo-func (* cairo-pattern-t) cairo-pattern-create-raster-source ((user_data void*) (content cairo-content-t) (width int) (height int)) "cairo_pattern_create_raster_source")
(define-cairo-func void cairo-raster-source-pattern-set-callback-data ((pattern (* cairo-pattern-t)) (data void*)) "cairo_raster_source_pattern_set_callback_data")
(define-cairo-func void* cairo-raster-source-pattern-get-callback-data ((pattern (* cairo-pattern-t))) "cairo_raster_source_pattern_get_callback_data")
(define-cairo-func void cairo-raster-source-pattern-set-acquire ((pattern (* cairo-pattern-t)) (acquire (* cairo-raster-source-acquire-func-t)) (release (* cairo-raster-source-release-func-t))) "cairo_raster_source_pattern_set_acquire")
(define-cairo-func void cairo-raster-source-pattern-get-acquire ((pattern (* cairo-pattern-t)) (acquire (* cairo-raster-source-acquire-func-t)) (release (* cairo-raster-source-release-func-t))) "cairo_raster_source_pattern_get_acquire")
(define-cairo-func void cairo-raster-source-pattern-set-snapshot ((pattern (* cairo-pattern-t)) (snapshot (* cairo-raster-source-snapshot-func-t))) "cairo_raster_source_pattern_set_snapshot")
(define-cairo-func (* cairo-raster-source-snapshot-func-t) cairo-raster-source-pattern-get-snapshot ((pattern (* cairo-pattern-t))) "cairo_raster_source_pattern_get_snapshot")
(define-cairo-func void cairo-raster-source-pattern-set-copy ((pattern (* cairo-pattern-t)) (copy (* cairo-raster-source-copy-func-t))) "cairo_raster_source_pattern_set_copy")
(define-cairo-func (* cairo-raster-source-copy-func-t) cairo-raster-source-pattern-get-copy ((pattern (* cairo-pattern-t))) "cairo_raster_source_pattern_get_copy")
(define-cairo-func void cairo-raster-source-pattern-set-finish ((pattern (* cairo-pattern-t)) (finish (* cairo-raster-source-finish-func-t))) "cairo_raster_source_pattern_set_finish")
(define-cairo-func (* cairo-raster-source-finish-func-t) cairo-raster-source-pattern-get-finish ((pattern (* cairo-pattern-t))) "cairo_raster_source_pattern_get_finish")
(define-cairo-func (* cairo-pattern-t) cairo-pattern-create-rgb ((red double) (green double) (blue double)) "cairo_pattern_create_rgb")
................................................................................
(define-cairo-func void cairo-pattern-set-matrix ((pattern (* cairo-pattern-t)) (matrix (* cairo-matrix-t))) "cairo_pattern_set_matrix")
(define-cairo-func void cairo-pattern-get-matrix ((pattern (* cairo-pattern-t)) (matrix (* cairo-matrix-t))) "cairo_pattern_get_matrix")
(define-cairo-func void cairo-pattern-set-extend ((pattern (* cairo-pattern-t)) (extend cairo-extend-t)) "cairo_pattern_set_extend")
(define-cairo-func cairo-extend-t cairo-pattern-get-extend ((pattern (* cairo-pattern-t))) "cairo_pattern_get_extend")
(define-cairo-func void cairo-pattern-set-filter ((pattern (* cairo-pattern-t)) (filter cairo-filter-t)) "cairo_pattern_set_filter")
(define-cairo-func cairo-filter-t cairo-pattern-get-filter ((pattern (* cairo-pattern-t))) "cairo_pattern_get_filter")
(define-cairo-func cairo-status-t cairo-pattern-get-rgba ((pattern (* cairo-pattern-t)) (red (* double)) (green (* double)) (blue (* double)) (alpha (* double))) "cairo_pattern_get_rgba")
(define-cairo-func cairo-status-t cairo-pattern-get-surface ((pattern (* cairo-pattern-t)) (surface (* cairo-surface-t))) "cairo_pattern_get_surface")
(define-cairo-func cairo-status-t cairo-pattern-get-color-stop-rgba ((pattern (* cairo-pattern-t)) (index int) (offset (* double)) (red (* double)) (green (* double)) (blue (* double)) (alpha (* double))) "cairo_pattern_get_color_stop_rgba")
(define-cairo-func cairo-status-t cairo-pattern-get-color-stop-count ((pattern (* cairo-pattern-t)) (count (* int))) "cairo_pattern_get_color_stop_count")
(define-cairo-func cairo-status-t cairo-pattern-get-linear-points ((pattern (* cairo-pattern-t)) (x0 (* double)) (y0 (* double)) (x1 (* double)) (y1 (* double))) "cairo_pattern_get_linear_points")
(define-cairo-func cairo-status-t cairo-pattern-get-radial-circles ((pattern (* cairo-pattern-t)) (x0 (* double)) (y0 (* double)) (r0 (* double)) (x1 (* double)) (y1 (* double)) (r1 (* double))) "cairo_pattern_get_radial_circles")
(define-cairo-func cairo-status-t cairo-mesh-pattern-get-patch-count ((pattern (* cairo-pattern-t)) (count (* unsigned-int))) "cairo_mesh_pattern_get_patch_count")
(define-cairo-func (* cairo-path-t) cairo-mesh-pattern-get-path ((pattern (* cairo-pattern-t)) (patch_num unsigned-int)) "cairo_mesh_pattern_get_path")
(define-cairo-func cairo-status-t cairo-mesh-pattern-get-corner-color-rgba ((pattern (* cairo-pattern-t)) (patch_num unsigned-int) (corner_num unsigned-int) (red (* double)) (green (* double)) (blue (* double)) (alpha (* double))) "cairo_mesh_pattern_get_corner_color_rgba")







|







 







|







 







|







 







|







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
...
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
...
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
(define-cairo-func cairo-status-t cairo-scaled-font-status ((scaled_font (* cairo-scaled-font-t))) "cairo_scaled_font_status")
(define-cairo-func cairo-font-type-t cairo-scaled-font-get-type ((scaled_font (* cairo-scaled-font-t))) "cairo_scaled_font_get_type")
(define-cairo-func void* cairo-scaled-font-get-user-data ((scaled_font (* cairo-scaled-font-t)) (key (* cairo-user-data-key-t))) "cairo_scaled_font_get_user_data")
(define-cairo-func cairo-status-t cairo-scaled-font-set-user-data ((scaled_font (* cairo-scaled-font-t)) (key (* cairo-user-data-key-t)) (user_data void*) (destroy cairo-destroy-func-t)) "cairo_scaled_font_set_user_data")
(define-cairo-func void cairo-scaled-font-extents ((scaled_font (* cairo-scaled-font-t)) (extents (* cairo-font-extents-t))) "cairo_scaled_font_extents")
(define-cairo-func void cairo-scaled-font-text-extents ((scaled_font (* cairo-scaled-font-t)) (utf8 string) (extents (* cairo-text-extents-t))) "cairo_scaled_font_text_extents")
(define-cairo-func void cairo-scaled-font-glyph-extents ((scaled_font (* cairo-scaled-font-t)) (glyphs (* cairo-glyph-t)) (num_glyphs int) (extents (* cairo-text-extents-t))) "cairo_scaled_font_glyph_extents")
(define-cairo-func cairo-status-t cairo-scaled-font-text-to-glyphs ((scaled_font (* cairo-scaled-font-t)) (x double) (y double) (utf8 string) (utf8_len int) (glyphs (* cairo-glyph-t*)) (num_glyphs (* int)) (clusters (* cairo-text-cluster-t*)) (num_clusters (* int)) (cluster_flags (* cairo-text-cluster-flags-t))) "cairo_scaled_font_text_to_glyphs")
(define-cairo-func (* cairo-font-face-t) cairo-scaled-font-get-font-face ((scaled_font (* cairo-scaled-font-t))) "cairo_scaled_font_get_font_face")
(define-cairo-func void cairo-scaled-font-get-font-matrix ((scaled_font (* cairo-scaled-font-t)) (font_matrix (* cairo-matrix-t))) "cairo_scaled_font_get_font_matrix")
(define-cairo-func void cairo-scaled-font-get-ctm ((scaled_font (* cairo-scaled-font-t)) (ctm (* cairo-matrix-t))) "cairo_scaled_font_get_ctm")
(define-cairo-func void cairo-scaled-font-get-scale-matrix ((scaled_font (* cairo-scaled-font-t)) (scale_matrix (* cairo-matrix-t))) "cairo_scaled_font_get_scale_matrix")
(define-cairo-func void cairo-scaled-font-get-font-options ((scaled_font (* cairo-scaled-font-t)) (options (* cairo-font-options-t))) "cairo_scaled_font_get_font_options")
(define-cairo-func (* cairo-font-face-t) cairo-toy-font-face-create ((family string) (slant cairo-font-slant-t) (weight cairo-font-weight-t)) "cairo_toy_font_face_create")
(define-cairo-func string cairo-toy-font-face-get-family ((font_face (* cairo-font-face-t))) "cairo_toy_font_face_get_family")
................................................................................
(define-cairo-func cairo-status-t cairo-surface-status ((surface (* cairo-surface-t))) "cairo_surface_status")
(define-cairo-func cairo-surface-type-t cairo-surface-get-type ((surface (* cairo-surface-t))) "cairo_surface_get_type")
(define-cairo-func cairo-content-t cairo-surface-get-content ((surface (* cairo-surface-t))) "cairo_surface_get_content")
(define-cairo-func cairo-status-t cairo-surface-write-to-png ((surface (* cairo-surface-t)) (filename string)) "cairo_surface_write_to_png")
(define-cairo-func cairo-status-t cairo-surface-write-to-png-stream ((surface (* cairo-surface-t)) (write_func (* cairo-write-func-t)) (closure void*)) "cairo_surface_write_to_png_stream")
(define-cairo-func void* cairo-surface-get-user-data ((surface (* cairo-surface-t)) (key (* cairo-user-data-key-t))) "cairo_surface_get_user_data")
(define-cairo-func cairo-status-t cairo-surface-set-user-data ((surface (* cairo-surface-t)) (key (* cairo-user-data-key-t)) (user_data void*) (destroy cairo-destroy-func-t)) "cairo_surface_set_user_data")
(define-cairo-func void cairo-surface-get-mime-data ((surface (* cairo-surface-t)) (mime_type string) (data (* unsigned-8*)) (length (* unsigned-long))) "cairo_surface_get_mime_data")
(define-cairo-func cairo-status-t cairo-surface-set-mime-data ((surface (* cairo-surface-t)) (mime_type string) (data (* unsigned-8)) (length unsigned-long) (destroy cairo-destroy-func-t) (closure void*)) "cairo_surface_set_mime_data")
(define-cairo-func cairo-bool-t cairo-surface-supports-mime-type ((surface (* cairo-surface-t)) (mime_type string)) "cairo_surface_supports_mime_type")
(define-cairo-func void cairo-surface-get-font-options ((surface (* cairo-surface-t)) (options (* cairo-font-options-t))) "cairo_surface_get_font_options")
(define-cairo-func void cairo-surface-flush ((surface (* cairo-surface-t))) "cairo_surface_flush")
(define-cairo-func void cairo-surface-mark-dirty ((surface (* cairo-surface-t))) "cairo_surface_mark_dirty")
(define-cairo-func void cairo-surface-mark-dirty-rectangle ((surface (* cairo-surface-t)) (x int) (y int) (width int) (height int)) "cairo_surface_mark_dirty_rectangle")
(define-cairo-func void cairo-surface-set-device-scale ((surface (* cairo-surface-t)) (x_scale double) (y_scale double)) "cairo_surface_set_device_scale")
................................................................................
(define-cairo-func (* cairo-surface-t) cairo-recording-surface-create ((content cairo-content-t) (extents (* cairo-rectangle-t))) "cairo_recording_surface_create")
(define-cairo-func void cairo-recording-surface-ink-extents ((surface (* cairo-surface-t)) (x0 (* double)) (y0 (* double)) (width (* double)) (height (* double))) "cairo_recording_surface_ink_extents")
(define-cairo-func cairo-bool-t cairo-recording-surface-get-extents ((surface (* cairo-surface-t)) (extents (* cairo-rectangle-t))) "cairo_recording_surface_get_extents")
(define-cairo-func (* cairo-pattern-t) cairo-pattern-create-raster-source ((user_data void*) (content cairo-content-t) (width int) (height int)) "cairo_pattern_create_raster_source")
(define-cairo-func void cairo-raster-source-pattern-set-callback-data ((pattern (* cairo-pattern-t)) (data void*)) "cairo_raster_source_pattern_set_callback_data")
(define-cairo-func void* cairo-raster-source-pattern-get-callback-data ((pattern (* cairo-pattern-t))) "cairo_raster_source_pattern_get_callback_data")
(define-cairo-func void cairo-raster-source-pattern-set-acquire ((pattern (* cairo-pattern-t)) (acquire (* cairo-raster-source-acquire-func-t)) (release (* cairo-raster-source-release-func-t))) "cairo_raster_source_pattern_set_acquire")
(define-cairo-func void cairo-raster-source-pattern-get-acquire ((pattern (* cairo-pattern-t)) (acquire (* cairo-raster-source-acquire-func-t*)) (release (* cairo-raster-source-release-func-t*))) "cairo_raster_source_pattern_get_acquire")
(define-cairo-func void cairo-raster-source-pattern-set-snapshot ((pattern (* cairo-pattern-t)) (snapshot (* cairo-raster-source-snapshot-func-t))) "cairo_raster_source_pattern_set_snapshot")
(define-cairo-func (* cairo-raster-source-snapshot-func-t) cairo-raster-source-pattern-get-snapshot ((pattern (* cairo-pattern-t))) "cairo_raster_source_pattern_get_snapshot")
(define-cairo-func void cairo-raster-source-pattern-set-copy ((pattern (* cairo-pattern-t)) (copy (* cairo-raster-source-copy-func-t))) "cairo_raster_source_pattern_set_copy")
(define-cairo-func (* cairo-raster-source-copy-func-t) cairo-raster-source-pattern-get-copy ((pattern (* cairo-pattern-t))) "cairo_raster_source_pattern_get_copy")
(define-cairo-func void cairo-raster-source-pattern-set-finish ((pattern (* cairo-pattern-t)) (finish (* cairo-raster-source-finish-func-t))) "cairo_raster_source_pattern_set_finish")
(define-cairo-func (* cairo-raster-source-finish-func-t) cairo-raster-source-pattern-get-finish ((pattern (* cairo-pattern-t))) "cairo_raster_source_pattern_get_finish")
(define-cairo-func (* cairo-pattern-t) cairo-pattern-create-rgb ((red double) (green double) (blue double)) "cairo_pattern_create_rgb")
................................................................................
(define-cairo-func void cairo-pattern-set-matrix ((pattern (* cairo-pattern-t)) (matrix (* cairo-matrix-t))) "cairo_pattern_set_matrix")
(define-cairo-func void cairo-pattern-get-matrix ((pattern (* cairo-pattern-t)) (matrix (* cairo-matrix-t))) "cairo_pattern_get_matrix")
(define-cairo-func void cairo-pattern-set-extend ((pattern (* cairo-pattern-t)) (extend cairo-extend-t)) "cairo_pattern_set_extend")
(define-cairo-func cairo-extend-t cairo-pattern-get-extend ((pattern (* cairo-pattern-t))) "cairo_pattern_get_extend")
(define-cairo-func void cairo-pattern-set-filter ((pattern (* cairo-pattern-t)) (filter cairo-filter-t)) "cairo_pattern_set_filter")
(define-cairo-func cairo-filter-t cairo-pattern-get-filter ((pattern (* cairo-pattern-t))) "cairo_pattern_get_filter")
(define-cairo-func cairo-status-t cairo-pattern-get-rgba ((pattern (* cairo-pattern-t)) (red (* double)) (green (* double)) (blue (* double)) (alpha (* double))) "cairo_pattern_get_rgba")
(define-cairo-func cairo-status-t cairo-pattern-get-surface ((pattern (* cairo-pattern-t)) (surface (* cairo-surface-t*))) "cairo_pattern_get_surface")
(define-cairo-func cairo-status-t cairo-pattern-get-color-stop-rgba ((pattern (* cairo-pattern-t)) (index int) (offset (* double)) (red (* double)) (green (* double)) (blue (* double)) (alpha (* double))) "cairo_pattern_get_color_stop_rgba")
(define-cairo-func cairo-status-t cairo-pattern-get-color-stop-count ((pattern (* cairo-pattern-t)) (count (* int))) "cairo_pattern_get_color_stop_count")
(define-cairo-func cairo-status-t cairo-pattern-get-linear-points ((pattern (* cairo-pattern-t)) (x0 (* double)) (y0 (* double)) (x1 (* double)) (y1 (* double))) "cairo_pattern_get_linear_points")
(define-cairo-func cairo-status-t cairo-pattern-get-radial-circles ((pattern (* cairo-pattern-t)) (x0 (* double)) (y0 (* double)) (r0 (* double)) (x1 (* double)) (y1 (* double)) (r1 (* double))) "cairo_pattern_get_radial_circles")
(define-cairo-func cairo-status-t cairo-mesh-pattern-get-patch-count ((pattern (* cairo-pattern-t)) (count (* unsigned-int))) "cairo_mesh_pattern_get_patch_count")
(define-cairo-func (* cairo-path-t) cairo-mesh-pattern-get-path ((pattern (* cairo-pattern-t)) (patch_num unsigned-int)) "cairo_mesh_pattern_get_path")
(define-cairo-func cairo-status-t cairo-mesh-pattern-get-corner-color-rgba ((pattern (* cairo-pattern-t)) (patch_num unsigned-int) (corner_num unsigned-int) (red (* double)) (green (* double)) (blue (* double)) (alpha (* double))) "cairo_mesh_pattern_get_corner_color_rgba")

Changes to cairo/cairo-pdf-functions.ss.

1
2
3
4
5
6
(define-cairo-func (* cairo-surface-t) cairo-pdf-surface-create ((filename string) (width_in_points double) (height_in_points double)) "cairo_pdf_surface_create")
(define-cairo-func (* cairo-surface-t) cairo-pdf-surface-create-for-stream ((write_func (* cairo-write-func-t)) (closure void*) (width_in_points double) (height_in_points double)) "cairo_pdf_surface_create_for_stream")
(define-cairo-func void cairo-pdf-surface-restrict-to-version ((surface (* cairo-surface-t)) (version cairo-pdf-version-t)) "cairo_pdf_surface_restrict_to_version")
(define-cairo-func void cairo-pdf-get-versions ((versions (* cairo-pdf-version-t)) (num_versions (* int))) "cairo_pdf_get_versions")
(define-cairo-func string cairo-pdf-version-to-string ((version cairo-pdf-version-t)) "cairo_pdf_version_to_string")
(define-cairo-func void cairo-pdf-surface-set-size ((surface (* cairo-surface-t)) (width_in_points double) (height_in_points double)) "cairo_pdf_surface_set_size")



|


1
2
3
4
5
6
(define-cairo-func (* cairo-surface-t) cairo-pdf-surface-create ((filename string) (width_in_points double) (height_in_points double)) "cairo_pdf_surface_create")
(define-cairo-func (* cairo-surface-t) cairo-pdf-surface-create-for-stream ((write_func (* cairo-write-func-t)) (closure void*) (width_in_points double) (height_in_points double)) "cairo_pdf_surface_create_for_stream")
(define-cairo-func void cairo-pdf-surface-restrict-to-version ((surface (* cairo-surface-t)) (version cairo-pdf-version-t)) "cairo_pdf_surface_restrict_to_version")
(define-cairo-func void cairo-pdf-get-versions ((versions (* cairo-pdf-version-t*)) (num_versions (* int))) "cairo_pdf_get_versions")
(define-cairo-func string cairo-pdf-version-to-string ((version cairo-pdf-version-t)) "cairo_pdf_version_to_string")
(define-cairo-func void cairo-pdf-surface-set-size ((surface (* cairo-surface-t)) (width_in_points double) (height_in_points double)) "cairo_pdf_surface_set_size")

Changes to cairo/ffi-utils.ss.

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
					; (indirect-export cairo-guard-pointer)
	   #`(begin
	       (define (name arg-name ...) 
		 (define-ftype function-ftype (function (renamed-type ...) renamed-ret))
		 (let* ([function-fptr  (make-ftype-pointer function-ftype c-name)]
			[function       (ftype-ref function-ftype () function-fptr)]
			[arg-name arg-convert] ...)
		   (printf "calling ffi ~d ~n" c-name)
		   (let ([result (function arg-name ...)])
		     
		     #,(case (syntax->datum #'ret-type)
			 [(cairo-status-t)  #'(cairo-status-enum-ref result)]
			 [((* cairo-t)
			   (* cairo-surface-t)
			   (* cairo-pattern-t)







|







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
					; (indirect-export cairo-guard-pointer)
	   #`(begin
	       (define (name arg-name ...) 
		 (define-ftype function-ftype (function (renamed-type ...) renamed-ret))
		 (let* ([function-fptr  (make-ftype-pointer function-ftype c-name)]
			[function       (ftype-ref function-ftype () function-fptr)]
			[arg-name arg-convert] ...)
		   ;(printf "calling ffi ~d ~n" c-name)
		   (let ([result (function arg-name ...)])
		     
		     #,(case (syntax->datum #'ret-type)
			 [(cairo-status-t)  #'(cairo-status-enum-ref result)]
			 [((* cairo-t)
			   (* cairo-surface-t)
			   (* cairo-pattern-t)

Changes to cairo/parse-json.ss.

46
47
48
49
50
51
52
53



54
55
56
57
58
59
60
..
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
    (if (and (string-prefix? "cairo-" xd) 
	     (not  (or (string-suffix? "*" x) (string-suffix? "-t" x))))
	(string-append x "-t")
	x)))

(define (add-* x)
  (string-append x "*"))
 



(define (decode-type t)
  (if t
      (let-json-object t (tag type)
		       (let ([tag* (if (string? tag) (string->symbol tag) tag)])
			 (case tag*
			   [:function-pointer 'void*]
			   [:int 'int]
................................................................................
			   [:float 'float]
			   [:pointer (let ([pt (decode-type type)])
				       (case pt
					 (char 'string)
					 (void 'void*)
					 (else
					  (if (and (pair? pt ) (eq? (car pt) '*))
					      pt ;; DOUBLE STAR SEEMS NOT SUPPORTED ON CHEZ
					      `(* ,pt))
					  #;(string->symbol 
					   (add-*
					    (symbol->string pt))))))]
			   [:void 'void]
			   [:char 'char]
			   [:unsigned-char 'unsigned-8]







|
>
>
>







 







|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
..
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
    (if (and (string-prefix? "cairo-" xd) 
	     (not  (or (string-suffix? "*" x) (string-suffix? "-t" x))))
	(string-append x "-t")
	x)))

(define (add-* x)
  (string-append x "*"))

(define (symbol-append . symbols)
  (apply string-append (map symbol->string symbols)))

(define (decode-type t)
  (if t
      (let-json-object t (tag type)
		       (let ([tag* (if (string? tag) (string->symbol tag) tag)])
			 (case tag*
			   [:function-pointer 'void*]
			   [:int 'int]
................................................................................
			   [:float 'float]
			   [:pointer (let ([pt (decode-type type)])
				       (case pt
					 (char 'string)
					 (void 'void*)
					 (else
					  (if (and (pair? pt ) (eq? (car pt) '*))
					      `(* ,(symbol-append (cadr pt) '*)) ;; DOUBLE STAR SEEMS NOT SUPPORTED ON CHEZ
					      `(* ,pt))
					  #;(string->symbol 
					   (add-*
					    (symbol->string pt))))))]
			   [:void 'void]
			   [:char 'char]
			   [:unsigned-char 'unsigned-8]

Changes to cairo/types.ss.

9
10
11
12
13
14
15

16

17
18
19
20
21
22
23
24
25
26
27
28
...
130
131
132
133
134
135
136



137
138
139
140
141



142
143
144
145





146
147
148
149
150
151
152
...
253
254
255
256
257
258
259



260
261
262
263
264



265
266
267
268
269
270
271
...
285
286
287
288
289
290
291

292
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.


 (define-ftype unsigned-char unsigned-8)

 (define-ftype cairo-bool-t int)
 (define-ftype cairo-t (struct))

 (define-ftype cairo-surface-t (struct))

 (define-ftype cairo-device-t void*)

 (define-ftype cairo-matrix-t
   (struct
    [xx double]
    [yx double]
    [xy double]
................................................................................
 (define-ftype cairo-font-face-t void*)

 (define-ftype cairo-glyph-t
   (struct [index unsigned-long] [x double] [y double]))

 (define-ftype-allocator cairo-glyph-create cairo-glyph-t)




 (define-ftype cairo-text-cluster-t
   (struct [num-bytes int] [num-glyphs int]))

 (define-ftype-allocator cairo-text-cluster-create cairo-text-cluster-t)




 (define-enumeration* cairo-text-cluster-flag
   (none backward))

 (define-ftype cairo-text-cluster-flags-t int)






 (define-ftype cairo-text-extents-t
   (struct
    [x-bearing double]
    [y-bearing double]
    [width double]
    [height double]
................................................................................
 (define-ftype cairo-raster-source-acquire-func-t
   (function
    ((* cairo-pattern-t)
     void*
     (* cairo-surface-t)
     (* cairo-rectangle-int-t))
    cairo-status-t))




 (define-ftype cairo-raster-source-release-func-t
   (function
    ((* cairo-pattern-t) void* (* cairo-surface-t))
    cairo-status-t))




 (define-ftype cairo-raster-source-snapshot-func-t
   (function ((* cairo-pattern-t) void*) cairo-status-t))

 (define-ftype cairo-raster-source-copy-func-t
   (function
    ((* cairo-pattern-t) void* (* cairo-pattern-t))
................................................................................

 (define-ftype cairo-region-t void*)

 (define-enumeration* cairo-region-overlap
   (in out part))

 (define-ftype cairo-pdf-version-t int)

 (define-ftype cairo-pdf-version-t-const cairo-pdf-version-t)







>

>




|







 







>
>
>





>
>
>




>
>
>
>
>







 







>
>
>





>
>
>







 







>

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
...
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
...
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
...
304
305
306
307
308
309
310
311
312
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

 (define-ftype unsigned-8* (* unsigned-8))
 (define-ftype unsigned-char unsigned-8)

 (define-ftype cairo-bool-t int)
 (define-ftype cairo-t (struct))

 (define-ftype cairo-surface-t (struct))
 (define-ftype cairo-surface-t* (* cairo-surface-t))
 (define-ftype cairo-device-t void*)

 (define-ftype cairo-matrix-t
   (struct
    [xx double]
    [yx double]
    [xy double]
................................................................................
 (define-ftype cairo-font-face-t void*)

 (define-ftype cairo-glyph-t
   (struct [index unsigned-long] [x double] [y double]))

 (define-ftype-allocator cairo-glyph-create cairo-glyph-t)

(define-ftype cairo-glyph-t* (* cairo-glyph-t))
(define-ftype-allocator cairo-glyph*-create cairo-glyph-t*)

 (define-ftype cairo-text-cluster-t
   (struct [num-bytes int] [num-glyphs int]))

 (define-ftype-allocator cairo-text-cluster-create cairo-text-cluster-t)

 (define-ftype cairo-text-cluster-t* (* cairo-text-cluster-t))
 (define-ftype-allocator cairo-text-cluster*-create cairo-text-cluster-t*)
 
 (define-enumeration* cairo-text-cluster-flag
   (none backward))

 (define-ftype cairo-text-cluster-flags-t int)

 (define-ftype-allocator cairo-text-cluster-flags-create cairo-text-cluster-flags-t)

 (define-ftype-allocator cairo-int-create int)
 (define-ftype-allocator cairo-void*-create void*)

 (define-ftype cairo-text-extents-t
   (struct
    [x-bearing double]
    [y-bearing double]
    [width double]
    [height double]
................................................................................
 (define-ftype cairo-raster-source-acquire-func-t
   (function
    ((* cairo-pattern-t)
     void*
     (* cairo-surface-t)
     (* cairo-rectangle-int-t))
    cairo-status-t))

 (define-ftype cairo-raster-source-acquire-func-t*
   (* cairo-raster-source-acquire-func-t))

 (define-ftype cairo-raster-source-release-func-t
   (function
    ((* cairo-pattern-t) void* (* cairo-surface-t))
    cairo-status-t))

 (define-ftype cairo-raster-source-release-func-t*
  (* cairo-raster-source-release-func-t))

 (define-ftype cairo-raster-source-snapshot-func-t
   (function ((* cairo-pattern-t) void*) cairo-status-t))

 (define-ftype cairo-raster-source-copy-func-t
   (function
    ((* cairo-pattern-t) void* (* cairo-pattern-t))
................................................................................

 (define-ftype cairo-region-t void*)

 (define-enumeration* cairo-region-overlap
   (in out part))

 (define-ftype cairo-pdf-version-t int)
 (define-ftype cairo-pdf-version-t* (* cairo-pdf-version-t))
 (define-ftype cairo-pdf-version-t-const cairo-pdf-version-t)