diff --git a/collects/ffi/c-printf.ss b/collects/ffi/c-printf.ss deleted file mode 100644 index 052864078c..0000000000 --- a/collects/ffi/c-printf.ss +++ /dev/null @@ -1,39 +0,0 @@ -#lang scheme/base - -(require mzlib/foreign) (unsafe!) - -;; This code demonstrates how to interface `printf' which can be used with -;; different arities and types. Also, `printf' is unsafe unless this code will -;; parse the format string and make sure that all the types match, instead, -;; this code demonstrates how to provide unsafe bindings in a way that forces -;; users to admit that `(c-printf-is-dangerous!)'. - -;; It's not too useful, since the C printf will obviously ignore -;; `current-output-port'. - -(provide* (unsafe c-printf)) - -(define interfaces (make-hash)) - -(define (c-printf fmt . args) - (define itypes - (cons _string - (map (lambda (x) - (cond [(and (integer? x) (exact? x)) _int] - [(and (number? x) (real? x)) _double*] - [(string? x) _string] - [(bytes? x) _bytes] - [(symbol? x) _symbol] - [else (error 'c-printf - "don't know how to deal with ~e" x)])) - args))) - (let ([printf (hash-ref interfaces itypes - (lambda () - ;; Note: throws away the return value of printf - (let ([i (get-ffi-obj "printf" #f - (_cprocedure itypes _void))]) - (hash-set! interfaces itypes i) - i)))]) - (apply printf fmt args))) - -(define-unsafer c-printf-is-dangerous!) diff --git a/collects/ffi/crypt.ss b/collects/ffi/crypt.ss deleted file mode 100644 index 4eccfe24dc..0000000000 --- a/collects/ffi/crypt.ss +++ /dev/null @@ -1,63 +0,0 @@ -#lang scheme/base - -(require mzlib/foreign) (unsafe!) - -(define libcrypt (ffi-lib "libcrypt")) - -(provide crypt) -(define crypt - (get-ffi-obj "crypt" libcrypt (_fun _string _string -> _bytes))) - -(define set-key* - (get-ffi-obj "setkey" libcrypt (_fun _bytes -> _void))) -(define encrypt* - (get-ffi-obj "encrypt" libcrypt (_fun _bytes _bool -> _void))) - -;; see the encrypt(3) man page for the following - -(define (*crypt str key flag) - (set-key* key) - (let ([str (string8->keystring str)]) - (encrypt* str flag) - (keystring->string8 str))) - -(provide encrypt decrypt) -(define (encrypt str key) (*crypt (string->bytes/utf-8 str) key #f)) -(define (decrypt str key) (bytes->string/utf-8 (*crypt str key #t))) - -(define (string8->keystring str) - (let* ([len (bytes-length str)] - [str (cond - [(> len 8) (subbytes str 0 8)] - [(< len 8) (bytes-append str (make-bytes (- 8 len) 32))] - [else str])] - [bin (apply string-append - (map (lambda (x) - (let* ([bin (format "~b" x)] - [len (string-length bin)]) - (if (< (string-length bin) 8) - (string-append (make-string (- 8 len) #\0) bin) - bin))) - (bytes->list str)))]) - (list->bytes - (map (lambda (x) - (case x - [(#\0) 0] [(#\1) 1] - [else (error 'string8->keystring "something bad happened")])) - (string->list bin))))) - -(define (keystring->string8 bin) - (unless (= 64 (bytes-length bin)) - (error 'keystring->string8 "bad input size: ~s" bin)) - (let ([bin (apply string (map (lambda (x) - (case x - [(0) #\0] [(1) #\1] - [else (error 'keystring->string8 - "something bad happened")])) - (bytes->list bin)))]) - (apply bytes - (let loop ([n (- 64 8)] [r '()]) - (if (< n 0) - r - (loop (- n 8) (cons (string->number (substring bin n (+ n 8)) 2) - r))))))) diff --git a/collects/ffi/cvector.rkt b/collects/ffi/cvector.rkt new file mode 100644 index 0000000000..a22434e76f --- /dev/null +++ b/collects/ffi/cvector.rkt @@ -0,0 +1,7 @@ +#lang racket/base +(require "unsafe/cvector.ss") + +(provide (except-out (all-from-out "unsafe/cvector.ss") + make-cvector*)) + + diff --git a/collects/ffi/esd.ss b/collects/ffi/esd.ss deleted file mode 100644 index e122181930..0000000000 --- a/collects/ffi/esd.ss +++ /dev/null @@ -1,78 +0,0 @@ -#lang scheme/base - -(require mzlib/foreign) (unsafe!) - -(define libesd (ffi-lib "libesd")) - -;; Use this type to properly close the esd channel -(define-struct esd (num)) -(define _esd - (make-ctype _int esd-num - (lambda (e) - (if (and (integer? e) (<= 0 e)) - (let ([new (make-esd e)]) - (register-finalizer new esd-close) - new) - (error '_esd "expecting an integer >=0, got: ~e" e))))) - -;; Use this type to free collected samples -(define-struct sample (num)) -(define _sample - (make-ctype _int sample-num - (lambda (s) - (if (and (integer? s) (<= 0 s)) - (let ([new (make-sample s)]) - (register-finalizer - new - (lambda (x) - (esd-sample-free x))) - new) - (error '_sample "expecting an integer >=0, got: ~e" s))))) -;; similar but no finalizer -(define _sample* (make-ctype _int sample-num make-sample)) - -(provide esd-open-sound) -(define esd-open-sound ; -> esd - (let ([f (get-ffi-obj "esd_open_sound" libesd (_fun _string -> _esd))]) - (lambda host? (f (and (pair? host?) (car host?)))))) - -(define (with-default ffi) - (lambda args - (if (and (pair? args) (esd? (car args))) - (apply ffi args) - (apply ffi (default-esd) args)))) - -(define (c-name x) - (regexp-replaces x '((#rx"-" "_") (#rx"[*?]$" "")))) - -(define-syntax defesd - (syntax-rules (: _esd) - [(_ name : [_esd] type ...) - (define name - (with-default - (get-ffi-obj (c-name 'name) libesd (_fun _esd type ...))))] - [(_ name : type ...) - (define name - (get-ffi-obj (c-name 'name) libesd (_fun type ...)))])) - -(define-syntax defesd* - (syntax-rules () - [(_ name x ...) (begin (provide name) (defesd name x ...))])) - -(defesd esd-close : [_esd] -> _int) -(defesd* esd-send-auth : [_esd] -> _int) -(defesd* esd-lock : [_esd] -> _int) -(defesd* esd-unlock : [_esd] -> _int) -(defesd* esd-standby : [_esd] -> _int) -(defesd* esd-resume : [_esd] -> _int) -(defesd* esd-get-latency : [_esd] -> _int) -(defesd* esd-play-file : (prefix : _string) _file (fallback? : _bool) -> _int) -(defesd* esd-file-cache : [_esd] (prefix : _string) _file -> _sample) -(defesd* esd-sample-getid : [_esd] _string -> _sample*) -(defesd esd-sample-free : [_esd] _sample -> _int) -(defesd* esd-sample-play : [_esd] _sample -> _int) -(defesd* esd-sample-loop : [_esd] _sample -> _int) -(defesd* esd-sample-stop : [_esd] _sample -> _int) -(defesd* esd-sample-kill : [_esd] _sample -> _int) -(provide default-esd) -(define default-esd (make-parameter (esd-open-sound) esd?)) diff --git a/collects/ffi/examples/c-printf.ss b/collects/ffi/examples/c-printf.ss old mode 100755 new mode 100644 index 723f065917..052864078c --- a/collects/ffi/examples/c-printf.ss +++ b/collects/ffi/examples/c-printf.ss @@ -1,13 +1,39 @@ -#! /usr/bin/env mzscheme - #lang scheme/base -(require ffi/c-printf) +(require mzlib/foreign) (unsafe!) -(c-printf-is-dangerous!) ; see last example below +;; This code demonstrates how to interface `printf' which can be used with +;; different arities and types. Also, `printf' is unsafe unless this code will +;; parse the format string and make sure that all the types match, instead, +;; this code demonstrates how to provide unsafe bindings in a way that forces +;; users to admit that `(c-printf-is-dangerous!)'. -(c-printf "|%4d| |%04d| |%-4d|\n" 12 34 56) -(c-printf "|%4d| |%04d| |%-4d|\n" "12" "34" "56") -(c-printf "Bye bye sanity:\n") -(c-printf "%s\n" 0) -(c-printf "%s\n" 1234) +;; It's not too useful, since the C printf will obviously ignore +;; `current-output-port'. + +(provide* (unsafe c-printf)) + +(define interfaces (make-hash)) + +(define (c-printf fmt . args) + (define itypes + (cons _string + (map (lambda (x) + (cond [(and (integer? x) (exact? x)) _int] + [(and (number? x) (real? x)) _double*] + [(string? x) _string] + [(bytes? x) _bytes] + [(symbol? x) _symbol] + [else (error 'c-printf + "don't know how to deal with ~e" x)])) + args))) + (let ([printf (hash-ref interfaces itypes + (lambda () + ;; Note: throws away the return value of printf + (let ([i (get-ffi-obj "printf" #f + (_cprocedure itypes _void))]) + (hash-set! interfaces itypes i) + i)))]) + (apply printf fmt args))) + +(define-unsafer c-printf-is-dangerous!) diff --git a/collects/ffi/examples/crypt.ss b/collects/ffi/examples/crypt.ss old mode 100755 new mode 100644 index 2b479ad823..4eccfe24dc --- a/collects/ffi/examples/crypt.ss +++ b/collects/ffi/examples/crypt.ss @@ -1,19 +1,63 @@ -#! /usr/bin/env mzscheme - #lang scheme/base -(require ffi/crypt) +(require mzlib/foreign) (unsafe!) -(define passwd "foo") -(define salt "xz") -(printf ">>> crypt(~s,~s) = ~s\n" passwd salt (crypt passwd salt)) +(define libcrypt (ffi-lib "libcrypt")) -;; md5-based version -(set! salt "$1$somesalt$") -(printf ">>> crypt(~s,~s) = ~s\n" passwd salt (crypt passwd salt)) +(provide crypt) +(define crypt + (get-ffi-obj "crypt" libcrypt (_fun _string _string -> _bytes))) -(newline) -(define foo "foo bar") -(define key (string->bytes/utf-8 "my key")) -(printf ">>> ~s --encrypt--> ~s --decrypt--> ~s\n" - foo (encrypt foo key) (decrypt (encrypt foo key) key)) +(define set-key* + (get-ffi-obj "setkey" libcrypt (_fun _bytes -> _void))) +(define encrypt* + (get-ffi-obj "encrypt" libcrypt (_fun _bytes _bool -> _void))) + +;; see the encrypt(3) man page for the following + +(define (*crypt str key flag) + (set-key* key) + (let ([str (string8->keystring str)]) + (encrypt* str flag) + (keystring->string8 str))) + +(provide encrypt decrypt) +(define (encrypt str key) (*crypt (string->bytes/utf-8 str) key #f)) +(define (decrypt str key) (bytes->string/utf-8 (*crypt str key #t))) + +(define (string8->keystring str) + (let* ([len (bytes-length str)] + [str (cond + [(> len 8) (subbytes str 0 8)] + [(< len 8) (bytes-append str (make-bytes (- 8 len) 32))] + [else str])] + [bin (apply string-append + (map (lambda (x) + (let* ([bin (format "~b" x)] + [len (string-length bin)]) + (if (< (string-length bin) 8) + (string-append (make-string (- 8 len) #\0) bin) + bin))) + (bytes->list str)))]) + (list->bytes + (map (lambda (x) + (case x + [(#\0) 0] [(#\1) 1] + [else (error 'string8->keystring "something bad happened")])) + (string->list bin))))) + +(define (keystring->string8 bin) + (unless (= 64 (bytes-length bin)) + (error 'keystring->string8 "bad input size: ~s" bin)) + (let ([bin (apply string (map (lambda (x) + (case x + [(0) #\0] [(1) #\1] + [else (error 'keystring->string8 + "something bad happened")])) + (bytes->list bin)))]) + (apply bytes + (let loop ([n (- 64 8)] [r '()]) + (if (< n 0) + r + (loop (- n 8) (cons (string->number (substring bin n (+ n 8)) 2) + r))))))) diff --git a/collects/ffi/examples/esd.ss b/collects/ffi/examples/esd.ss old mode 100755 new mode 100644 index 0952ee9acc..e122181930 --- a/collects/ffi/examples/esd.ss +++ b/collects/ffi/examples/esd.ss @@ -1,31 +1,78 @@ -#! /usr/bin/env mzscheme - #lang scheme/base -(require ffi/esd) +(require mzlib/foreign) (unsafe!) -(printf "default = ~s\n" (default-esd)) -(printf "latency = ~s\n" (esd-get-latency)) -(printf "standby -> ~s\n" (esd-standby)) -(sleep 1) -(printf "resume -> ~s\n" (esd-resume)) +(define libesd (ffi-lib "libesd")) -(printf "Normal play...\n") -(esd-play-file "esd.ss" "~/stuff/sounds/Eeeooop.wav" #t) -(sleep 1) +;; Use this type to properly close the esd channel +(define-struct esd (num)) +(define _esd + (make-ctype _int esd-num + (lambda (e) + (if (and (integer? e) (<= 0 e)) + (let ([new (make-esd e)]) + (register-finalizer new esd-close) + new) + (error '_esd "expecting an integer >=0, got: ~e" e))))) -(printf "Sample play...\n") -(let ((sample-id (esd-file-cache "foooo" "~/stuff/sounds/Eeeooop.wav"))) - (printf ">>> sample = ~s\n" sample-id) - (printf ">>> getid -> ~s\n" - (esd-sample-getid "foooo:/home/eli/stuff/sounds/Eeeooop.wav")) - (printf "playing...\n") - (esd-sample-play sample-id) - (sleep 1) - (printf "looping...\n") - (esd-sample-loop sample-id) - (sleep 3) - (printf "enough!\n") - (esd-sample-stop sample-id) - (sleep 1) - (printf "bye.\n")) +;; Use this type to free collected samples +(define-struct sample (num)) +(define _sample + (make-ctype _int sample-num + (lambda (s) + (if (and (integer? s) (<= 0 s)) + (let ([new (make-sample s)]) + (register-finalizer + new + (lambda (x) + (esd-sample-free x))) + new) + (error '_sample "expecting an integer >=0, got: ~e" s))))) +;; similar but no finalizer +(define _sample* (make-ctype _int sample-num make-sample)) + +(provide esd-open-sound) +(define esd-open-sound ; -> esd + (let ([f (get-ffi-obj "esd_open_sound" libesd (_fun _string -> _esd))]) + (lambda host? (f (and (pair? host?) (car host?)))))) + +(define (with-default ffi) + (lambda args + (if (and (pair? args) (esd? (car args))) + (apply ffi args) + (apply ffi (default-esd) args)))) + +(define (c-name x) + (regexp-replaces x '((#rx"-" "_") (#rx"[*?]$" "")))) + +(define-syntax defesd + (syntax-rules (: _esd) + [(_ name : [_esd] type ...) + (define name + (with-default + (get-ffi-obj (c-name 'name) libesd (_fun _esd type ...))))] + [(_ name : type ...) + (define name + (get-ffi-obj (c-name 'name) libesd (_fun type ...)))])) + +(define-syntax defesd* + (syntax-rules () + [(_ name x ...) (begin (provide name) (defesd name x ...))])) + +(defesd esd-close : [_esd] -> _int) +(defesd* esd-send-auth : [_esd] -> _int) +(defesd* esd-lock : [_esd] -> _int) +(defesd* esd-unlock : [_esd] -> _int) +(defesd* esd-standby : [_esd] -> _int) +(defesd* esd-resume : [_esd] -> _int) +(defesd* esd-get-latency : [_esd] -> _int) +(defesd* esd-play-file : (prefix : _string) _file (fallback? : _bool) -> _int) +(defesd* esd-file-cache : [_esd] (prefix : _string) _file -> _sample) +(defesd* esd-sample-getid : [_esd] _string -> _sample*) +(defesd esd-sample-free : [_esd] _sample -> _int) +(defesd* esd-sample-play : [_esd] _sample -> _int) +(defesd* esd-sample-loop : [_esd] _sample -> _int) +(defesd* esd-sample-stop : [_esd] _sample -> _int) +(defesd* esd-sample-kill : [_esd] _sample -> _int) +(provide default-esd) +(define default-esd (make-parameter (esd-open-sound) esd?)) diff --git a/collects/ffi/examples/magick.ss b/collects/ffi/examples/magick.ss old mode 100755 new mode 100644 index 1beec94205..13bb216cdf --- a/collects/ffi/examples/magick.ss +++ b/collects/ffi/examples/magick.ss @@ -1,316 +1,2813 @@ -#! /usr/bin/env mzscheme - #lang scheme/base -(require ffi/magick (for-syntax scheme/base)) +(require mzlib/foreign) (unsafe!) -(define-syntax (test stx) - (syntax-case stx () - [(_ (func arg ...)) - (with-syntax ([(tmp ...) (generate-temporaries #'(arg ...))]) - #'(let ([tmp arg] ...) - (printf ">>> ~s~s\n" 'func `(,tmp ...)) - (let ([r (func tmp ...)]) - (printf " -> ~s\n" r) - r)))])) +(define (ffi-try-libs . libs) + (let loop ([libs* libs] + [exceptions '()]) + (if (null? libs*) + (error 'ffi-try-libs "Could not load any of the libraries in ~a\n~a\n" libs exceptions) + (let ([lib (caar libs*)] + [version (cdar libs*)]) + (with-handlers ([exn:fail:filesystem? (lambda (e) + (loop (cdr libs*) (cons e exceptions)))]) + (ffi-lib lib version)))))) + +(define libwand (ffi-try-libs '("libWand" "6.0.1" "6") + '("libMagickWand" "1"))) -;; (test (MagickGetPackageName)) -;; (test (MagickGetCopyright)) -;; (test (MagickGetVersion)) -;; (test (MagickGetReleaseDate)) -;; (test (MagickGetQuantumDepth)) -;; (test (MagickQueryConfigureOptions "CO*")) -;; (test (MagickQueryFonts "Cou*")) -;; (test (MagickQueryFormats "J*")) -;; (test (MagickGetHomeURL)) +;; ===== Main Objects ========================================================= -;; (define w (test (NewMagickWand))) -;; (test (MagickGetImageFilename w)) -;; (test (MagickReadImage w "~/html/images/eli.jpg")) +(define-syntax defmagick-pointer-type + (syntax-rules () + [(_ _name destructor s->c) + (define-cpointer-type _name #f s->c + (lambda (ptr) + (if ptr + (begin (register-finalizer ptr destructor) ptr) + (error '_name "got a NULL pointer"))))] + [(_ _name destructor) (defmagick-pointer-type _name destructor #f)])) -(define w (test (MagickReadImage "~/html/images/eli.jpg"))) -;; (test (MagickGetImageFilename w)) +(defmagick-pointer-type _MagickWand DestroyMagickWand) +(defmagick-pointer-type _DrawingWand DestroyDrawingWand) +(defmagick-pointer-type _Image DestroyImage) +(defmagick-pointer-type _DrawInfo DestroyDrawInfo) +(defmagick-pointer-type _PixelWand DestroyPixelWand + ;; This can be implicitly built when given a color name + (lambda (x) + (let loop ([x x]) + (cond [(string? x) (loop (NewPixelWand x))] + [(list? x) (loop (NewPixelWand x))] + [else x])))) ; can use NULL as a pixel wand (see floodfill) -;; (test (MagickGetImageFilename w)) -;; (test (MagickGetImageFormat w)) -;; (test (MagickGetImageCompression w)) -;; (test (MagickGetImageDispose w)) -;; (test (MagickGetImageType w)) -;; (test (MagickGetImageInterlaceScheme w)) -;; (test (MagickGetImageIndex w)) -;; (test (MagickGetImageSize w)) -;; (test (MagickGetImageSignature w)) -;; (test (MagickBlurImage w 2.0 1.0)) -;; ;; (test (MagickReadImage w "~/html/images/eeli.jpg")) -;; ;; (test (MagickGetException w)) -;; (test (MagickSwirlImage w 90.0)) -;; (test (MagickWaveImage w 4.0 40.0)) -;; (test (MagickCharcoalImage w 5.0 0.7)) -;; (test (MagickGetImageCompose w)) -;; (test (MagickGetImageColorspace w)) -;; (test (MagickCommentImage w "This is my test image")) -;; (test (MagickWriteImage w "~/tmp/x.jpg")) -;; (test (MagickDisplayImage w #f)) -;; (test (MagickDescribeImage w)) -;; (test (MagickGetImageWidth w)) -;; (test (MagickGetImageHeight w)) -;; (test (MagickGetImageChannelDepth w 'RedChannel)) -;; (test (MagickGetImageExtrema w)) -;; (test (MagickGetImageChannelExtrema w 'RedChannel)) -;; (test (MagickGetImageChannelMean w 'RedChannel)) -;; (test (MagickGetImageColors w)) -;; (test (MagickGetImageDelay w)) -;; (test (MagickSetImageDelay w 20)) -;; (test (MagickGetImageDelay w)) -;; (test (MagickGetImageDepth w)) -;; (test (MagickSetImageDepth w 2)) -;; (test (MagickGetImageDepth w)) -;; (test (MagickGetImageIterations w)) -;; (test (MagickSetImageIterations w 4)) -;; (test (MagickGetImageIterations w)) -;; (test (MagickGetSamplingFactors w)) -;; (test (MagickSetSamplingFactors w '(2.0 1.0 0.5))) -;; (test (MagickGetSamplingFactors w)) -;; (test (MagickGetImageRenderingIntent w)) -;; (test (MagickSetImageRenderingIntent w 'SaturationIntent)) -;; (test (MagickGetImageRenderingIntent w)) -;; (test (MagickGetImageUnits w)) -;; (test (MagickSetImageUnits w 'PixelsPerInchResolution)) -;; (test (MagickGetImageUnits w)) -;; (test (MagickGetImageVirtualPixelMethod w)) -;; (test (MagickSetImageVirtualPixelMethod w 'EdgeVirtualPixelMethod)) -;; (test (MagickGetImageVirtualPixelMethod w)) -;; (test (MagickGetImageWhitePoint w)) -;; (test (MagickSetImageWhitePoint w 3.0 4.0)) -;; (test (MagickGetImageWhitePoint w)) -;; (test (MagickGetImageResolution w)) -;; (test (MagickSetImageResolution w 33.0 33.0)) -;; (test (MagickGetImageResolution w)) -;; (test (MagickGetSize w)) -;; (test (MagickSetSize w 20 20)) -;; (test (MagickGetSize w)) -;; (test (MagickGetImageProfile w "ICC")) +;; Use a struct for this because we want to keep the associated image width +(define-struct PixelIterator (ptr [width #:mutable])) +(define _PixelIterator + (make-ctype _pointer PixelIterator-ptr + (lambda (ptr) + (if ptr + (let ([new (make-PixelIterator ptr #f)]) ; width set by makers + (register-finalizer new DestroyPixelIterator) + new) + (error '_PixelIterator "got a NULL pointer"))))) -;; (test (MagickAdaptiveThresholdImage w 2 2 0)) -;; (test (MagickAddNoiseImage w 'LaplacianNoise)) -;; (test (MagickEmbossImage w 1.0 0.5)) -;; (test (MagickEvaluateImage w 'MaxEvaluateOperator 30768.0)) -;; (test (MagickEvaluateImage w 'MinEvaluateOperator 34768.0)) -;; (test (MagickEvaluateImageChannel w 'RedChannel 'MaxEvaluateOperator 28768.0)) -;; (test (MagickEvaluateImageChannel w 'RedChannel 'MinEvaluateOperator 36768.0)) -;; (test (MagickGetImageGamma w)) -;; (test (MagickGammaImage w 0.5)) -;; (test (MagickSetImageGamma w 0.5)) -;; (test (MagickGetImageGamma w)) -;; (test (MagickGaussianBlurImage w 5.0 2.0)) -;; (test (MagickGaussianBlurImageChannel w 'RedChannel 1.0 0.1)) -;; (test (MagickGetImageRedPrimary w)) -;; (test (MagickSetImageRedPrimary w 20.0 20.0)) -;; (test (MagickGetImageRedPrimary w)) -;; (test (MagickTransformImage w "120x120+10+10" "100x100+0+0")) -;; (test (MagickThresholdImage w 32768.0)) -;; (test (MagickThresholdImageChannel w 'RedChannel 32768.0)) -;; (test (MagickSpreadImage w 2.0)) -;; (test (MagickOilPaintImage w 3.0)) -;; (test (MagickSpliceImage w 100 100 50 50)) -;; (test (MagickSolarizeImage w 2.0)) -;; (test (MagickShaveImage w 20 50)) -;; (test (MagickSharpenImage w 10.0 9.0)) -;; (test (MagickPosterizeImage w 2 #t)) -;; (test (MagickContrastImage w 20)) -;; (test (MagickEdgeImage w 5.0)) -;; (test (MagickImplodeImage w 0.5)) +;; ===== Utilities ============================================================ -;; (test (MagickConvolveImage -;; w '(( 0.0 -1.0 0.0) ; sharpen -;; (-1.0 5.0 -1.0) -;; ( 0.0 -1.0 0.0)))) -;; (test (MagickConvolveImage ; sharpen++ -;; w '((-1.0 -1.0 -1.0) -;; (-1.0 9.0 -1.0) -;; (-1.0 -1.0 -1.0)))) -;; (test (MagickConvolveImage ; blur -;; w '(( 1.0 1.0 1.0) -;; ( 1.0 1.0 1.0) -;; ( 1.0 1.0 1.0)))) -;; (test (MagickConvolveImage ; edge enhance -;; w '(( 0.0 0.0 0.0) -;; (-1.0 1.0 0.0) -;; ( 0.0 0.0 0.0)))) -;; (test (MagickConvolveImage ; edge enhance++ -;; w '((-1.0 0.0 1.0) -;; (-1.0 0.0 1.0) -;; (-1.0 0.0 1.0)))) -;; (test (MagickConvolveImage ; edge detect -;; w '(( 0.0 1.0 0.0) -;; ( 1.0 -4.0 1.0) -;; ( 0.0 1.0 0.0)))) -;; (test (MagickConvolveImage ; emboss -;; w '((-2.0 -1.0 0.0) -;; (-1.0 1.0 1.0) -;; ( 0.0 1.0 2.0)))) -;; (test (MagickConvolveImageChannel -;; w 'RedChannel '((1.0 0.0 0.0 0.0 1.0) -;; (0.0 0.0 0.0 0.0 0.0) -;; (0.0 0.0 -1.0 0.0 0.0) -;; (0.0 0.0 0.0 0.0 0.0) -;; (1.0 0.0 0.0 0.0 1.0)))) +(define (raise-wand-exception w) + ((cond [(MagickWand? w) MagickGetException ] + [(PixelWand? w) PixelGetException ] + [(PixelIterator? w) PixelIteratorGetException] + [(DrawingWand? w) DrawGetException ] + [else (error 'raise-wand-exception "got an unknown value: ~e" w)]) + w) + (error 'wand-exception "an undefined error occured with ~e" w)) -;; (define pixels (test (MagickGetImagePixels w 0 0 40 40 "RGB" 'ShortPixel))) -;; (test (MagickSetImagePixels -;; w 0 0 "RGB" 'ShortPixel -;; (let ([pixels (map (lambda (x) (append x x)) -;; pixels)]) -;; (append pixels -;; (map (lambda (row) -;; (map (lambda (pixel) -;; (list (cadr pixel) (caddr pixel) (car pixel)) -;; ;; (map (lambda (v) (- 65535 v)) pixel) -;; ) -;; row)) -;; pixels))))) +(define-fun-syntax _status + (syntax-id-rules (_status) + [_status (type: _bool + 1st-arg: 1st + post: (r => (unless r (raise-wand-exception 1st))))])) -;; (test (MagickLabelImage w "FOO")) -;; (test (MagickLevelImage w 20000.0 1.0 45535.0)) -;; (test (MagickMedianFilterImage w 2.0)) -;; (test (MagickModulateImage w 100.0 100.0 40.0)) -;; (test (MagickMotionBlurImage w 10.0 10.0 60.0)) -;; (test (MagickNegateImage w #f)) -;; (test (MagickNegateImageChannel w 'GreenChannel #f)) -;; (test (MagickNormalizeImage w)) -;; (test (MagickRaiseImage w 10 10 20 20 #f)) +(define-syntax defmagick + (syntax-rules (:) + [(_ id : x ...) (define id (get-ffi-obj 'id libwand (_fun x ...)))])) -;; (MagickMinifyImage w) (MagickMinifyImage w) (MagickMinifyImage w) -;; (test (MagickResampleImage w 576.0 576.0 'UndefinedFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'BoxFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'TriangleFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'HermiteFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'HanningFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'HammingFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'BlackmanFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'GaussianFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'QuadraticFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'CubicFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'CatromFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'MitchellFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'LanczosFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'BesselFilter 1.0)) -;; (test (MagickResampleImage w 576.0 576.0 'SincFilter 1.0)) +(define-syntax defmagick* + (syntax-rules () + [(_ name x ...) (begin (defmagick name x ...) (provide name))])) -;; (test (MagickOpaqueImage w "black" "yellow" 20000.0)) -;; (test (MagickColorFloodfillImage w "yellow" 20000.0 "black" 0 0)) -;; (test (MagickColorFloodfillImage w "yellow" 20000.0 #f 0 0)) -;; (test (MagickColorFloodfillImage w '(65535 0 0) 20000.0 "black" 0 0)) -;; (test (MagickColorFloodfillImage w '(65535 0 0 32737) 20000.0 "black" 0 0)) +;; Used to convert (small) square matrices (lists of lists) to a memory block. +(define (_sqmatrix-of type) + (make-ctype _pointer + (lambda (m) + (let ([len (and (list? m) (length m))]) + (unless (and len (< 0 len) + (andmap (lambda (x) (and (list? x) (= len (length x)))) + m)) + (error '_sqmatrix "expecting a rectangular matrix")) + (let ([block (malloc (* len len) type)]) + (let loop ([n 0] [xs (apply append m)]) + (unless (null? xs) + (ptr-set! block type n (car xs)) + (loop (add1 n) (cdr xs)))) + block))) + (lambda (x) (error '_sqmatrix "can be used only for ffi inputs")))) -;; (test (MagickTransparentImage w "black" 16384 20000.0)) -;; (test (MagickWriteImage w "~/tmp/x.png")) +;; This is a hack. What is needed is to be able to define a type that is a +;; struct of two doubles that translates to a list of two values. +(define _Points + (make-ctype _pointer + (lambda (l) + (unless (and (list? l) + (andmap (lambda (x) (and (list? x) (= 2 (length x)))) l)) + (error '_Points "expecting a list of two-element lists, got ~e" l)) + (list->cblock (apply append l) _double*)) + (lambda (x) + (error '_Points "cannot be used as an output type")))) -;; (test (MagickResetIterator w)) -;; (test (MagickGetImageProfile w "ICC")) -;; (test (MagickSetImageProfile w "ICC" "foo")) -;; (test (MagickGetImageProfile w "ICC")) +;; Hack for the same reason as above. +(define _AffineMatrix + (make-ctype _pointer + (lambda (l) + (unless (and (list? l) (= 6 (length l))) + (error '_Points "expecting a list of six numbers, got ~e" l)) + (list->cblock l _double*)) + (lambda (x) (cblock->list x _double* 6)))) -;; (test (MagickGetImageBackgroundColor w)) +;; Utilities for MagickGetImagePixels/MagickSetImagePixels -;; (test (MagickDisplayImage w)) +(define (StorageType->type storage-type) + (case storage-type + [(UndefinedPixel) (error 'StorageType->type "got an UndefinedPixel")] + [(CharPixel) _byte] + [(ShortPixel) _word] + [(IntegerPixel) _uint] + [(LongPixel) _ulong] + [(FloatPixel) _float] + [(DoublePixel) _double*])) -;; (for-each -;; (lambda (p) (MagickDisplayImage (test (MagickPreviewImages w p)))) -;; '(UndefinedPreview RotatePreview ShearPreview RollPreview HuePreview -;; SaturationPreview BrightnessPreview GammaPreview SpiffPreview DullPreview -;; GrayscalePreview QuantizePreview DespecklePreview ReduceNoisePreview -;; AddNoisePreview SharpenPreview BlurPreview ThresholdPreview -;; EdgeDetectPreview SpreadPreview SolarizePreview ShadePreview RaisePreview -;; SegmentPreview SwirlPreview ImplodePreview WavePreview OilPaintPreview -;; CharcoalDrawingPreview JPEGPreview)) +;; Gets a list and a number, and returns a list of lists of length n. +(define (n-split l n) + (let loop ([l l][i 0][a2 null][a null]) + (cond + [(null? l) (let ([a (if (null? a2) + a + (cons (reverse a2) a))]) + (reverse a))] + [(= i n) (loop l 0 null (cons (reverse a2) a))] + [else (loop (cdr l) (add1 i) (cons (car l) a2) a)]))) -;; (test (MagickDisplayImage -;; (MagickFxImageChannel w 'AllChannels "(p[-4,-4].r+p[4,4].g)/2"))) +;; _Quantum is something that the library tells us how big it is +(define _Quantum + (let* ([q ((get-ffi-obj "MagickGetQuantumDepth" libwand + (_fun _pointer -> _string)) + #f)] + [err (lambda () + (error 'libwand + "MagickGetQuantumDepth returned a bad value: ~s" q))]) + (cond [(and (string? q) (regexp-match #rx"^Q([0-9]+)$" q)) + => (lambda (m) + (case (string->number (cadr m)) + [( 8) _uint8] [(16) _uint16] [(32) _uint32] + [else (err)]))] + [else (err)]))) -;; (test (MagickMagnifyImage w)) -;; (let ([ww (CloneMagickWand w)]) -;; (test (MagickMinifyImage ww)) -;; (test (MagickMinifyImage ww)) -;; (test (MagickMinifyImage ww)) -;; (test (MagickDisplayImage (MagickTextureImage w ww)))) +;; Used twice (PixelGetIndex/PixelSetIndex). +(define _IndexPacket _Quantum) -;; (test (MagickChopImage w 100 100 10 10)) -;; (test (MagickCropImage w 100 100 10 10)) -;; (test (MagickDisplayImage w)) +(define _MagickSizeType _uint64) -;; (define w1 (test (CloneMagickWand w))) -;; (test (MagickBlurImage w1 1.0 0.18)) -;; (define t (cadr (test (MagickCompareImageChannels -;; w w1 'RedChannels 'MeanSquaredErrorMetric)))) -;; (test (MagickDisplayImage t)) +;; This type only needs to be created for PixelGetQuantumColor results. +;; (Could also define it as a macro for (_list ? _Quantum 4).) +(define-struct PixelPacket (ptr)) +(define _PixelPacket + (make-ctype _pointer PixelPacket-ptr make-PixelPacket)) +(define (NewPixelPacket) + (make-PixelPacket (malloc _Quantum 4))) -;; (test (MagickReadImage w "~/html/images/EliRegina.jpg")) -;; (define morph (test (MagickMorphImages w 20))) -;; (test (MagickWriteImage morph "~/tmp/x.gif")) -;; (MagickAnimateImages morph) +;; ===== Enumeration Types ==================================================== -;; (let ([x (test (MagickWriteImageBlob w))]) -;; (with-output-to-file "~/tmp/x" (lambda () (display x)) 'truncate) -;; (let ([ww (NewMagickWand)]) -;; (test (MagickReadImageBlob ww x)) -;; (MagickDisplayImage ww))) +(define _MagickExceptionType + (_enum '(UndefinedException + WarningException = 300 + ResourceLimitWarning = 300 + TypeWarning = 305 + OptionWarning = 310 + DelegateWarning = 315 + MissingDelegateWarning = 320 + CorruptImageWarning = 325 + FileOpenWarning = 330 + BlobWarning = 335 + StreamWarning = 340 + CacheWarning = 345 + CoderWarning = 350 + ModuleWarning = 355 + DrawWarning = 360 + ImageWarning = 365 + WandWarning = 370 + XServerWarning = 380 + MonitorWarning = 385 + RegistryWarning = 390 + ConfigureWarning = 395 + ErrorException = 400 + ResourceLimitError = 400 + TypeError = 405 + OptionError = 410 + DelegateError = 415 + MissingDelegateError = 420 + CorruptImageError = 425 + FileOpenError = 430 + BlobError = 435 + StreamError = 440 + CacheError = 445 + CoderError = 450 + ModuleError = 455 + DrawError = 460 + ImageError = 465 + WandError = 470 + XServerError = 480 + MonitorError = 485 + RegistryError = 490 + ConfigureError = 495 + FatalErrorException = 700 + ResourceLimitFatalError = 700 + TypeFatalError = 705 + OptionFatalError = 710 + DelegateFatalError = 715 + MissingDelegateFatalError = 720 + CorruptImageFatalError = 725 + FileOpenFatalError = 730 + BlobFatalError = 735 + StreamFatalError = 740 + CacheFatalError = 745 + CoderFatalError = 750 + ModuleFatalError = 755 + DrawFatalError = 760 + ImageFatalError = 765 + WandFatalError = 770 + XServerFatalError = 780 + MonitorFatalError = 785 + RegistryFatalError = 790 + ConfigureFatalError = 795 + ))) -;; (define w (test (NewMagickWand))) -;; (test (MagickReadImage w "~/html/images/spinlambda.gif")) -;; (test (MagickDisplayImage (test (MagickAppendImages w #f)))) -;; (test (MagickDisplayImage (MagickAverageImages w))) -;; (test (MagickDisplayImage (test (MagickDeconstructImages w)))) -;; (MagickAnimateImages w) +(define _CompositeOperator + (_enum '(UndefinedCompositeOp + NoCompositeOp + AddCompositeOp + AtopCompositeOp + BlendCompositeOp + BumpmapCompositeOp + ClearCompositeOp + ColorBurnCompositeOp + ColorDodgeCompositeOp + ColorizeCompositeOp + CopyBlackCompositeOp + CopyBlueCompositeOp + CopyCompositeOp + CopyCyanCompositeOp + CopyGreenCompositeOp + CopyMagentaCompositeOp + CopyOpacityCompositeOp + CopyRedCompositeOp + CopyYellowCompositeOp + DarkenCompositeOp + DstAtopCompositeOp + DstCompositeOp + DstInCompositeOp + DstOutCompositeOp + DstOverCompositeOp + DifferenceCompositeOp + DisplaceCompositeOp + DissolveCompositeOp + ExclusionCompositeOp + HardLightCompositeOp + HueCompositeOp + InCompositeOp + LightenCompositeOp + LuminizeCompositeOp + MinusCompositeOp + ModulateCompositeOp + MultiplyCompositeOp + OutCompositeOp + OverCompositeOp + OverlayCompositeOp + PlusCompositeOp + ReplaceCompositeOp + SaturateCompositeOp + ScreenCompositeOp + SoftLightCompositeOp + SrcAtopCompositeOp + SrcCompositeOp + SrcInCompositeOp + SrcOutCompositeOp + SrcOverCompositeOp + SubtractCompositeOp + ThresholdCompositeOp + XorCompositeOp + ))) -;; (let ([y (NewPixelWand "yellow")] -;; [c (test (PixelGetQuantumColor "yellow"))] -;; [r (NewPixelWand "red")] -;; [rgb (lambda (p) -;; (map (lambda (f) (f p)) -;; (list PixelGetRedQuantum -;; PixelGetGreenQuantum -;; PixelGetBlueQuantum)))]) -;; (printf ">>> y = ~s\n" (rgb y)) -;; (printf ">>> r1 = ~s\n" (rgb r)) -;; (PixelSetQuantumColor r c) -;; (printf ">>> r2 = ~s\n" (rgb r))) +(define _ColorspaceType + (_enum '(UndefinedColorspace + RGBColorspace + GRAYColorspace + TransparentColorspace + OHTAColorspace + LABColorspace + XYZColorspace + YCbCrColorspace + YCCColorspace + YIQColorspace + YPbPrColorspace + YUVColorspace + CMYKColorspace + sRGBColorspace + HSBColorspace + HSLColorspace + HWBColorspace + ))) -;; (define i (test (NewPixelRegionIterator w 0 0 10 10))) -;; (test (PixelSetIteratorRow i 5)) -;; (test (map PixelGetRedQuantum (PixelGetNextRow i))) -;; (test (map PixelGetRedQuantum (PixelGetNextRow i))) -;; (test (map PixelGetRedQuantum (PixelGetNextRow i))) +(define _CompressionType + (_enum '(UndefinedCompression + NoCompression + BZipCompression + FaxCompression + Group4Compression + JPEGCompression + LosslessJPEGCompression + LZWCompression + RLECompression + ZipCompression + ))) -(define d (test (NewDrawingWand))) -;; (test (DrawGetTextEncoding d)) -;; (test (MagickQueryFonts "Cou*")) -(test (DrawSetFont d "Courier-Bold")) -(test (DrawGetFont d)) -(test (DrawSetFontSize d 96.0)) -(test (DrawSetFontStretch d 'UltraCondensedStretch)) -(test (DrawSetFontStyle d 'ObliqueStyle)) -(test (DrawSetFontWeight d 24)) -(test (DrawSetGravity d 'CenterGravity)) -(test (DrawGetStrokeDashArray d)) -(test (DrawSetStrokeDashArray d '(20.0 20.0))) -(test (DrawGetStrokeDashArray d)) -(test (DrawSetStrokeColor d "red")) -(test (DrawSetStrokeAntialias d #t)) -(test (DrawSetStrokeWidth d 5.0)) -(test (DrawSetStrokeLineCap d 'RoundCap)) -(test (DrawSetStrokeOpacity d 0.5)) -;; (test (DrawLine d 0.0 0.0 200.0 200.0)) -(define line '((10.0 10.0) (100.0 100.0) (100.0 10.0) (50.0 20.0))) -;; (test (DrawPolyline d line)) -;; (test (DrawPolygon d line)) -;; (test (DrawBezier d line)) -;; (test (DrawLine d 0.0 0.0 100.0 100.0)) -;; (test (DrawLine d 5.0 0.0 105.0 100.0)) -;; (test (DrawLine d 10.0 0.0 110.0 100.0)) -(test (DrawAffine d '(0.0 1.0 1.0 0.5 0.0 0.0))) -(test (DrawAnnotation d 0.0 0.0 "FOO")) -;; (test (DrawArc d 0.0 0.0 100.0 100.0 0.0 270.0)) -;; (test (DrawCircle d 50.0 50.0 50.0 0.0)) -(test (MagickDrawImage w d)) -(test (MagickDisplayImage w)) +(define _DisposeType + (_enum '(UnrecognizedDispose + UndefinedDispose = 0 + NoneDispose = 1 + BackgroundDispose = 2 + PreviousDispose = 3 + ))) + +(define _ImageType + (_enum '(UndefinedType + BilevelType + GrayscaleType + GrayscaleMatteType + PaletteType + PaletteMatteType + TrueColorType + TrueColorMatteType + ColorSeparationType + ColorSeparationMatteType + OptimizeType + ))) + +(define _InterlaceType + (_enum '(UndefinedInterlace + NoInterlace + LineInterlace + PlaneInterlace + PartitionInterlace + ))) + +(define _ChannelType + (_bitmask '(UndefinedChannel = #x0000 + RedChannel = #x0001 + CyanChannel = #x0001 + GreenChannel = #x0002 + MagentaChannel = #x0002 + BlueChannel = #x0004 + YellowChannel = #x0004 + AlphaChannel = #x0008 + OpacityChannel = #x0008 + MatteChannel = #x0008 ; deprecated + BlackChannel = #x0020 + IndexChannel = #x0020 + AllChannels = #x7fffffff + ))) + +(define _MetricType + (_enum '(UndefinedMetric + MeanAbsoluteErrorMetric + MeanSquaredErrorMetric + PeakAbsoluteErrorMetric + PeakSignalToNoiseRatioMetric + RootMeanSquaredErrorMetric + ))) + +(define _NoiseType + (_enum '(UndefinedNoise + UniformNoise + GaussianNoise + MultiplicativeGaussianNoise + ImpulseNoise + LaplacianNoise + PoissonNoise + ))) + +(define _MagickEvaluateOperator + (_enum '(UndefinedEvaluateOperator + AddEvaluateOperator + AndEvaluateOperator + DivideEvaluateOperator + LeftShiftEvaluateOperator + MaxEvaluateOperator + MinEvaluateOperator + MultiplyEvaluateOperator + OrEvaluateOperator + RightShiftEvaluateOperator + SetEvaluateOperator + SubtractEvaluateOperator + XorEvaluateOperator + ))) + +(define _ResourceType + (_enum '(UndefinedResource + AreaResource + DiskResource + FileResource + MapResource + MemoryResource + ))) + +(define _StorageType + (_enum '(UndefinedPixel + CharPixel + ShortPixel + IntegerPixel + LongPixel + FloatPixel + DoublePixel + ))) + +(define _RenderingIntent + (_enum '(UndefinedIntent + SaturationIntent + PerceptualIntent + AbsoluteIntent + RelativeIntent + ))) + +(define _ResolutionType + (_enum '(UndefinedResolution + PixelsPerInchResolution + PixelsPerCentimeterResolution + ))) + +(define _VirtualPixelMethod + (_enum '(UndefinedVirtualPixelMethod + ConstantVirtualPixelMethod + EdgeVirtualPixelMethod + MirrorVirtualPixelMethod + TileVirtualPixelMethod + ))) + +(define _PreviewType + (_enum '(UndefinedPreview + RotatePreview + ShearPreview + RollPreview + HuePreview + SaturationPreview + BrightnessPreview + GammaPreview + SpiffPreview + DullPreview + GrayscalePreview + QuantizePreview + DespecklePreview + ReduceNoisePreview + AddNoisePreview + SharpenPreview + BlurPreview + ThresholdPreview + EdgeDetectPreview + SpreadPreview + SolarizePreview + ShadePreview + RaisePreview + SegmentPreview + SwirlPreview + ImplodePreview + WavePreview + OilPaintPreview + CharcoalDrawingPreview + JPEGPreview + ))) + +(define _FilterTypes + (_enum '(UndefinedFilter + PointFilter + BoxFilter + TriangleFilter + HermiteFilter + HanningFilter + HammingFilter + BlackmanFilter + GaussianFilter + QuadraticFilter + CubicFilter + CatromFilter + MitchellFilter + LanczosFilter + BesselFilter + SincFilter + ))) + +(define _MontageMode + (_enum '(UndefinedMode + FrameMode + UnframeMode + ConcatenateMode + ))) + +(define _StretchType + (_enum '(UndefinedStretch + NormalStretch + UltraCondensedStretch + ExtraCondensedStretch + CondensedStretch + SemiCondensedStretch + SemiExpandedStretch + ExpandedStretch + ExtraExpandedStretch + UltraExpandedStretch + AnyStretch + ))) + +(define _StyleType + (_enum '(UndefinedStyle + NormalStyle + ItalicStyle + ObliqueStyle + AnyStyle + ))) + +(define _GravityType + (_enum '(UndefinedGravity + ForgetGravity = 0 + NorthWestGravity = 1 + NorthGravity = 2 + NorthEastGravity = 3 + WestGravity = 4 + CenterGravity = 5 + EastGravity = 6 + SouthWestGravity = 7 + SouthGravity = 8 + SouthEastGravity = 9 + StaticGravity = 10 + ))) + +(define _ClipPathUnits + (_enum '(UndefinedPathUnits + UserSpace + UserSpaceOnUse + ObjectBoundingBox + ))) + +(define _DecorationType + (_enum '(UndefinedDecoration + NoDecoration + UnderlineDecoration + OverlineDecoration + LineThroughDecoration + ))) + +(define _FillRule + (_enum '(UndefinedRule + EvenOddRule + NonZeroRule + ))) + +(define _LineCap + (_enum '(UndefinedCap + ButtCap + RoundCap + SquareCap + ))) + +(define _LineJoin + (_enum '(UndefinedJoin + MiterJoin + RoundJoin + BevelJoin + ))) + +(define _PaintMethod + (_enum '(UndefinedMethod + PointMethod + ReplaceMethod + FloodfillMethod + FillToBorderMethod + ResetMethod + ))) + +;; ===== MagickWand API ======================================================= + +;; MagickGetException returns the severity, reason, and description of any +;; error that occurs when using other methods in this API (as an exception). +(defmagick* MagickGetException : + _MagickWand (severity : (_ptr o _MagickExceptionType)) -> (message : _string) + -> (unless (eq? severity 'UndefinedException) + (error 'MagickWand "(~a) ~a" severity message))) + +;; DestroyMagickWand deallocates memory associated with an MagickWand. +;; Intended for internal use only, must be defined after the above. +(defmagick DestroyMagickWand : + _MagickWand -> _void) + +;; CloneMagickWand makes an exact copy of the specified wand. +(defmagick* CloneMagickWand : + _MagickWand -> _MagickWand) + +;; GetImageFromMagickWand returns the current image from the magick wand. +(defmagick* GetImageFromMagickWand : + _MagickWand -> _Image) + +;; MagickAdaptiveThresholdImage selects an individual threshold for each pixel +;; based on the range of intensity values in its local neighborhood. This +;; allows for thresholding of an image whose global intensity histogram doesn't +;; contain distinctive peaks. +(defmagick* MagickAdaptiveThresholdImage : + _MagickWand (width : _ulong) (height : _ulong) (offset : _long) -> _status) + +;; MagickAddImage adds the specified images at the current image location. +(defmagick* MagickAddImage : + _MagickWand (insert-wand : _MagickWand) -> _status) + +;; MagickAddNoiseImage adds random noise to the image. +(defmagick* MagickAddNoiseImage : + _MagickWand _NoiseType -> _status) + +;; MagickAffineTransformImage transforms an image as dictated by the affine +;; matrix of the drawing wand. +(defmagick* MagickAffineTransformImage : + _MagickWand _DrawingWand -> _status) + +;; MagickAnimateImages animates an image or image sequence. +(defmagick* MagickAnimateImages : + (w . server) :: + (w : _MagickWand) (_string = (and (pair? server) (car server))) -> _status) + +;; MagickAnnotateImage annotates an image with text. +(defmagick* MagickAnnotateImage : + _MagickWand _DrawingWand + (x : _double*) (y : _double*) (angle : _double*) (text : _string) + -> _status) + +;; MagickAppendImages append a set of images. +(defmagick* MagickAppendImages : + _MagickWand (top-to-bottom? : _bool) -> _MagickWand) + +;; MagickAverageImages average a set of images. +(defmagick* MagickAverageImages : + _MagickWand -> _MagickWand) + +;; MagickBlackThresholdImage is like MagickThresholdImage but forces all pixels +;; below the threshold into black while leaving all pixels above the threshold +;; unchanged. +(defmagick* MagickBlackThresholdImage : + _MagickWand _PixelWand -> _status) + +;; MagickBlurImage blurs an image. We convolve the image with a gaussian +;; operator of the given radius and standard deviation (sigma). For reasonable +;; results, the radius should be larger than sigma. Use a radius of 0 and +;; MagickBlurImage selects a suitable radius for you. +(defmagick* MagickBlurImage : + _MagickWand (radius : _double*) (sigma : _double*) -> _status) + +;; MagickBlurImageChannel blurs one or more image channels. We convolve the +;; image cnannel with a gaussian operator of the given radius and standard +;; deviation (sigma). For reasonable results, the radius should be larger than +;; sigma. Use a radius of 0 and MagickBlurImageChannel selects a suitable +;; radius for you. +(defmagick* MagickBlurImageChannel : + _MagickWand _ChannelType (radius : _double*) (sigma : _double*) -> _status) + +;; MagickBorderImage surrounds the image with a border of the color defined by +;; the bordercolor pixel wand. +(defmagick* MagickBorderImage : + _MagickWand (border : _PixelWand) (width : _ulong) (height : _ulong) + -> _status) + +;; MagickCharcoalImage simulates a charcoal drawing. +(defmagick* MagickCharcoalImage : + _MagickWand (radius : _double*) (sigma : _double*) -> _status) + +;; MagickChopImage removes a region of an image and collapses the image to +;; occupy the removed portion. +(defmagick* MagickChopImage : + _MagickWand (width : _ulong) (height : _ulong) (x : _long) (y : _long) + -> _status) + +;; MagickClipImage clips along the first path from the 8BIM profile, if +;; present. +(defmagick* MagickClipImage : + _MagickWand -> _status) + +;; MagickClipPathImage clips along the named paths from the 8BIM profile, if +;; present. Later operations take effect inside the path. Id may be a number +;; if preceded with #, to work on a numbered path, e.g., "#1" to use the first +;; path. If inside? is non-zero, later operations take effect inside clipping +;; path. Otherwise later operations take effect outside clipping path. +(defmagick* MagickClipPathImage : + _MagickWand (name : _string) (inside? : _bool) -> _status) + +;; MagickCoalesceImages composites a set of images while respecting any page +;; offsets and disposal methods. GIF, MIFF, and MNG animation sequences +;; typically start with an image background and each subsequent image varies in +;; size and offset. MagickCoalesceImages returns a new sequence where each +;; image in the sequence is the same size as the first and composited with the +;; next image in the sequence. +(defmagick* MagickCoalesceImages : + _MagickWand -> _MagickWand) + +;; MagickColorFloodfillImage changes the color value of any pixel that matches +;; target and is an immediate neighbor. If the method FillToBorderMethod is +;; specified, the color value is changed for any neighbor pixel that does not +;; match the bordercolor member of image. +(defmagick* MagickColorFloodfillImage : + _MagickWand (fill : _PixelWand) (fuzz : _double*) (border : _PixelWand) + (x : _long) (y : _long) + -> _status) + +;; MagickColorizeImage blends the fill color with each pixel in the image. +(defmagick* MagickColorizeImage : + _MagickWand (colorize : _PixelWand) (opacity : _PixelWand) -> _status) + +;; MagickCombineImages combines one or more images into a single image. The +;; grayscale value of the pixels of each image in the sequence is assigned in +;; order to the specified hannels of the combined image. The typical ordering +;; would be image 1 => Red, 2 => Green, 3 => Blue, etc. +(defmagick* MagickCombineImages : + _MagickWand _ChannelType -> _MagickWand) + +;; MagickCommentImage adds a comment to your image. +(defmagick* MagickCommentImage : + _MagickWand (comment : _string) -> _status) + +;; MagickCompareImageChannels compares one or more image channels and returns +;; the specified distortion metric. +(defmagick* MagickCompareImageChannels : + _MagickWand (reference : _MagickWand) + _ChannelType _MetricType (distortion : (_ptr o _double*)) + -> (comp : _MagickWand) + -> (list distortion comp)) + +;; MagickCompositeImage composite one image onto another at the specified +;; offset. +(defmagick* MagickCompositeImage : + _MagickWand (composite : _MagickWand) _CompositeOperator + (x-offset : _long) (y-offset : _long) + -> _status) + +;; MagickContrastImage enhances the intensity differences between the lighter +;; and darker elements of the image. Set sharpen? to a value other than 0 to +;; increase the image contrast otherwise the contrast is reduced. +(defmagick* MagickContrastImage : + _MagickWand (sharpen? : _bool) -> _status) + +;; MagickConvolveImage applies a custom convolution kernel to the image. +(defmagick* MagickConvolveImage : + (w kernel) :: + (w : _MagickWand) + (_ulong = (length kernel)) (kernel : (_sqmatrix-of _double*)) + -> _status) + +;; MagickConvolveImageChannel applies a custom convolution kernel to one or +;; more image channels. +(defmagick* MagickConvolveImageChannel : + (w channels kernel) :: + (w : _MagickWand) (channels : _ChannelType) + (_ulong = (length kernel)) (kernel : (_sqmatrix-of _double*)) + -> _status) + +;; MagickCropImage extracts a region of the image. +(defmagick* MagickCropImage : + _MagickWand (width : _ulong) (height : _ulong) (x : _long) (y : _long) + -> _status) + +;; MagickCycleColormapImage displaces an image's colormap by a given number of +;; positions. If you cycle the colormap a number of times you can produce a +;; psychodelic effect. +(defmagick* MagickCycleColormapImage : + _MagickWand (displace : _long) -> _status) + +;; MagickDeconstructImages compares each image with the next in a sequence and +;; returns the maximum bounding region of any pixel differences it discovers. +(defmagick* MagickDeconstructImages : + _MagickWand -> _MagickWand) + +;; MagickDescribeImage describes an image by printing its attributes to the +;; file. Attributes include the image width, height, size, and others. +(defmagick* MagickDescribeImage : + _MagickWand -> _string) + +;; MagickDespeckleImage reduces the speckle noise in an image while perserving +;; the edges of the original image. +(defmagick* MagickDespeckleImage : + _MagickWand -> _status) + +;; MagickDisplayImage displays an image. +(defmagick* MagickDisplayImage : + (w . server) :: + (w : _MagickWand) (_string = (and (pair? server) (car server))) -> _status) + +;; MagickDisplayImages displays an image or image sequence. +(defmagick* MagickDisplayImages : + (w . server) :: + (w : _MagickWand) (_string = (and (pair? server) (car server))) -> _status) + +;; MagickDrawImage draw an image the specified number of degrees. +(defmagick* MagickDrawImage : + _MagickWand _DrawingWand -> _status) + +;; MagickEdgeImage enhance edges within the image with a convolution filter of +;; the given radius. Use a radius of 0 and MagickEdgeImage selects a +;; suitable radius for you. +(defmagick* MagickEdgeImage : + _MagickWand (radius : _double*) -> _status) + +;; MagickEmbossImage returns a grayscale image with a three-dimensional effect. +;; We convolve the image with a Gaussian operator of the given radius and +;; standard deviation (sigma). For reasonable results, radius should be larger +;; than sigma. Use a radius of 0 and MagickEmbossImage selects a suitable +;; radius for you. +(defmagick* MagickEmbossImage : + _MagickWand (radius : _double*) (sigma : _double*) -> _status) + +;; MagickEnhanceImage applies a digital filter that improves the quality of a +;; noisy image. +(defmagick* MagickEnhanceImage : + _MagickWand -> _status) + +;; MagickEqualizeImage equalizes the image histogram. +(defmagick* MagickEqualizeImage : + _MagickWand -> _status) + +;; Use MagickEvaluateImage to apply an arithmetic, relational, or logical +;; operator to an image. These operations can be used to lighten or darken an +;; image, to increase or decrease contrast in an image, or to produce the +;; "negative" of an image. +(defmagick* MagickEvaluateImage : + _MagickWand _MagickEvaluateOperator (const : _double*) -> _status) + +;; Use MagickEvaluateImageChannel to apply an arithmetic, relational, or +;; logical operator to an image. These operations can be used to lighten or +;; darken an image, to increase or decrease contrast in an image, or to produce +;; the "negative" of an image. +(defmagick* MagickEvaluateImageChannel : + _MagickWand _ChannelType _MagickEvaluateOperator (const : _double*) + -> _status) + +;; MagickFlattenImages merges a sequence of images. This is useful for +;; combining Photoshop layers into a single image. +(defmagick* MagickFlattenImages : + _MagickWand -> _MagickWand) + +;; MagickFlipImage creates a vertical mirror image by reflecting the pixels +;; around the central x-axis. +(defmagick* MagickFlipImage : + _MagickWand -> _status) + +;; MagickFlopImage creates a horizontal mirror image by reflecting the pixels +;; around the central y-axis. +(defmagick* MagickFlopImage : + _MagickWand -> _status) + +;; MagickFrameImage adds a simulated three-dimensional border around the image. +;; The width and height specify the border width of the vertical and horizontal +;; sides of the frame. The inner and outer bevels indicate the width of the +;; inner and outer shadows of the frame. +(defmagick* MagickFrameImage : + _MagickWand (matte : _PixelWand) + (width : _ulong) (height : _ulong) + (inner-bevel : _long) (outer-bevel : _long) + -> _status) + +;; MagickFxImage evaluate expression for each pixel in the image. +(defmagick* MagickFxImage : + _MagickWand (expr : _string) -> _MagickWand) + +;; MagickFxImageChannel evaluate expression for each pixel in the specified +;; channel. +(defmagick* MagickFxImageChannel : + _MagickWand _ChannelType (expr : _string) -> _MagickWand) + +;; Use MagickGammaImage to gamma-correct an image. The same image viewed on +;; different devices will have perceptual differences in the way the image's +;; intensities are represented on the screen. Specify individual gamma levels +;; for the red, green, and blue channels, or adjust all three with the gamma +;; parameter. Values typically range from 0.8 to 2.3. You can also reduce the +;; influence of a particular channel with a gamma value of 0. +(defmagick* MagickGammaImage : + _MagickWand (gamma : _double*) -> _status) + +;; Use MagickGammaImageChannel to gamma-correct a particular image channel. +;; The same image viewed on different devices will have perceptual differences +;; in the way the image's intensities are represented on the screen. Specify +;; individual gamma levels for the red, green, and blue channels, or adjust all +;; three with the gamma parameter. Values typically range from 0.8 to 2.3. +(defmagick* MagickGammaImageChannel : + _MagickWand _ChannelType (gamma : _double*) -> _status) + +;; MagickGaussianBlurImage blurs an image. We convolve the image with a +;; Gaussian operator of the given radius and standard deviation (sigma). For +;; reasonable results, the radius should be larger than sigma. Use a radius of +;; 0 and MagickGaussianBlurImage selects a suitable radius for you. +(defmagick* MagickGaussianBlurImage : + _MagickWand (radius : _double*) (sigma : _double*) -> _status) + +;; MagickGaussianBlurImageChannel blurs one or more image channels. We +;; convolve the image cnannel with a Gaussian operator of the given radius and +;; standard deviation (sigma). For reasonable results, the radius should be +;; larger than sigma. Use a radius of 0 and MagickGaussianBlurImageChannel +;; selects a suitable radius for you. +(defmagick* MagickGaussianBlurImageChannel : + _MagickWand _ChannelType (radius : _double*) (sigma : _double*) -> _status) + +;; MagickGetCopyright returns the ImageMagick API copyright as a string. +(defmagick* MagickGetCopyright : + -> _string) + +;; MagickGetFilename returns the filename associated with an image sequence. +(defmagick* MagickGetFilename : + _MagickWand -> _file) + +;; MagickGetHomeURL returns the ImageMagick home URL. +(defmagick* MagickGetHomeURL : + -> _string) + +;; MagickGetImage gets the image at the current image index. +(defmagick* MagickGetImage : + _MagickWand -> _MagickWand) + +;; MagickGetImageBackgroundColor returns the image background color. +(defmagick* MagickGetImageBackgroundColor : + _MagickWand (c : _PixelWand = (NewPixelWand)) -> _status -> c) + +;; MagickGetImageBluePrimary returns the chromaticy blue primary point for the +;; image. +(defmagick* MagickGetImageBluePrimary : + _MagickWand (x : (_ptr o _double*)) (y : (_ptr o _double*)) -> _status + -> (list x y)) + +;; MagickGetImageBorderColor returns the image border color. +(defmagick* MagickGetImageBorderColor : + _MagickWand (c : _PixelWand = (NewPixelWand)) -> _status -> c) + +;; MagickGetImageChannelDepth gets the depth for a particular image channel. +(defmagick* MagickGetImageChannelDepth : + _MagickWand _ChannelType -> _ulong) + +;; MagickGetImageChannelExtrema gets the extrema for one or more image +;; channels. +(defmagick* MagickGetImageChannelExtrema : + _MagickWand _ChannelType (min : (_ptr o _ulong)) (max : (_ptr o _ulong)) + -> _status + -> (list min max)) + +;; MagickGetImageChannelMean gets the mean and standard deviation of one or +;; more image channels. +(defmagick* MagickGetImageChannelMean : + _MagickWand _ChannelType + (mean : (_ptr o _double*)) (standard-deviation : (_ptr o _double*)) + -> _status + -> (list mean standard-deviation)) + +;; MagickGetImageColormapColor returns the color of the specified colormap +;; index. +(defmagick* MagickGetImageColormapColor : + _MagickWand (colormap-index : _ulong) (c : _PixelWand = (NewPixelWand)) + -> _status -> c) + +;; MagickGetImageColors gets the number of unique colors in the image. +(defmagick* MagickGetImageColors : + _MagickWand -> _ulong) + +;; MagickGetImageColorspace gets the image colorspace. +(defmagick* MagickGetImageColorspace : + _MagickWand -> _ColorspaceType) + +;; MagickGetImageCompose returns the composite operator associated with the +;; image. +(defmagick* MagickGetImageCompose : + _MagickWand -> _CompositeOperator) + +;; MagickGetImageCompression gets the image compression. +(defmagick* MagickGetImageCompression : + _MagickWand -> _CompressionType) + +;; MagickGetImageCompressionQuality gets the image compression quality. +(defmagick* MagickGetImageCompressionQuality : + _MagickWand -> _ulong) + +;; MagickGetImageDelay gets the image delay. +(defmagick* MagickGetImageDelay : + _MagickWand -> _ulong) + +;; MagickGetImageDepth gets the image depth. +(defmagick* MagickGetImageDepth : + _MagickWand -> _ulong) + +;; MagickGetImageDispose gets the image disposal method. +(defmagick* MagickGetImageDispose : + _MagickWand -> _DisposeType) + +;; MagickGetImageExtrema gets the extrema for the image. +(defmagick* MagickGetImageExtrema : + _MagickWand (min : (_ptr o _ulong)) (max : (_ptr o _ulong)) -> _status + -> (list min max)) + +;; MagickGetImageFilename returns the filename of a particular image in a +;; sequence. +(defmagick* MagickGetImageFilename : + _MagickWand -> _string) + +;; MagickGetImageFormat returns the format of a particular image in a sequence. +(defmagick* MagickGetImageFormat : + _MagickWand -> _string) + +;; MagickGetImageGamma gets the image gamma. +(defmagick* MagickGetImageGamma : + _MagickWand -> _double*) + +;; MagickGetImageGreenPrimary returns the chromaticy green primary point. +(defmagick* MagickGetImageGreenPrimary : + _MagickWand (x : (_ptr o _double*)) (y : (_ptr o _double*)) -> _status + -> (list x y)) + +;; MagickGetImageHeight returns the image height. +(defmagick* MagickGetImageHeight : + _MagickWand -> _ulong) + +;; MagickGetImageHistogram returns the image histogram as an array of PixelWand +;; wands. +(defmagick* MagickGetImageHistogram : + _MagickWand (len : (_ptr o _ulong)) -> (_list o _PixelWand len)) + +;; MagickGetImageIndex returns the index of the current image. +(defmagick* MagickGetImageIndex : + _MagickWand -> _long) + +;; MagickGetImageInterlaceScheme gets the image interlace scheme. +(defmagick* MagickGetImageInterlaceScheme : + _MagickWand -> _InterlaceType) + +;; MagickGetImageIterations gets the image iterations. +(defmagick* MagickGetImageIterations : + _MagickWand -> _ulong) + +;; MagickGetImageMatteColor returns the image matte color. +(defmagick* MagickGetImageMatteColor : + _MagickWand (c : _PixelWand = (NewPixelWand)) -> _status -> c) + +;; MagickGetImagePixels extracts pixel data from an image and returns it to +;; you. The method returns False on success otherwise True if an error is +;; encountered. The data is returned as char, short int, int, long, float, or +;; double in the order specified by map. Suppose you want to extract the first +;; scanline of a 640x480 image as character data in red-green-blue order: +;; (MagickGetImagePixels wand 0 0 640 1 "RGB" 'CharPixel) +;; `map' is a string that reflects the expected ordering of the pixel array. +;; It can be any combination or order of R = red, G = green, B = blue, +;; A = alpha (0 is transparent), O = opacity (0 is opaque), C = cyan, +;; Y = yellow, M = magenta, K = black, I = intensity (for grayscale), P = pad. +;; Note: the scheme interface uses a list of rows, each a list of values for +;; each element in the map. +(defmagick* MagickGetImagePixels : + _MagickWand (x : _long) (y : _long) (width : _ulong) (height : _ulong) + (map : _string) (storage-type : _StorageType) + ;; create the block, remember size and type + (size : _? = (* width height (string-length map))) + (type : _? = (StorageType->type storage-type)) + (block : _pointer = (malloc size type)) + -> _status + -> (let loop ([n (sub1 size)] [r '()]) + (if (< n 0) + (n-split (n-split r (string-length map)) width) + (loop (sub1 n) (cons (ptr-ref block type n) r))))) + +;; MagickGetImageProfile returns the named image profile. +(defmagick* MagickGetImageProfile : + _MagickWand (profile-name : _string) (len : (_ptr o _ulong)) + -> (_bytes o len)) + +;; MagickGetImageRedPrimary returns the chromaticy red primary point. +(defmagick* MagickGetImageRedPrimary : + _MagickWand (x : (_ptr o _double*)) (y : (_ptr o _double*)) -> _status + -> (list x y)) + +;; MagickGetImageRenderingIntent gets the image rendering intent. +(defmagick* MagickGetImageRenderingIntent : + _MagickWand -> _RenderingIntent) + +;; MagickGetImageSignature generates an SHA-256 message digest for the image +;; pixel stream. +(defmagick* MagickGetImageSignature : + _MagickWand -> _string) + +;; MagickGetImageSize returns the image size. +(defmagick* MagickGetImageSize : + _MagickWand -> _MagickSizeType) + +;; MagickGetImageType gets the image type. +(defmagick* MagickGetImageType : + _MagickWand -> _ImageType) + +;; MagickGetImageUnits gets the image units of resolution. +(defmagick* MagickGetImageUnits : + _MagickWand -> _ResolutionType) + +;; MagickGetImageVirtualPixelMethod returns the virtual pixel method for the +;; sepcified image. +(defmagick* MagickGetImageVirtualPixelMethod : + _MagickWand -> _VirtualPixelMethod) + +;; MagickGetImageWhitePoint returns the chromaticy white point. +(defmagick* MagickGetImageWhitePoint : + _MagickWand (x : (_ptr o _double*)) (y : (_ptr o _double*)) -> _status + -> (list x y)) + +;; MagickGetImageWidth returns the image width. +(defmagick* MagickGetImageWidth : + _MagickWand -> _ulong) + +;; MagickGetImageResolution gets the image X & Y resolution. +(defmagick* MagickGetImageResolution : + _MagickWand (res-x : (_ptr o _double*)) (res-y : (_ptr o _double*)) + -> _status + -> (list res-x res-y)) + +;; MagickGetNumberImages returns the number of images associated with a magick +;; wand. +(defmagick* MagickGetNumberImages : + _MagickWand -> _ulong) + +;; MagickGetPackageName returns the ImageMagick package name. +(defmagick* MagickGetPackageName : + -> _string) + +;; MagickGetQuantumDepth returns the ImageMagick quantum depth. +(defmagick* MagickGetQuantumDepth : + (q : (_ptr o _ulong)) -> _string -> q) + +;; MagickGetReleaseDate returns the ImageMagick release date. +(defmagick* MagickGetReleaseDate : + -> _string) + +;; MagickGetResourceLimit returns the specified resource in megabytes. +(defmagick* MagickGetResourceLimit : + _ResourceType -> _ulong) + +;; MagickGetSamplingFactors gets the horizontal and vertical sampling factor. +(defmagick* MagickGetSamplingFactors : + _MagickWand (len : (_ptr o _ulong)) -> (_list o _double* len)) + +;; MagickGetSize returns the size associated with the magick wand. +(defmagick* MagickGetSize : + _MagickWand (width : (_ptr o _ulong)) (height : (_ptr o _ulong)) -> _status + -> (list width height)) + +;; MagickGetVersion returns the ImageMagick API version as a string and as a +;; number. +(defmagick* MagickGetVersion : + (v : (_ptr o _ulong)) -> (s : _string) -> (list v s)) + +;; MagickHasNextImage returns True if the wand has more images when traversing +;; the list in the forward direction +(defmagick* MagickHasNextImage : + _MagickWand -> _bool) + +;; MagickHasPreviousImage returns True if the wand has more images when +;; traversing the list in the reverse direction +(defmagick* MagickHasPreviousImage : + _MagickWand -> _bool) + +;; MagickImplodeImage creates a new image that is a copy of an existing one +;; with the image pixels "implode" by the specified percentage. +(defmagick* MagickImplodeImage : + _MagickWand (amount : _double*) -> _status) + +;; MagickLabelImage adds a label to your image. +(defmagick* MagickLabelImage : + _MagickWand (label : _string) -> _status) + +;; MagickLevelImage adjusts the levels of an image by scaling the colors +;; falling between specified white and black points to the full available +;; quantum range. The parameters provided represent the black, mid, and white +;; points. The black point specifies the darkest color in the image. Colors +;; darker than the black point are set to zero. Mid point specifies a gamma +;; correction to apply to the image. White point specifies the lightest color +;; in the image. Colors brighter than the white point are set to the maximum +;; quantum value. +(defmagick* MagickLevelImage : + _MagickWand + (black-point : _double*) (gamma : _double*) (white-point : _double*) + -> _status) + +;; MagickLevelImageChannel adjusts the levels of the specified channel of the +;; reference image by scaling the colors falling between specified white and +;; black points to the full available quantum range. The parameters provided +;; represent the black, mid, and white points. The black point specifies the +;; darkest color in the image. Colors darker than the black point are set to +;; zero. Mid point specifies a gamma correction to apply to the image. White +;; point specifies the lightest color in the image. Colors brighter than the +;; white point are set to the maximum quantum value. +(defmagick* MagickLevelImageChannel : + _MagickWand _ChannelType + (black-point : _double*) (gamma : _double*) (white-point : _double*) + -> _status) + +;; MagickMagnifyImage is a convenience method that scales an image +;; proportionally to twice its original size. +(defmagick* MagickMagnifyImage : + _MagickWand -> _status) + +;; MagickMapImage replaces the colors of an image with the closest color from a +;; reference image. +(defmagick* MagickMapImage : + _MagickWand (mapping : _MagickWand) (dither? : _bool) -> _status) + +;; MagickMatteFloodfillImage changes the transparency value of any pixel that +;; matches target and is an immediate neighbor. If the method +;; FillToBorderMethod is specified, the transparency value is changed for any +;; neighbor pixel that does not match the bordercolor member of image. +(defmagick* MagickMatteFloodfillImage : + _MagickWand + (opacity : _Quantum) (fuzz : _double*) (border : _PixelWand) + (x : _long) (y : _long) + -> _status) + +;; MagickMedianFilterImage applies a digital filter that improves the quality +;; of a noisy image. Each pixel is replaced by the median in a set of +;; neighboring pixels as defined by radius. +(defmagick* MagickMedianFilterImage : + _MagickWand (radius : _double*) -> _status) + +;; MagickMinifyImage is a convenience method that scales an image +;; proportionally to one-half its original size +(defmagick* MagickMinifyImage : + _MagickWand -> _status) + +;; MagickModulateImage lets you control the brightness, saturation, and hue of +;; an image. +(defmagick* MagickModulateImage : + _MagickWand (brightness : _double*) (saturation : _double*) (hue : _double*) + -> _status) + +;; Use MagickMontageImage to create a composite image by combining several +;; separate images. The images are tiled on the composite image with the name +;; of the image optionally appearing just below the individual tile. +(defmagick* MagickMontageImage : + _MagickWand _DrawingWand + (tile-geometry : _string) (thumbnail-geometry : _string) + _MontageMode (frame-geometry : _string) -> _MagickWand) + +;; MagickMorphImages method morphs a set of images. Both the image pixels and +;; size are linearly interpolated to give the appearance of a meta-morphosis +;; from one image to the next. +(defmagick* MagickMorphImages : + _MagickWand (num-of-frames : _ulong) -> _MagickWand) + +;; MagickMosaicImages inlays an image sequence to form a single coherent +;; picture. It returns a wand with each image in the sequence composited at +;; the location defined by the page offset of the image. +(defmagick* MagickMosaicImages : + _MagickWand -> _MagickWand) + +;; MagickMotionBlurImage simulates motion blur. We convolve the image with a +;; Gaussian operator of the given radius and standard deviation (sigma). For +;; reasonable results, radius should be larger than sigma. Use a radius of 0 +;; and MagickMotionBlurImage selects a suitable radius for you. Angle gives +;; the angle of the blurring motion. +(defmagick* MagickMotionBlurImage : + _MagickWand (radius : _double*) (sigma : _double*) (angle : _double*) + -> _status) + +;; MagickNegateImage negates the colors in the reference image. The Grayscale +;; option means that only grayscale values within the image are negated. +(defmagick* MagickNegateImage : + _MagickWand (gray? : _bool) -> _status) + +;; MagickNegateImageChannel negates the colors in the specified channel of the +;; reference image. The Grayscale option means that only grayscale values +;; within the image are negated. You can also reduce the influence of a +;; particular channel with a gamma value of 0. +(defmagick* MagickNegateImageChannel : + _MagickWand _ChannelType (gray? : _bool) -> _status) + +;; MagickNextImage associates the next image in the image list with a magick +;; wand. +(defmagick* MagickNextImage : + _MagickWand -> _status) + +;; MagickNormalizeImage enhances the contrast of a color image by adjusting the +;; pixels color to span the entire range of colors available +(defmagick* MagickNormalizeImage : + _MagickWand -> _status) + +;; MagickOilPaintImage applies a special effect filter that simulates an oil +;; painting. Each pixel is replaced by the most frequent color occurring in a +;; circular region defined by radius. +(defmagick* MagickOilPaintImage : + _MagickWand _double* -> _status) + +;; MagickOpaqueImage changes any pixel that matches color with the color +;; defined by fill. +(defmagick* MagickOpaqueImage : + _MagickWand (target : _PixelWand) (fill : _PixelWand) (fuzz : _double*) + -> _status) + +;; MagickPingImage is like MagickReadImage except the only valid information +;; returned is the image width, height, size, and format. It is designed to +;; efficiently obtain this information from a file without reading the entire +;; image sequence into memory. +(defmagick* MagickPingImage : + _MagickWand _file -> _status) + +;; MagickPosterizeImage reduces the image to a limited number of color level. +(defmagick* MagickPosterizeImage : + _MagickWand (levels : _ulong) (dither? : _bool) -> _status) + +;; MagickPreviewImages tiles 9 thumbnails of the specified image with an image +;; processing operation applied at varying strengths. This is helpful to +;; quickly pin-point an appropriate parameter for an image processing +;; operation. +(defmagick* MagickPreviewImages : + _MagickWand _PreviewType -> _MagickWand) + +;; MagickPreviousImage assocates the previous image in an image list with the +;; magick wand. +(defmagick* MagickPreviousImage : + _MagickWand -> _status) + +;; Use MagickProfileImage to add or remove a ICC, IPTC, or generic profile from +;; an image. If the profile is #f (NULL), it is removed from the image +;; otherwise added. Use a name of '*' and a profile of NULL to remove all +;; profiles from the image. +(defmagick* MagickProfileImage : + _MagickWand (profile-name : _string) + (profile : _bytes) (_ulong = (bytes-length profile)) + -> _status) + +;; MagickQuantizeImage analyzes the colors within a reference image and chooses +;; a fixed number of colors to represent the image. The goal of the algorithm +;; is to minimize the color difference between the input and output image while +;; minimizing the processing time. +(defmagick* MagickQuantizeImage : + _MagickWand (num-colors : _ulong) _ColorspaceType (tree-depth : _ulong) + (dither? : _bool) (measure-error? : _bool) + -> _status) + +;; MagickQuantizeImages analyzes the colors within a sequence of images and +;; chooses a fixed number of colors to represent the image. The goal of the +;; algorithm is to minimize the color difference between the input and output +;; image while minimizing the processing time. +(defmagick* MagickQuantizeImages : + _MagickWand + (num-colors : _ulong) _ColorspaceType (tree-depth : _ulong) + (dither? : _bool) (measure-error? : _bool) + -> _status) + +;; MagickQueryConfigureOptions returns any configure options that match the +;; specified pattern (e.g. "*" for all). Options include NAME, VERSION, +;; LIB_VERSION, etc. +(defmagick* MagickQueryConfigureOptions : + (pattern : _string) (len : (_ptr o _ulong)) -> (_list o _string len)) + +;; MagickQueryFontMetrics returns a 7 element list representing the following +;; font metrics: char-width, char-height, ascender, descender, text-width, +;; text-height, max-horizontal-advance. +(defmagick* MagickQueryFontMetrics : + _MagickWand _DrawingWand (text : _string) -> (_list o _double* 7)) + +;; MagickQueryFonts returns any font that match the specified pattern (e.g. "*" +;; for all). +(defmagick* MagickQueryFonts : + (pattern : _string) (len : (_ptr o _ulong)) -> (_list o _string len)) + +;; MagickQueryFormats returns any image formats that match the specified +;; pattern (e.g. "*" for all). +(defmagick* MagickQueryFormats : + (pattern : _string) (len : (_ptr o _ulong)) -> (_list o _string len)) + +;; MagickRadialBlurImage radial blurs an image. +(defmagick* MagickRadialBlurImage : + _MagickWand (angle : _double*) -> _status) + +;; MagickRaiseImage creates a simulated three-dimensional button-like effect by +;; lightening and darkening the edges of the image. Members width and height +;; of raise_info define the width of the vertical and horizontal edge of the +;; effect. +(defmagick* MagickRaiseImage : + _MagickWand + (width : _ulong) (height : _ulong) (x : _long) (y : _long) (raise? : _bool) + -> _status) + +;; MagickReadImage reads an image or image sequence. +;; Extended: the wand argument is optional -- will be made and returned if not +;; given. +(defmagick* MagickReadImage : + (arg . args) :: + (w : _MagickWand = (if (null? args) (NewMagickWand) arg)) + (_file = (if (null? args) arg (car args))) + -> _status + -> (if (null? args) w (void))) + +;; MagickReadImageBlob reads an image or image sequence from a blob. +(defmagick* MagickReadImageBlob : + _MagickWand (blob : _bytes) (_ulong = (bytes-length blob)) -> _status) + +;; MagickReadImageFile reads an image or image sequence from an open file +;; descriptor. +(defmagick* MagickReadImageFile : + _MagickWand (FILE* : _pointer) -> _status) + +;; MagickReduceNoiseImage smooths the contours of an image while still +;; preserving edge information. The algorithm works by replacing each pixel +;; with its neighbor closest in value. A neighbor is defined by radius. Use a +;; radius of 0 and MagickReduceNoiseImage selects a suitable radius for you. +(defmagick* MagickReduceNoiseImage : + _MagickWand (radius : _double*) -> _status) + +;; MagickRelinquishMemory relinquishes memory resources returned by such +;; methods as MagickDescribeImage, MagickGetException, etc. +;; Looks like this is not needed with a GC (tried it with the result of +;; MagickDescribeImage many times, got an error). +;; (defmagick* MagickRelinquishMemory : +;; _pointer -> _status) + +;; MagickRemoveImage removes an image from the image list. +(defmagick* MagickRemoveImage : + _MagickWand -> _status) + +;; MagickRemoveImageProfile removes the named image profile and returns it. +(defmagick* MagickRemoveImageProfile : + _MagickWand (profile-name : _string) (len : (_ptr o _ulong)) + -> (_bytes o len)) + +;; MagickResampleImage resample image to desired resolution. Most of the +;; filters are FIR (finite impulse response), however, Bessel, Gaussian, and +;; Sinc are IIR (infinite impulse response). Bessel and Sinc are windowed +;; (brought down to zero) with the Blackman filter. +(defmagick* MagickResampleImage : + _MagickWand + (x-res : _double*) (y-res : _double*) _FilterTypes (blur-factor : _double*) + -> _status) + +;; MagickResetIterator resets the wand iterator. Use it in conjunction with +;; MagickNextImage to iterate over all the images in a wand container. +(defmagick* MagickResetIterator : + _MagickWand -> _void) + +;; MagickResizeImage scales an image to the desired dimensions with some +;; filter. Most of the filters are FIR (finite impulse response), however, +;; Bessel, Gaussian, and Sinc are IIR (infinite impulse response). Bessel and +;; Sinc are windowed (brought down to zero) with the Blackman filter. +(defmagick* MagickResizeImage : + _MagickWand + (width : _ulong) (height : _ulong) _FilterTypes (blur-factor : _double*) + -> _status) + +;; MagickRollImage offsets an image as defined by x_offset and y_offset. +(defmagick* MagickRollImage : + _MagickWand (x-offset : _long) (y-offset : _long) -> _status) + +;; MagickRotateImage rotates an image the specified number of degrees. Empty +;; triangles left over from rotating the image are filled with the background +;; color. +(defmagick* MagickRotateImage : + _MagickWand (background : _PixelWand) (degrees : _double*) -> _status) + +;; MagickSampleImage scales an image to the desired dimensions with pixel +;; sampling. Unlike other scaling methods, this method does not introduce any +;; additional color into the scaled image. +(defmagick* MagickSampleImage : + _MagickWand (width : _ulong) (height : _ulong) -> _status) + +;; MagickScaleImage scales the size of an image to the given dimensions. +(defmagick* MagickScaleImage : + _MagickWand (width : _ulong) (height : _ulong) -> _status) + +;; MagickSeparateImageChannel separates a channel from the image and returns a +;; grayscale image. A channel is a particular color component of each pixel in +;; the image. +(defmagick* MagickSeparateImageChannel : + _MagickWand _ChannelType -> _status) + +;; MagickSetFilename sets the filename before you read or write an image file. +(defmagick* MagickSetFilename : + _MagickWand _file -> _status) + +;; MagickSetImage replaces the last image returned by MagickSetImageIndex, +;; MagickNextImage, MagickPreviousImage with the images from the specified +;; wand. +(defmagick* MagickSetImage : + _MagickWand (set-wand : _MagickWand) -> _status) + +;; MagickSetImageBackgroundColor sets the image background color. +(defmagick* MagickSetImageBackgroundColor : + _MagickWand (background : _PixelWand) -> _status) + +;; MagickSetImageBluePrimary sets the image chromaticity blue primary point. +(defmagick* MagickSetImageBluePrimary : + _MagickWand (x : _double*) (y : _double*) -> _status) + +;; MagickSetImageBorderColor sets the image border color. +(defmagick* MagickSetImageBorderColor : + _MagickWand (border-color : _PixelWand) -> _status) + +;; MagickSetImageChannelDepth sets the depth of a particular image channel. +(defmagick* MagickSetImageChannelDepth : + _MagickWand _ChannelType (depth : _ulong) -> _status) + +;; MagickSetImageColormapColor sets the color of the specified colormap index. +(defmagick* MagickSetImageColormapColor : + _MagickWand (index : _ulong) _PixelWand -> _status) + +;; MagickSetImageColorspace sets the image colorspace. +(defmagick* MagickSetImageColorspace : + _MagickWand _ColorspaceType -> _status) + +;; MagickSetImageCompose sets the image composite operator, useful for +;; specifying how to composite the image thumbnail when using the +;; MagickMontageImage method. +(defmagick* MagickSetImageCompose : + _MagickWand _CompositeOperator -> _status) + +;; MagickSetImageCompression sets the image compression. +(defmagick* MagickSetImageCompression : + _MagickWand _CompressionType -> _status) + +;; MagickSetImageCompressionQuality sets the image compression quality. +(defmagick* MagickSetImageCompressionQuality : + _MagickWand (quality : _ulong) -> _status) + +;; MagickSetImageDelay sets the image delay. +(defmagick* MagickSetImageDelay : + _MagickWand (delay : _ulong) -> _status) + +;; MagickSetImageDepth sets the image depth. +(defmagick* MagickSetImageDepth : + _MagickWand (depth : _ulong) -> _status) + +;; MagickSetImageDispose sets the image disposal method. +(defmagick* MagickSetImageDispose : + _MagickWand _DisposeType -> _status) + +;; MagickSetImageFilename sets the filename of a particular image in a +;; sequence. +(defmagick* MagickSetImageFilename : + _MagickWand _file -> _status) + +;; MagickSetImageGamma sets the image gamma. +(defmagick* MagickSetImageGamma : + _MagickWand (gamma : _double*) -> _status) + +;; MagickSetImageGreenPrimary sets the image chromaticity green primary point. +(defmagick* MagickSetImageGreenPrimary : + _MagickWand (y : _double*) (x : _double*) -> _status) + +;; MagickSetImageIndex replaces the last image returned by MagickSetImageIndex, +;; MagickNextImage, MagickPreviousImage with the images from the specified +;; wand. +(defmagick* MagickSetImageIndex : + _MagickWand (index : _long) -> _status) + +;; MagickSetImageInterlaceScheme sets the image interlace scheme. +(defmagick* MagickSetImageInterlaceScheme : + _MagickWand _InterlaceType -> _status) + +;; MagickSetImageIterations sets the image iterations. +(defmagick* MagickSetImageIterations : + _MagickWand (iterations : _ulong) -> _status) + +;; MagickSetImageMatteColor sets the image matte color. +(defmagick* MagickSetImageMatteColor : + _MagickWand (matte : _PixelWand) -> _status) + +;; MagickSetImageOption associates one or options with a particular image +;; format (e.g. (MagickSetImageOption wand "jpeg" "perserve" "yes")). +(defmagick* MagickSetImageOption : + _MagickWand (format : _string) (key : _string) (value : _string) -> _status) + +;; MagickSetImagePixels accepts pixel data and stores it in the image at the +;; location you specify. The method returns False on success otherwise True if +;; an error is encountered. The pixel data can be either char, short int, int, +;; long, float, or double in the order specified by map. Suppose your want +;; want to upload the first scanline of a 640x480 image from character data in +;; red-green-blue order: +;; (MagickSetImagePixels wand 0 0 640 1 "RGB" 'CharPixel pixels) +;; `map' is a string that reflects the expected ordering of the pixel array. +;; It can be any combination or order of R = red, G = green, B = blue, +;; A = alpha (0 is transparent), O = opacity (0 is opaque), C = cyan, +;; Y = yellow, M = magenta, K = black, I = intensity (for grayscale), P = pad. +;; Note: the scheme interface uses a list of rows, each a list of values for +;; each element in the map. Also, the map here should not have the type +;; character as in the MagickWand API (it is a documentation bug), and there is +;; no need for width and height too. +(defmagick* MagickSetImagePixels : + (w x y map storage-type matrix) :: + (w : _MagickWand) (x : _long) (y : _long) + (width : _ulong = (length (car matrix))) (height : _ulong = (length matrix)) + (map : _string) (storage-type : _StorageType) + (_pointer = (let* ([size (* width height (string-length map))] + [type (StorageType->type storage-type)] + [block (malloc size type)]) + (let loop ([m matrix] [n 0]) + (cond [(null? m) n] + [(pair? m) (loop (cdr m) (loop (car m) n))] + [else (ptr-set! block type n m) (add1 n)])) + block)) + -> _status) + +;; MagickSetImageProfile adds a named profile to the magick wand. If a profile +;; with the same name already exists, it is replaced. This method differs from +;; the MagickProfileImage method in that it does not apply any CMS color +;; profiles. +(defmagick* MagickSetImageProfile : + _MagickWand (profile-name : _string) + (profile : _bytes) (_ulong = (bytes-length profile)) + -> _status) + +;; MagickSetImageRedPrimary sets the image chromaticity red primary point. +(defmagick* MagickSetImageRedPrimary : + _MagickWand (x : _double*) (y : _double*) -> _status) + +;; MagickSetImageRenderingIntent sets the image rendering intent. +(defmagick* MagickSetImageRenderingIntent : + _MagickWand _RenderingIntent -> _status) + +;; MagickSetImageResolution sets the image resolution. +(defmagick* MagickSetImageResolution : + _MagickWand (res-x : _double*) (res-y : _double*) -> _status) + +;; MagickSetImageScene sets the image scene. +(defmagick* MagickSetImageScene : + _MagickWand (schene-number : _ulong) -> _status) + +;; MagickSetImageType sets the image type. +(defmagick* MagickSetImageType : + _MagickWand _ImageType -> _status) + +;; MagickSetImageUnits sets the image units of resolution. +(defmagick* MagickSetImageUnits : + _MagickWand _ResolutionType -> _status) + +;; MagickSetImageVirtualPixelMethod sets the image virtual pixel method. +(defmagick* MagickSetImageVirtualPixelMethod : + _MagickWand _VirtualPixelMethod -> _status) + +;; MagickSetImageWhitePoint sets the image chromaticity white point. +(defmagick* MagickSetImageWhitePoint : + _MagickWand (x : _double*) (y : _double*) -> _status) + +;; MagickSetInterlaceScheme sets the image compression. +(defmagick* MagickSetInterlaceScheme : + _MagickWand _InterlaceType -> _status) + +;; MagickSetPassphrase sets the passphrase. +(defmagick* MagickSetPassphrase : + _MagickWand (passphrase : _string) -> _status) + +;; MagickSetResourceLimit sets the limit for a particular resource in +;; megabytes. +(defmagick* MagickSetResourceLimit : + _ResourceType (limit : _ulong) -> _status) + +;; MagickSetSamplingFactors sets the image sampling factors. +(defmagick* MagickSetSamplingFactors : + (w factors) :: + (w : _MagickWand) (_ulong = (length factors)) (factors : (_list i _double*)) + -> _status) + +;; MagickSetSize sets the size of the magick wand. Set it before you read a +;; raw image format such as RGB, GRAY, or CMYK. +(defmagick* MagickSetSize : + _MagickWand (width : _ulong) (height : _ulong) -> _status) + +;; MagickSharpenImage sharpens an image. We convolve the image with a Gaussian +;; operator of the given radius and standard deviation (sigma). For reasonable +;; results, the radius should be larger than sigma. Use a radius of 0 and +;; SharpenImage selects a suitable radius for you. +(defmagick* MagickSharpenImage : + _MagickWand (radius : _double*) (sigma : _double*) -> _status) + +;; MagickSharpenImageChannel sharpens one or more image channels. We convolve +;; the image cnannel with a gaussian operator of the given radius and standard +;; deviation (sigma). For reasonable results, the radius should be larger than +;; sigma. Use a radius of 0 and GaussinSharpenImageChannel selects a suitable +;; radius for you. +(defmagick* MagickSharpenImageChannel : + _MagickWand _ChannelType (radius : _double*) (sigma : _double*) -> _status) + +;; MagickShaveImage shaves pixels from the image edges. It allocates the +;; memory necessary for the new Image structure and returns a pointer to the +;; new image. +(defmagick* MagickShaveImage : + _MagickWand (width : _ulong) (height : _ulong) -> _status) + +;; MagickShearImage slides one edge of an image along the X or Y axis, creating +;; a parallelogram. An X direction shear slides an edge along the X axis, +;; while a Y direction shear slides an edge along the Y axis. The amount of +;; the shear is controlled by a shear angle. For X direction shears, x_shear +;; is measured relative to the Y axis, and similarly, for Y direction shears +;; y_shear is measured relative to the X axis. Empty triangles left over from +;; shearing the image are filled with the background color. +(defmagick* MagickShearImage : + _MagickWand (background : _PixelWand) + (x-shear : _double*) (y-shear : _double*) + -> _status) + +;; MagickSolarizeImage applies a special effect to the image, similar to the +;; effect achieved in a photo darkroom by selectively exposing areas of photo +;; sensitive paper to light. Threshold ranges from 0 to MaxRGB and is a +;; measure of the extent of the solarization. +(defmagick* MagickSolarizeImage : + _MagickWand (threshold : _double*) -> _status) + +;; MagickSpliceImage splices a solid color into the image. +(defmagick* MagickSpliceImage : + _MagickWand (width : _ulong) (height : _ulong) (x : _long) (y : _long) + -> _status) + +;; MagickSpreadImage is a special effects method that randomly displaces each +;; pixel in a block defined by the radius parameter. +(defmagick* MagickSpreadImage : + _MagickWand (radius : _double*) -> _status) + +;; Use MagickSteganoImage to hide a digital watermark within the image. +;; Recover the hidden watermark later to prove that the authenticity of an +;; image. Offset defines the start position within the image to hide the +;; watermark. +(defmagick* MagickSteganoImage : + _MagickWand (watermark : _MagickWand) (offset : _long) -> _MagickWand) + +;; MagickStereoImage composites two images and produces a single image that is +;; the composite of a left and right image of a stereo pair. +(defmagick* MagickStereoImage : + _MagickWand (offset : _MagickWand) -> _MagickWand) + +;; MagickStripImage strips an image of all profiles and comments. +(defmagick* MagickStripImage : + _MagickWand -> _status) + +;; MagickSwirlImage swirls the pixels about the center of the image, where +;; degrees indicates the sweep of the arc through which each pixel is moved. +;; You get a more dramatic effect as the degrees move from 1 to 360. +(defmagick* MagickSwirlImage : + _MagickWand (degrees : _double*) -> _status) + +;; MagickTextureImage repeatedly tiles the texture image across and down the +;; image canvas. +(defmagick* MagickTextureImage : + _MagickWand (texture : _MagickWand) -> _MagickWand) + +;; MagickThresholdImage changes the value of individual pixels based on the +;; intensity of each pixel compared to threshold. The result is a +;; high-contrast, two color image. +(defmagick* MagickThresholdImage : + _MagickWand _double* -> _status) + +;; MagickThresholdImageChannel changes the value of individual pixel component +;; based on the intensity of each pixel compared to threshold. The result is a +;; high-contrast, two color image. +(defmagick* MagickThresholdImageChannel : + _MagickWand _ChannelType (threshold : _double*) -> _status) + +;; MagickTintImage applies a color vector to each pixel in the image. The +;; length of the vector is 0 for black and white and at its maximum for the +;; midtones. The vector weighting function is +;; f(x)=(1-(4.0*((x-0.5)*(x-0.5)))). +(defmagick* MagickTintImage : + _MagickWand (tint : _PixelWand) (opacity : _PixelWand) -> _status) + +;; MagickTransformImage is a convenience method that behaves like +;; MagickResizeImage or MagickCropImage but accepts scaling and/or cropping +;; information as a region geometry specification. If the operation fails, the +;; original image handle is returned. +(defmagick* MagickTransformImage : + _MagickWand (crop-geometry : _string) (image-geometry : _string) + -> _MagickWand) + +;; MagickTransparentImage changes any pixel that matches color with the color +;; defined by fill. +(defmagick* MagickTransparentImage : + _MagickWand (target : _PixelWand) (opacity : _Quantum) (fuzz : _double*) + -> _status) + +;; MagickTrimImage remove edges that are the background color from the image. +(defmagick* MagickTrimImage : + _MagickWand (fuzz : _double*) -> _status) + +;; MagickUnsharpMaskImage sharpens an image. We convolve the image with a +;; Gaussian operator of the given radius and standard deviation (sigma). For +;; reasonable results, radius should be larger than sigma. Use a radius of 0 +;; and UnsharpMaskImage selects a suitable radius for you. +(defmagick* MagickUnsharpMaskImage : + _MagickWand (radius : _double*) (sigma : _double*) + (amount-precentage : _double*) (threshold : _double*) + -> _status) + +;; MagickWaveImage creates a "ripple" effect in the image by shifting the +;; pixels vertically along a sine wave whose amplitude and wavelength is +;; specified by the given parameters. +(defmagick* MagickWaveImage : + _MagickWand (amplitude : _double*) (wave-length : _double*) -> _status) + +;; MagickWhiteThresholdImage is like ThresholdImage but forces all pixels above +;; the threshold into white while leaving all pixels below the threshold +;; unchanged. +(defmagick* MagickWhiteThresholdImage : + _MagickWand _PixelWand -> _status) + +;; MagickWriteImage writes an image. +(defmagick* MagickWriteImage : + _MagickWand _file -> _status) + +;; MagickGetImageBlob implements direct to memory image formats. It returns +;; the image as a blob and its length. The magick member of the Image +;; structure determines the format of the returned blob (GIF, JPEG, PNG, etc.) +(defmagick* MagickGetImageBlob : + _MagickWand (len : (_ptr o _ulong)) -> (_bytes o len)) + +;; MagickWriteImageFile writes an image to an open file descriptor. +(defmagick* MagickWriteImageFile : + _MagickWand (FILE* : _pointer) -> _status) + +;; MagickWriteImages writes an image or image sequence. +(defmagick* MagickWriteImages : + _MagickWand _file (adjoin? : _bool) -> _status) + +;; NewMagickWand returns a wand required for all other methods in the API. +(defmagick* NewMagickWand : + -> _MagickWand) + +;; ===== PixelIterator API ==================================================== + +;; DestroyPixelIterator deallocates resources associated with a PixelIterator. +(defmagick DestroyPixelIterator : + _PixelIterator -> _void) + +;; NewPixelIterator returns a new pixel iterator. +(defmagick* NewPixelIterator : + (w : _MagickWand) -> (pi : _PixelIterator) + -> (begin (set-PixelIterator-width! pi (MagickGetImageWidth w)) pi)) + +;; NewPixelRegionIterator returns a new pixel iterator. +(defmagick* NewPixelRegionIterator : + _MagickWand (x : _long) (y : _long) (width : _ulong) (height : _ulong) + -> (pi : _PixelIterator) + -> (begin (set-PixelIterator-width! pi width) pi)) + +;; PixelIteratorGetException returns the severity, reason, and description of +;; any error that occurs when using other methods in this API. +(defmagick* PixelIteratorGetException : + _PixelIterator (severity : (_ptr o _MagickExceptionType)) + -> (message : _string) + -> (unless (eq? severity 'UndefinedException) + (error 'PixelIterator "(~a) ~a" severity message))) + +;; PixelGetNextRow returns the next row from the pixel iterator. +(defmagick* PixelGetNextRow : + (pi : _PixelIterator) -> (_list o _PixelWand (PixelIterator-width pi))) + +;; PixelResetIterator resets the pixel iterator. Use it in conjunction with +;; PixelGetNextPixel to iterate over all the pixels in a pixel container. +(defmagick* PixelResetIterator : + _PixelIterator -> _void) + +;; PixelSetIteratorRow set the pixel iterator row. +(defmagick* PixelSetIteratorRow : + (pi : _PixelIterator) (row : _long) -> _status) + +;; PixelSyncIterator syncs the pixel iterator. +(defmagick* PixelSyncIterator : + _PixelIterator -> _status) + +;; ===== PixelWand API ======================================================== + +;; PixelGetException returns the severity, reason, and description of any error +;; that occurs when using other methods in this API (as an exception). +(defmagick* PixelGetException : + _MagickWand (severity : (_ptr o _MagickExceptionType)) -> (message : _string) + -> (unless (eq? severity 'UndefinedException) + (error 'PixelWand "(~a) ~a" severity message))) + +;; DestroyPixelWand deallocates resources associated with a PixelWand. +;; Intended for internal use only, must be defined after the above. +(defmagick DestroyPixelWand : + _PixelWand -> _void) + +;; DestroyPixelWands deallocates resources associated with an array of +;; pixel wands. +;; * There is no need for this + +;; NewPixelWand returns a new pixel wand. +;; Extended: can get a color name to use for the new pixel wand, or an RGB list +;; (integers or floats determine the method to use for setting the values), or +;; a CMYK list. (See also the _PixelWand type definition). +(defmagick* NewPixelWand : + init-color :: + -> (p : _PixelWand) + -> (let ([color (and (pair? init-color) (car init-color))]) + (define (err) (error 'NewPixelWand "bad initial color: ~e" color)) + (cond [(null? init-color)] + [(string? color) (PixelSetColor p color)] + [(list? color) + (let ([len (length color)] + [ints? (andmap integer? color)] + [flts? (andmap inexact? color)]) + (if (or ints? flts?) + (let ([len (if flts? (- len) len)]) + (case len + [(3) (PixelSetRedQuantum p (car color)) + (PixelSetGreenQuantum p (cadr color)) + (PixelSetBlueQuantum p (caddr color))] + [(-3) (PixelSetRed p (car color)) + (PixelSetGreen p (cadr color)) + (PixelSetBlue p (caddr color))] + [(4) (PixelSetCyanQuantum p (car color)) + (PixelSetMagentaQuantum p (cadr color)) + (PixelSetYellowQuantum p (caddr color)) + (PixelSetBlackQuantum p (cadddr color))] + [(-4) (PixelSetCyan p (car color)) + (PixelSetMagenta p (cadr color)) + (PixelSetYellow p (caddr color)) + (PixelSetBlack p (cadddr color))] + [else (err)])) + (err)))] + [else (err)]) + p)) + +;; NewPixelWands returns an array of pixel wands. +;; * There is no need for this + +;; PixelGetBlack returns the normalized black color of the pixel wand. +(defmagick* PixelGetBlack : + _PixelWand -> _double*) + +;; PixelGetBlackQuantum returns the black color of the pixel wand. The color +;; is in the range of [0..MaxRGB]. +(defmagick* PixelGetBlackQuantum : + _PixelWand -> _Quantum) + +;; PixelGetBlue returns the normalized blue color of the pixel wand. +(defmagick* PixelGetBlue : + _PixelWand -> _double*) + +;; PixelGetBlueQuantum returns the blue color of the pixel wand. The color is +;; in the range of [0..MaxRGB]. +(defmagick* PixelGetBlueQuantum : + _PixelWand -> _Quantum) + +;; PixelGetColorAsString gets the color of the pixel wand. +(defmagick* PixelGetColorAsString : + _PixelWand -> _string) + +;; PixelGetColorCount returns the color count associated with this color. +(defmagick* PixelGetColorCount : + _PixelWand -> _ulong) + +;; PixelGetCyan returns the normalized cyan color of the pixel wand. +(defmagick* PixelGetCyan : + _PixelWand -> _double*) + +;; PixelGetCyanQuantum returns the cyan color of the pixel wand. The color is +;; in the range of [0..MaxRGB]. +(defmagick* PixelGetCyanQuantum : + _PixelWand -> _Quantum) + +;; PixelGetGreen returns the normalized green color of the pixel wand. +(defmagick* PixelGetGreen : + _PixelWand -> _double*) + +;; PixelGetGreenQuantum returns the green color of the pixel wand. The color +;; is in the range of [0..MaxRGB]. +(defmagick* PixelGetGreenQuantum : + _PixelWand -> _Quantum) + +;; PixelGetIndex returns the colormap index from the pixel wand. +(defmagick* PixelGetIndex : + _PixelWand -> _IndexPacket) + +;; PixelGetMagenta returns the normalized magenta color of the pixel wand. +(defmagick* PixelGetMagenta : + _PixelWand -> _double*) + +;; PixelGetMagentaQuantum returns the magenta color of the pixel wand. The +;; color is in the range of [0..MaxRGB]. +(defmagick* PixelGetMagentaQuantum : + _PixelWand -> _Quantum) + +;; PixelGetOpacity returns the normalized opacity color of the pixel wand. +(defmagick* PixelGetOpacity : + _PixelWand -> _double*) + +;; PixelGetOpacityQuantum returns the opacity color of the pixel wand. The +;; color is in the range of [0..MaxRGB]. +(defmagick* PixelGetOpacityQuantum : + _PixelWand -> _Quantum) + +;; PixelGetQuantumColor gets the color of the pixel wand. +(defmagick* PixelGetQuantumColor : + _PixelWand (color : _PixelPacket = (NewPixelPacket)) -> _void + -> color) + +;; PixelGetRed returns the normalized red color of the pixel wand. +(defmagick* PixelGetRed : + _PixelWand -> _double*) + +;; PixelGetRedQuantum returns the red color of the pixel wand. The color is in +;; the range of [0..MaxRGB]. +(defmagick* PixelGetRedQuantum : + _PixelWand -> _Quantum) + +;; PixelGetYellow returns the normalized yellow color of the pixel wand. +(defmagick* PixelGetYellow : + _PixelWand -> _double*) + +;; PixelGetYellowQuantum returns the yellow color of the pixel wand. The color +;; is in the range of [0..MaxRGB]. +(defmagick* PixelGetYellowQuantum : + _PixelWand -> _Quantum) + +;; PixelSetBlack sets the normalized black color of the pixel wand. +(defmagick* PixelSetBlack : + _PixelWand (black : _double*) -> _void) + +;; PixelSetBlackQuantum sets the black color of the pixel wand. The color must +;; be in the range of [0..MaxRGB]. +(defmagick* PixelSetBlackQuantum : + _PixelWand (black : _Quantum) -> _void) + +;; PixelSetBlue sets the normalized blue color of the pixel wand. +(defmagick* PixelSetBlue : + _PixelWand (blue : _double*) -> _void) + +;; PixelSetBlueQuantum sets the blue color of the pixel wand. The color must +;; be in the range of [0..MaxRGB]. +(defmagick* PixelSetBlueQuantum : + _PixelWand (blue : _Quantum) -> _void) + +;; PixelSetColor sets the color of the pixel wand with a string (e.g. "blue", +;; "#0000ff", "rgb(0,0,255)", "cmyk(100,100,100,10)", etc.). +(defmagick* PixelSetColor : + _PixelWand (color : _string) -> _status) + +;; PixelSetColorCount sets the color count of the pixel wand. +(defmagick* PixelSetColorCount : + _PixelWand (count : _ulong) -> _void) + +;; PixelSetCyan sets the normalized cyan color of the pixel wand. +(defmagick* PixelSetCyan : + _PixelWand (cyan : _double*) -> _void) + +;; PixelSetCyanQuantum sets the cyan color of the pixel wand. The color must +;; be in the range of [0..MaxRGB]. +(defmagick* PixelSetCyanQuantum : + _PixelWand (cyan : _Quantum) -> _void) + +;; PixelSetGreen sets the normalized green color of the pixel wand. +(defmagick* PixelSetGreen : + _PixelWand (green : _double*) -> _void) + +;; PixelSetGreenQuantum sets the green color of the pixel wand. The color must +;; be in the range of [0..MaxRGB]. +(defmagick* PixelSetGreenQuantum : + _PixelWand (green : _Quantum) -> _void) + +;; PixelSetIndex sets the colormap index of the pixel wand. +(defmagick* PixelSetIndex : + _PixelWand _IndexPacket -> _void) + +;; PixelSetMagenta sets the normalized magenta color of the pixel wand. +(defmagick* PixelSetMagenta : + _PixelWand (magenta : _double*) -> _void) + +;; PixelSetMagentaQuantum sets the magenta color of the pixel wand. The color +;; must be in the range of [0..MaxRGB]. +(defmagick* PixelSetMagentaQuantum : + _PixelWand (magenta : _Quantum) -> _void) + +;; PixelSetOpacity sets the normalized opacity color of the pixel wand. +(defmagick* PixelSetOpacity : + _PixelWand (opacity : _double*) -> _void) + +;; PixelSetOpacityQuantum sets the opacity color of the pixel wand. The color +;; must be in the range of [0..MaxRGB]. +(defmagick* PixelSetOpacityQuantum : + _PixelWand (opacity : _Quantum) -> _void) + +;; PixelSetQuantumColor sets the color of the pixel wand. +(defmagick* PixelSetQuantumColor : + _PixelWand _PixelPacket -> _void) + +;; PixelSetRed sets the normalized red color of the pixel wand. +(defmagick* PixelSetRed : + _PixelWand (red : _double*) -> _void) + +;; PixelSetRedQuantum sets the red color of the pixel wand. The color must be +;; in the range of [0..MaxRGB]. +(defmagick* PixelSetRedQuantum : + _PixelWand (red : _Quantum) -> _void) + +;; PixelSetYellow sets the normalized yellow color of the pixel wand. +(defmagick* PixelSetYellow : + _PixelWand (yellow : _double*) -> _void) + +;; PixelSetYellowQuantum sets the yellow color of the pixel wand. The color +;; must be in the range of [0..MaxRGB]. +(defmagick* PixelSetYellowQuantum : + _PixelWand (yellow : _Quantum) -> _void) + +;; ===== DrawingWand API ====================================================== + +;; DrawGetException returns the severity, reason, and description of any error +;; that occurs when using other methods in this API. +(defmagick* DrawGetException : + _DrawingWand (severity : (_ptr o _MagickExceptionType)) + -> (message : _string) + -> (unless (eq? severity 'UndefinedException) + (error 'DrawingWand "(~a) ~a" severity message))) + +;; DestroyDrawingWand frees all resources associated with the drawing wand. +;; Once the drawing wand has been freed, it should not be used any further +;; unless it re-allocated. +(defmagick DestroyDrawingWand : + _DrawingWand -> _void) + +;; DrawAnnotation draws text on the image. +(defmagick* DrawAnnotation : + _DrawingWand (x : _double*) (y : _double*) (text : _string) -> _void) + +;; DrawAffine adjusts the current affine transformation matrix with the +;; specified affine transformation matrix. Note that the current affine +;; transform is adjusted rather than replaced. +(defmagick* DrawAffine : + _DrawingWand _AffineMatrix -> _void) + +;; DrawAllocateWand allocates an initial drawing wand which is an opaque handle +;; required by the remaining drawing methods. +(defmagick* DrawAllocateWand : + _DrawInfo _Image -> _DrawingWand) + +;; DrawArc draws an arc falling within a specified bounding rectangle on the +;; image. +(defmagick* DrawArc : + _DrawingWand + (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) + (deg1 : _double*) (deg2 : _double*) + -> _void) + +;; DrawBezier draws a bezier curve through a set of points on the image. +(defmagick* DrawBezier : + (d points) :: + (d : _DrawingWand) (_ulong = (length points)) (points : _Points) -> _void) + +;; DrawCircle draws a circle on the image. +(defmagick* DrawCircle : + _DrawingWand + (x : _double*) (y : _double*) + (perimeter-x : _double*) (perimeter-y : _double*) + -> _void) + +;; DrawGetClipPath obtains the current clipping path ID. The value returned +;; must be deallocated by the user when it is no longer needed. +(defmagick* DrawGetClipPath : + _DrawingWand -> _string) + +;; DrawSetClipPath associates a named clipping path with the image. Only the +;; areas drawn on by the clipping path will be modified as long as it remains +;; in effect. +(defmagick* DrawSetClipPath : + _DrawingWand (clip_path : _string) -> _void) + +;; DrawGetClipRule returns the current polygon fill rule to be used by the +;; clipping path. +(defmagick* DrawGetClipRule : + _DrawingWand -> _FillRule) + +;; DrawSetClipRule set the polygon fill rule to be used by the clipping path. +(defmagick* DrawSetClipRule : + _DrawingWand _FillRule -> _void) + +;; DrawGetClipUnits returns the interpretation of clip path units. +(defmagick* DrawGetClipUnits : + _DrawingWand -> _ClipPathUnits) + +;; DrawSetClipUnits sets the interpretation of clip path units. +(defmagick* DrawSetClipUnits : + _DrawingWand _ClipPathUnits -> _void) + +;; DrawColor draws color on image using the current fill color, starting at +;; specified position, and using specified paint method. The available paint +;; methods are: +;; PointMethod: Recolors the target pixel +;; ReplaceMethod: Recolor any pixel that matches the target pixel. +;; FloodfillMethod: Recolors target pixels and matching neighbors. +;; FillToBorderMethod: Recolor target pixels and neighbors not matching +;; border color. +;; ResetMethod: Recolor all pixels. +(defmagick* DrawColor : + _DrawingWand (x : _double*) (y : _double*) _PaintMethod -> _void) + +;; DrawComment adds a comment to a vector output stream. +(defmagick* DrawComment : + _DrawingWand (comment : _string) -> _void) + +;; DrawEllipse draws an ellipse on the image. +(defmagick* DrawEllipse : + _DrawingWand + (x : _double*) (y : _double*) + (radius-x : _double*) (radius-y : _double*) + (start-deg : _double*) (end-deg : _double*) + -> _void) + +;; DrawGetFillColor returns the fill color used for drawing filled objects. +(defmagick* DrawGetFillColor : + _DrawingWand (c : _PixelWand = (NewPixelWand)) -> _void -> c) + +;; DrawSetFillColor sets the fill color to be used for drawing filled objects. +(defmagick* DrawSetFillColor : + _DrawingWand _PixelWand -> _void) + +;; DrawSetFillPatternURL sets the URL to use as a fill pattern for filling +;; objects. Only local URLs ("#identifier") are supported at this time. These +;; local URLs are normally created by defining a named fill pattern with +;; DrawPushPattern/DrawPopPattern. +(defmagick* DrawSetFillPatternURL : + _DrawingWand (fill-url : _string) -> _void) + +;; DrawGetFillOpacity returns the opacity used when drawing using the fill +;; color or fill texture. Fully opaque is 1.0. +(defmagick* DrawGetFillOpacity : + _DrawingWand -> _double*) + +;; DrawSetFillOpacity sets the opacity to use when drawing using the fill color +;; or fill texture. Fully opaque is 1.0. +(defmagick* DrawSetFillOpacity : + _DrawingWand (fill-opacity : _double*) -> _void) + +;; DrawGetFillRule returns the fill rule used while drawing polygons. +(defmagick* DrawGetFillRule : + _DrawingWand -> _FillRule) + +;; DrawSetFillRule sets the fill rule to use while drawing polygons. +(defmagick* DrawSetFillRule : + _DrawingWand _FillRule -> _void) + +;; DrawGetFont returns a null-terminaged string specifying the font used when +;; annotating with text. +(defmagick* DrawGetFont : + _DrawingWand -> _string) + +;; DrawSetFont sets the fully-sepecified font to use when annotating with text. +(defmagick* DrawSetFont : + _DrawingWand (font-name : _string) -> _void) + +;; DrawGetFontFamily returns the font family to use when annotating with text. +(defmagick* DrawGetFontFamily : + _DrawingWand -> _string) + +;; DrawSetFontFamily sets the font family to use when annotating with text. +(defmagick* DrawSetFontFamily : + _DrawingWand (font-family : _string) -> _void) + +;; DrawGetFontSize returns the font pointsize used when annotating with text. +(defmagick* DrawGetFontSize : + _DrawingWand -> _double*) + +;; DrawSetFontSize sets the font pointsize to use when annotating with text. +(defmagick* DrawSetFontSize : + _DrawingWand (pointsize : _double*) -> _void) + +;; DrawGetFontStretch returns the font stretch used when annotating with text. +(defmagick* DrawGetFontStretch : + _DrawingWand -> _StretchType) + +;; DrawSetFontStretch sets the font stretch to use when annotating with text. +;; The AnyStretch enumeration acts as a wild-card "don't care" option. +(defmagick* DrawSetFontStretch : + _DrawingWand _StretchType -> _void) + +;; DrawGetFontStyle returns the font style used when annotating with text. +(defmagick* DrawGetFontStyle : + _DrawingWand -> _StyleType) + +;; DrawSetFontStyle sets the font style to use when annotating with text. The +;; AnyStyle enumeration acts as a wild-card "don't care" option. +(defmagick* DrawSetFontStyle : + _DrawingWand _StyleType -> _void) + +;; DrawGetFontWeight returns the font weight used when annotating with text. +(defmagick* DrawGetFontWeight : + _DrawingWand -> _ulong) + +;; DrawSetFontWeight sets the font weight to use when annotating with text. +(defmagick* DrawSetFontWeight : + _DrawingWand (font-weight : _ulong) -> _void) + +;; DrawGetGravity returns the text placement gravity used when annotating with +;; text. +(defmagick* DrawGetGravity : + _DrawingWand -> _GravityType) + +;; DrawSetGravity sets the text placement gravity to use when annotating with +;; text. +(defmagick* DrawSetGravity : + _DrawingWand _GravityType -> _void) + +;; DrawComposite composites an image onto the current image, using the +;; specified composition operator, specified position, and at the specified +;; size. +(defmagick* DrawComposite : + _DrawingWand _CompositeOperator + (x : _double*) (y : _double*) (width : _double*) (height : _double*) _Image + -> _void) + +;; DrawLine draws a line on the image using the current stroke color, stroke +;; opacity, and stroke width. +(defmagick* DrawLine : + _DrawingWand (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) + -> _void) + +;; DrawMatte paints on the image's opacity channel in order to set effected +;; pixels to transparent. The available paint methods are: +;; PointMethod: Select the target pixel +;; ReplaceMethod: Select any pixel that matches the target pixel. +;; FloodfillMethod: Select the target pixel and matching neighbors. +;; FillToBorderMethod: Select the target pixel and neighbors not matching +;; border color. +;; ResetMethod: Select all pixels. +(defmagick* DrawMatte : + _DrawingWand (x : _double*) (y : _double*) _PaintMethod -> _void) + +;; DrawPathClose adds a path element to the current path which closes the +;; current subpath by drawing a straight line from the current point to the +;; current subpath's most recent starting point (usually, the most recent +;; moveto point). +(defmagick* DrawPathClose : + _DrawingWand -> _void) + +;; DrawPathCurveToAbsolute draws a cubic Bezier curve from the current point to +;; (x,y) using (x1,y1) as the control point at the beginning of the curve and +;; (x2,y2) as the control point at the end of the curve using absolute +;; coordinates. At the end of the command, the new current point becomes the +;; final (x,y) coordinate pair used in the polybezier. +(defmagick* DrawPathCurveToAbsolute : + _DrawingWand + (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) + (x : _double*) (y : _double*) + -> _void) + +;; DrawPathCurveToRelative draws a cubic Bezier curve from the current point to +;; (x,y) using (x1,y1) as the control point at the beginning of the curve and +;; (x2,y2) as the control point at the end of the curve using relative +;; coordinates. At the end of the command, the new current point becomes the +;; final (x,y) coordinate pair used in the polybezier. +(defmagick* DrawPathCurveToRelative : + _DrawingWand + (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) + (x : _double*) (y : _double*) + -> _void) + +;; DrawPathCurveToQuadraticBezierAbsolute draws a quadratic Bezier curve from +;; the current point to (x,y) using (x1,y1) as the control point using absolute +;; coordinates. At the end of the command, the new current point becomes the +;; final (x,y) coordinate pair used in the polybezier. +(defmagick* DrawPathCurveToQuadraticBezierAbsolute : + _DrawingWand (x1 : _double*) (y1 : _double*) (x : _double*) (y : _double*) + -> _void) + +;; DrawPathCurveToQuadraticBezierRelative draws a quadratic Bezier curve from +;; the current point to (x,y) using (x1,y1) as the control point using relative +;; coordinates. At the end of the command, the new current point becomes the +;; final (x,y) coordinate pair used in the polybezier. +(defmagick* DrawPathCurveToQuadraticBezierRelative : + _DrawingWand (x1 : _double*) (y1 : _double*) (x : _double*) (y : _double*) + -> _void) + +;; DrawPathCurveToQuadraticBezierSmoothAbsolute draws a quadratic Bezier curve +;; (using absolute coordinates) from the current point to (x,y). The control +;; point is assumed to be the reflection of the control point on the previous +;; command relative to the current point. (If there is no previous command or +;; if the previous command was not a DrawPathCurveToQuadraticBezierAbsolute, +;; DrawPathCurveToQuadraticBezierRelative, +;; DrawPathCurveToQuadraticBezierSmoothAbsolut or +;; DrawPathCurveToQuadraticBezierSmoothRelative, assume the control point is +;; coincident with the current point.). At the end of the command, the new +;; current point becomes the final (x,y) coordinate pair used in the +;; polybezier. +(defmagick* DrawPathCurveToQuadraticBezierSmoothAbsolute : + _DrawingWand (x : _double*) (y : _double*) -> _void) + +;; DrawPathCurveToQuadraticBezierSmoothAbsolute draws a quadratic Bezier curve +;; (using relative coordinates) from the current point to (x,y). The control +;; point is assumed to be the reflection of the control point on the previous +;; command relative to the current point. (If there is no previous command or +;; if the previous command was not a DrawPathCurveToQuadraticBezierAbsolute, +;; DrawPathCurveToQuadraticBezierRelative, +;; DrawPathCurveToQuadraticBezierSmoothAbsolut or +;; DrawPathCurveToQuadraticBezierSmoothRelative, assume the control point is +;; coincident with the current point.). At the end of the command, the new +;; current point becomes the final (x,y) coordinate pair used in the +;; polybezier. +(defmagick* DrawPathCurveToQuadraticBezierSmoothRelative : + _DrawingWand (x : _double*) (y : _double*) -> _void) + +;; DrawPathCurveToSmoothAbsolute draws a cubic Bezier curve from the current +;; point to (x,y) using absolute coordinates. The first control point is +;; assumed to be the reflection of the second control point on the previous +;; command relative to the current point. (If there is no previous command or +;; if the previous command was not an DrawPathCurveToAbsolute, +;; DrawPathCurveToRelative, DrawPathCurveToSmoothAbsolute or +;; DrawPathCurveToSmoothRelative, assume the first control point is coincident +;; with the current point.) (x2,y2) is the second control point (i.e., the +;; control point at the end of the curve). At the end of the command, the new +;; current point becomes the final (x,y) coordinate pair used in the +;; polybezier. +(defmagick* DrawPathCurveToSmoothAbsolute : + _DrawingWand (x2 : _double*) (y2 : _double*) (x : _double*) (y : _double*) + -> _void) + +;; DrawPathCurveToSmoothRelative draws a cubic Bezier curve from the current +;; point to (x,y) using relative coordinates. The first control point is +;; assumed to be the reflection of the second control point on the previous +;; command relative to the current point. (If there is no previous command or +;; if the previous command was not an DrawPathCurveToAbsolute, +;; DrawPathCurveToRelative, DrawPathCurveToSmoothAbsolute or +;; DrawPathCurveToSmoothRelative, assume the first control point is coincident +;; with the current point.) (x2,y2) is the second control point (i.e., the +;; control point at the end of the curve). At the end of the command, the new +;; current point becomes the final (x,y) coordinate pair used in the +;; polybezier. +(defmagick* DrawPathCurveToSmoothRelative : + _DrawingWand (x2 : _double*) (y2 : _double*) (x : _double*) (y : _double*) + -> _void) + +;; DrawPathEllipticArcAbsolute draws an elliptical arc from the current point +;; to (x, y) using absolute coordinates. The size and orientation of the +;; ellipse are defined by two radii (rx, ry) and an xAxisRotation, which +;; indicates how the ellipse as a whole is rotated relative to the current +;; coordinate system. The center (cx, cy) of the ellipse is calculated +;; automatically to satisfy the constraints imposed by the other parameters. +;; largeArcFlag and sweepFlag contribute to the automatic calculations and help +;; determine how the arc is drawn. If largeArcFlag is true then draw the +;; larger of the available arcs. If sweepFlag is true, then draw the arc +;; matching a clock-wise rotation. +(defmagick* DrawPathEllipticArcAbsolute : + _DrawingWand (rx : _double*) (ry : _double*) + (x-axis-rotation : _double*) (large-arc-flag? : _bool) (sweep-flag? : _bool) + (x : _double*) (y : _double*) + -> _void) + +;; DrawPathEllipticArcRelative draws an elliptical arc from the current point +;; to (x, y) using relative coordinates. The size and orientation of the +;; ellipse are defined by two radii (rx, ry) and an xAxisRotation, which +;; indicates how the ellipse as a whole is rotated relative to the current +;; coordinate system. The center (cx, cy) of the ellipse is calculated +;; automatically to satisfy the constraints imposed by the other parameters. +;; largeArcFlag and sweepFlag contribute to the automatic calculations and help +;; determine how the arc is drawn. If largeArcFlag is true then draw the +;; larger of the available arcs. If sweepFlag is true, then draw the arc +;; matching a clock-wise rotation. +(defmagick* DrawPathEllipticArcRelative : + _DrawingWand (rx : _double*) (ry : _double*) + (x-axis-rotation : _double*) (large-arc-flag? : _bool) (sweep-flag? : _bool) + (x : _double*) (y : _double*) + -> _void) + +;; DrawPathFinish terminates the current path. +(defmagick* DrawPathFinish : + _DrawingWand -> _void) + +;; DrawPathLineToAbsolute draws a line path from the current point to the given +;; coordinate using absolute coordinates. The coordinate then becomes the new +;; current point. +(defmagick* DrawPathLineToAbsolute : + _DrawingWand (x : _double*) (y : _double*) -> _void) + +;; DrawPathLineToRelative draws a line path from the current point to the given +;; coordinate using relative coordinates. The coordinate then becomes the new +;; current point. +(defmagick* DrawPathLineToRelative : + _DrawingWand (x : _double*) (y : _double*) -> _void) + +;; DrawPathLineToHorizontalAbsolute draws a horizontal line path from the +;; current point to the target point using absolute coordinates. The target +;; point then becomes the new current point. +(defmagick* DrawPathLineToHorizontalAbsolute : + _DrawingWand (x : _double*) -> _void) + +;; DrawPathLineToHorizontalRelative draws a horizontal line path from the +;; current point to the target point using relative coordinates. The target +;; point then becomes the new current point. +(defmagick* DrawPathLineToHorizontalRelative : + _DrawingWand (x : _double*) -> _void) + +;; DrawPathLineToVerticalAbsolute draws a vertical line path from the current +;; point to the target point using absolute coordinates. The target point then +;; becomes the new current point. +(defmagick* DrawPathLineToVerticalAbsolute : + _DrawingWand (y : _double*) -> _void) + +;; DrawPathLineToVerticalRelative draws a vertical line path from the current +;; point to the target point using relative coordinates. The target point then +;; becomes the new current point. +(defmagick* DrawPathLineToVerticalRelative : + _DrawingWand (y : _double*) -> _void) + +;; DrawPathMoveToAbsolute starts a new sub-path at the given coordinate using +;; absolute coordinates. The current point then becomes the specified +;; coordinate. +(defmagick* DrawPathMoveToAbsolute : + _DrawingWand (x : _double*) (y : _double*) -> _void) + +;; DrawPathMoveToRelative starts a new sub-path at the given coordinate using +;; relative coordinates. The current point then becomes the specified +;; coordinate. +(defmagick* DrawPathMoveToRelative : + _DrawingWand (x : _double*) (y : _double*) -> _void) + +;; DrawPathStart declares the start of a path drawing list which is terminated +;; by a matching DrawPathFinish command. All other DrawPath commands must be +;; enclosed between a DrawPathStart and a DrawPathFinish command. This is +;; because path drawing commands are subordinate commands and they do not +;; function by themselves. +(defmagick* DrawPathStart : + _DrawingWand -> _void) + +;; PeekDrawingWand returns the current drawing wand. +(defmagick* PeekDrawingWand : + _DrawingWand -> _DrawInfo) + +;; DrawPoint draws a point using the current stroke color and stroke thickness +;; at the specified coordinates. +(defmagick* DrawPoint : + _DrawingWand (x : _double*) (y : _double*) -> _void) + +;; DrawPolygon draws a polygon using the current stroke, stroke width, and fill +;; color or texture, using the specified array of coordinates. +(defmagick* DrawPolygon : + (d points) :: + (d : _DrawingWand) (_ulong = (length points)) (points : _Points) -> _void) + +;; DrawPolyline draws a polyline using the current stroke, stroke width, and +;; fill color or texture, using the specified array of coordinates. +(defmagick* DrawPolyline : + (d points) :: + (d : _DrawingWand) (_ulong = (length points)) (points : _Points) -> _void) + +;; DrawPopClipPath terminates a clip path definition. +(defmagick* DrawPopClipPath : + _DrawingWand -> _void) + +;; DrawPopDefs terminates a definition list. +(defmagick* DrawPopDefs : + _DrawingWand -> _void) + +;; PopDrawingWand destroys the current drawing wand and returns to the +;; previously pushed drawing wand. Multiple drawing wands may exist. It is an +;; error to attempt to pop more drawing wands than have been pushed, and it is +;; proper form to pop all drawing wands which have been pushed. +(defmagick* PopDrawingWand : + _DrawingWand -> _void) + +;; DrawPopPattern terminates a pattern definition. +(defmagick* DrawPopPattern : + _DrawingWand -> _void) + +;; DrawPushClipPath starts a clip path definition which is comprized of any +;; number of drawing commands and terminated by a DrawPopClipPath command. +(defmagick* DrawPushClipPath : + _DrawingWand (clip-path-id : _string) -> _void) + +;; DrawPushDefs indicates that commands up to a terminating DrawPopDefs command +;; create named elements (e.g. clip-paths, textures, etc.) which may safely be +;; processed earlier for the sake of efficiency. +(defmagick* DrawPushDefs : + _DrawingWand -> _void) + +;; PushDrawingWand clones the current drawing wand to create a new +;; drawing wand. The original drawing drawing wand(s) may be returned to by +;; invoking PopDrawingWand. The drawing wands are stored on a drawing wand +;; stack. For every Pop there must have already been an equivalent Push. +(defmagick* PushDrawingWand : + _DrawingWand -> _void) + +;; DrawPushPattern indicates that subsequent commands up to a DrawPopPattern +;; command comprise the definition of a named pattern. The pattern space is +;; assigned top left corner coordinates, a width and height, and becomes its +;; own drawing space. Anything which can be drawn may be used in a pattern +;; definition. Named patterns may be used as stroke or brush definitions. +(defmagick* DrawPushPattern : + _DrawingWand (pattern-id : _string) + (x : _double*) (y : _double*) (width : _double*) (height : _double*) + -> _void) + +;; DrawRectangle draws a rectangle given two coordinates and using the current +;; stroke, stroke width, and fill settings. +(defmagick* DrawRectangle : + _DrawingWand (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) + -> _void) + +;; DrawRender renders all preceding drawing commands onto the image. +(defmagick* DrawRender : + _DrawingWand -> _status) + +;; DrawRotate applies the specified rotation to the current coordinate space. +(defmagick* DrawRotate : + _DrawingWand (degrees : _double*) -> _void) + +;; DrawRoundRectangle draws a rounted rectangle given two coordinates, x & y +;; corner radiuses and using the current stroke, stroke width, and fill +;; settings. +(defmagick* DrawRoundRectangle : + _DrawingWand + (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) + (rx : _double*) (ry : _double*) + -> _void) + +;; DrawScale adjusts the scaling factor to apply in the horizontal and vertical +;; directions to the current coordinate space. +(defmagick* DrawScale : + _DrawingWand (horizontal-scale : _double*) (vertical-scale : _double*) + -> _void) + +;; DrawSkewX skews the current coordinate system in the horizontal direction. +(defmagick* DrawSkewX : + _DrawingWand (degrees : _double*) -> _void) + +;; DrawSkewY skews the current coordinate system in the vertical direction. +(defmagick* DrawSkewY : + _DrawingWand (degrees : _double*) -> _void) + +;; DrawGetStrokeColor returns the color used for stroking object outlines. +(defmagick* DrawGetStrokeColor : + _DrawingWand (c : _PixelWand = (NewPixelWand)) -> _void -> c) + +;; DrawSetStrokeColor sets the color used for stroking object outlines. +(defmagick* DrawSetStrokeColor : + _DrawingWand _PixelWand -> _void) + +;; DrawSetStrokePatternURL sets the pattern used for stroking object outlines. +(defmagick* DrawSetStrokePatternURL : + _DrawingWand (stroke-url : _string) -> _void) + +;; DrawGetStrokeAntialias returns the current stroke antialias setting. +;; Stroked outlines are antialiased by default. When antialiasing is disabled +;; stroked pixels are thresholded to determine if the stroke color or +;; underlying canvas color should be used. +(defmagick* DrawGetStrokeAntialias : + _DrawingWand -> _bool) + +;; DrawSetStrokeAntialias controls whether stroked outlines are antialiased. +;; Stroked outlines are antialiased by default. When antialiasing is disabled +;; stroked pixels are thresholded to determine if the stroke color or +;; underlying canvas color should be used. +(defmagick* DrawSetStrokeAntialias : + _DrawingWand (stroke-antialias? : _bool) -> _void) + +;; DrawGetStrokeDashArray returns an array representing the pattern of dashes +;; and gaps used to stroke paths (see DrawSetStrokeDashArray). +(defmagick* DrawGetStrokeDashArray : + _DrawingWand (len : (_ptr o _ulong)) -> (_list o _double* len)) + +;; DrawSetStrokeDashArray specifies the pattern of dashes and gaps used to +;; stroke paths. The strokeDashArray represents an array of numbers that +;; specify the lengths of alternating dashes and gaps in pixels. If an odd +;; number of values is provided, then the list of values is repeated to yield +;; an even number of values. To remove an existing dash array, pass a zero +;; number_elements argument and null dash_array. A typical strokeDashArray_ +;; array might contain the members 5 3 2. +(defmagick* DrawSetStrokeDashArray : + (d dash-list) :: + ;; the function seem to always expect a 0.0-terminated vector + (dash-list : _? = (append dash-list '(0.0))) + (d : _DrawingWand) + (_ulong = (length dash-list)) (dash-list : (_list i _double*)) + -> _void) + +;; DrawGetStrokeDashOffset returns the offset into the dash pattern to start +;; the dash. +(defmagick* DrawGetStrokeDashOffset : + _DrawingWand -> _double*) + +;; DrawSetStrokeDashOffset specifies the offset into the dash pattern to start +;; the dash. +(defmagick* DrawSetStrokeDashOffset : + _DrawingWand (dash-offset : _double*) -> _void) + +;; DrawGetStrokeLineCap returns the shape to be used at the end of open +;; subpaths when they are stroked. Values of LineCap are UndefinedCap, +;; ButtCap, RoundCap, and SquareCap. +(defmagick* DrawGetStrokeLineCap : + _DrawingWand -> _LineCap) + +;; DrawSetStrokeLineCap specifies the shape to be used at the end of open +;; subpaths when they are stroked. Values of LineCap are UndefinedCap, +;; ButtCap, RoundCap, and SquareCap. +(defmagick* DrawSetStrokeLineCap : + _DrawingWand _LineCap -> _void) + +;; DrawGetStrokeLineJoin returns the shape to be used at the corners of paths +;; (or other vector shapes) when they are stroked. Values of LineJoin are +;; UndefinedJoin, MiterJoin, RoundJoin, and BevelJoin. +(defmagick* DrawGetStrokeLineJoin : + _DrawingWand -> _LineJoin) + +;; DrawSetStrokeLineJoin specifies the shape to be used at the corners of paths +;; (or other vector shapes) when they are stroked. Values of LineJoin are +;; UndefinedJoin, MiterJoin, RoundJoin, and BevelJoin. +(defmagick* DrawSetStrokeLineJoin : + _DrawingWand _LineJoin -> _void) + +;; DrawGetStrokeMiterLimit returns the miter limit. When two line segments +;; meet at a sharp angle and miter joins have been specified for 'lineJoin', it +;; is possible for the miter to extend far beyond the thickness of the line +;; stroking the path. The miterLimit' imposes a limit on the ratio of the +;; miter length to the 'lineWidth'. +(defmagick* DrawGetStrokeMiterLimit : + _DrawingWand -> _ulong) + +;; DrawSetStrokeMiterLimit specifies the miter limit. When two line segments +;; meet at a sharp angle and miter joins have been specified for 'lineJoin', it +;; is possible for the miter to extend far beyond the thickness of the line +;; stroking the path. The miterLimit' imposes a limit on the ratio of the +;; miter length to the 'lineWidth'. +(defmagick* DrawSetStrokeMiterLimit : + _DrawingWand (miterlimit : _ulong) -> _void) + +;; DrawGetStrokeOpacity returns the opacity of stroked object outlines. +(defmagick* DrawGetStrokeOpacity : + _DrawingWand -> _double*) + +;; DrawSetStrokeOpacity specifies the opacity of stroked object outlines. +(defmagick* DrawSetStrokeOpacity : + _DrawingWand (stroke-opacity : _double*) -> _void) + +;; DrawGetStrokeWidth returns the width of the stroke used to draw object +;; outlines. +(defmagick* DrawGetStrokeWidth : + _DrawingWand -> _double*) + +;; DrawSetStrokeWidth sets the width of the stroke used to draw object +;; outlines. +(defmagick* DrawSetStrokeWidth : + _DrawingWand (stroke-width : _double*) -> _void) + +;; DrawGetTextAntialias returns the current text antialias setting, which +;; determines whether text is antialiased. Text is antialiased by default. +(defmagick* DrawGetTextAntialias : + _DrawingWand -> _bool) + +;; DrawSetTextAntialias controls whether text is antialiased. Text is +;; antialiased by default. +(defmagick* DrawSetTextAntialias : + _DrawingWand (text-antialias? : _bool) -> _void) + +;; DrawGetTextDecoration returns the decoration applied when annotating with +;; text. +(defmagick* DrawGetTextDecoration : + _DrawingWand -> _DecorationType) + +;; DrawSetTextDecoration specifies a decoration to be applied when annotating +;; with text. +(defmagick* DrawSetTextDecoration : + _DrawingWand _DecorationType -> _void) + +;; DrawGetTextEncoding returns a null-terminated string which specifies the +;; code set used for text annotations. +(defmagick* DrawGetTextEncoding : + _DrawingWand -> _string) + +;; DrawSetTextEncoding specifies specifies the code set to use for text +;; annotations. The only character encoding which may be specified at this +;; time is "UTF-8" for representing Unicode as a sequence of bytes. Specify an +;; empty string to set text encoding to the system's default. Successful text +;; annotation using Unicode may require fonts designed to support Unicode. +(defmagick* DrawSetTextEncoding : + _DrawingWand (encoding : _string) -> _void) + +;; DrawGetTextUnderColor returns the color of a background rectangle to place +;; under text annotations. +(defmagick* DrawGetTextUnderColor : + _DrawingWand (c : _PixelWand = (NewPixelWand)) -> _void -> c) + +;; DrawSetTextUnderColor specifies the color of a background rectangle to place +;; under text annotations. +(defmagick* DrawSetTextUnderColor : + _DrawingWand _PixelWand -> _void) + +;; DrawTranslate applies a translation to the current coordinate system which +;; moves the coordinate system origin to the specified coordinate. +(defmagick* DrawTranslate : + _DrawingWand (x : _double*) (y : _double*) -> _void) + +;; DrawSetViewbox sets the overall canvas size to be recorded with the drawing +;; vector data. Usually this will be specified using the same size as the +;; canvas image. When the vector data is saved to SVG or MVG formats, the +;; viewbox is use to specify the size of the canvas image that a viewer will +;; render the vector data on. +(defmagick* DrawSetViewbox : + _DrawingWand (x1 : _ulong) (y1 : _ulong) (x2 : _ulong) (y2 : _ulong) + -> _void) + +;; NewDrawingWand returns a draw wand required for all other methods in the +;; API. +(defmagick* NewDrawingWand : + -> _DrawingWand) + +;; ===== Misc APIs ============================================================ + +;; These are not part of the Wand API, but they are used by it so we need +;; destructor functions when collecting them. + +;; DestroyImage dereferences an image, deallocating memory associated with the +;; image if the reference count becomes zero. +(defmagick DestroyImage : + _Image -> _void) + +(defmagick DestroyDrawInfo : + _DrawInfo -> _void) diff --git a/collects/ffi/examples/sndfile.ss b/collects/ffi/examples/sndfile.ss old mode 100755 new mode 100644 index bddca62c71..2ccaf9f5e9 --- a/collects/ffi/examples/sndfile.ss +++ b/collects/ffi/examples/sndfile.ss @@ -1,33 +1,343 @@ -#! /usr/bin/env mzscheme - #lang scheme/base -(require ffi/sndfile) +(require mzlib/foreign) (unsafe!) -;; (require swindle) +(define libsndfile (ffi-lib "libsndfile")) -(define (add-half x y) - (/ (+ x (* y 0.5)) 1.5)) +;; ==================== Types etc ==================== -(define (repeated-list x n) - (let loop ([n n] [r '()]) - (if (zero? n) r (loop (sub1 n) (cons x r))))) +;; This is the scheme represtenatation of the soundfile that is handeled by +;; libsndfile. -(let-values ([(data meta) (read-sound* "x.wav")]) - (printf ">>> data-length: ~s\n>>> meta: ~s\n" (length data) meta) - (let* ([data data #; - (list-of (list (add-half (1st x) (1st y)) - (add-half (2nd x) (2nd y))) - (x <- data - and - y <- (append (repeated-list (list 0.0 0.0) 11025) data) - and - i <- 0.1 0.12 ..))]) - (printf "writing to y.wav\n") - (write-sound* "y.wav" - ;data - ;(append data (reverse data)) - (append data (reverse (map reverse data))) - `((artist "Eli") (comment "Comment") (title "Title") - (date "1/1/1999") (software "mzscheme") - ,@meta)))) +;; In libsndfile the sndfile object is represented as a pointer. When +;; translating scheme->c the struct will just return the pointer. When +;; translating from c->scheme, ie. creating the object in scheme it will be +;; wrapped by an object finalizer that uses the libsndfile fuction sf_close that +;; returns a 0 upon successful termination or an error. +(define-struct sndfile (ptr [info #:mutable])) +(define _sndfile + (make-ctype _pointer sndfile-ptr + (lambda (p) + (if p + (make-sndfile p #f) + (error '_sndfile "got a NULL pointer (bad info?)"))))) + +;; sf_count_t is a count type that depends on the operating system however it +;; seems to be a long int for all the supported ones so in this scase we just +;; define it as two ints. +(define _sf-count-t _int64) + +(define _sf-mode + (_bitmask '(sfm-read = #x10 + sfm-write = #x20 + sfm-rdwrt = #x30))) + +(define str-types '(title copyright software artist comment date)) +(define _sf-str-type (_enum (cons "dummy" str-types))) ; begins from 1 + +(define _sf-format + (let ([majors ; Major formats + '((wav #x010000) ; Microsoft WAV format (little endian) + (aiff #x020000) ; Apple/SGI AIFF format (big endian) + (au #x030000) ; Sun/NeXT AU format (big endian) + (raw #x040000) ; RAW PCM data + (paf #x050000) ; Ensoniq PARIS file format + (svx #x060000) ; Amiga IFF / SVX8 / SV16 format + (nist #x070000) ; Sphere NIST format + (voc #x080000) ; VOC files + (ircam #x0A0000) ; Berkeley/IRCAM/CARL + (w64 #x0B0000) ; Sonic Foundry's 64 bit RIFF/WAV + (mat4 #x0C0000) ; Matlab (tm) V4.2 / GNU Octave 2.0 + (mat5 #x0D0000) ; Matlab (tm) V5.0 / GNU Octave 2.1 + (pvf #x0E0000) ; Portable Voice Format + (xi #x0F0000) ; Fasttracker 2 Extended Instrument + (htk #x100000) ; HMM Tool Kit format + (sds #x110000) ; Midi Sample Dump Standard + (avr #x120000) ; Audio Visual Research + (wavex #x130000) ; MS WAVE with WAVEFORMATEX + )] + [subtypes ; Subtypes from here on + '((pcm-s8 #x0001) ; Signed 8 bit data + (pcm-16 #x0002) ; Signed 16 bit data + (pcm-24 #x0003) ; Signed 24 bit data + (pcm-32 #x0004) ; Signed 32 bit data + (pcm-u8 #x0005) ; Unsigned 8 bit data (WAV and RAW only) + (float #x0006) ; 32 bit float data + (double #x0007) ; 64 bit float data + (ulaw #x0010) ; U-Law encoded + (alaw #x0011) ; A-Law encoded + (ima-adpcm #x0012) ; IMA ADPCM + (ms-adpcm #x0013) ; Microsoft ADPCM + (gsm610 #x0020) ; GSM 6.10 encoding + (vox-adpcm #x0021) ; OKI / Dialogix ADPCM + (g721-32 #x0030) ; 32kbs G721 ADPCM encoding + (g723-24 #x0031) ; 24kbs G723 ADPCM encoding + (g723-40 #x0032) ; 40kbs G723 ADPCM encoding + (dwvw-12 #x0040) ; 12 bit Delta Width Variable Word encoding + (dwvw-16 #x0041) ; 16 bit Delta Width Variable Word encoding + (dwvw-24 #x0042) ; 24 bit Delta Width Variable Word encoding + (dwvw-n #x0043) ; N bit Delta Width Variable Word encoding + (dpcm-8 #x0050) ; 8 bit differential PCM (XI only) + (dpcm-16 #x0051) ; 16 bit differential PCM (XI only) + )] + [endians ; Endian-ness options + '((file #x00000000) ; Default file endian-ness + (little #x10000000) ; Force little endian-ness + (big #x20000000) ; Force big endian-ness + (cpu #x30000000) ; Force CPU endian-ness + )] + [submask #x0000FFFF] + [typemask #x0FFF0000] + [endmask #x30000000]) + (define (rev-find n l) + (let loop ([l l]) + (cond [(null? l) #f] + [(eq? n (cadar l)) (caar l)] + [else (loop (cdr l))]))) + (make-ctype _int + (lambda (syms) + (let ([major #f] [subtype #f] [endian #f]) + (for-each + (lambda (sym) + (cond [(assq sym majors) => + (lambda (x) + (if major + (error 'sf-format "got two major modes: ~s" syms) + (set! major (cadr x))))] + [(assq sym subtypes) => + (lambda (x) + (if subtype + (error 'sf-format "got two subtype modes: ~s" syms) + (set! subtype (cadr x))))] + [(assq sym endians) => + (lambda (x) + (if endian + (error 'sf-format "got two endian modes: ~s" syms) + (set! endian (cadr x))))] + [else (error 'sf-format "got a bad symbol: ~s" sym)])) + (if (list? syms) syms (list syms))) + (bitwise-ior (or major 0) (or subtype 0) (or endian 0)))) + (lambda (n) + (let ([subtype (rev-find (bitwise-and n submask) subtypes)] + [major (rev-find (bitwise-and n typemask) majors)] + [endian (rev-find (bitwise-and n endmask) endians)]) + (unless subtype + (error 'sf-format "got a bad number from C for subtype: ~x" + (bitwise-and n submask))) + (unless major + (error 'sf-format "got a bad number from C for major: ~x" + (bitwise-and n typemask))) + (unless endian + (error 'sf-format "got a bad number from C for endian: ~x" + (bitwise-and n endmask))) + (list major subtype endian)))))) + +(define-cstruct _sf-info + ((frames _sf-count-t) + (samplerate _int) + (channels _int) + (format _sf-format) + (sections _int) + (seekable _bool))) + +;; ==================== Utilities ==================== + +(define-syntax defsndfile + (syntax-rules (:) + [(_ name : type ...) + (define name + (get-ffi-obj (regexp-replaces 'name '((#rx"-" "_"))) + libsndfile (_fun type ...)))])) + +(define (n-split l n) + (let loop ([l l][i 0][a2 null][a null]) + (cond + [(null? l) (let ([a (if (null? a2) + a + (cons (reverse a2) a))]) + (reverse a))] + [(= i n) (loop l 0 null (cons (reverse a2) a))] + [else (loop (cdr l) (add1 i) (cons (car l) a2) a)]))) + +;; ==================== sndfile API ==================== + +(defsndfile sf-close : _sndfile -> _int) + +(defsndfile sf-open : (path mode . info) :: + (path : _file) + (mode : _sf-mode) + (info : _sf-info-pointer + = (if (pair? info) (car info) (make-sf-info 0 0 0 '() 0 #f))) + -> (sf : _sndfile) + -> (begin (set-sndfile-info! sf info) sf)) + +(defsndfile sf-format-check : _sf-info-pointer -> _bool) + +(defsndfile sf-readf-short : _sndfile _pointer _sf-count-t -> _sf-count-t) +(defsndfile sf-readf-int : _sndfile _pointer _sf-count-t -> _sf-count-t) +(defsndfile sf-readf-double : _sndfile _pointer _sf-count-t -> _sf-count-t) + +(defsndfile sf-writef-short : _sndfile _pointer _sf-count-t -> _sf-count-t) +(defsndfile sf-writef-int : _sndfile _pointer _sf-count-t -> _sf-count-t) +(defsndfile sf-writef-double : _sndfile _pointer _sf-count-t -> _sf-count-t) + +(defsndfile sf-get-string : _sndfile _sf-str-type -> _string) +(defsndfile sf-set-string : _sndfile _sf-str-type _string -> _bool) + +;; ==================== Utilities for the Scheme interface ==================== + +(define (get-strings sndfile) + (let loop ([sts str-types] [r '()]) + (cond [(null? sts) (reverse r)] + [(sf-get-string sndfile (car sts)) => + (lambda (x) + (loop (cdr sts) (cons (list (car sts) (string-copy x)) r)))] + [else (loop (cdr sts) r)]))) + +(define (set-strings sndfile meta) + (for-each (lambda (st) + (cond [(assq st meta) => + (lambda (x) (sf-set-string sndfile st (cadr x)))])) + str-types)) + +(define (read-sound-internal file meta?) + (let* ([sndfile (sf-open file 'sfm-read)] + [strings (and meta? (get-strings sndfile))] + [info (sndfile-info sndfile)] + [frames (sf-info-frames info)] + [channels (sf-info-channels info)] + [stype (case (sample-type) + [(short) _int16] [(int) _int] [(float) _double*])] + [readf (case (sample-type) + [(short) sf-readf-short] + [(int) sf-readf-int] + [(float) sf-readf-double])] + [cblock (malloc (* frames channels) stype)] + [num-read (readf sndfile cblock frames)] + [data (cblock->list cblock stype (* num-read channels))] + [data (if (> channels 1) (n-split data channels) data)]) + (unless (= frames num-read) + (error 'read-sound-internal + "wanted ~s frames, but got ~s" frames num-read)) + (begin0 (if meta? + (values data `((frames ,frames) + (samplerate ,(sf-info-samplerate info)) + (channels ,channels) + (format ,(sf-info-format info)) + (sections ,(sf-info-sections info)) + ,@strings)) + data) + (sf-close sndfile)))) + +(define (frame-list->cblock data frames channels type) + (cond + [(null? data) #f] + [(and (= 1 channels) (not (pair? (car data)))) (list->cblock data type)] + [else + (let ([test (lambda (x) + (and (list? x) (= channels (length x)) (andmap number? x)))]) + (unless (andmap test data) + (error 'frame-list->cblock "got a bad frame: ~e" + (ormap (lambda (x) (and (not (test x)) x)) data)))) + (let ([cblock (malloc (* channels frames) type)] + [i 0]) + (let loop ([d data]) + (cond [(number? d) (ptr-set! cblock type i d) (set! i (add1 i))] + [(pair? d) (loop (car d)) (loop (cdr d))])) + cblock)])) + +(define (write-sound-internal file data meta) + (let* ([frames (length data)] + [channels (if (or (null? data) (not (pair? (car data)))) + 1 ; 1-channel if no data, or data is not made of lists + (length (car data)))] + [stype (case (sample-type) + [(short) _int16] [(int) _int] [(float) _double*])] + [writef (case (sample-type) + [(short) sf-writef-short] + [(int) sf-writef-int] + [(float) sf-writef-double])] + [cblock (frame-list->cblock data frames channels stype)] + [format (cond [(assq 'format meta) => cadr] + [else (guess-format file)])] + [samplerate (cond [(assq 'samplerate meta) => cadr] + [else (default-samplerate)])] + [info (make-sf-info frames samplerate channels format 1 #f)] + [_ (unless (sf-format-check info) + (error 'write-sound-internal "bad format: ~s" format))] + [sndfile (sf-open file 'sfm-write info)] + [_ (set-strings sndfile meta)] + [num-write (writef sndfile cblock frames)]) + (unless (= frames num-write) + (error 'write-sound-internal + "wanted to write ~s frames, but wrote only ~s" frames num-write)) + (sf-close sndfile) + (void))) + +(define file-format-table + '((#rx"\\.aiff?" (aiff pcm-16 file)) + (#rx"\\.wave?" (wav pcm-16 file)) + (#rx"\\.au" (au pcm-16 file)) + (#rx"\\.snd" (au pcm-16 file)) + (#rx"\\.svx" (svx pcm-16 file)) + (#rx"\\.paf" (paf pcm-16 big)) + (#rx"\\.fap" (paf pcm-16 little)) + (#rx"\\.nist" (nist pcm-16 little)) + (#rx"\\.ircam" (ircam pcm-16 little)) + (#rx"\\.sf" (ircam pcm-16 little)) + (#rx"\\.voc" (voc pcm-16 file)) + (#rx"\\.w64" (w64 pcm-16 file)) + (#rx"\\.raw" (raw pcm-16 cpu)) + (#rx"\\.mat4" (mat4 pcm-16 little)) + (#rx"\\.mat5" (mat5 pcm-16 little)) + (#rx"\\.mat" (mat4 pcm-16 little)) + (#rx"\\.pvf" (pvf pcm-16 file)) + (#rx"\\.sds" (sds pcm-16 file)) + (#rx"\\.xi" (xi dpcm-16 file)))) +(define (guess-format filename) + (let loop ([xs file-format-table]) + (cond [(null? xs) (default-file-format)] + [(regexp-match (caar xs) filename) (cadar xs)] + [else (loop (cdr xs))]))) + +;; ==================== Exposed Scheme interface ==================== + +;; types of samples we handle: 'short, 'int, or 'float +(provide sample-type) +(define sample-type + (make-parameter + 'float (lambda (x) + (if (memq x '(short int float)) + x (error 'sample-type "bad type: ~s" x))))) + +;; TODO: add a parameter that will determine if you get a list, vector or +;; srfi/4-like thing. possibly also determine if a list/vector gets automatic +;; treatment of 1-channel - not converting it into a list of singleton lists. + +(provide default-samplerate) +(define default-samplerate + (make-parameter + 11025 (lambda (x) + (if (and (integer? x) (positive? x)) + x (error 'default-samplerate "bad samplerate: ~s" x))))) + +(provide default-file-format) +(define default-file-format ; no guard, but should be good for _sf-format + (make-parameter '(wav pcm-16 file))) + +(provide read-sound) +(define (read-sound file) + (read-sound-internal file #f)) + +(provide read-sound*) +(define (read-sound* file) + (read-sound-internal file #t)) + +(provide write-sound) +(define (write-sound file data) + (write-sound-internal file data '())) + +;; meta is used only for samplerate & format +(provide write-sound*) +(define (write-sound* file data meta) + (write-sound-internal file data meta)) diff --git a/collects/ffi/examples/tcl.ss b/collects/ffi/examples/tcl.ss old mode 100755 new mode 100644 index 8550fadb76..08979b4fbd --- a/collects/ffi/examples/tcl.ss +++ b/collects/ffi/examples/tcl.ss @@ -1,25 +1,49 @@ -#! /usr/bin/env mzscheme - #lang scheme/base -(require ffi/tcl) +(require mzlib/foreign) (unsafe!) -(define (tcldemo . strs) - (for-each (lambda (s) - (printf "> ~a\n" s) - (with-handlers ([void (lambda (e) - (display (if (exn? e) (exn-message e) e) - (current-error-port)) - (newline (current-error-port)))]) - (printf "~a\n" (eval-tcl s)))) - strs)) +(define libtcl (ffi-lib "libtcl")) -(tcldemo "puts 123" - "puts $a" - "set a {this is some stupid string}" - "set b [list a a]" - "set c {[list $a $a]}" - "puts \"a = \\\"$a\\\"\"" - "puts \"b = \\\"$b\\\"\"" - "puts \"c = \\\"$c\\\"\"" - "puts \"even better... \\\"[expr $c]\\\"\"") +(provide current-interp create-interp eval-tcl) + +(define current-interp + (make-parameter + #f (lambda (x) + (if (and x (cpointer? x)) + x + (error 'tcl:current-interp + "expecting a non-void C pointer, got ~s" x))))) + +;; This creates _interp as a type to be used for functions that return an +;; interpreter that should be destroyed with delete-interp. +(define _interp + (make-ctype _pointer #f ; no op when going to C + (lambda (interp) + (when interp (register-finalizer interp delete-interp)) + interp))) + +;; This is for arguments that always use the value of current-interp +(define-fun-syntax _interp* + (syntax-id-rules () + [_ (type: _interp expr: (current-interp))])) + +(define create-interp + (get-ffi-obj "Tcl_CreateInterp" libtcl (_fun -> _interp))) +(define delete-interp + (let ([f (get-ffi-obj "Tcl_DeleteInterp" libtcl (_fun _interp -> _void))]) + (lambda (i) (f i)))) + +(current-interp (create-interp)) + +(define get-string-result + (get-ffi-obj "Tcl_GetStringResult" libtcl (_fun _interp -> _string))) + +(define _tclret + (make-ctype (_enum '(ok error return break continue)) + (lambda (x) (error "tclret is only for return values")) + (lambda (x) + (when (eq? x 'error) (error 'tcl (get-string-result (current-interp)))) + x))) + +(define eval-tcl + (get-ffi-obj "Tcl_Eval" libtcl (_fun _interp* (expr : _string) -> _tclret))) diff --git a/collects/ffi/examples/use-c-printf.ss b/collects/ffi/examples/use-c-printf.ss new file mode 100755 index 0000000000..39e9fb06d8 --- /dev/null +++ b/collects/ffi/examples/use-c-printf.ss @@ -0,0 +1,13 @@ +#! /usr/bin/env racket + +#lang racket/base + +(require "c-printf.ss") + +(c-printf-is-dangerous!) ; see last example below + +(c-printf "|%4d| |%04d| |%-4d|\n" 12 34 56) +(c-printf "|%4d| |%04d| |%-4d|\n" "12" "34" "56") +(c-printf "Bye bye sanity:\n") +(c-printf "%s\n" 0) +(c-printf "%s\n" 1234) diff --git a/collects/ffi/examples/use-crypt.ss b/collects/ffi/examples/use-crypt.ss new file mode 100755 index 0000000000..4aeecf04d5 --- /dev/null +++ b/collects/ffi/examples/use-crypt.ss @@ -0,0 +1,19 @@ +#! /usr/bin/env racket + +#lang racket/base + +(require "crypt.ss") + +(define passwd "foo") +(define salt "xz") +(printf ">>> crypt(~s,~s) = ~s\n" passwd salt (crypt passwd salt)) + +;; md5-based version +(set! salt "$1$somesalt$") +(printf ">>> crypt(~s,~s) = ~s\n" passwd salt (crypt passwd salt)) + +(newline) +(define foo "foo bar") +(define key (string->bytes/utf-8 "my key")) +(printf ">>> ~s --encrypt--> ~s --decrypt--> ~s\n" + foo (encrypt foo key) (decrypt (encrypt foo key) key)) diff --git a/collects/ffi/examples/use-esd.ss b/collects/ffi/examples/use-esd.ss new file mode 100755 index 0000000000..61a31fcf1d --- /dev/null +++ b/collects/ffi/examples/use-esd.ss @@ -0,0 +1,31 @@ +#! /usr/bin/env racket + +#lang racket/base + +(require "esd.ss") + +(printf "default = ~s\n" (default-esd)) +(printf "latency = ~s\n" (esd-get-latency)) +(printf "standby -> ~s\n" (esd-standby)) +(sleep 1) +(printf "resume -> ~s\n" (esd-resume)) + +(printf "Normal play...\n") +(esd-play-file "esd.ss" "~/stuff/sounds/Eeeooop.wav" #t) +(sleep 1) + +(printf "Sample play...\n") +(let ((sample-id (esd-file-cache "foooo" "~/stuff/sounds/Eeeooop.wav"))) + (printf ">>> sample = ~s\n" sample-id) + (printf ">>> getid -> ~s\n" + (esd-sample-getid "foooo:/home/eli/stuff/sounds/Eeeooop.wav")) + (printf "playing...\n") + (esd-sample-play sample-id) + (sleep 1) + (printf "looping...\n") + (esd-sample-loop sample-id) + (sleep 3) + (printf "enough!\n") + (esd-sample-stop sample-id) + (sleep 1) + (printf "bye.\n")) diff --git a/collects/ffi/examples/use-magick.ss b/collects/ffi/examples/use-magick.ss new file mode 100755 index 0000000000..4d943e90fe --- /dev/null +++ b/collects/ffi/examples/use-magick.ss @@ -0,0 +1,316 @@ +#! /usr/bin/env racket + +#lang racket/base + +(require "magick.ss" (for-syntax racket/base)) + +(define-syntax (test stx) + (syntax-case stx () + [(_ (func arg ...)) + (with-syntax ([(tmp ...) (generate-temporaries #'(arg ...))]) + #'(let ([tmp arg] ...) + (printf ">>> ~s~s\n" 'func `(,tmp ...)) + (let ([r (func tmp ...)]) + (printf " -> ~s\n" r) + r)))])) + +;; (test (MagickGetPackageName)) +;; (test (MagickGetCopyright)) +;; (test (MagickGetVersion)) +;; (test (MagickGetReleaseDate)) +;; (test (MagickGetQuantumDepth)) +;; (test (MagickQueryConfigureOptions "CO*")) +;; (test (MagickQueryFonts "Cou*")) +;; (test (MagickQueryFormats "J*")) +;; (test (MagickGetHomeURL)) + +;; (define w (test (NewMagickWand))) +;; (test (MagickGetImageFilename w)) +;; (test (MagickReadImage w "~/html/images/eli.jpg")) + +(define w (test (MagickReadImage "~/html/images/eli.jpg"))) +;; (test (MagickGetImageFilename w)) + +;; (test (MagickGetImageFilename w)) +;; (test (MagickGetImageFormat w)) +;; (test (MagickGetImageCompression w)) +;; (test (MagickGetImageDispose w)) +;; (test (MagickGetImageType w)) +;; (test (MagickGetImageInterlaceScheme w)) +;; (test (MagickGetImageIndex w)) +;; (test (MagickGetImageSize w)) +;; (test (MagickGetImageSignature w)) +;; (test (MagickBlurImage w 2.0 1.0)) +;; ;; (test (MagickReadImage w "~/html/images/eeli.jpg")) +;; ;; (test (MagickGetException w)) +;; (test (MagickSwirlImage w 90.0)) +;; (test (MagickWaveImage w 4.0 40.0)) +;; (test (MagickCharcoalImage w 5.0 0.7)) +;; (test (MagickGetImageCompose w)) +;; (test (MagickGetImageColorspace w)) +;; (test (MagickCommentImage w "This is my test image")) +;; (test (MagickWriteImage w "~/tmp/x.jpg")) +;; (test (MagickDisplayImage w #f)) +;; (test (MagickDescribeImage w)) +;; (test (MagickGetImageWidth w)) +;; (test (MagickGetImageHeight w)) +;; (test (MagickGetImageChannelDepth w 'RedChannel)) +;; (test (MagickGetImageExtrema w)) +;; (test (MagickGetImageChannelExtrema w 'RedChannel)) +;; (test (MagickGetImageChannelMean w 'RedChannel)) +;; (test (MagickGetImageColors w)) +;; (test (MagickGetImageDelay w)) +;; (test (MagickSetImageDelay w 20)) +;; (test (MagickGetImageDelay w)) +;; (test (MagickGetImageDepth w)) +;; (test (MagickSetImageDepth w 2)) +;; (test (MagickGetImageDepth w)) +;; (test (MagickGetImageIterations w)) +;; (test (MagickSetImageIterations w 4)) +;; (test (MagickGetImageIterations w)) +;; (test (MagickGetSamplingFactors w)) +;; (test (MagickSetSamplingFactors w '(2.0 1.0 0.5))) +;; (test (MagickGetSamplingFactors w)) +;; (test (MagickGetImageRenderingIntent w)) +;; (test (MagickSetImageRenderingIntent w 'SaturationIntent)) +;; (test (MagickGetImageRenderingIntent w)) +;; (test (MagickGetImageUnits w)) +;; (test (MagickSetImageUnits w 'PixelsPerInchResolution)) +;; (test (MagickGetImageUnits w)) +;; (test (MagickGetImageVirtualPixelMethod w)) +;; (test (MagickSetImageVirtualPixelMethod w 'EdgeVirtualPixelMethod)) +;; (test (MagickGetImageVirtualPixelMethod w)) +;; (test (MagickGetImageWhitePoint w)) +;; (test (MagickSetImageWhitePoint w 3.0 4.0)) +;; (test (MagickGetImageWhitePoint w)) +;; (test (MagickGetImageResolution w)) +;; (test (MagickSetImageResolution w 33.0 33.0)) +;; (test (MagickGetImageResolution w)) +;; (test (MagickGetSize w)) +;; (test (MagickSetSize w 20 20)) +;; (test (MagickGetSize w)) +;; (test (MagickGetImageProfile w "ICC")) + +;; (test (MagickAdaptiveThresholdImage w 2 2 0)) +;; (test (MagickAddNoiseImage w 'LaplacianNoise)) +;; (test (MagickEmbossImage w 1.0 0.5)) +;; (test (MagickEvaluateImage w 'MaxEvaluateOperator 30768.0)) +;; (test (MagickEvaluateImage w 'MinEvaluateOperator 34768.0)) +;; (test (MagickEvaluateImageChannel w 'RedChannel 'MaxEvaluateOperator 28768.0)) +;; (test (MagickEvaluateImageChannel w 'RedChannel 'MinEvaluateOperator 36768.0)) +;; (test (MagickGetImageGamma w)) +;; (test (MagickGammaImage w 0.5)) +;; (test (MagickSetImageGamma w 0.5)) +;; (test (MagickGetImageGamma w)) +;; (test (MagickGaussianBlurImage w 5.0 2.0)) +;; (test (MagickGaussianBlurImageChannel w 'RedChannel 1.0 0.1)) +;; (test (MagickGetImageRedPrimary w)) +;; (test (MagickSetImageRedPrimary w 20.0 20.0)) +;; (test (MagickGetImageRedPrimary w)) +;; (test (MagickTransformImage w "120x120+10+10" "100x100+0+0")) +;; (test (MagickThresholdImage w 32768.0)) +;; (test (MagickThresholdImageChannel w 'RedChannel 32768.0)) +;; (test (MagickSpreadImage w 2.0)) +;; (test (MagickOilPaintImage w 3.0)) +;; (test (MagickSpliceImage w 100 100 50 50)) +;; (test (MagickSolarizeImage w 2.0)) +;; (test (MagickShaveImage w 20 50)) +;; (test (MagickSharpenImage w 10.0 9.0)) +;; (test (MagickPosterizeImage w 2 #t)) +;; (test (MagickContrastImage w 20)) +;; (test (MagickEdgeImage w 5.0)) +;; (test (MagickImplodeImage w 0.5)) + +;; (test (MagickConvolveImage +;; w '(( 0.0 -1.0 0.0) ; sharpen +;; (-1.0 5.0 -1.0) +;; ( 0.0 -1.0 0.0)))) +;; (test (MagickConvolveImage ; sharpen++ +;; w '((-1.0 -1.0 -1.0) +;; (-1.0 9.0 -1.0) +;; (-1.0 -1.0 -1.0)))) +;; (test (MagickConvolveImage ; blur +;; w '(( 1.0 1.0 1.0) +;; ( 1.0 1.0 1.0) +;; ( 1.0 1.0 1.0)))) +;; (test (MagickConvolveImage ; edge enhance +;; w '(( 0.0 0.0 0.0) +;; (-1.0 1.0 0.0) +;; ( 0.0 0.0 0.0)))) +;; (test (MagickConvolveImage ; edge enhance++ +;; w '((-1.0 0.0 1.0) +;; (-1.0 0.0 1.0) +;; (-1.0 0.0 1.0)))) +;; (test (MagickConvolveImage ; edge detect +;; w '(( 0.0 1.0 0.0) +;; ( 1.0 -4.0 1.0) +;; ( 0.0 1.0 0.0)))) +;; (test (MagickConvolveImage ; emboss +;; w '((-2.0 -1.0 0.0) +;; (-1.0 1.0 1.0) +;; ( 0.0 1.0 2.0)))) +;; (test (MagickConvolveImageChannel +;; w 'RedChannel '((1.0 0.0 0.0 0.0 1.0) +;; (0.0 0.0 0.0 0.0 0.0) +;; (0.0 0.0 -1.0 0.0 0.0) +;; (0.0 0.0 0.0 0.0 0.0) +;; (1.0 0.0 0.0 0.0 1.0)))) + +;; (define pixels (test (MagickGetImagePixels w 0 0 40 40 "RGB" 'ShortPixel))) +;; (test (MagickSetImagePixels +;; w 0 0 "RGB" 'ShortPixel +;; (let ([pixels (map (lambda (x) (append x x)) +;; pixels)]) +;; (append pixels +;; (map (lambda (row) +;; (map (lambda (pixel) +;; (list (cadr pixel) (caddr pixel) (car pixel)) +;; ;; (map (lambda (v) (- 65535 v)) pixel) +;; ) +;; row)) +;; pixels))))) + +;; (test (MagickLabelImage w "FOO")) +;; (test (MagickLevelImage w 20000.0 1.0 45535.0)) +;; (test (MagickMedianFilterImage w 2.0)) +;; (test (MagickModulateImage w 100.0 100.0 40.0)) +;; (test (MagickMotionBlurImage w 10.0 10.0 60.0)) +;; (test (MagickNegateImage w #f)) +;; (test (MagickNegateImageChannel w 'GreenChannel #f)) +;; (test (MagickNormalizeImage w)) +;; (test (MagickRaiseImage w 10 10 20 20 #f)) + +;; (MagickMinifyImage w) (MagickMinifyImage w) (MagickMinifyImage w) +;; (test (MagickResampleImage w 576.0 576.0 'UndefinedFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'BoxFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'TriangleFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'HermiteFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'HanningFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'HammingFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'BlackmanFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'GaussianFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'QuadraticFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'CubicFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'CatromFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'MitchellFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'LanczosFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'BesselFilter 1.0)) +;; (test (MagickResampleImage w 576.0 576.0 'SincFilter 1.0)) + +;; (test (MagickOpaqueImage w "black" "yellow" 20000.0)) +;; (test (MagickColorFloodfillImage w "yellow" 20000.0 "black" 0 0)) +;; (test (MagickColorFloodfillImage w "yellow" 20000.0 #f 0 0)) +;; (test (MagickColorFloodfillImage w '(65535 0 0) 20000.0 "black" 0 0)) +;; (test (MagickColorFloodfillImage w '(65535 0 0 32737) 20000.0 "black" 0 0)) + +;; (test (MagickTransparentImage w "black" 16384 20000.0)) +;; (test (MagickWriteImage w "~/tmp/x.png")) + +;; (test (MagickResetIterator w)) +;; (test (MagickGetImageProfile w "ICC")) +;; (test (MagickSetImageProfile w "ICC" "foo")) +;; (test (MagickGetImageProfile w "ICC")) + +;; (test (MagickGetImageBackgroundColor w)) + +;; (test (MagickDisplayImage w)) + +;; (for-each +;; (lambda (p) (MagickDisplayImage (test (MagickPreviewImages w p)))) +;; '(UndefinedPreview RotatePreview ShearPreview RollPreview HuePreview +;; SaturationPreview BrightnessPreview GammaPreview SpiffPreview DullPreview +;; GrayscalePreview QuantizePreview DespecklePreview ReduceNoisePreview +;; AddNoisePreview SharpenPreview BlurPreview ThresholdPreview +;; EdgeDetectPreview SpreadPreview SolarizePreview ShadePreview RaisePreview +;; SegmentPreview SwirlPreview ImplodePreview WavePreview OilPaintPreview +;; CharcoalDrawingPreview JPEGPreview)) + +;; (test (MagickDisplayImage +;; (MagickFxImageChannel w 'AllChannels "(p[-4,-4].r+p[4,4].g)/2"))) + +;; (test (MagickMagnifyImage w)) +;; (let ([ww (CloneMagickWand w)]) +;; (test (MagickMinifyImage ww)) +;; (test (MagickMinifyImage ww)) +;; (test (MagickMinifyImage ww)) +;; (test (MagickDisplayImage (MagickTextureImage w ww)))) + +;; (test (MagickChopImage w 100 100 10 10)) +;; (test (MagickCropImage w 100 100 10 10)) +;; (test (MagickDisplayImage w)) + +;; (define w1 (test (CloneMagickWand w))) +;; (test (MagickBlurImage w1 1.0 0.18)) +;; (define t (cadr (test (MagickCompareImageChannels +;; w w1 'RedChannels 'MeanSquaredErrorMetric)))) +;; (test (MagickDisplayImage t)) + +;; (test (MagickReadImage w "~/html/images/EliRegina.jpg")) +;; (define morph (test (MagickMorphImages w 20))) +;; (test (MagickWriteImage morph "~/tmp/x.gif")) +;; (MagickAnimateImages morph) + +;; (let ([x (test (MagickWriteImageBlob w))]) +;; (with-output-to-file "~/tmp/x" (lambda () (display x)) 'truncate) +;; (let ([ww (NewMagickWand)]) +;; (test (MagickReadImageBlob ww x)) +;; (MagickDisplayImage ww))) + +;; (define w (test (NewMagickWand))) +;; (test (MagickReadImage w "~/html/images/spinlambda.gif")) +;; (test (MagickDisplayImage (test (MagickAppendImages w #f)))) +;; (test (MagickDisplayImage (MagickAverageImages w))) +;; (test (MagickDisplayImage (test (MagickDeconstructImages w)))) +;; (MagickAnimateImages w) + +;; (let ([y (NewPixelWand "yellow")] +;; [c (test (PixelGetQuantumColor "yellow"))] +;; [r (NewPixelWand "red")] +;; [rgb (lambda (p) +;; (map (lambda (f) (f p)) +;; (list PixelGetRedQuantum +;; PixelGetGreenQuantum +;; PixelGetBlueQuantum)))]) +;; (printf ">>> y = ~s\n" (rgb y)) +;; (printf ">>> r1 = ~s\n" (rgb r)) +;; (PixelSetQuantumColor r c) +;; (printf ">>> r2 = ~s\n" (rgb r))) + +;; (define i (test (NewPixelRegionIterator w 0 0 10 10))) +;; (test (PixelSetIteratorRow i 5)) +;; (test (map PixelGetRedQuantum (PixelGetNextRow i))) +;; (test (map PixelGetRedQuantum (PixelGetNextRow i))) +;; (test (map PixelGetRedQuantum (PixelGetNextRow i))) + +(define d (test (NewDrawingWand))) +;; (test (DrawGetTextEncoding d)) +;; (test (MagickQueryFonts "Cou*")) +(test (DrawSetFont d "Courier-Bold")) +(test (DrawGetFont d)) +(test (DrawSetFontSize d 96.0)) +(test (DrawSetFontStretch d 'UltraCondensedStretch)) +(test (DrawSetFontStyle d 'ObliqueStyle)) +(test (DrawSetFontWeight d 24)) +(test (DrawSetGravity d 'CenterGravity)) +(test (DrawGetStrokeDashArray d)) +(test (DrawSetStrokeDashArray d '(20.0 20.0))) +(test (DrawGetStrokeDashArray d)) +(test (DrawSetStrokeColor d "red")) +(test (DrawSetStrokeAntialias d #t)) +(test (DrawSetStrokeWidth d 5.0)) +(test (DrawSetStrokeLineCap d 'RoundCap)) +(test (DrawSetStrokeOpacity d 0.5)) +;; (test (DrawLine d 0.0 0.0 200.0 200.0)) +(define line '((10.0 10.0) (100.0 100.0) (100.0 10.0) (50.0 20.0))) +;; (test (DrawPolyline d line)) +;; (test (DrawPolygon d line)) +;; (test (DrawBezier d line)) +;; (test (DrawLine d 0.0 0.0 100.0 100.0)) +;; (test (DrawLine d 5.0 0.0 105.0 100.0)) +;; (test (DrawLine d 10.0 0.0 110.0 100.0)) +(test (DrawAffine d '(0.0 1.0 1.0 0.5 0.0 0.0))) +(test (DrawAnnotation d 0.0 0.0 "FOO")) +;; (test (DrawArc d 0.0 0.0 100.0 100.0 0.0 270.0)) +;; (test (DrawCircle d 50.0 50.0 50.0 0.0)) +(test (MagickDrawImage w d)) +(test (MagickDisplayImage w)) diff --git a/collects/ffi/examples/use-sndfile.ss b/collects/ffi/examples/use-sndfile.ss new file mode 100755 index 0000000000..868140b062 --- /dev/null +++ b/collects/ffi/examples/use-sndfile.ss @@ -0,0 +1,33 @@ +#! /usr/bin/env racket + +#lang racket/base + +(require "sndfile.ss") + +;; (require swindle) + +(define (add-half x y) + (/ (+ x (* y 0.5)) 1.5)) + +(define (repeated-list x n) + (let loop ([n n] [r '()]) + (if (zero? n) r (loop (sub1 n) (cons x r))))) + +(let-values ([(data meta) (read-sound* "x.wav")]) + (printf ">>> data-length: ~s\n>>> meta: ~s\n" (length data) meta) + (let* ([data data #; + (list-of (list (add-half (1st x) (1st y)) + (add-half (2nd x) (2nd y))) + (x <- data + and + y <- (append (repeated-list (list 0.0 0.0) 11025) data) + and + i <- 0.1 0.12 ..))]) + (printf "writing to y.wav\n") + (write-sound* "y.wav" + ;data + ;(append data (reverse data)) + (append data (reverse (map reverse data))) + `((artist "Eli") (comment "Comment") (title "Title") + (date "1/1/1999") (software "mzscheme") + ,@meta)))) diff --git a/collects/ffi/examples/use-tcl.ss b/collects/ffi/examples/use-tcl.ss new file mode 100755 index 0000000000..c163c8f95f --- /dev/null +++ b/collects/ffi/examples/use-tcl.ss @@ -0,0 +1,25 @@ +#! /usr/bin/env racket + +#lang racket/base + +(require "tcl.ss") + +(define (tcldemo . strs) + (for-each (lambda (s) + (printf "> ~a\n" s) + (with-handlers ([void (lambda (e) + (display (if (exn? e) (exn-message e) e) + (current-error-port)) + (newline (current-error-port)))]) + (printf "~a\n" (eval-tcl s)))) + strs)) + +(tcldemo "puts 123" + "puts $a" + "set a {this is some stupid string}" + "set b [list a a]" + "set c {[list $a $a]}" + "puts \"a = \\\"$a\\\"\"" + "puts \"b = \\\"$b\\\"\"" + "puts \"c = \\\"$c\\\"\"" + "puts \"even better... \\\"[expr $c]\\\"\"") diff --git a/collects/ffi/examples/use-xmmsctrl.ss b/collects/ffi/examples/use-xmmsctrl.ss new file mode 100755 index 0000000000..b83adbbf7b --- /dev/null +++ b/collects/ffi/examples/use-xmmsctrl.ss @@ -0,0 +1,55 @@ +#! /usr/bin/env racket + +#lang racket/base + +(require (prefix-in xmms- "xmmsctrl.ss")) + +(printf "version: ~s\n" (xmms-get-version)) +(printf "skin: ~s\n" (xmms-get-skin)) +(printf "volume: ~s\n" (xmms-get-volume)) +(printf "balance: ~s\n" (xmms-get-balance)) +(printf "number of tracks: ~s\n" (xmms-get-playlist-length)) +(printf "Track #10 file = ~s\n" (xmms-get-playlist-file 10)) +(printf "Track #10 title = ~s\n" (xmms-get-playlist-title 10)) +(printf "Track #10 time = ~s\n" (xmms-get-playlist-time 10)) + +;; (define all-files +;; (let loop ((i (sub1 (xmms-get-playlist-length))) (files '())) +;; (if (< i 0) +;; files (loop (sub1 i) (cons (xmms-get-playlist-file i) files))))) +;; (printf "Number of files: ~s\n" (length all-files)) +;; (sleep 1) +;; (xmms-playlist (list (car all-files) (caddr all-files) (cadddr all-files)) #f) +;; (sleep 1) +;; (xmms-playlist all-files #f) +;; (sleep 1) +;; (xmms-stop) + +;; (let ([eq (xmms-get-eq)]) +;; (xmms-set-eq (list 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)) +;; (sleep 1) +;; (xmms-set-eq eq) +;; (sleep 1)) + +(xmms-set-playlist-pos 10) +(printf "playing? -> ~s\n" (xmms-is-playing?)) +(xmms-play) + +(define t + (thread (lambda () + (let loop () + (printf ">>> ~s\n" (xmms-get-output-time)) (sleep .1) (loop))))) +(define (back-sec) + (let ([t (- (xmms-get-output-time) 1000)]) + (printf "Jumping to ~s\n" t) + (xmms-jump-to-time t))) +(sleep 3) (back-sec) (sleep 3) (back-sec) (sleep 3) (back-sec) (sleep 3) +(kill-thread t) + +(printf "playing? -> ~s\n" (xmms-is-playing?)) +(printf "pos -> ~s\n" (xmms-get-playlist-pos)) +(printf "info -> ~s\n" (xmms-get-info)) +(xmms-playlist-next) +(sleep 1) +(printf "pos -> ~s\n" (xmms-get-playlist-pos)) +(xmms-stop) diff --git a/collects/ffi/examples/use-xosd.ss b/collects/ffi/examples/use-xosd.ss new file mode 100755 index 0000000000..bba6efc816 --- /dev/null +++ b/collects/ffi/examples/use-xosd.ss @@ -0,0 +1,75 @@ +#! /usr/bin/env racket + +#lang racket/base + +(require "xosd.ss") + +(define x (xosd-create)) + +;; (xost-set-bar-length x 12) +(xosd-set-pos x 'middle) +(xosd-set-align x 'center) +(xosd-set-shadow-offset x 7) +(xosd-set-outline-offset x 2) +(xosd-set-colour x "yellow") +(xosd-set-shadow-colour x "black") +(xosd-set-outline-colour x "blue") +(xosd-set-font x "-adobe-courier-bold-r-*-*-34-*-*-*-*-*-*-*") + +(printf ">>> xosd=~s, lines=~s, colour=~s\n" + x (xosd-get-number-lines x) (xosd-get-colour x)) + +(xosd-display-string x "Xosd Test") + +;; this doesn't work for some reason +;; (xosd-set-timeout x 1) +;; (xosd-wait-until-no-display x) + +(sleep 2) +(xosd-set-timeout x 0) + +(let loop ([n 10]) + (unless (zero? n) + (xosd-show x) + (sleep .05) + (xosd-hide x) + (sleep .05) + (loop (sub1 n)))) + +(let ([f (lambda (disp) + (let loop ([n 100]) + (when (> n 0) (disp x n) (sleep .1) (loop (- n 5)))))]) + (xosd-set-bar-length x 10) + (f xosd-display-percentage) + (sleep 1) + (xosd-set-bar-length x 20) + (f xosd-display-slider) + (xosd-hide x) + (sleep 1) + (xosd-display-string x "FOO") + (f (lambda (x n) + (xosd-hide x) (xosd-set-vertical-offset x n) (xosd-show x))) + (f (lambda (x n) + (xosd-hide x) (xosd-set-vertical-offset x (- 100 n)) (xosd-show x))) + (f (lambda (x n) + (xosd-hide x) (xosd-set-vertical-offset x n) (xosd-show x))) + (f (lambda (x n) + (xosd-hide x) (xosd-set-vertical-offset x (- 100 n)) (xosd-show x)))) +(xosd-hide x) +(sleep 1) + +(set! x (xosd-create 4)) +(xosd-set-pos x 'middle) +(xosd-set-align x 'center) +(xosd-set-font x "-adobe-courier-bold-r-*-*-25-*-*-*-*-*-*-*") +(xosd-set-shadow-offset x 7) +(xosd-set-outline-offset x 2) +(xosd-display-string x "This is the first line" 0) +(xosd-display-string x "and the second line" 1) +(xosd-display-string x "the third one" 2) +(xosd-display-string x "and finally the fourth line" 3) +(sleep 2) (xosd-scroll x 1) +(sleep 1) (xosd-scroll x 1) +(sleep 1) (xosd-scroll x 1) +(sleep 1) (xosd-scroll x 1) +(sleep 1) diff --git a/collects/ffi/examples/xmmsctrl.ss b/collects/ffi/examples/xmmsctrl.ss old mode 100755 new mode 100644 index 8645381b19..ecccddcbe1 --- a/collects/ffi/examples/xmmsctrl.ss +++ b/collects/ffi/examples/xmmsctrl.ss @@ -1,55 +1,109 @@ -#! /usr/bin/env mzscheme - #lang scheme/base -(require (prefix-in xmms- ffi/xmmsctrl)) +(require mzlib/foreign) (unsafe!) -(printf "version: ~s\n" (xmms-get-version)) -(printf "skin: ~s\n" (xmms-get-skin)) -(printf "volume: ~s\n" (xmms-get-volume)) -(printf "balance: ~s\n" (xmms-get-balance)) -(printf "number of tracks: ~s\n" (xmms-get-playlist-length)) -(printf "Track #10 file = ~s\n" (xmms-get-playlist-file 10)) -(printf "Track #10 title = ~s\n" (xmms-get-playlist-title 10)) -(printf "Track #10 time = ~s\n" (xmms-get-playlist-time 10)) +(define libxmms (ffi-lib "libxmms")) -;; (define all-files -;; (let loop ((i (sub1 (xmms-get-playlist-length))) (files '())) -;; (if (< i 0) -;; files (loop (sub1 i) (cons (xmms-get-playlist-file i) files))))) -;; (printf "Number of files: ~s\n" (length all-files)) -;; (sleep 1) -;; (xmms-playlist (list (car all-files) (caddr all-files) (cadddr all-files)) #f) -;; (sleep 1) -;; (xmms-playlist all-files #f) -;; (sleep 1) -;; (xmms-stop) +(provide session) +(define session + (make-parameter + 0 (lambda (x) + (if (integer? x) + x + (error 'xmms-session "expecting an integer, got ~s" x))))) -;; (let ([eq (xmms-get-eq)]) -;; (xmms-set-eq (list 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)) -;; (sleep 1) -;; (xmms-set-eq eq) -;; (sleep 1)) +;; used for playlist position values +(define _pos _int) -(xmms-set-playlist-pos 10) -(printf "playing? -> ~s\n" (xmms-is-playing?)) -(xmms-play) +;; number of equalizer bands +(define eq-bands 10) -(define t - (thread (lambda () - (let loop () - (printf ">>> ~s\n" (xmms-get-output-time)) (sleep .1) (loop))))) -(define (back-sec) - (let ([t (- (xmms-get-output-time) 1000)]) - (printf "Jumping to ~s\n" t) - (xmms-jump-to-time t))) -(sleep 3) (back-sec) (sleep 3) (back-sec) (sleep 3) (back-sec) (sleep 3) -(kill-thread t) +;; used for getting the default session from the session parameter +(define-fun-syntax _session + (syntax-id-rules (_session) + [_session (type: _int pre: (session))])) -(printf "playing? -> ~s\n" (xmms-is-playing?)) -(printf "pos -> ~s\n" (xmms-get-playlist-pos)) -(printf "info -> ~s\n" (xmms-get-info)) -(xmms-playlist-next) -(sleep 1) -(printf "pos -> ~s\n" (xmms-get-playlist-pos)) -(xmms-stop) +(define-syntax defxmms + (syntax-rules (:) + [(_ name : x ...) + (begin + (provide name) + (define name + (get-ffi-obj + (regexp-replaces + 'name '((#rx"-" "_") (#rx"[?]$" "") (#rx"^" "xmms_remote_"))) + libxmms (_fun x ...))))])) + +(defxmms playlist : (files enqueue?) :: + _session + (files : (_list i _string)) + (_int = (length files)) + (enqueue? : _bool) + -> _void) +(defxmms get-version : _session -> _int) +;; The second argument is a GList (see glib/glist.h) which requires structs, +;; but the playlist function is sufficient (looks like this is for glib code). +;; (defxmms playlist-add : _session "GList * list" -> _void) +(defxmms playlist-delete : _session _pos -> _void) +(defxmms play : _session -> _void) +(defxmms pause : _session -> _void) +(defxmms stop : _session -> _void) +(defxmms is-playing? : _session -> _bool) +(defxmms is-paused? : _session -> _bool) +(defxmms get-playlist-pos : _session -> _pos) +(defxmms set-playlist-pos : _session _pos -> _void) +(defxmms get-playlist-length : _session -> _pos) +(defxmms playlist-clear : _session -> _void) +(defxmms get-output-time : _session -> _int) +(defxmms jump-to-time : _session _int -> _void) +(defxmms get-volume : _session (l : (_ptr o _int)) (r : (_ptr o _int)) + -> _void -> (list l r)) +(defxmms get-main-volume : _session -> _int) +(defxmms get-balance : _session -> _int) +(defxmms set-volume : _session (l : _int) (r : _int) -> _void) +(defxmms set-main-volume : _session _int -> _void) +(defxmms set-balance : _session _int -> _void) +(defxmms get-skin : _session -> _file) +(defxmms set-skin : _session _file -> _void) +(defxmms get-playlist-file : _session _pos -> _string) +(defxmms get-playlist-title : _session _pos -> _string) +(defxmms get-playlist-time : _session _pos -> _int) +(defxmms get-info : _session + (rate : (_ptr o _int)) + (freq : (_ptr o _int)) + (nch : (_ptr o _int)) + -> _void -> (list rate freq nch)) +(defxmms main-win-toggle : _session (show? : _bool) -> _void) +(defxmms pl-win-toggle : _session (show? : _bool) -> _void) +(defxmms eq-win-toggle : _session (show? : _bool) -> _void) +(defxmms is-main-win? : _session -> _bool) +(defxmms is-pl-win? : _session -> _bool) +(defxmms is-eq-win? : _session -> _bool) +(defxmms show-prefs-box : _session -> _void) +(defxmms toggle-aot : _session (ontop? : _bool) -> _void) +(defxmms eject : _session -> _void) +(defxmms playlist-prev : _session -> _void) +(defxmms playlist-next : _session -> _void) +(defxmms playlist-add-url-string : _session _string -> _void) +(defxmms is-running? : _session -> _bool) +(defxmms toggle-repeat : _session -> _void) +(defxmms toggle-shuffle : _session -> _void) +(defxmms is-repeat? : _session -> _bool) +(defxmms is-shuffle? : _session -> _bool) +(defxmms get-eq : _session + (preamp : (_ptr o _float)) + (bands : (_ptr o _pointer)) + -> _void + -> (cons preamp (cblock->list bands _float eq-bands))) +(defxmms get-eq-preamp : _session -> _float) +(defxmms get-eq-band : _session (band : _int) -> _float) +(defxmms set-eq : (l) :: + _session + (preamp : _float = (car l)) + (bands : (_list i _float) = (cdr l)) + -> _void) +(defxmms set-eq-preamp : _session (preamp : _float) -> _void) +(defxmms set-eq-band : _session (band : _int) _float -> _void) +(defxmms quit : _session -> _void) +(defxmms play-pause : _session -> _void) +(defxmms playlist-ins-url-string : _session _string _pos -> _void) diff --git a/collects/ffi/examples/xosd.ss b/collects/ffi/examples/xosd.ss old mode 100755 new mode 100644 index a0eeba45ec..8a074f20dc --- a/collects/ffi/examples/xosd.ss +++ b/collects/ffi/examples/xosd.ss @@ -1,75 +1,104 @@ -#! /usr/bin/env mzscheme - #lang scheme/base -(require ffi/xosd) +(require mzlib/foreign) (unsafe!) -(define x (xosd-create)) +(define libxosd (ffi-lib "libxosd")) -;; (xost-set-bar-length x 12) -(xosd-set-pos x 'middle) -(xosd-set-align x 'center) -(xosd-set-shadow-offset x 7) -(xosd-set-outline-offset x 2) -(xosd-set-colour x "yellow") -(xosd-set-shadow-colour x "black") -(xosd-set-outline-colour x "blue") -(xosd-set-font x "-adobe-courier-bold-r-*-*-34-*-*-*-*-*-*-*") +;; Use this type to properly destroy an xosd object +(define _xosd (make-ctype (_cpointer "xosd") #f + (lambda (p) + (if p + (register-finalizer p xosd-destroy) + (error '_xosd "got a NULL pointer")) + p))) -(printf ">>> xosd=~s, lines=~s, colour=~s\n" - x (xosd-get-number-lines x) (xosd-get-colour x)) +(define-syntax defxosd + (syntax-rules (:) + [(_ name : type ...) + (define name + (get-ffi-obj (regexp-replaces 'name '((#rx"-" "_") (#rx"[*?]$" ""))) + libxosd (_fun type ...)))])) -(xosd-display-string x "Xosd Test") +(define-syntax defxosd* + (syntax-rules () + [(_ name x ...) (begin (provide name) (defxosd name x ...))])) -;; this doesn't work for some reason -;; (xosd-set-timeout x 1) -;; (xosd-wait-until-no-display x) +(define _status + (make-ctype _int #f + (lambda (x) + (if (eq? -1 x) + (error 'xosd "~a" + (or (get-ffi-obj "xosd_error" libxosd _string) + "unknown xosd error")) + x)))) -(sleep 2) -(xosd-set-timeout x 0) +(define _sbool + (make-ctype _status #f + (lambda (x) + (case x [(1) #t] [(0) #f] [else (error "bad boolean value: ~e" x)])))) -(let loop ([n 10]) - (unless (zero? n) - (xosd-show x) - (sleep .05) - (xosd-hide x) - (sleep .05) - (loop (sub1 n)))) +;; ===== Initializing ========================================================= -(let ([f (lambda (disp) - (let loop ([n 100]) - (when (> n 0) (disp x n) (sleep .1) (loop (- n 5)))))]) - (xosd-set-bar-length x 10) - (f xosd-display-percentage) - (sleep 1) - (xosd-set-bar-length x 20) - (f xosd-display-slider) - (xosd-hide x) - (sleep 1) - (xosd-display-string x "FOO") - (f (lambda (x n) - (xosd-hide x) (xosd-set-vertical-offset x n) (xosd-show x))) - (f (lambda (x n) - (xosd-hide x) (xosd-set-vertical-offset x (- 100 n)) (xosd-show x))) - (f (lambda (x n) - (xosd-hide x) (xosd-set-vertical-offset x n) (xosd-show x))) - (f (lambda (x n) - (xosd-hide x) (xosd-set-vertical-offset x (- 100 n)) (xosd-show x)))) -(xosd-hide x) -(sleep 1) +(defxosd* xosd-create : ; [num-lines = 1] -> xosd-obj + args :: (num-lines : _int = (if (pair? args) (car args) 1)) -> _xosd) +(defxosd xosd-destroy : _xosd -> _int) -(set! x (xosd-create 4)) -(xosd-set-pos x 'middle) -(xosd-set-align x 'center) -(xosd-set-font x "-adobe-courier-bold-r-*-*-25-*-*-*-*-*-*-*") -(xosd-set-shadow-offset x 7) -(xosd-set-outline-offset x 2) -(xosd-display-string x "This is the first line" 0) -(xosd-display-string x "and the second line" 1) -(xosd-display-string x "the third one" 2) -(xosd-display-string x "and finally the fourth line" 3) -(sleep 2) (xosd-scroll x 1) -(sleep 1) (xosd-scroll x 1) -(sleep 1) (xosd-scroll x 1) -(sleep 1) (xosd-scroll x 1) -(sleep 1) +(defxosd* xosd-is-onscreen? : _xosd -> _sbool) + +;; ===== Displaying & Hiding ================================================== + +(defxosd xosd-show* : _xosd -> _status) +(provide xosd-show) +(define (xosd-show xosd) (unless (xosd-is-onscreen? xosd) (xosd-show* xosd))) +(defxosd xosd-hide* : _xosd -> _status) +(provide xosd-hide) +(define (xosd-hide xosd) (when (xosd-is-onscreen? xosd) (xosd-hide* xosd))) + +(defxosd* xosd-set-timeout : _xosd _int -> _status) +(defxosd* xosd-wait-until-no-display : _xosd -> _status) + +;; ===== Attributed =========================================================== + +(define _xosd-pos (_enum '(top bottom middle))) +(define _xosd-align (_enum '(left center right))) + +(defxosd* xosd-set-pos : _xosd _xosd-pos -> _status) +(defxosd* xosd-set-align : _xosd _xosd-align -> _status) +(defxosd* xosd-set-horizontal-offset : _xosd _int -> _status) +(defxosd* xosd-set-vertical-offset : _xosd _int -> _status) +(defxosd* xosd-set-shadow-offset : _xosd _int -> _status) +(defxosd* xosd-set-outline-offset : _xosd _int -> _status) +(defxosd* xosd-set-colour : _xosd _string -> _status) +(defxosd* xosd-set-shadow-colour : _xosd _string -> _status) +(defxosd* xosd-set-outline-colour : _xosd _string -> _status) +(defxosd* xosd-set-font : _xosd _string -> _status) + +(defxosd* xosd-get-colour : + _xosd (r : (_ptr o _int)) (g : (_ptr o _int)) (b : (_ptr o _int)) -> _status + -> (list r g b)) +(defxosd* xosd-get-number-lines : _xosd -> _status) + +;; ===== Content ============================================================== + +(define _xosd-command (_enum '(percentage string printf slider))) + +(define disp-int* + (get-ffi-obj "xosd_display" libxosd + (_fun _xosd _int _xosd-command _int -> _status))) +(define disp-string* + (get-ffi-obj "xosd_display" libxosd + (_fun _xosd _int _xosd-command _string -> _status))) + +(provide xosd-display-percentage xosd-display-string xosd-display-slider) +;; xosd-obj percent [line-num] -> int +(define (xosd-display-percentage xosd percent . line) + (disp-int* xosd (if (pair? line) (car line) 0) 'percentage percent)) +;; xosd-obj string [line-num] -> int +(define (xosd-display-string xosd str . line) + (disp-string* xosd (if (pair? line) (car line) 0) 'string str)) +;; xosd-obj percent [line-num] -> int +(define (xosd-display-slider xosd int . line) + (disp-int* xosd (if (pair? line) (car line) 0) 'slider int)) + +(defxosd* xosd-set-bar-length : _xosd _int -> _status) +(defxosd* xosd-scroll : _xosd _int -> _status) diff --git a/collects/ffi/info.ss b/collects/ffi/info.ss index de10b968fb..7e41f36e49 100644 --- a/collects/ffi/info.ss +++ b/collects/ffi/info.ss @@ -1,5 +1,3 @@ #lang setup/infotab -(define name "Sample FFIs") - (define compile-omit-paths '("examples")) diff --git a/collects/ffi/magick.ss b/collects/ffi/magick.ss deleted file mode 100644 index 13bb216cdf..0000000000 --- a/collects/ffi/magick.ss +++ /dev/null @@ -1,2813 +0,0 @@ -#lang scheme/base - -(require mzlib/foreign) (unsafe!) - -(define (ffi-try-libs . libs) - (let loop ([libs* libs] - [exceptions '()]) - (if (null? libs*) - (error 'ffi-try-libs "Could not load any of the libraries in ~a\n~a\n" libs exceptions) - (let ([lib (caar libs*)] - [version (cdar libs*)]) - (with-handlers ([exn:fail:filesystem? (lambda (e) - (loop (cdr libs*) (cons e exceptions)))]) - (ffi-lib lib version)))))) - -(define libwand (ffi-try-libs '("libWand" "6.0.1" "6") - '("libMagickWand" "1"))) - -;; ===== Main Objects ========================================================= - -(define-syntax defmagick-pointer-type - (syntax-rules () - [(_ _name destructor s->c) - (define-cpointer-type _name #f s->c - (lambda (ptr) - (if ptr - (begin (register-finalizer ptr destructor) ptr) - (error '_name "got a NULL pointer"))))] - [(_ _name destructor) (defmagick-pointer-type _name destructor #f)])) - -(defmagick-pointer-type _MagickWand DestroyMagickWand) -(defmagick-pointer-type _DrawingWand DestroyDrawingWand) -(defmagick-pointer-type _Image DestroyImage) -(defmagick-pointer-type _DrawInfo DestroyDrawInfo) -(defmagick-pointer-type _PixelWand DestroyPixelWand - ;; This can be implicitly built when given a color name - (lambda (x) - (let loop ([x x]) - (cond [(string? x) (loop (NewPixelWand x))] - [(list? x) (loop (NewPixelWand x))] - [else x])))) ; can use NULL as a pixel wand (see floodfill) - -;; Use a struct for this because we want to keep the associated image width -(define-struct PixelIterator (ptr [width #:mutable])) -(define _PixelIterator - (make-ctype _pointer PixelIterator-ptr - (lambda (ptr) - (if ptr - (let ([new (make-PixelIterator ptr #f)]) ; width set by makers - (register-finalizer new DestroyPixelIterator) - new) - (error '_PixelIterator "got a NULL pointer"))))) - -;; ===== Utilities ============================================================ - -(define (raise-wand-exception w) - ((cond [(MagickWand? w) MagickGetException ] - [(PixelWand? w) PixelGetException ] - [(PixelIterator? w) PixelIteratorGetException] - [(DrawingWand? w) DrawGetException ] - [else (error 'raise-wand-exception "got an unknown value: ~e" w)]) - w) - (error 'wand-exception "an undefined error occured with ~e" w)) - -(define-fun-syntax _status - (syntax-id-rules (_status) - [_status (type: _bool - 1st-arg: 1st - post: (r => (unless r (raise-wand-exception 1st))))])) - -(define-syntax defmagick - (syntax-rules (:) - [(_ id : x ...) (define id (get-ffi-obj 'id libwand (_fun x ...)))])) - -(define-syntax defmagick* - (syntax-rules () - [(_ name x ...) (begin (defmagick name x ...) (provide name))])) - -;; Used to convert (small) square matrices (lists of lists) to a memory block. -(define (_sqmatrix-of type) - (make-ctype _pointer - (lambda (m) - (let ([len (and (list? m) (length m))]) - (unless (and len (< 0 len) - (andmap (lambda (x) (and (list? x) (= len (length x)))) - m)) - (error '_sqmatrix "expecting a rectangular matrix")) - (let ([block (malloc (* len len) type)]) - (let loop ([n 0] [xs (apply append m)]) - (unless (null? xs) - (ptr-set! block type n (car xs)) - (loop (add1 n) (cdr xs)))) - block))) - (lambda (x) (error '_sqmatrix "can be used only for ffi inputs")))) - -;; This is a hack. What is needed is to be able to define a type that is a -;; struct of two doubles that translates to a list of two values. -(define _Points - (make-ctype _pointer - (lambda (l) - (unless (and (list? l) - (andmap (lambda (x) (and (list? x) (= 2 (length x)))) l)) - (error '_Points "expecting a list of two-element lists, got ~e" l)) - (list->cblock (apply append l) _double*)) - (lambda (x) - (error '_Points "cannot be used as an output type")))) - -;; Hack for the same reason as above. -(define _AffineMatrix - (make-ctype _pointer - (lambda (l) - (unless (and (list? l) (= 6 (length l))) - (error '_Points "expecting a list of six numbers, got ~e" l)) - (list->cblock l _double*)) - (lambda (x) (cblock->list x _double* 6)))) - -;; Utilities for MagickGetImagePixels/MagickSetImagePixels - -(define (StorageType->type storage-type) - (case storage-type - [(UndefinedPixel) (error 'StorageType->type "got an UndefinedPixel")] - [(CharPixel) _byte] - [(ShortPixel) _word] - [(IntegerPixel) _uint] - [(LongPixel) _ulong] - [(FloatPixel) _float] - [(DoublePixel) _double*])) - -;; Gets a list and a number, and returns a list of lists of length n. -(define (n-split l n) - (let loop ([l l][i 0][a2 null][a null]) - (cond - [(null? l) (let ([a (if (null? a2) - a - (cons (reverse a2) a))]) - (reverse a))] - [(= i n) (loop l 0 null (cons (reverse a2) a))] - [else (loop (cdr l) (add1 i) (cons (car l) a2) a)]))) - -;; _Quantum is something that the library tells us how big it is -(define _Quantum - (let* ([q ((get-ffi-obj "MagickGetQuantumDepth" libwand - (_fun _pointer -> _string)) - #f)] - [err (lambda () - (error 'libwand - "MagickGetQuantumDepth returned a bad value: ~s" q))]) - (cond [(and (string? q) (regexp-match #rx"^Q([0-9]+)$" q)) - => (lambda (m) - (case (string->number (cadr m)) - [( 8) _uint8] [(16) _uint16] [(32) _uint32] - [else (err)]))] - [else (err)]))) - -;; Used twice (PixelGetIndex/PixelSetIndex). -(define _IndexPacket _Quantum) - -(define _MagickSizeType _uint64) - -;; This type only needs to be created for PixelGetQuantumColor results. -;; (Could also define it as a macro for (_list ? _Quantum 4).) -(define-struct PixelPacket (ptr)) -(define _PixelPacket - (make-ctype _pointer PixelPacket-ptr make-PixelPacket)) -(define (NewPixelPacket) - (make-PixelPacket (malloc _Quantum 4))) - -;; ===== Enumeration Types ==================================================== - -(define _MagickExceptionType - (_enum '(UndefinedException - WarningException = 300 - ResourceLimitWarning = 300 - TypeWarning = 305 - OptionWarning = 310 - DelegateWarning = 315 - MissingDelegateWarning = 320 - CorruptImageWarning = 325 - FileOpenWarning = 330 - BlobWarning = 335 - StreamWarning = 340 - CacheWarning = 345 - CoderWarning = 350 - ModuleWarning = 355 - DrawWarning = 360 - ImageWarning = 365 - WandWarning = 370 - XServerWarning = 380 - MonitorWarning = 385 - RegistryWarning = 390 - ConfigureWarning = 395 - ErrorException = 400 - ResourceLimitError = 400 - TypeError = 405 - OptionError = 410 - DelegateError = 415 - MissingDelegateError = 420 - CorruptImageError = 425 - FileOpenError = 430 - BlobError = 435 - StreamError = 440 - CacheError = 445 - CoderError = 450 - ModuleError = 455 - DrawError = 460 - ImageError = 465 - WandError = 470 - XServerError = 480 - MonitorError = 485 - RegistryError = 490 - ConfigureError = 495 - FatalErrorException = 700 - ResourceLimitFatalError = 700 - TypeFatalError = 705 - OptionFatalError = 710 - DelegateFatalError = 715 - MissingDelegateFatalError = 720 - CorruptImageFatalError = 725 - FileOpenFatalError = 730 - BlobFatalError = 735 - StreamFatalError = 740 - CacheFatalError = 745 - CoderFatalError = 750 - ModuleFatalError = 755 - DrawFatalError = 760 - ImageFatalError = 765 - WandFatalError = 770 - XServerFatalError = 780 - MonitorFatalError = 785 - RegistryFatalError = 790 - ConfigureFatalError = 795 - ))) - -(define _CompositeOperator - (_enum '(UndefinedCompositeOp - NoCompositeOp - AddCompositeOp - AtopCompositeOp - BlendCompositeOp - BumpmapCompositeOp - ClearCompositeOp - ColorBurnCompositeOp - ColorDodgeCompositeOp - ColorizeCompositeOp - CopyBlackCompositeOp - CopyBlueCompositeOp - CopyCompositeOp - CopyCyanCompositeOp - CopyGreenCompositeOp - CopyMagentaCompositeOp - CopyOpacityCompositeOp - CopyRedCompositeOp - CopyYellowCompositeOp - DarkenCompositeOp - DstAtopCompositeOp - DstCompositeOp - DstInCompositeOp - DstOutCompositeOp - DstOverCompositeOp - DifferenceCompositeOp - DisplaceCompositeOp - DissolveCompositeOp - ExclusionCompositeOp - HardLightCompositeOp - HueCompositeOp - InCompositeOp - LightenCompositeOp - LuminizeCompositeOp - MinusCompositeOp - ModulateCompositeOp - MultiplyCompositeOp - OutCompositeOp - OverCompositeOp - OverlayCompositeOp - PlusCompositeOp - ReplaceCompositeOp - SaturateCompositeOp - ScreenCompositeOp - SoftLightCompositeOp - SrcAtopCompositeOp - SrcCompositeOp - SrcInCompositeOp - SrcOutCompositeOp - SrcOverCompositeOp - SubtractCompositeOp - ThresholdCompositeOp - XorCompositeOp - ))) - -(define _ColorspaceType - (_enum '(UndefinedColorspace - RGBColorspace - GRAYColorspace - TransparentColorspace - OHTAColorspace - LABColorspace - XYZColorspace - YCbCrColorspace - YCCColorspace - YIQColorspace - YPbPrColorspace - YUVColorspace - CMYKColorspace - sRGBColorspace - HSBColorspace - HSLColorspace - HWBColorspace - ))) - -(define _CompressionType - (_enum '(UndefinedCompression - NoCompression - BZipCompression - FaxCompression - Group4Compression - JPEGCompression - LosslessJPEGCompression - LZWCompression - RLECompression - ZipCompression - ))) - -(define _DisposeType - (_enum '(UnrecognizedDispose - UndefinedDispose = 0 - NoneDispose = 1 - BackgroundDispose = 2 - PreviousDispose = 3 - ))) - -(define _ImageType - (_enum '(UndefinedType - BilevelType - GrayscaleType - GrayscaleMatteType - PaletteType - PaletteMatteType - TrueColorType - TrueColorMatteType - ColorSeparationType - ColorSeparationMatteType - OptimizeType - ))) - -(define _InterlaceType - (_enum '(UndefinedInterlace - NoInterlace - LineInterlace - PlaneInterlace - PartitionInterlace - ))) - -(define _ChannelType - (_bitmask '(UndefinedChannel = #x0000 - RedChannel = #x0001 - CyanChannel = #x0001 - GreenChannel = #x0002 - MagentaChannel = #x0002 - BlueChannel = #x0004 - YellowChannel = #x0004 - AlphaChannel = #x0008 - OpacityChannel = #x0008 - MatteChannel = #x0008 ; deprecated - BlackChannel = #x0020 - IndexChannel = #x0020 - AllChannels = #x7fffffff - ))) - -(define _MetricType - (_enum '(UndefinedMetric - MeanAbsoluteErrorMetric - MeanSquaredErrorMetric - PeakAbsoluteErrorMetric - PeakSignalToNoiseRatioMetric - RootMeanSquaredErrorMetric - ))) - -(define _NoiseType - (_enum '(UndefinedNoise - UniformNoise - GaussianNoise - MultiplicativeGaussianNoise - ImpulseNoise - LaplacianNoise - PoissonNoise - ))) - -(define _MagickEvaluateOperator - (_enum '(UndefinedEvaluateOperator - AddEvaluateOperator - AndEvaluateOperator - DivideEvaluateOperator - LeftShiftEvaluateOperator - MaxEvaluateOperator - MinEvaluateOperator - MultiplyEvaluateOperator - OrEvaluateOperator - RightShiftEvaluateOperator - SetEvaluateOperator - SubtractEvaluateOperator - XorEvaluateOperator - ))) - -(define _ResourceType - (_enum '(UndefinedResource - AreaResource - DiskResource - FileResource - MapResource - MemoryResource - ))) - -(define _StorageType - (_enum '(UndefinedPixel - CharPixel - ShortPixel - IntegerPixel - LongPixel - FloatPixel - DoublePixel - ))) - -(define _RenderingIntent - (_enum '(UndefinedIntent - SaturationIntent - PerceptualIntent - AbsoluteIntent - RelativeIntent - ))) - -(define _ResolutionType - (_enum '(UndefinedResolution - PixelsPerInchResolution - PixelsPerCentimeterResolution - ))) - -(define _VirtualPixelMethod - (_enum '(UndefinedVirtualPixelMethod - ConstantVirtualPixelMethod - EdgeVirtualPixelMethod - MirrorVirtualPixelMethod - TileVirtualPixelMethod - ))) - -(define _PreviewType - (_enum '(UndefinedPreview - RotatePreview - ShearPreview - RollPreview - HuePreview - SaturationPreview - BrightnessPreview - GammaPreview - SpiffPreview - DullPreview - GrayscalePreview - QuantizePreview - DespecklePreview - ReduceNoisePreview - AddNoisePreview - SharpenPreview - BlurPreview - ThresholdPreview - EdgeDetectPreview - SpreadPreview - SolarizePreview - ShadePreview - RaisePreview - SegmentPreview - SwirlPreview - ImplodePreview - WavePreview - OilPaintPreview - CharcoalDrawingPreview - JPEGPreview - ))) - -(define _FilterTypes - (_enum '(UndefinedFilter - PointFilter - BoxFilter - TriangleFilter - HermiteFilter - HanningFilter - HammingFilter - BlackmanFilter - GaussianFilter - QuadraticFilter - CubicFilter - CatromFilter - MitchellFilter - LanczosFilter - BesselFilter - SincFilter - ))) - -(define _MontageMode - (_enum '(UndefinedMode - FrameMode - UnframeMode - ConcatenateMode - ))) - -(define _StretchType - (_enum '(UndefinedStretch - NormalStretch - UltraCondensedStretch - ExtraCondensedStretch - CondensedStretch - SemiCondensedStretch - SemiExpandedStretch - ExpandedStretch - ExtraExpandedStretch - UltraExpandedStretch - AnyStretch - ))) - -(define _StyleType - (_enum '(UndefinedStyle - NormalStyle - ItalicStyle - ObliqueStyle - AnyStyle - ))) - -(define _GravityType - (_enum '(UndefinedGravity - ForgetGravity = 0 - NorthWestGravity = 1 - NorthGravity = 2 - NorthEastGravity = 3 - WestGravity = 4 - CenterGravity = 5 - EastGravity = 6 - SouthWestGravity = 7 - SouthGravity = 8 - SouthEastGravity = 9 - StaticGravity = 10 - ))) - -(define _ClipPathUnits - (_enum '(UndefinedPathUnits - UserSpace - UserSpaceOnUse - ObjectBoundingBox - ))) - -(define _DecorationType - (_enum '(UndefinedDecoration - NoDecoration - UnderlineDecoration - OverlineDecoration - LineThroughDecoration - ))) - -(define _FillRule - (_enum '(UndefinedRule - EvenOddRule - NonZeroRule - ))) - -(define _LineCap - (_enum '(UndefinedCap - ButtCap - RoundCap - SquareCap - ))) - -(define _LineJoin - (_enum '(UndefinedJoin - MiterJoin - RoundJoin - BevelJoin - ))) - -(define _PaintMethod - (_enum '(UndefinedMethod - PointMethod - ReplaceMethod - FloodfillMethod - FillToBorderMethod - ResetMethod - ))) - -;; ===== MagickWand API ======================================================= - -;; MagickGetException returns the severity, reason, and description of any -;; error that occurs when using other methods in this API (as an exception). -(defmagick* MagickGetException : - _MagickWand (severity : (_ptr o _MagickExceptionType)) -> (message : _string) - -> (unless (eq? severity 'UndefinedException) - (error 'MagickWand "(~a) ~a" severity message))) - -;; DestroyMagickWand deallocates memory associated with an MagickWand. -;; Intended for internal use only, must be defined after the above. -(defmagick DestroyMagickWand : - _MagickWand -> _void) - -;; CloneMagickWand makes an exact copy of the specified wand. -(defmagick* CloneMagickWand : - _MagickWand -> _MagickWand) - -;; GetImageFromMagickWand returns the current image from the magick wand. -(defmagick* GetImageFromMagickWand : - _MagickWand -> _Image) - -;; MagickAdaptiveThresholdImage selects an individual threshold for each pixel -;; based on the range of intensity values in its local neighborhood. This -;; allows for thresholding of an image whose global intensity histogram doesn't -;; contain distinctive peaks. -(defmagick* MagickAdaptiveThresholdImage : - _MagickWand (width : _ulong) (height : _ulong) (offset : _long) -> _status) - -;; MagickAddImage adds the specified images at the current image location. -(defmagick* MagickAddImage : - _MagickWand (insert-wand : _MagickWand) -> _status) - -;; MagickAddNoiseImage adds random noise to the image. -(defmagick* MagickAddNoiseImage : - _MagickWand _NoiseType -> _status) - -;; MagickAffineTransformImage transforms an image as dictated by the affine -;; matrix of the drawing wand. -(defmagick* MagickAffineTransformImage : - _MagickWand _DrawingWand -> _status) - -;; MagickAnimateImages animates an image or image sequence. -(defmagick* MagickAnimateImages : - (w . server) :: - (w : _MagickWand) (_string = (and (pair? server) (car server))) -> _status) - -;; MagickAnnotateImage annotates an image with text. -(defmagick* MagickAnnotateImage : - _MagickWand _DrawingWand - (x : _double*) (y : _double*) (angle : _double*) (text : _string) - -> _status) - -;; MagickAppendImages append a set of images. -(defmagick* MagickAppendImages : - _MagickWand (top-to-bottom? : _bool) -> _MagickWand) - -;; MagickAverageImages average a set of images. -(defmagick* MagickAverageImages : - _MagickWand -> _MagickWand) - -;; MagickBlackThresholdImage is like MagickThresholdImage but forces all pixels -;; below the threshold into black while leaving all pixels above the threshold -;; unchanged. -(defmagick* MagickBlackThresholdImage : - _MagickWand _PixelWand -> _status) - -;; MagickBlurImage blurs an image. We convolve the image with a gaussian -;; operator of the given radius and standard deviation (sigma). For reasonable -;; results, the radius should be larger than sigma. Use a radius of 0 and -;; MagickBlurImage selects a suitable radius for you. -(defmagick* MagickBlurImage : - _MagickWand (radius : _double*) (sigma : _double*) -> _status) - -;; MagickBlurImageChannel blurs one or more image channels. We convolve the -;; image cnannel with a gaussian operator of the given radius and standard -;; deviation (sigma). For reasonable results, the radius should be larger than -;; sigma. Use a radius of 0 and MagickBlurImageChannel selects a suitable -;; radius for you. -(defmagick* MagickBlurImageChannel : - _MagickWand _ChannelType (radius : _double*) (sigma : _double*) -> _status) - -;; MagickBorderImage surrounds the image with a border of the color defined by -;; the bordercolor pixel wand. -(defmagick* MagickBorderImage : - _MagickWand (border : _PixelWand) (width : _ulong) (height : _ulong) - -> _status) - -;; MagickCharcoalImage simulates a charcoal drawing. -(defmagick* MagickCharcoalImage : - _MagickWand (radius : _double*) (sigma : _double*) -> _status) - -;; MagickChopImage removes a region of an image and collapses the image to -;; occupy the removed portion. -(defmagick* MagickChopImage : - _MagickWand (width : _ulong) (height : _ulong) (x : _long) (y : _long) - -> _status) - -;; MagickClipImage clips along the first path from the 8BIM profile, if -;; present. -(defmagick* MagickClipImage : - _MagickWand -> _status) - -;; MagickClipPathImage clips along the named paths from the 8BIM profile, if -;; present. Later operations take effect inside the path. Id may be a number -;; if preceded with #, to work on a numbered path, e.g., "#1" to use the first -;; path. If inside? is non-zero, later operations take effect inside clipping -;; path. Otherwise later operations take effect outside clipping path. -(defmagick* MagickClipPathImage : - _MagickWand (name : _string) (inside? : _bool) -> _status) - -;; MagickCoalesceImages composites a set of images while respecting any page -;; offsets and disposal methods. GIF, MIFF, and MNG animation sequences -;; typically start with an image background and each subsequent image varies in -;; size and offset. MagickCoalesceImages returns a new sequence where each -;; image in the sequence is the same size as the first and composited with the -;; next image in the sequence. -(defmagick* MagickCoalesceImages : - _MagickWand -> _MagickWand) - -;; MagickColorFloodfillImage changes the color value of any pixel that matches -;; target and is an immediate neighbor. If the method FillToBorderMethod is -;; specified, the color value is changed for any neighbor pixel that does not -;; match the bordercolor member of image. -(defmagick* MagickColorFloodfillImage : - _MagickWand (fill : _PixelWand) (fuzz : _double*) (border : _PixelWand) - (x : _long) (y : _long) - -> _status) - -;; MagickColorizeImage blends the fill color with each pixel in the image. -(defmagick* MagickColorizeImage : - _MagickWand (colorize : _PixelWand) (opacity : _PixelWand) -> _status) - -;; MagickCombineImages combines one or more images into a single image. The -;; grayscale value of the pixels of each image in the sequence is assigned in -;; order to the specified hannels of the combined image. The typical ordering -;; would be image 1 => Red, 2 => Green, 3 => Blue, etc. -(defmagick* MagickCombineImages : - _MagickWand _ChannelType -> _MagickWand) - -;; MagickCommentImage adds a comment to your image. -(defmagick* MagickCommentImage : - _MagickWand (comment : _string) -> _status) - -;; MagickCompareImageChannels compares one or more image channels and returns -;; the specified distortion metric. -(defmagick* MagickCompareImageChannels : - _MagickWand (reference : _MagickWand) - _ChannelType _MetricType (distortion : (_ptr o _double*)) - -> (comp : _MagickWand) - -> (list distortion comp)) - -;; MagickCompositeImage composite one image onto another at the specified -;; offset. -(defmagick* MagickCompositeImage : - _MagickWand (composite : _MagickWand) _CompositeOperator - (x-offset : _long) (y-offset : _long) - -> _status) - -;; MagickContrastImage enhances the intensity differences between the lighter -;; and darker elements of the image. Set sharpen? to a value other than 0 to -;; increase the image contrast otherwise the contrast is reduced. -(defmagick* MagickContrastImage : - _MagickWand (sharpen? : _bool) -> _status) - -;; MagickConvolveImage applies a custom convolution kernel to the image. -(defmagick* MagickConvolveImage : - (w kernel) :: - (w : _MagickWand) - (_ulong = (length kernel)) (kernel : (_sqmatrix-of _double*)) - -> _status) - -;; MagickConvolveImageChannel applies a custom convolution kernel to one or -;; more image channels. -(defmagick* MagickConvolveImageChannel : - (w channels kernel) :: - (w : _MagickWand) (channels : _ChannelType) - (_ulong = (length kernel)) (kernel : (_sqmatrix-of _double*)) - -> _status) - -;; MagickCropImage extracts a region of the image. -(defmagick* MagickCropImage : - _MagickWand (width : _ulong) (height : _ulong) (x : _long) (y : _long) - -> _status) - -;; MagickCycleColormapImage displaces an image's colormap by a given number of -;; positions. If you cycle the colormap a number of times you can produce a -;; psychodelic effect. -(defmagick* MagickCycleColormapImage : - _MagickWand (displace : _long) -> _status) - -;; MagickDeconstructImages compares each image with the next in a sequence and -;; returns the maximum bounding region of any pixel differences it discovers. -(defmagick* MagickDeconstructImages : - _MagickWand -> _MagickWand) - -;; MagickDescribeImage describes an image by printing its attributes to the -;; file. Attributes include the image width, height, size, and others. -(defmagick* MagickDescribeImage : - _MagickWand -> _string) - -;; MagickDespeckleImage reduces the speckle noise in an image while perserving -;; the edges of the original image. -(defmagick* MagickDespeckleImage : - _MagickWand -> _status) - -;; MagickDisplayImage displays an image. -(defmagick* MagickDisplayImage : - (w . server) :: - (w : _MagickWand) (_string = (and (pair? server) (car server))) -> _status) - -;; MagickDisplayImages displays an image or image sequence. -(defmagick* MagickDisplayImages : - (w . server) :: - (w : _MagickWand) (_string = (and (pair? server) (car server))) -> _status) - -;; MagickDrawImage draw an image the specified number of degrees. -(defmagick* MagickDrawImage : - _MagickWand _DrawingWand -> _status) - -;; MagickEdgeImage enhance edges within the image with a convolution filter of -;; the given radius. Use a radius of 0 and MagickEdgeImage selects a -;; suitable radius for you. -(defmagick* MagickEdgeImage : - _MagickWand (radius : _double*) -> _status) - -;; MagickEmbossImage returns a grayscale image with a three-dimensional effect. -;; We convolve the image with a Gaussian operator of the given radius and -;; standard deviation (sigma). For reasonable results, radius should be larger -;; than sigma. Use a radius of 0 and MagickEmbossImage selects a suitable -;; radius for you. -(defmagick* MagickEmbossImage : - _MagickWand (radius : _double*) (sigma : _double*) -> _status) - -;; MagickEnhanceImage applies a digital filter that improves the quality of a -;; noisy image. -(defmagick* MagickEnhanceImage : - _MagickWand -> _status) - -;; MagickEqualizeImage equalizes the image histogram. -(defmagick* MagickEqualizeImage : - _MagickWand -> _status) - -;; Use MagickEvaluateImage to apply an arithmetic, relational, or logical -;; operator to an image. These operations can be used to lighten or darken an -;; image, to increase or decrease contrast in an image, or to produce the -;; "negative" of an image. -(defmagick* MagickEvaluateImage : - _MagickWand _MagickEvaluateOperator (const : _double*) -> _status) - -;; Use MagickEvaluateImageChannel to apply an arithmetic, relational, or -;; logical operator to an image. These operations can be used to lighten or -;; darken an image, to increase or decrease contrast in an image, or to produce -;; the "negative" of an image. -(defmagick* MagickEvaluateImageChannel : - _MagickWand _ChannelType _MagickEvaluateOperator (const : _double*) - -> _status) - -;; MagickFlattenImages merges a sequence of images. This is useful for -;; combining Photoshop layers into a single image. -(defmagick* MagickFlattenImages : - _MagickWand -> _MagickWand) - -;; MagickFlipImage creates a vertical mirror image by reflecting the pixels -;; around the central x-axis. -(defmagick* MagickFlipImage : - _MagickWand -> _status) - -;; MagickFlopImage creates a horizontal mirror image by reflecting the pixels -;; around the central y-axis. -(defmagick* MagickFlopImage : - _MagickWand -> _status) - -;; MagickFrameImage adds a simulated three-dimensional border around the image. -;; The width and height specify the border width of the vertical and horizontal -;; sides of the frame. The inner and outer bevels indicate the width of the -;; inner and outer shadows of the frame. -(defmagick* MagickFrameImage : - _MagickWand (matte : _PixelWand) - (width : _ulong) (height : _ulong) - (inner-bevel : _long) (outer-bevel : _long) - -> _status) - -;; MagickFxImage evaluate expression for each pixel in the image. -(defmagick* MagickFxImage : - _MagickWand (expr : _string) -> _MagickWand) - -;; MagickFxImageChannel evaluate expression for each pixel in the specified -;; channel. -(defmagick* MagickFxImageChannel : - _MagickWand _ChannelType (expr : _string) -> _MagickWand) - -;; Use MagickGammaImage to gamma-correct an image. The same image viewed on -;; different devices will have perceptual differences in the way the image's -;; intensities are represented on the screen. Specify individual gamma levels -;; for the red, green, and blue channels, or adjust all three with the gamma -;; parameter. Values typically range from 0.8 to 2.3. You can also reduce the -;; influence of a particular channel with a gamma value of 0. -(defmagick* MagickGammaImage : - _MagickWand (gamma : _double*) -> _status) - -;; Use MagickGammaImageChannel to gamma-correct a particular image channel. -;; The same image viewed on different devices will have perceptual differences -;; in the way the image's intensities are represented on the screen. Specify -;; individual gamma levels for the red, green, and blue channels, or adjust all -;; three with the gamma parameter. Values typically range from 0.8 to 2.3. -(defmagick* MagickGammaImageChannel : - _MagickWand _ChannelType (gamma : _double*) -> _status) - -;; MagickGaussianBlurImage blurs an image. We convolve the image with a -;; Gaussian operator of the given radius and standard deviation (sigma). For -;; reasonable results, the radius should be larger than sigma. Use a radius of -;; 0 and MagickGaussianBlurImage selects a suitable radius for you. -(defmagick* MagickGaussianBlurImage : - _MagickWand (radius : _double*) (sigma : _double*) -> _status) - -;; MagickGaussianBlurImageChannel blurs one or more image channels. We -;; convolve the image cnannel with a Gaussian operator of the given radius and -;; standard deviation (sigma). For reasonable results, the radius should be -;; larger than sigma. Use a radius of 0 and MagickGaussianBlurImageChannel -;; selects a suitable radius for you. -(defmagick* MagickGaussianBlurImageChannel : - _MagickWand _ChannelType (radius : _double*) (sigma : _double*) -> _status) - -;; MagickGetCopyright returns the ImageMagick API copyright as a string. -(defmagick* MagickGetCopyright : - -> _string) - -;; MagickGetFilename returns the filename associated with an image sequence. -(defmagick* MagickGetFilename : - _MagickWand -> _file) - -;; MagickGetHomeURL returns the ImageMagick home URL. -(defmagick* MagickGetHomeURL : - -> _string) - -;; MagickGetImage gets the image at the current image index. -(defmagick* MagickGetImage : - _MagickWand -> _MagickWand) - -;; MagickGetImageBackgroundColor returns the image background color. -(defmagick* MagickGetImageBackgroundColor : - _MagickWand (c : _PixelWand = (NewPixelWand)) -> _status -> c) - -;; MagickGetImageBluePrimary returns the chromaticy blue primary point for the -;; image. -(defmagick* MagickGetImageBluePrimary : - _MagickWand (x : (_ptr o _double*)) (y : (_ptr o _double*)) -> _status - -> (list x y)) - -;; MagickGetImageBorderColor returns the image border color. -(defmagick* MagickGetImageBorderColor : - _MagickWand (c : _PixelWand = (NewPixelWand)) -> _status -> c) - -;; MagickGetImageChannelDepth gets the depth for a particular image channel. -(defmagick* MagickGetImageChannelDepth : - _MagickWand _ChannelType -> _ulong) - -;; MagickGetImageChannelExtrema gets the extrema for one or more image -;; channels. -(defmagick* MagickGetImageChannelExtrema : - _MagickWand _ChannelType (min : (_ptr o _ulong)) (max : (_ptr o _ulong)) - -> _status - -> (list min max)) - -;; MagickGetImageChannelMean gets the mean and standard deviation of one or -;; more image channels. -(defmagick* MagickGetImageChannelMean : - _MagickWand _ChannelType - (mean : (_ptr o _double*)) (standard-deviation : (_ptr o _double*)) - -> _status - -> (list mean standard-deviation)) - -;; MagickGetImageColormapColor returns the color of the specified colormap -;; index. -(defmagick* MagickGetImageColormapColor : - _MagickWand (colormap-index : _ulong) (c : _PixelWand = (NewPixelWand)) - -> _status -> c) - -;; MagickGetImageColors gets the number of unique colors in the image. -(defmagick* MagickGetImageColors : - _MagickWand -> _ulong) - -;; MagickGetImageColorspace gets the image colorspace. -(defmagick* MagickGetImageColorspace : - _MagickWand -> _ColorspaceType) - -;; MagickGetImageCompose returns the composite operator associated with the -;; image. -(defmagick* MagickGetImageCompose : - _MagickWand -> _CompositeOperator) - -;; MagickGetImageCompression gets the image compression. -(defmagick* MagickGetImageCompression : - _MagickWand -> _CompressionType) - -;; MagickGetImageCompressionQuality gets the image compression quality. -(defmagick* MagickGetImageCompressionQuality : - _MagickWand -> _ulong) - -;; MagickGetImageDelay gets the image delay. -(defmagick* MagickGetImageDelay : - _MagickWand -> _ulong) - -;; MagickGetImageDepth gets the image depth. -(defmagick* MagickGetImageDepth : - _MagickWand -> _ulong) - -;; MagickGetImageDispose gets the image disposal method. -(defmagick* MagickGetImageDispose : - _MagickWand -> _DisposeType) - -;; MagickGetImageExtrema gets the extrema for the image. -(defmagick* MagickGetImageExtrema : - _MagickWand (min : (_ptr o _ulong)) (max : (_ptr o _ulong)) -> _status - -> (list min max)) - -;; MagickGetImageFilename returns the filename of a particular image in a -;; sequence. -(defmagick* MagickGetImageFilename : - _MagickWand -> _string) - -;; MagickGetImageFormat returns the format of a particular image in a sequence. -(defmagick* MagickGetImageFormat : - _MagickWand -> _string) - -;; MagickGetImageGamma gets the image gamma. -(defmagick* MagickGetImageGamma : - _MagickWand -> _double*) - -;; MagickGetImageGreenPrimary returns the chromaticy green primary point. -(defmagick* MagickGetImageGreenPrimary : - _MagickWand (x : (_ptr o _double*)) (y : (_ptr o _double*)) -> _status - -> (list x y)) - -;; MagickGetImageHeight returns the image height. -(defmagick* MagickGetImageHeight : - _MagickWand -> _ulong) - -;; MagickGetImageHistogram returns the image histogram as an array of PixelWand -;; wands. -(defmagick* MagickGetImageHistogram : - _MagickWand (len : (_ptr o _ulong)) -> (_list o _PixelWand len)) - -;; MagickGetImageIndex returns the index of the current image. -(defmagick* MagickGetImageIndex : - _MagickWand -> _long) - -;; MagickGetImageInterlaceScheme gets the image interlace scheme. -(defmagick* MagickGetImageInterlaceScheme : - _MagickWand -> _InterlaceType) - -;; MagickGetImageIterations gets the image iterations. -(defmagick* MagickGetImageIterations : - _MagickWand -> _ulong) - -;; MagickGetImageMatteColor returns the image matte color. -(defmagick* MagickGetImageMatteColor : - _MagickWand (c : _PixelWand = (NewPixelWand)) -> _status -> c) - -;; MagickGetImagePixels extracts pixel data from an image and returns it to -;; you. The method returns False on success otherwise True if an error is -;; encountered. The data is returned as char, short int, int, long, float, or -;; double in the order specified by map. Suppose you want to extract the first -;; scanline of a 640x480 image as character data in red-green-blue order: -;; (MagickGetImagePixels wand 0 0 640 1 "RGB" 'CharPixel) -;; `map' is a string that reflects the expected ordering of the pixel array. -;; It can be any combination or order of R = red, G = green, B = blue, -;; A = alpha (0 is transparent), O = opacity (0 is opaque), C = cyan, -;; Y = yellow, M = magenta, K = black, I = intensity (for grayscale), P = pad. -;; Note: the scheme interface uses a list of rows, each a list of values for -;; each element in the map. -(defmagick* MagickGetImagePixels : - _MagickWand (x : _long) (y : _long) (width : _ulong) (height : _ulong) - (map : _string) (storage-type : _StorageType) - ;; create the block, remember size and type - (size : _? = (* width height (string-length map))) - (type : _? = (StorageType->type storage-type)) - (block : _pointer = (malloc size type)) - -> _status - -> (let loop ([n (sub1 size)] [r '()]) - (if (< n 0) - (n-split (n-split r (string-length map)) width) - (loop (sub1 n) (cons (ptr-ref block type n) r))))) - -;; MagickGetImageProfile returns the named image profile. -(defmagick* MagickGetImageProfile : - _MagickWand (profile-name : _string) (len : (_ptr o _ulong)) - -> (_bytes o len)) - -;; MagickGetImageRedPrimary returns the chromaticy red primary point. -(defmagick* MagickGetImageRedPrimary : - _MagickWand (x : (_ptr o _double*)) (y : (_ptr o _double*)) -> _status - -> (list x y)) - -;; MagickGetImageRenderingIntent gets the image rendering intent. -(defmagick* MagickGetImageRenderingIntent : - _MagickWand -> _RenderingIntent) - -;; MagickGetImageSignature generates an SHA-256 message digest for the image -;; pixel stream. -(defmagick* MagickGetImageSignature : - _MagickWand -> _string) - -;; MagickGetImageSize returns the image size. -(defmagick* MagickGetImageSize : - _MagickWand -> _MagickSizeType) - -;; MagickGetImageType gets the image type. -(defmagick* MagickGetImageType : - _MagickWand -> _ImageType) - -;; MagickGetImageUnits gets the image units of resolution. -(defmagick* MagickGetImageUnits : - _MagickWand -> _ResolutionType) - -;; MagickGetImageVirtualPixelMethod returns the virtual pixel method for the -;; sepcified image. -(defmagick* MagickGetImageVirtualPixelMethod : - _MagickWand -> _VirtualPixelMethod) - -;; MagickGetImageWhitePoint returns the chromaticy white point. -(defmagick* MagickGetImageWhitePoint : - _MagickWand (x : (_ptr o _double*)) (y : (_ptr o _double*)) -> _status - -> (list x y)) - -;; MagickGetImageWidth returns the image width. -(defmagick* MagickGetImageWidth : - _MagickWand -> _ulong) - -;; MagickGetImageResolution gets the image X & Y resolution. -(defmagick* MagickGetImageResolution : - _MagickWand (res-x : (_ptr o _double*)) (res-y : (_ptr o _double*)) - -> _status - -> (list res-x res-y)) - -;; MagickGetNumberImages returns the number of images associated with a magick -;; wand. -(defmagick* MagickGetNumberImages : - _MagickWand -> _ulong) - -;; MagickGetPackageName returns the ImageMagick package name. -(defmagick* MagickGetPackageName : - -> _string) - -;; MagickGetQuantumDepth returns the ImageMagick quantum depth. -(defmagick* MagickGetQuantumDepth : - (q : (_ptr o _ulong)) -> _string -> q) - -;; MagickGetReleaseDate returns the ImageMagick release date. -(defmagick* MagickGetReleaseDate : - -> _string) - -;; MagickGetResourceLimit returns the specified resource in megabytes. -(defmagick* MagickGetResourceLimit : - _ResourceType -> _ulong) - -;; MagickGetSamplingFactors gets the horizontal and vertical sampling factor. -(defmagick* MagickGetSamplingFactors : - _MagickWand (len : (_ptr o _ulong)) -> (_list o _double* len)) - -;; MagickGetSize returns the size associated with the magick wand. -(defmagick* MagickGetSize : - _MagickWand (width : (_ptr o _ulong)) (height : (_ptr o _ulong)) -> _status - -> (list width height)) - -;; MagickGetVersion returns the ImageMagick API version as a string and as a -;; number. -(defmagick* MagickGetVersion : - (v : (_ptr o _ulong)) -> (s : _string) -> (list v s)) - -;; MagickHasNextImage returns True if the wand has more images when traversing -;; the list in the forward direction -(defmagick* MagickHasNextImage : - _MagickWand -> _bool) - -;; MagickHasPreviousImage returns True if the wand has more images when -;; traversing the list in the reverse direction -(defmagick* MagickHasPreviousImage : - _MagickWand -> _bool) - -;; MagickImplodeImage creates a new image that is a copy of an existing one -;; with the image pixels "implode" by the specified percentage. -(defmagick* MagickImplodeImage : - _MagickWand (amount : _double*) -> _status) - -;; MagickLabelImage adds a label to your image. -(defmagick* MagickLabelImage : - _MagickWand (label : _string) -> _status) - -;; MagickLevelImage adjusts the levels of an image by scaling the colors -;; falling between specified white and black points to the full available -;; quantum range. The parameters provided represent the black, mid, and white -;; points. The black point specifies the darkest color in the image. Colors -;; darker than the black point are set to zero. Mid point specifies a gamma -;; correction to apply to the image. White point specifies the lightest color -;; in the image. Colors brighter than the white point are set to the maximum -;; quantum value. -(defmagick* MagickLevelImage : - _MagickWand - (black-point : _double*) (gamma : _double*) (white-point : _double*) - -> _status) - -;; MagickLevelImageChannel adjusts the levels of the specified channel of the -;; reference image by scaling the colors falling between specified white and -;; black points to the full available quantum range. The parameters provided -;; represent the black, mid, and white points. The black point specifies the -;; darkest color in the image. Colors darker than the black point are set to -;; zero. Mid point specifies a gamma correction to apply to the image. White -;; point specifies the lightest color in the image. Colors brighter than the -;; white point are set to the maximum quantum value. -(defmagick* MagickLevelImageChannel : - _MagickWand _ChannelType - (black-point : _double*) (gamma : _double*) (white-point : _double*) - -> _status) - -;; MagickMagnifyImage is a convenience method that scales an image -;; proportionally to twice its original size. -(defmagick* MagickMagnifyImage : - _MagickWand -> _status) - -;; MagickMapImage replaces the colors of an image with the closest color from a -;; reference image. -(defmagick* MagickMapImage : - _MagickWand (mapping : _MagickWand) (dither? : _bool) -> _status) - -;; MagickMatteFloodfillImage changes the transparency value of any pixel that -;; matches target and is an immediate neighbor. If the method -;; FillToBorderMethod is specified, the transparency value is changed for any -;; neighbor pixel that does not match the bordercolor member of image. -(defmagick* MagickMatteFloodfillImage : - _MagickWand - (opacity : _Quantum) (fuzz : _double*) (border : _PixelWand) - (x : _long) (y : _long) - -> _status) - -;; MagickMedianFilterImage applies a digital filter that improves the quality -;; of a noisy image. Each pixel is replaced by the median in a set of -;; neighboring pixels as defined by radius. -(defmagick* MagickMedianFilterImage : - _MagickWand (radius : _double*) -> _status) - -;; MagickMinifyImage is a convenience method that scales an image -;; proportionally to one-half its original size -(defmagick* MagickMinifyImage : - _MagickWand -> _status) - -;; MagickModulateImage lets you control the brightness, saturation, and hue of -;; an image. -(defmagick* MagickModulateImage : - _MagickWand (brightness : _double*) (saturation : _double*) (hue : _double*) - -> _status) - -;; Use MagickMontageImage to create a composite image by combining several -;; separate images. The images are tiled on the composite image with the name -;; of the image optionally appearing just below the individual tile. -(defmagick* MagickMontageImage : - _MagickWand _DrawingWand - (tile-geometry : _string) (thumbnail-geometry : _string) - _MontageMode (frame-geometry : _string) -> _MagickWand) - -;; MagickMorphImages method morphs a set of images. Both the image pixels and -;; size are linearly interpolated to give the appearance of a meta-morphosis -;; from one image to the next. -(defmagick* MagickMorphImages : - _MagickWand (num-of-frames : _ulong) -> _MagickWand) - -;; MagickMosaicImages inlays an image sequence to form a single coherent -;; picture. It returns a wand with each image in the sequence composited at -;; the location defined by the page offset of the image. -(defmagick* MagickMosaicImages : - _MagickWand -> _MagickWand) - -;; MagickMotionBlurImage simulates motion blur. We convolve the image with a -;; Gaussian operator of the given radius and standard deviation (sigma). For -;; reasonable results, radius should be larger than sigma. Use a radius of 0 -;; and MagickMotionBlurImage selects a suitable radius for you. Angle gives -;; the angle of the blurring motion. -(defmagick* MagickMotionBlurImage : - _MagickWand (radius : _double*) (sigma : _double*) (angle : _double*) - -> _status) - -;; MagickNegateImage negates the colors in the reference image. The Grayscale -;; option means that only grayscale values within the image are negated. -(defmagick* MagickNegateImage : - _MagickWand (gray? : _bool) -> _status) - -;; MagickNegateImageChannel negates the colors in the specified channel of the -;; reference image. The Grayscale option means that only grayscale values -;; within the image are negated. You can also reduce the influence of a -;; particular channel with a gamma value of 0. -(defmagick* MagickNegateImageChannel : - _MagickWand _ChannelType (gray? : _bool) -> _status) - -;; MagickNextImage associates the next image in the image list with a magick -;; wand. -(defmagick* MagickNextImage : - _MagickWand -> _status) - -;; MagickNormalizeImage enhances the contrast of a color image by adjusting the -;; pixels color to span the entire range of colors available -(defmagick* MagickNormalizeImage : - _MagickWand -> _status) - -;; MagickOilPaintImage applies a special effect filter that simulates an oil -;; painting. Each pixel is replaced by the most frequent color occurring in a -;; circular region defined by radius. -(defmagick* MagickOilPaintImage : - _MagickWand _double* -> _status) - -;; MagickOpaqueImage changes any pixel that matches color with the color -;; defined by fill. -(defmagick* MagickOpaqueImage : - _MagickWand (target : _PixelWand) (fill : _PixelWand) (fuzz : _double*) - -> _status) - -;; MagickPingImage is like MagickReadImage except the only valid information -;; returned is the image width, height, size, and format. It is designed to -;; efficiently obtain this information from a file without reading the entire -;; image sequence into memory. -(defmagick* MagickPingImage : - _MagickWand _file -> _status) - -;; MagickPosterizeImage reduces the image to a limited number of color level. -(defmagick* MagickPosterizeImage : - _MagickWand (levels : _ulong) (dither? : _bool) -> _status) - -;; MagickPreviewImages tiles 9 thumbnails of the specified image with an image -;; processing operation applied at varying strengths. This is helpful to -;; quickly pin-point an appropriate parameter for an image processing -;; operation. -(defmagick* MagickPreviewImages : - _MagickWand _PreviewType -> _MagickWand) - -;; MagickPreviousImage assocates the previous image in an image list with the -;; magick wand. -(defmagick* MagickPreviousImage : - _MagickWand -> _status) - -;; Use MagickProfileImage to add or remove a ICC, IPTC, or generic profile from -;; an image. If the profile is #f (NULL), it is removed from the image -;; otherwise added. Use a name of '*' and a profile of NULL to remove all -;; profiles from the image. -(defmagick* MagickProfileImage : - _MagickWand (profile-name : _string) - (profile : _bytes) (_ulong = (bytes-length profile)) - -> _status) - -;; MagickQuantizeImage analyzes the colors within a reference image and chooses -;; a fixed number of colors to represent the image. The goal of the algorithm -;; is to minimize the color difference between the input and output image while -;; minimizing the processing time. -(defmagick* MagickQuantizeImage : - _MagickWand (num-colors : _ulong) _ColorspaceType (tree-depth : _ulong) - (dither? : _bool) (measure-error? : _bool) - -> _status) - -;; MagickQuantizeImages analyzes the colors within a sequence of images and -;; chooses a fixed number of colors to represent the image. The goal of the -;; algorithm is to minimize the color difference between the input and output -;; image while minimizing the processing time. -(defmagick* MagickQuantizeImages : - _MagickWand - (num-colors : _ulong) _ColorspaceType (tree-depth : _ulong) - (dither? : _bool) (measure-error? : _bool) - -> _status) - -;; MagickQueryConfigureOptions returns any configure options that match the -;; specified pattern (e.g. "*" for all). Options include NAME, VERSION, -;; LIB_VERSION, etc. -(defmagick* MagickQueryConfigureOptions : - (pattern : _string) (len : (_ptr o _ulong)) -> (_list o _string len)) - -;; MagickQueryFontMetrics returns a 7 element list representing the following -;; font metrics: char-width, char-height, ascender, descender, text-width, -;; text-height, max-horizontal-advance. -(defmagick* MagickQueryFontMetrics : - _MagickWand _DrawingWand (text : _string) -> (_list o _double* 7)) - -;; MagickQueryFonts returns any font that match the specified pattern (e.g. "*" -;; for all). -(defmagick* MagickQueryFonts : - (pattern : _string) (len : (_ptr o _ulong)) -> (_list o _string len)) - -;; MagickQueryFormats returns any image formats that match the specified -;; pattern (e.g. "*" for all). -(defmagick* MagickQueryFormats : - (pattern : _string) (len : (_ptr o _ulong)) -> (_list o _string len)) - -;; MagickRadialBlurImage radial blurs an image. -(defmagick* MagickRadialBlurImage : - _MagickWand (angle : _double*) -> _status) - -;; MagickRaiseImage creates a simulated three-dimensional button-like effect by -;; lightening and darkening the edges of the image. Members width and height -;; of raise_info define the width of the vertical and horizontal edge of the -;; effect. -(defmagick* MagickRaiseImage : - _MagickWand - (width : _ulong) (height : _ulong) (x : _long) (y : _long) (raise? : _bool) - -> _status) - -;; MagickReadImage reads an image or image sequence. -;; Extended: the wand argument is optional -- will be made and returned if not -;; given. -(defmagick* MagickReadImage : - (arg . args) :: - (w : _MagickWand = (if (null? args) (NewMagickWand) arg)) - (_file = (if (null? args) arg (car args))) - -> _status - -> (if (null? args) w (void))) - -;; MagickReadImageBlob reads an image or image sequence from a blob. -(defmagick* MagickReadImageBlob : - _MagickWand (blob : _bytes) (_ulong = (bytes-length blob)) -> _status) - -;; MagickReadImageFile reads an image or image sequence from an open file -;; descriptor. -(defmagick* MagickReadImageFile : - _MagickWand (FILE* : _pointer) -> _status) - -;; MagickReduceNoiseImage smooths the contours of an image while still -;; preserving edge information. The algorithm works by replacing each pixel -;; with its neighbor closest in value. A neighbor is defined by radius. Use a -;; radius of 0 and MagickReduceNoiseImage selects a suitable radius for you. -(defmagick* MagickReduceNoiseImage : - _MagickWand (radius : _double*) -> _status) - -;; MagickRelinquishMemory relinquishes memory resources returned by such -;; methods as MagickDescribeImage, MagickGetException, etc. -;; Looks like this is not needed with a GC (tried it with the result of -;; MagickDescribeImage many times, got an error). -;; (defmagick* MagickRelinquishMemory : -;; _pointer -> _status) - -;; MagickRemoveImage removes an image from the image list. -(defmagick* MagickRemoveImage : - _MagickWand -> _status) - -;; MagickRemoveImageProfile removes the named image profile and returns it. -(defmagick* MagickRemoveImageProfile : - _MagickWand (profile-name : _string) (len : (_ptr o _ulong)) - -> (_bytes o len)) - -;; MagickResampleImage resample image to desired resolution. Most of the -;; filters are FIR (finite impulse response), however, Bessel, Gaussian, and -;; Sinc are IIR (infinite impulse response). Bessel and Sinc are windowed -;; (brought down to zero) with the Blackman filter. -(defmagick* MagickResampleImage : - _MagickWand - (x-res : _double*) (y-res : _double*) _FilterTypes (blur-factor : _double*) - -> _status) - -;; MagickResetIterator resets the wand iterator. Use it in conjunction with -;; MagickNextImage to iterate over all the images in a wand container. -(defmagick* MagickResetIterator : - _MagickWand -> _void) - -;; MagickResizeImage scales an image to the desired dimensions with some -;; filter. Most of the filters are FIR (finite impulse response), however, -;; Bessel, Gaussian, and Sinc are IIR (infinite impulse response). Bessel and -;; Sinc are windowed (brought down to zero) with the Blackman filter. -(defmagick* MagickResizeImage : - _MagickWand - (width : _ulong) (height : _ulong) _FilterTypes (blur-factor : _double*) - -> _status) - -;; MagickRollImage offsets an image as defined by x_offset and y_offset. -(defmagick* MagickRollImage : - _MagickWand (x-offset : _long) (y-offset : _long) -> _status) - -;; MagickRotateImage rotates an image the specified number of degrees. Empty -;; triangles left over from rotating the image are filled with the background -;; color. -(defmagick* MagickRotateImage : - _MagickWand (background : _PixelWand) (degrees : _double*) -> _status) - -;; MagickSampleImage scales an image to the desired dimensions with pixel -;; sampling. Unlike other scaling methods, this method does not introduce any -;; additional color into the scaled image. -(defmagick* MagickSampleImage : - _MagickWand (width : _ulong) (height : _ulong) -> _status) - -;; MagickScaleImage scales the size of an image to the given dimensions. -(defmagick* MagickScaleImage : - _MagickWand (width : _ulong) (height : _ulong) -> _status) - -;; MagickSeparateImageChannel separates a channel from the image and returns a -;; grayscale image. A channel is a particular color component of each pixel in -;; the image. -(defmagick* MagickSeparateImageChannel : - _MagickWand _ChannelType -> _status) - -;; MagickSetFilename sets the filename before you read or write an image file. -(defmagick* MagickSetFilename : - _MagickWand _file -> _status) - -;; MagickSetImage replaces the last image returned by MagickSetImageIndex, -;; MagickNextImage, MagickPreviousImage with the images from the specified -;; wand. -(defmagick* MagickSetImage : - _MagickWand (set-wand : _MagickWand) -> _status) - -;; MagickSetImageBackgroundColor sets the image background color. -(defmagick* MagickSetImageBackgroundColor : - _MagickWand (background : _PixelWand) -> _status) - -;; MagickSetImageBluePrimary sets the image chromaticity blue primary point. -(defmagick* MagickSetImageBluePrimary : - _MagickWand (x : _double*) (y : _double*) -> _status) - -;; MagickSetImageBorderColor sets the image border color. -(defmagick* MagickSetImageBorderColor : - _MagickWand (border-color : _PixelWand) -> _status) - -;; MagickSetImageChannelDepth sets the depth of a particular image channel. -(defmagick* MagickSetImageChannelDepth : - _MagickWand _ChannelType (depth : _ulong) -> _status) - -;; MagickSetImageColormapColor sets the color of the specified colormap index. -(defmagick* MagickSetImageColormapColor : - _MagickWand (index : _ulong) _PixelWand -> _status) - -;; MagickSetImageColorspace sets the image colorspace. -(defmagick* MagickSetImageColorspace : - _MagickWand _ColorspaceType -> _status) - -;; MagickSetImageCompose sets the image composite operator, useful for -;; specifying how to composite the image thumbnail when using the -;; MagickMontageImage method. -(defmagick* MagickSetImageCompose : - _MagickWand _CompositeOperator -> _status) - -;; MagickSetImageCompression sets the image compression. -(defmagick* MagickSetImageCompression : - _MagickWand _CompressionType -> _status) - -;; MagickSetImageCompressionQuality sets the image compression quality. -(defmagick* MagickSetImageCompressionQuality : - _MagickWand (quality : _ulong) -> _status) - -;; MagickSetImageDelay sets the image delay. -(defmagick* MagickSetImageDelay : - _MagickWand (delay : _ulong) -> _status) - -;; MagickSetImageDepth sets the image depth. -(defmagick* MagickSetImageDepth : - _MagickWand (depth : _ulong) -> _status) - -;; MagickSetImageDispose sets the image disposal method. -(defmagick* MagickSetImageDispose : - _MagickWand _DisposeType -> _status) - -;; MagickSetImageFilename sets the filename of a particular image in a -;; sequence. -(defmagick* MagickSetImageFilename : - _MagickWand _file -> _status) - -;; MagickSetImageGamma sets the image gamma. -(defmagick* MagickSetImageGamma : - _MagickWand (gamma : _double*) -> _status) - -;; MagickSetImageGreenPrimary sets the image chromaticity green primary point. -(defmagick* MagickSetImageGreenPrimary : - _MagickWand (y : _double*) (x : _double*) -> _status) - -;; MagickSetImageIndex replaces the last image returned by MagickSetImageIndex, -;; MagickNextImage, MagickPreviousImage with the images from the specified -;; wand. -(defmagick* MagickSetImageIndex : - _MagickWand (index : _long) -> _status) - -;; MagickSetImageInterlaceScheme sets the image interlace scheme. -(defmagick* MagickSetImageInterlaceScheme : - _MagickWand _InterlaceType -> _status) - -;; MagickSetImageIterations sets the image iterations. -(defmagick* MagickSetImageIterations : - _MagickWand (iterations : _ulong) -> _status) - -;; MagickSetImageMatteColor sets the image matte color. -(defmagick* MagickSetImageMatteColor : - _MagickWand (matte : _PixelWand) -> _status) - -;; MagickSetImageOption associates one or options with a particular image -;; format (e.g. (MagickSetImageOption wand "jpeg" "perserve" "yes")). -(defmagick* MagickSetImageOption : - _MagickWand (format : _string) (key : _string) (value : _string) -> _status) - -;; MagickSetImagePixels accepts pixel data and stores it in the image at the -;; location you specify. The method returns False on success otherwise True if -;; an error is encountered. The pixel data can be either char, short int, int, -;; long, float, or double in the order specified by map. Suppose your want -;; want to upload the first scanline of a 640x480 image from character data in -;; red-green-blue order: -;; (MagickSetImagePixels wand 0 0 640 1 "RGB" 'CharPixel pixels) -;; `map' is a string that reflects the expected ordering of the pixel array. -;; It can be any combination or order of R = red, G = green, B = blue, -;; A = alpha (0 is transparent), O = opacity (0 is opaque), C = cyan, -;; Y = yellow, M = magenta, K = black, I = intensity (for grayscale), P = pad. -;; Note: the scheme interface uses a list of rows, each a list of values for -;; each element in the map. Also, the map here should not have the type -;; character as in the MagickWand API (it is a documentation bug), and there is -;; no need for width and height too. -(defmagick* MagickSetImagePixels : - (w x y map storage-type matrix) :: - (w : _MagickWand) (x : _long) (y : _long) - (width : _ulong = (length (car matrix))) (height : _ulong = (length matrix)) - (map : _string) (storage-type : _StorageType) - (_pointer = (let* ([size (* width height (string-length map))] - [type (StorageType->type storage-type)] - [block (malloc size type)]) - (let loop ([m matrix] [n 0]) - (cond [(null? m) n] - [(pair? m) (loop (cdr m) (loop (car m) n))] - [else (ptr-set! block type n m) (add1 n)])) - block)) - -> _status) - -;; MagickSetImageProfile adds a named profile to the magick wand. If a profile -;; with the same name already exists, it is replaced. This method differs from -;; the MagickProfileImage method in that it does not apply any CMS color -;; profiles. -(defmagick* MagickSetImageProfile : - _MagickWand (profile-name : _string) - (profile : _bytes) (_ulong = (bytes-length profile)) - -> _status) - -;; MagickSetImageRedPrimary sets the image chromaticity red primary point. -(defmagick* MagickSetImageRedPrimary : - _MagickWand (x : _double*) (y : _double*) -> _status) - -;; MagickSetImageRenderingIntent sets the image rendering intent. -(defmagick* MagickSetImageRenderingIntent : - _MagickWand _RenderingIntent -> _status) - -;; MagickSetImageResolution sets the image resolution. -(defmagick* MagickSetImageResolution : - _MagickWand (res-x : _double*) (res-y : _double*) -> _status) - -;; MagickSetImageScene sets the image scene. -(defmagick* MagickSetImageScene : - _MagickWand (schene-number : _ulong) -> _status) - -;; MagickSetImageType sets the image type. -(defmagick* MagickSetImageType : - _MagickWand _ImageType -> _status) - -;; MagickSetImageUnits sets the image units of resolution. -(defmagick* MagickSetImageUnits : - _MagickWand _ResolutionType -> _status) - -;; MagickSetImageVirtualPixelMethod sets the image virtual pixel method. -(defmagick* MagickSetImageVirtualPixelMethod : - _MagickWand _VirtualPixelMethod -> _status) - -;; MagickSetImageWhitePoint sets the image chromaticity white point. -(defmagick* MagickSetImageWhitePoint : - _MagickWand (x : _double*) (y : _double*) -> _status) - -;; MagickSetInterlaceScheme sets the image compression. -(defmagick* MagickSetInterlaceScheme : - _MagickWand _InterlaceType -> _status) - -;; MagickSetPassphrase sets the passphrase. -(defmagick* MagickSetPassphrase : - _MagickWand (passphrase : _string) -> _status) - -;; MagickSetResourceLimit sets the limit for a particular resource in -;; megabytes. -(defmagick* MagickSetResourceLimit : - _ResourceType (limit : _ulong) -> _status) - -;; MagickSetSamplingFactors sets the image sampling factors. -(defmagick* MagickSetSamplingFactors : - (w factors) :: - (w : _MagickWand) (_ulong = (length factors)) (factors : (_list i _double*)) - -> _status) - -;; MagickSetSize sets the size of the magick wand. Set it before you read a -;; raw image format such as RGB, GRAY, or CMYK. -(defmagick* MagickSetSize : - _MagickWand (width : _ulong) (height : _ulong) -> _status) - -;; MagickSharpenImage sharpens an image. We convolve the image with a Gaussian -;; operator of the given radius and standard deviation (sigma). For reasonable -;; results, the radius should be larger than sigma. Use a radius of 0 and -;; SharpenImage selects a suitable radius for you. -(defmagick* MagickSharpenImage : - _MagickWand (radius : _double*) (sigma : _double*) -> _status) - -;; MagickSharpenImageChannel sharpens one or more image channels. We convolve -;; the image cnannel with a gaussian operator of the given radius and standard -;; deviation (sigma). For reasonable results, the radius should be larger than -;; sigma. Use a radius of 0 and GaussinSharpenImageChannel selects a suitable -;; radius for you. -(defmagick* MagickSharpenImageChannel : - _MagickWand _ChannelType (radius : _double*) (sigma : _double*) -> _status) - -;; MagickShaveImage shaves pixels from the image edges. It allocates the -;; memory necessary for the new Image structure and returns a pointer to the -;; new image. -(defmagick* MagickShaveImage : - _MagickWand (width : _ulong) (height : _ulong) -> _status) - -;; MagickShearImage slides one edge of an image along the X or Y axis, creating -;; a parallelogram. An X direction shear slides an edge along the X axis, -;; while a Y direction shear slides an edge along the Y axis. The amount of -;; the shear is controlled by a shear angle. For X direction shears, x_shear -;; is measured relative to the Y axis, and similarly, for Y direction shears -;; y_shear is measured relative to the X axis. Empty triangles left over from -;; shearing the image are filled with the background color. -(defmagick* MagickShearImage : - _MagickWand (background : _PixelWand) - (x-shear : _double*) (y-shear : _double*) - -> _status) - -;; MagickSolarizeImage applies a special effect to the image, similar to the -;; effect achieved in a photo darkroom by selectively exposing areas of photo -;; sensitive paper to light. Threshold ranges from 0 to MaxRGB and is a -;; measure of the extent of the solarization. -(defmagick* MagickSolarizeImage : - _MagickWand (threshold : _double*) -> _status) - -;; MagickSpliceImage splices a solid color into the image. -(defmagick* MagickSpliceImage : - _MagickWand (width : _ulong) (height : _ulong) (x : _long) (y : _long) - -> _status) - -;; MagickSpreadImage is a special effects method that randomly displaces each -;; pixel in a block defined by the radius parameter. -(defmagick* MagickSpreadImage : - _MagickWand (radius : _double*) -> _status) - -;; Use MagickSteganoImage to hide a digital watermark within the image. -;; Recover the hidden watermark later to prove that the authenticity of an -;; image. Offset defines the start position within the image to hide the -;; watermark. -(defmagick* MagickSteganoImage : - _MagickWand (watermark : _MagickWand) (offset : _long) -> _MagickWand) - -;; MagickStereoImage composites two images and produces a single image that is -;; the composite of a left and right image of a stereo pair. -(defmagick* MagickStereoImage : - _MagickWand (offset : _MagickWand) -> _MagickWand) - -;; MagickStripImage strips an image of all profiles and comments. -(defmagick* MagickStripImage : - _MagickWand -> _status) - -;; MagickSwirlImage swirls the pixels about the center of the image, where -;; degrees indicates the sweep of the arc through which each pixel is moved. -;; You get a more dramatic effect as the degrees move from 1 to 360. -(defmagick* MagickSwirlImage : - _MagickWand (degrees : _double*) -> _status) - -;; MagickTextureImage repeatedly tiles the texture image across and down the -;; image canvas. -(defmagick* MagickTextureImage : - _MagickWand (texture : _MagickWand) -> _MagickWand) - -;; MagickThresholdImage changes the value of individual pixels based on the -;; intensity of each pixel compared to threshold. The result is a -;; high-contrast, two color image. -(defmagick* MagickThresholdImage : - _MagickWand _double* -> _status) - -;; MagickThresholdImageChannel changes the value of individual pixel component -;; based on the intensity of each pixel compared to threshold. The result is a -;; high-contrast, two color image. -(defmagick* MagickThresholdImageChannel : - _MagickWand _ChannelType (threshold : _double*) -> _status) - -;; MagickTintImage applies a color vector to each pixel in the image. The -;; length of the vector is 0 for black and white and at its maximum for the -;; midtones. The vector weighting function is -;; f(x)=(1-(4.0*((x-0.5)*(x-0.5)))). -(defmagick* MagickTintImage : - _MagickWand (tint : _PixelWand) (opacity : _PixelWand) -> _status) - -;; MagickTransformImage is a convenience method that behaves like -;; MagickResizeImage or MagickCropImage but accepts scaling and/or cropping -;; information as a region geometry specification. If the operation fails, the -;; original image handle is returned. -(defmagick* MagickTransformImage : - _MagickWand (crop-geometry : _string) (image-geometry : _string) - -> _MagickWand) - -;; MagickTransparentImage changes any pixel that matches color with the color -;; defined by fill. -(defmagick* MagickTransparentImage : - _MagickWand (target : _PixelWand) (opacity : _Quantum) (fuzz : _double*) - -> _status) - -;; MagickTrimImage remove edges that are the background color from the image. -(defmagick* MagickTrimImage : - _MagickWand (fuzz : _double*) -> _status) - -;; MagickUnsharpMaskImage sharpens an image. We convolve the image with a -;; Gaussian operator of the given radius and standard deviation (sigma). For -;; reasonable results, radius should be larger than sigma. Use a radius of 0 -;; and UnsharpMaskImage selects a suitable radius for you. -(defmagick* MagickUnsharpMaskImage : - _MagickWand (radius : _double*) (sigma : _double*) - (amount-precentage : _double*) (threshold : _double*) - -> _status) - -;; MagickWaveImage creates a "ripple" effect in the image by shifting the -;; pixels vertically along a sine wave whose amplitude and wavelength is -;; specified by the given parameters. -(defmagick* MagickWaveImage : - _MagickWand (amplitude : _double*) (wave-length : _double*) -> _status) - -;; MagickWhiteThresholdImage is like ThresholdImage but forces all pixels above -;; the threshold into white while leaving all pixels below the threshold -;; unchanged. -(defmagick* MagickWhiteThresholdImage : - _MagickWand _PixelWand -> _status) - -;; MagickWriteImage writes an image. -(defmagick* MagickWriteImage : - _MagickWand _file -> _status) - -;; MagickGetImageBlob implements direct to memory image formats. It returns -;; the image as a blob and its length. The magick member of the Image -;; structure determines the format of the returned blob (GIF, JPEG, PNG, etc.) -(defmagick* MagickGetImageBlob : - _MagickWand (len : (_ptr o _ulong)) -> (_bytes o len)) - -;; MagickWriteImageFile writes an image to an open file descriptor. -(defmagick* MagickWriteImageFile : - _MagickWand (FILE* : _pointer) -> _status) - -;; MagickWriteImages writes an image or image sequence. -(defmagick* MagickWriteImages : - _MagickWand _file (adjoin? : _bool) -> _status) - -;; NewMagickWand returns a wand required for all other methods in the API. -(defmagick* NewMagickWand : - -> _MagickWand) - -;; ===== PixelIterator API ==================================================== - -;; DestroyPixelIterator deallocates resources associated with a PixelIterator. -(defmagick DestroyPixelIterator : - _PixelIterator -> _void) - -;; NewPixelIterator returns a new pixel iterator. -(defmagick* NewPixelIterator : - (w : _MagickWand) -> (pi : _PixelIterator) - -> (begin (set-PixelIterator-width! pi (MagickGetImageWidth w)) pi)) - -;; NewPixelRegionIterator returns a new pixel iterator. -(defmagick* NewPixelRegionIterator : - _MagickWand (x : _long) (y : _long) (width : _ulong) (height : _ulong) - -> (pi : _PixelIterator) - -> (begin (set-PixelIterator-width! pi width) pi)) - -;; PixelIteratorGetException returns the severity, reason, and description of -;; any error that occurs when using other methods in this API. -(defmagick* PixelIteratorGetException : - _PixelIterator (severity : (_ptr o _MagickExceptionType)) - -> (message : _string) - -> (unless (eq? severity 'UndefinedException) - (error 'PixelIterator "(~a) ~a" severity message))) - -;; PixelGetNextRow returns the next row from the pixel iterator. -(defmagick* PixelGetNextRow : - (pi : _PixelIterator) -> (_list o _PixelWand (PixelIterator-width pi))) - -;; PixelResetIterator resets the pixel iterator. Use it in conjunction with -;; PixelGetNextPixel to iterate over all the pixels in a pixel container. -(defmagick* PixelResetIterator : - _PixelIterator -> _void) - -;; PixelSetIteratorRow set the pixel iterator row. -(defmagick* PixelSetIteratorRow : - (pi : _PixelIterator) (row : _long) -> _status) - -;; PixelSyncIterator syncs the pixel iterator. -(defmagick* PixelSyncIterator : - _PixelIterator -> _status) - -;; ===== PixelWand API ======================================================== - -;; PixelGetException returns the severity, reason, and description of any error -;; that occurs when using other methods in this API (as an exception). -(defmagick* PixelGetException : - _MagickWand (severity : (_ptr o _MagickExceptionType)) -> (message : _string) - -> (unless (eq? severity 'UndefinedException) - (error 'PixelWand "(~a) ~a" severity message))) - -;; DestroyPixelWand deallocates resources associated with a PixelWand. -;; Intended for internal use only, must be defined after the above. -(defmagick DestroyPixelWand : - _PixelWand -> _void) - -;; DestroyPixelWands deallocates resources associated with an array of -;; pixel wands. -;; * There is no need for this - -;; NewPixelWand returns a new pixel wand. -;; Extended: can get a color name to use for the new pixel wand, or an RGB list -;; (integers or floats determine the method to use for setting the values), or -;; a CMYK list. (See also the _PixelWand type definition). -(defmagick* NewPixelWand : - init-color :: - -> (p : _PixelWand) - -> (let ([color (and (pair? init-color) (car init-color))]) - (define (err) (error 'NewPixelWand "bad initial color: ~e" color)) - (cond [(null? init-color)] - [(string? color) (PixelSetColor p color)] - [(list? color) - (let ([len (length color)] - [ints? (andmap integer? color)] - [flts? (andmap inexact? color)]) - (if (or ints? flts?) - (let ([len (if flts? (- len) len)]) - (case len - [(3) (PixelSetRedQuantum p (car color)) - (PixelSetGreenQuantum p (cadr color)) - (PixelSetBlueQuantum p (caddr color))] - [(-3) (PixelSetRed p (car color)) - (PixelSetGreen p (cadr color)) - (PixelSetBlue p (caddr color))] - [(4) (PixelSetCyanQuantum p (car color)) - (PixelSetMagentaQuantum p (cadr color)) - (PixelSetYellowQuantum p (caddr color)) - (PixelSetBlackQuantum p (cadddr color))] - [(-4) (PixelSetCyan p (car color)) - (PixelSetMagenta p (cadr color)) - (PixelSetYellow p (caddr color)) - (PixelSetBlack p (cadddr color))] - [else (err)])) - (err)))] - [else (err)]) - p)) - -;; NewPixelWands returns an array of pixel wands. -;; * There is no need for this - -;; PixelGetBlack returns the normalized black color of the pixel wand. -(defmagick* PixelGetBlack : - _PixelWand -> _double*) - -;; PixelGetBlackQuantum returns the black color of the pixel wand. The color -;; is in the range of [0..MaxRGB]. -(defmagick* PixelGetBlackQuantum : - _PixelWand -> _Quantum) - -;; PixelGetBlue returns the normalized blue color of the pixel wand. -(defmagick* PixelGetBlue : - _PixelWand -> _double*) - -;; PixelGetBlueQuantum returns the blue color of the pixel wand. The color is -;; in the range of [0..MaxRGB]. -(defmagick* PixelGetBlueQuantum : - _PixelWand -> _Quantum) - -;; PixelGetColorAsString gets the color of the pixel wand. -(defmagick* PixelGetColorAsString : - _PixelWand -> _string) - -;; PixelGetColorCount returns the color count associated with this color. -(defmagick* PixelGetColorCount : - _PixelWand -> _ulong) - -;; PixelGetCyan returns the normalized cyan color of the pixel wand. -(defmagick* PixelGetCyan : - _PixelWand -> _double*) - -;; PixelGetCyanQuantum returns the cyan color of the pixel wand. The color is -;; in the range of [0..MaxRGB]. -(defmagick* PixelGetCyanQuantum : - _PixelWand -> _Quantum) - -;; PixelGetGreen returns the normalized green color of the pixel wand. -(defmagick* PixelGetGreen : - _PixelWand -> _double*) - -;; PixelGetGreenQuantum returns the green color of the pixel wand. The color -;; is in the range of [0..MaxRGB]. -(defmagick* PixelGetGreenQuantum : - _PixelWand -> _Quantum) - -;; PixelGetIndex returns the colormap index from the pixel wand. -(defmagick* PixelGetIndex : - _PixelWand -> _IndexPacket) - -;; PixelGetMagenta returns the normalized magenta color of the pixel wand. -(defmagick* PixelGetMagenta : - _PixelWand -> _double*) - -;; PixelGetMagentaQuantum returns the magenta color of the pixel wand. The -;; color is in the range of [0..MaxRGB]. -(defmagick* PixelGetMagentaQuantum : - _PixelWand -> _Quantum) - -;; PixelGetOpacity returns the normalized opacity color of the pixel wand. -(defmagick* PixelGetOpacity : - _PixelWand -> _double*) - -;; PixelGetOpacityQuantum returns the opacity color of the pixel wand. The -;; color is in the range of [0..MaxRGB]. -(defmagick* PixelGetOpacityQuantum : - _PixelWand -> _Quantum) - -;; PixelGetQuantumColor gets the color of the pixel wand. -(defmagick* PixelGetQuantumColor : - _PixelWand (color : _PixelPacket = (NewPixelPacket)) -> _void - -> color) - -;; PixelGetRed returns the normalized red color of the pixel wand. -(defmagick* PixelGetRed : - _PixelWand -> _double*) - -;; PixelGetRedQuantum returns the red color of the pixel wand. The color is in -;; the range of [0..MaxRGB]. -(defmagick* PixelGetRedQuantum : - _PixelWand -> _Quantum) - -;; PixelGetYellow returns the normalized yellow color of the pixel wand. -(defmagick* PixelGetYellow : - _PixelWand -> _double*) - -;; PixelGetYellowQuantum returns the yellow color of the pixel wand. The color -;; is in the range of [0..MaxRGB]. -(defmagick* PixelGetYellowQuantum : - _PixelWand -> _Quantum) - -;; PixelSetBlack sets the normalized black color of the pixel wand. -(defmagick* PixelSetBlack : - _PixelWand (black : _double*) -> _void) - -;; PixelSetBlackQuantum sets the black color of the pixel wand. The color must -;; be in the range of [0..MaxRGB]. -(defmagick* PixelSetBlackQuantum : - _PixelWand (black : _Quantum) -> _void) - -;; PixelSetBlue sets the normalized blue color of the pixel wand. -(defmagick* PixelSetBlue : - _PixelWand (blue : _double*) -> _void) - -;; PixelSetBlueQuantum sets the blue color of the pixel wand. The color must -;; be in the range of [0..MaxRGB]. -(defmagick* PixelSetBlueQuantum : - _PixelWand (blue : _Quantum) -> _void) - -;; PixelSetColor sets the color of the pixel wand with a string (e.g. "blue", -;; "#0000ff", "rgb(0,0,255)", "cmyk(100,100,100,10)", etc.). -(defmagick* PixelSetColor : - _PixelWand (color : _string) -> _status) - -;; PixelSetColorCount sets the color count of the pixel wand. -(defmagick* PixelSetColorCount : - _PixelWand (count : _ulong) -> _void) - -;; PixelSetCyan sets the normalized cyan color of the pixel wand. -(defmagick* PixelSetCyan : - _PixelWand (cyan : _double*) -> _void) - -;; PixelSetCyanQuantum sets the cyan color of the pixel wand. The color must -;; be in the range of [0..MaxRGB]. -(defmagick* PixelSetCyanQuantum : - _PixelWand (cyan : _Quantum) -> _void) - -;; PixelSetGreen sets the normalized green color of the pixel wand. -(defmagick* PixelSetGreen : - _PixelWand (green : _double*) -> _void) - -;; PixelSetGreenQuantum sets the green color of the pixel wand. The color must -;; be in the range of [0..MaxRGB]. -(defmagick* PixelSetGreenQuantum : - _PixelWand (green : _Quantum) -> _void) - -;; PixelSetIndex sets the colormap index of the pixel wand. -(defmagick* PixelSetIndex : - _PixelWand _IndexPacket -> _void) - -;; PixelSetMagenta sets the normalized magenta color of the pixel wand. -(defmagick* PixelSetMagenta : - _PixelWand (magenta : _double*) -> _void) - -;; PixelSetMagentaQuantum sets the magenta color of the pixel wand. The color -;; must be in the range of [0..MaxRGB]. -(defmagick* PixelSetMagentaQuantum : - _PixelWand (magenta : _Quantum) -> _void) - -;; PixelSetOpacity sets the normalized opacity color of the pixel wand. -(defmagick* PixelSetOpacity : - _PixelWand (opacity : _double*) -> _void) - -;; PixelSetOpacityQuantum sets the opacity color of the pixel wand. The color -;; must be in the range of [0..MaxRGB]. -(defmagick* PixelSetOpacityQuantum : - _PixelWand (opacity : _Quantum) -> _void) - -;; PixelSetQuantumColor sets the color of the pixel wand. -(defmagick* PixelSetQuantumColor : - _PixelWand _PixelPacket -> _void) - -;; PixelSetRed sets the normalized red color of the pixel wand. -(defmagick* PixelSetRed : - _PixelWand (red : _double*) -> _void) - -;; PixelSetRedQuantum sets the red color of the pixel wand. The color must be -;; in the range of [0..MaxRGB]. -(defmagick* PixelSetRedQuantum : - _PixelWand (red : _Quantum) -> _void) - -;; PixelSetYellow sets the normalized yellow color of the pixel wand. -(defmagick* PixelSetYellow : - _PixelWand (yellow : _double*) -> _void) - -;; PixelSetYellowQuantum sets the yellow color of the pixel wand. The color -;; must be in the range of [0..MaxRGB]. -(defmagick* PixelSetYellowQuantum : - _PixelWand (yellow : _Quantum) -> _void) - -;; ===== DrawingWand API ====================================================== - -;; DrawGetException returns the severity, reason, and description of any error -;; that occurs when using other methods in this API. -(defmagick* DrawGetException : - _DrawingWand (severity : (_ptr o _MagickExceptionType)) - -> (message : _string) - -> (unless (eq? severity 'UndefinedException) - (error 'DrawingWand "(~a) ~a" severity message))) - -;; DestroyDrawingWand frees all resources associated with the drawing wand. -;; Once the drawing wand has been freed, it should not be used any further -;; unless it re-allocated. -(defmagick DestroyDrawingWand : - _DrawingWand -> _void) - -;; DrawAnnotation draws text on the image. -(defmagick* DrawAnnotation : - _DrawingWand (x : _double*) (y : _double*) (text : _string) -> _void) - -;; DrawAffine adjusts the current affine transformation matrix with the -;; specified affine transformation matrix. Note that the current affine -;; transform is adjusted rather than replaced. -(defmagick* DrawAffine : - _DrawingWand _AffineMatrix -> _void) - -;; DrawAllocateWand allocates an initial drawing wand which is an opaque handle -;; required by the remaining drawing methods. -(defmagick* DrawAllocateWand : - _DrawInfo _Image -> _DrawingWand) - -;; DrawArc draws an arc falling within a specified bounding rectangle on the -;; image. -(defmagick* DrawArc : - _DrawingWand - (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) - (deg1 : _double*) (deg2 : _double*) - -> _void) - -;; DrawBezier draws a bezier curve through a set of points on the image. -(defmagick* DrawBezier : - (d points) :: - (d : _DrawingWand) (_ulong = (length points)) (points : _Points) -> _void) - -;; DrawCircle draws a circle on the image. -(defmagick* DrawCircle : - _DrawingWand - (x : _double*) (y : _double*) - (perimeter-x : _double*) (perimeter-y : _double*) - -> _void) - -;; DrawGetClipPath obtains the current clipping path ID. The value returned -;; must be deallocated by the user when it is no longer needed. -(defmagick* DrawGetClipPath : - _DrawingWand -> _string) - -;; DrawSetClipPath associates a named clipping path with the image. Only the -;; areas drawn on by the clipping path will be modified as long as it remains -;; in effect. -(defmagick* DrawSetClipPath : - _DrawingWand (clip_path : _string) -> _void) - -;; DrawGetClipRule returns the current polygon fill rule to be used by the -;; clipping path. -(defmagick* DrawGetClipRule : - _DrawingWand -> _FillRule) - -;; DrawSetClipRule set the polygon fill rule to be used by the clipping path. -(defmagick* DrawSetClipRule : - _DrawingWand _FillRule -> _void) - -;; DrawGetClipUnits returns the interpretation of clip path units. -(defmagick* DrawGetClipUnits : - _DrawingWand -> _ClipPathUnits) - -;; DrawSetClipUnits sets the interpretation of clip path units. -(defmagick* DrawSetClipUnits : - _DrawingWand _ClipPathUnits -> _void) - -;; DrawColor draws color on image using the current fill color, starting at -;; specified position, and using specified paint method. The available paint -;; methods are: -;; PointMethod: Recolors the target pixel -;; ReplaceMethod: Recolor any pixel that matches the target pixel. -;; FloodfillMethod: Recolors target pixels and matching neighbors. -;; FillToBorderMethod: Recolor target pixels and neighbors not matching -;; border color. -;; ResetMethod: Recolor all pixels. -(defmagick* DrawColor : - _DrawingWand (x : _double*) (y : _double*) _PaintMethod -> _void) - -;; DrawComment adds a comment to a vector output stream. -(defmagick* DrawComment : - _DrawingWand (comment : _string) -> _void) - -;; DrawEllipse draws an ellipse on the image. -(defmagick* DrawEllipse : - _DrawingWand - (x : _double*) (y : _double*) - (radius-x : _double*) (radius-y : _double*) - (start-deg : _double*) (end-deg : _double*) - -> _void) - -;; DrawGetFillColor returns the fill color used for drawing filled objects. -(defmagick* DrawGetFillColor : - _DrawingWand (c : _PixelWand = (NewPixelWand)) -> _void -> c) - -;; DrawSetFillColor sets the fill color to be used for drawing filled objects. -(defmagick* DrawSetFillColor : - _DrawingWand _PixelWand -> _void) - -;; DrawSetFillPatternURL sets the URL to use as a fill pattern for filling -;; objects. Only local URLs ("#identifier") are supported at this time. These -;; local URLs are normally created by defining a named fill pattern with -;; DrawPushPattern/DrawPopPattern. -(defmagick* DrawSetFillPatternURL : - _DrawingWand (fill-url : _string) -> _void) - -;; DrawGetFillOpacity returns the opacity used when drawing using the fill -;; color or fill texture. Fully opaque is 1.0. -(defmagick* DrawGetFillOpacity : - _DrawingWand -> _double*) - -;; DrawSetFillOpacity sets the opacity to use when drawing using the fill color -;; or fill texture. Fully opaque is 1.0. -(defmagick* DrawSetFillOpacity : - _DrawingWand (fill-opacity : _double*) -> _void) - -;; DrawGetFillRule returns the fill rule used while drawing polygons. -(defmagick* DrawGetFillRule : - _DrawingWand -> _FillRule) - -;; DrawSetFillRule sets the fill rule to use while drawing polygons. -(defmagick* DrawSetFillRule : - _DrawingWand _FillRule -> _void) - -;; DrawGetFont returns a null-terminaged string specifying the font used when -;; annotating with text. -(defmagick* DrawGetFont : - _DrawingWand -> _string) - -;; DrawSetFont sets the fully-sepecified font to use when annotating with text. -(defmagick* DrawSetFont : - _DrawingWand (font-name : _string) -> _void) - -;; DrawGetFontFamily returns the font family to use when annotating with text. -(defmagick* DrawGetFontFamily : - _DrawingWand -> _string) - -;; DrawSetFontFamily sets the font family to use when annotating with text. -(defmagick* DrawSetFontFamily : - _DrawingWand (font-family : _string) -> _void) - -;; DrawGetFontSize returns the font pointsize used when annotating with text. -(defmagick* DrawGetFontSize : - _DrawingWand -> _double*) - -;; DrawSetFontSize sets the font pointsize to use when annotating with text. -(defmagick* DrawSetFontSize : - _DrawingWand (pointsize : _double*) -> _void) - -;; DrawGetFontStretch returns the font stretch used when annotating with text. -(defmagick* DrawGetFontStretch : - _DrawingWand -> _StretchType) - -;; DrawSetFontStretch sets the font stretch to use when annotating with text. -;; The AnyStretch enumeration acts as a wild-card "don't care" option. -(defmagick* DrawSetFontStretch : - _DrawingWand _StretchType -> _void) - -;; DrawGetFontStyle returns the font style used when annotating with text. -(defmagick* DrawGetFontStyle : - _DrawingWand -> _StyleType) - -;; DrawSetFontStyle sets the font style to use when annotating with text. The -;; AnyStyle enumeration acts as a wild-card "don't care" option. -(defmagick* DrawSetFontStyle : - _DrawingWand _StyleType -> _void) - -;; DrawGetFontWeight returns the font weight used when annotating with text. -(defmagick* DrawGetFontWeight : - _DrawingWand -> _ulong) - -;; DrawSetFontWeight sets the font weight to use when annotating with text. -(defmagick* DrawSetFontWeight : - _DrawingWand (font-weight : _ulong) -> _void) - -;; DrawGetGravity returns the text placement gravity used when annotating with -;; text. -(defmagick* DrawGetGravity : - _DrawingWand -> _GravityType) - -;; DrawSetGravity sets the text placement gravity to use when annotating with -;; text. -(defmagick* DrawSetGravity : - _DrawingWand _GravityType -> _void) - -;; DrawComposite composites an image onto the current image, using the -;; specified composition operator, specified position, and at the specified -;; size. -(defmagick* DrawComposite : - _DrawingWand _CompositeOperator - (x : _double*) (y : _double*) (width : _double*) (height : _double*) _Image - -> _void) - -;; DrawLine draws a line on the image using the current stroke color, stroke -;; opacity, and stroke width. -(defmagick* DrawLine : - _DrawingWand (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) - -> _void) - -;; DrawMatte paints on the image's opacity channel in order to set effected -;; pixels to transparent. The available paint methods are: -;; PointMethod: Select the target pixel -;; ReplaceMethod: Select any pixel that matches the target pixel. -;; FloodfillMethod: Select the target pixel and matching neighbors. -;; FillToBorderMethod: Select the target pixel and neighbors not matching -;; border color. -;; ResetMethod: Select all pixels. -(defmagick* DrawMatte : - _DrawingWand (x : _double*) (y : _double*) _PaintMethod -> _void) - -;; DrawPathClose adds a path element to the current path which closes the -;; current subpath by drawing a straight line from the current point to the -;; current subpath's most recent starting point (usually, the most recent -;; moveto point). -(defmagick* DrawPathClose : - _DrawingWand -> _void) - -;; DrawPathCurveToAbsolute draws a cubic Bezier curve from the current point to -;; (x,y) using (x1,y1) as the control point at the beginning of the curve and -;; (x2,y2) as the control point at the end of the curve using absolute -;; coordinates. At the end of the command, the new current point becomes the -;; final (x,y) coordinate pair used in the polybezier. -(defmagick* DrawPathCurveToAbsolute : - _DrawingWand - (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) - (x : _double*) (y : _double*) - -> _void) - -;; DrawPathCurveToRelative draws a cubic Bezier curve from the current point to -;; (x,y) using (x1,y1) as the control point at the beginning of the curve and -;; (x2,y2) as the control point at the end of the curve using relative -;; coordinates. At the end of the command, the new current point becomes the -;; final (x,y) coordinate pair used in the polybezier. -(defmagick* DrawPathCurveToRelative : - _DrawingWand - (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) - (x : _double*) (y : _double*) - -> _void) - -;; DrawPathCurveToQuadraticBezierAbsolute draws a quadratic Bezier curve from -;; the current point to (x,y) using (x1,y1) as the control point using absolute -;; coordinates. At the end of the command, the new current point becomes the -;; final (x,y) coordinate pair used in the polybezier. -(defmagick* DrawPathCurveToQuadraticBezierAbsolute : - _DrawingWand (x1 : _double*) (y1 : _double*) (x : _double*) (y : _double*) - -> _void) - -;; DrawPathCurveToQuadraticBezierRelative draws a quadratic Bezier curve from -;; the current point to (x,y) using (x1,y1) as the control point using relative -;; coordinates. At the end of the command, the new current point becomes the -;; final (x,y) coordinate pair used in the polybezier. -(defmagick* DrawPathCurveToQuadraticBezierRelative : - _DrawingWand (x1 : _double*) (y1 : _double*) (x : _double*) (y : _double*) - -> _void) - -;; DrawPathCurveToQuadraticBezierSmoothAbsolute draws a quadratic Bezier curve -;; (using absolute coordinates) from the current point to (x,y). The control -;; point is assumed to be the reflection of the control point on the previous -;; command relative to the current point. (If there is no previous command or -;; if the previous command was not a DrawPathCurveToQuadraticBezierAbsolute, -;; DrawPathCurveToQuadraticBezierRelative, -;; DrawPathCurveToQuadraticBezierSmoothAbsolut or -;; DrawPathCurveToQuadraticBezierSmoothRelative, assume the control point is -;; coincident with the current point.). At the end of the command, the new -;; current point becomes the final (x,y) coordinate pair used in the -;; polybezier. -(defmagick* DrawPathCurveToQuadraticBezierSmoothAbsolute : - _DrawingWand (x : _double*) (y : _double*) -> _void) - -;; DrawPathCurveToQuadraticBezierSmoothAbsolute draws a quadratic Bezier curve -;; (using relative coordinates) from the current point to (x,y). The control -;; point is assumed to be the reflection of the control point on the previous -;; command relative to the current point. (If there is no previous command or -;; if the previous command was not a DrawPathCurveToQuadraticBezierAbsolute, -;; DrawPathCurveToQuadraticBezierRelative, -;; DrawPathCurveToQuadraticBezierSmoothAbsolut or -;; DrawPathCurveToQuadraticBezierSmoothRelative, assume the control point is -;; coincident with the current point.). At the end of the command, the new -;; current point becomes the final (x,y) coordinate pair used in the -;; polybezier. -(defmagick* DrawPathCurveToQuadraticBezierSmoothRelative : - _DrawingWand (x : _double*) (y : _double*) -> _void) - -;; DrawPathCurveToSmoothAbsolute draws a cubic Bezier curve from the current -;; point to (x,y) using absolute coordinates. The first control point is -;; assumed to be the reflection of the second control point on the previous -;; command relative to the current point. (If there is no previous command or -;; if the previous command was not an DrawPathCurveToAbsolute, -;; DrawPathCurveToRelative, DrawPathCurveToSmoothAbsolute or -;; DrawPathCurveToSmoothRelative, assume the first control point is coincident -;; with the current point.) (x2,y2) is the second control point (i.e., the -;; control point at the end of the curve). At the end of the command, the new -;; current point becomes the final (x,y) coordinate pair used in the -;; polybezier. -(defmagick* DrawPathCurveToSmoothAbsolute : - _DrawingWand (x2 : _double*) (y2 : _double*) (x : _double*) (y : _double*) - -> _void) - -;; DrawPathCurveToSmoothRelative draws a cubic Bezier curve from the current -;; point to (x,y) using relative coordinates. The first control point is -;; assumed to be the reflection of the second control point on the previous -;; command relative to the current point. (If there is no previous command or -;; if the previous command was not an DrawPathCurveToAbsolute, -;; DrawPathCurveToRelative, DrawPathCurveToSmoothAbsolute or -;; DrawPathCurveToSmoothRelative, assume the first control point is coincident -;; with the current point.) (x2,y2) is the second control point (i.e., the -;; control point at the end of the curve). At the end of the command, the new -;; current point becomes the final (x,y) coordinate pair used in the -;; polybezier. -(defmagick* DrawPathCurveToSmoothRelative : - _DrawingWand (x2 : _double*) (y2 : _double*) (x : _double*) (y : _double*) - -> _void) - -;; DrawPathEllipticArcAbsolute draws an elliptical arc from the current point -;; to (x, y) using absolute coordinates. The size and orientation of the -;; ellipse are defined by two radii (rx, ry) and an xAxisRotation, which -;; indicates how the ellipse as a whole is rotated relative to the current -;; coordinate system. The center (cx, cy) of the ellipse is calculated -;; automatically to satisfy the constraints imposed by the other parameters. -;; largeArcFlag and sweepFlag contribute to the automatic calculations and help -;; determine how the arc is drawn. If largeArcFlag is true then draw the -;; larger of the available arcs. If sweepFlag is true, then draw the arc -;; matching a clock-wise rotation. -(defmagick* DrawPathEllipticArcAbsolute : - _DrawingWand (rx : _double*) (ry : _double*) - (x-axis-rotation : _double*) (large-arc-flag? : _bool) (sweep-flag? : _bool) - (x : _double*) (y : _double*) - -> _void) - -;; DrawPathEllipticArcRelative draws an elliptical arc from the current point -;; to (x, y) using relative coordinates. The size and orientation of the -;; ellipse are defined by two radii (rx, ry) and an xAxisRotation, which -;; indicates how the ellipse as a whole is rotated relative to the current -;; coordinate system. The center (cx, cy) of the ellipse is calculated -;; automatically to satisfy the constraints imposed by the other parameters. -;; largeArcFlag and sweepFlag contribute to the automatic calculations and help -;; determine how the arc is drawn. If largeArcFlag is true then draw the -;; larger of the available arcs. If sweepFlag is true, then draw the arc -;; matching a clock-wise rotation. -(defmagick* DrawPathEllipticArcRelative : - _DrawingWand (rx : _double*) (ry : _double*) - (x-axis-rotation : _double*) (large-arc-flag? : _bool) (sweep-flag? : _bool) - (x : _double*) (y : _double*) - -> _void) - -;; DrawPathFinish terminates the current path. -(defmagick* DrawPathFinish : - _DrawingWand -> _void) - -;; DrawPathLineToAbsolute draws a line path from the current point to the given -;; coordinate using absolute coordinates. The coordinate then becomes the new -;; current point. -(defmagick* DrawPathLineToAbsolute : - _DrawingWand (x : _double*) (y : _double*) -> _void) - -;; DrawPathLineToRelative draws a line path from the current point to the given -;; coordinate using relative coordinates. The coordinate then becomes the new -;; current point. -(defmagick* DrawPathLineToRelative : - _DrawingWand (x : _double*) (y : _double*) -> _void) - -;; DrawPathLineToHorizontalAbsolute draws a horizontal line path from the -;; current point to the target point using absolute coordinates. The target -;; point then becomes the new current point. -(defmagick* DrawPathLineToHorizontalAbsolute : - _DrawingWand (x : _double*) -> _void) - -;; DrawPathLineToHorizontalRelative draws a horizontal line path from the -;; current point to the target point using relative coordinates. The target -;; point then becomes the new current point. -(defmagick* DrawPathLineToHorizontalRelative : - _DrawingWand (x : _double*) -> _void) - -;; DrawPathLineToVerticalAbsolute draws a vertical line path from the current -;; point to the target point using absolute coordinates. The target point then -;; becomes the new current point. -(defmagick* DrawPathLineToVerticalAbsolute : - _DrawingWand (y : _double*) -> _void) - -;; DrawPathLineToVerticalRelative draws a vertical line path from the current -;; point to the target point using relative coordinates. The target point then -;; becomes the new current point. -(defmagick* DrawPathLineToVerticalRelative : - _DrawingWand (y : _double*) -> _void) - -;; DrawPathMoveToAbsolute starts a new sub-path at the given coordinate using -;; absolute coordinates. The current point then becomes the specified -;; coordinate. -(defmagick* DrawPathMoveToAbsolute : - _DrawingWand (x : _double*) (y : _double*) -> _void) - -;; DrawPathMoveToRelative starts a new sub-path at the given coordinate using -;; relative coordinates. The current point then becomes the specified -;; coordinate. -(defmagick* DrawPathMoveToRelative : - _DrawingWand (x : _double*) (y : _double*) -> _void) - -;; DrawPathStart declares the start of a path drawing list which is terminated -;; by a matching DrawPathFinish command. All other DrawPath commands must be -;; enclosed between a DrawPathStart and a DrawPathFinish command. This is -;; because path drawing commands are subordinate commands and they do not -;; function by themselves. -(defmagick* DrawPathStart : - _DrawingWand -> _void) - -;; PeekDrawingWand returns the current drawing wand. -(defmagick* PeekDrawingWand : - _DrawingWand -> _DrawInfo) - -;; DrawPoint draws a point using the current stroke color and stroke thickness -;; at the specified coordinates. -(defmagick* DrawPoint : - _DrawingWand (x : _double*) (y : _double*) -> _void) - -;; DrawPolygon draws a polygon using the current stroke, stroke width, and fill -;; color or texture, using the specified array of coordinates. -(defmagick* DrawPolygon : - (d points) :: - (d : _DrawingWand) (_ulong = (length points)) (points : _Points) -> _void) - -;; DrawPolyline draws a polyline using the current stroke, stroke width, and -;; fill color or texture, using the specified array of coordinates. -(defmagick* DrawPolyline : - (d points) :: - (d : _DrawingWand) (_ulong = (length points)) (points : _Points) -> _void) - -;; DrawPopClipPath terminates a clip path definition. -(defmagick* DrawPopClipPath : - _DrawingWand -> _void) - -;; DrawPopDefs terminates a definition list. -(defmagick* DrawPopDefs : - _DrawingWand -> _void) - -;; PopDrawingWand destroys the current drawing wand and returns to the -;; previously pushed drawing wand. Multiple drawing wands may exist. It is an -;; error to attempt to pop more drawing wands than have been pushed, and it is -;; proper form to pop all drawing wands which have been pushed. -(defmagick* PopDrawingWand : - _DrawingWand -> _void) - -;; DrawPopPattern terminates a pattern definition. -(defmagick* DrawPopPattern : - _DrawingWand -> _void) - -;; DrawPushClipPath starts a clip path definition which is comprized of any -;; number of drawing commands and terminated by a DrawPopClipPath command. -(defmagick* DrawPushClipPath : - _DrawingWand (clip-path-id : _string) -> _void) - -;; DrawPushDefs indicates that commands up to a terminating DrawPopDefs command -;; create named elements (e.g. clip-paths, textures, etc.) which may safely be -;; processed earlier for the sake of efficiency. -(defmagick* DrawPushDefs : - _DrawingWand -> _void) - -;; PushDrawingWand clones the current drawing wand to create a new -;; drawing wand. The original drawing drawing wand(s) may be returned to by -;; invoking PopDrawingWand. The drawing wands are stored on a drawing wand -;; stack. For every Pop there must have already been an equivalent Push. -(defmagick* PushDrawingWand : - _DrawingWand -> _void) - -;; DrawPushPattern indicates that subsequent commands up to a DrawPopPattern -;; command comprise the definition of a named pattern. The pattern space is -;; assigned top left corner coordinates, a width and height, and becomes its -;; own drawing space. Anything which can be drawn may be used in a pattern -;; definition. Named patterns may be used as stroke or brush definitions. -(defmagick* DrawPushPattern : - _DrawingWand (pattern-id : _string) - (x : _double*) (y : _double*) (width : _double*) (height : _double*) - -> _void) - -;; DrawRectangle draws a rectangle given two coordinates and using the current -;; stroke, stroke width, and fill settings. -(defmagick* DrawRectangle : - _DrawingWand (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) - -> _void) - -;; DrawRender renders all preceding drawing commands onto the image. -(defmagick* DrawRender : - _DrawingWand -> _status) - -;; DrawRotate applies the specified rotation to the current coordinate space. -(defmagick* DrawRotate : - _DrawingWand (degrees : _double*) -> _void) - -;; DrawRoundRectangle draws a rounted rectangle given two coordinates, x & y -;; corner radiuses and using the current stroke, stroke width, and fill -;; settings. -(defmagick* DrawRoundRectangle : - _DrawingWand - (x1 : _double*) (y1 : _double*) (x2 : _double*) (y2 : _double*) - (rx : _double*) (ry : _double*) - -> _void) - -;; DrawScale adjusts the scaling factor to apply in the horizontal and vertical -;; directions to the current coordinate space. -(defmagick* DrawScale : - _DrawingWand (horizontal-scale : _double*) (vertical-scale : _double*) - -> _void) - -;; DrawSkewX skews the current coordinate system in the horizontal direction. -(defmagick* DrawSkewX : - _DrawingWand (degrees : _double*) -> _void) - -;; DrawSkewY skews the current coordinate system in the vertical direction. -(defmagick* DrawSkewY : - _DrawingWand (degrees : _double*) -> _void) - -;; DrawGetStrokeColor returns the color used for stroking object outlines. -(defmagick* DrawGetStrokeColor : - _DrawingWand (c : _PixelWand = (NewPixelWand)) -> _void -> c) - -;; DrawSetStrokeColor sets the color used for stroking object outlines. -(defmagick* DrawSetStrokeColor : - _DrawingWand _PixelWand -> _void) - -;; DrawSetStrokePatternURL sets the pattern used for stroking object outlines. -(defmagick* DrawSetStrokePatternURL : - _DrawingWand (stroke-url : _string) -> _void) - -;; DrawGetStrokeAntialias returns the current stroke antialias setting. -;; Stroked outlines are antialiased by default. When antialiasing is disabled -;; stroked pixels are thresholded to determine if the stroke color or -;; underlying canvas color should be used. -(defmagick* DrawGetStrokeAntialias : - _DrawingWand -> _bool) - -;; DrawSetStrokeAntialias controls whether stroked outlines are antialiased. -;; Stroked outlines are antialiased by default. When antialiasing is disabled -;; stroked pixels are thresholded to determine if the stroke color or -;; underlying canvas color should be used. -(defmagick* DrawSetStrokeAntialias : - _DrawingWand (stroke-antialias? : _bool) -> _void) - -;; DrawGetStrokeDashArray returns an array representing the pattern of dashes -;; and gaps used to stroke paths (see DrawSetStrokeDashArray). -(defmagick* DrawGetStrokeDashArray : - _DrawingWand (len : (_ptr o _ulong)) -> (_list o _double* len)) - -;; DrawSetStrokeDashArray specifies the pattern of dashes and gaps used to -;; stroke paths. The strokeDashArray represents an array of numbers that -;; specify the lengths of alternating dashes and gaps in pixels. If an odd -;; number of values is provided, then the list of values is repeated to yield -;; an even number of values. To remove an existing dash array, pass a zero -;; number_elements argument and null dash_array. A typical strokeDashArray_ -;; array might contain the members 5 3 2. -(defmagick* DrawSetStrokeDashArray : - (d dash-list) :: - ;; the function seem to always expect a 0.0-terminated vector - (dash-list : _? = (append dash-list '(0.0))) - (d : _DrawingWand) - (_ulong = (length dash-list)) (dash-list : (_list i _double*)) - -> _void) - -;; DrawGetStrokeDashOffset returns the offset into the dash pattern to start -;; the dash. -(defmagick* DrawGetStrokeDashOffset : - _DrawingWand -> _double*) - -;; DrawSetStrokeDashOffset specifies the offset into the dash pattern to start -;; the dash. -(defmagick* DrawSetStrokeDashOffset : - _DrawingWand (dash-offset : _double*) -> _void) - -;; DrawGetStrokeLineCap returns the shape to be used at the end of open -;; subpaths when they are stroked. Values of LineCap are UndefinedCap, -;; ButtCap, RoundCap, and SquareCap. -(defmagick* DrawGetStrokeLineCap : - _DrawingWand -> _LineCap) - -;; DrawSetStrokeLineCap specifies the shape to be used at the end of open -;; subpaths when they are stroked. Values of LineCap are UndefinedCap, -;; ButtCap, RoundCap, and SquareCap. -(defmagick* DrawSetStrokeLineCap : - _DrawingWand _LineCap -> _void) - -;; DrawGetStrokeLineJoin returns the shape to be used at the corners of paths -;; (or other vector shapes) when they are stroked. Values of LineJoin are -;; UndefinedJoin, MiterJoin, RoundJoin, and BevelJoin. -(defmagick* DrawGetStrokeLineJoin : - _DrawingWand -> _LineJoin) - -;; DrawSetStrokeLineJoin specifies the shape to be used at the corners of paths -;; (or other vector shapes) when they are stroked. Values of LineJoin are -;; UndefinedJoin, MiterJoin, RoundJoin, and BevelJoin. -(defmagick* DrawSetStrokeLineJoin : - _DrawingWand _LineJoin -> _void) - -;; DrawGetStrokeMiterLimit returns the miter limit. When two line segments -;; meet at a sharp angle and miter joins have been specified for 'lineJoin', it -;; is possible for the miter to extend far beyond the thickness of the line -;; stroking the path. The miterLimit' imposes a limit on the ratio of the -;; miter length to the 'lineWidth'. -(defmagick* DrawGetStrokeMiterLimit : - _DrawingWand -> _ulong) - -;; DrawSetStrokeMiterLimit specifies the miter limit. When two line segments -;; meet at a sharp angle and miter joins have been specified for 'lineJoin', it -;; is possible for the miter to extend far beyond the thickness of the line -;; stroking the path. The miterLimit' imposes a limit on the ratio of the -;; miter length to the 'lineWidth'. -(defmagick* DrawSetStrokeMiterLimit : - _DrawingWand (miterlimit : _ulong) -> _void) - -;; DrawGetStrokeOpacity returns the opacity of stroked object outlines. -(defmagick* DrawGetStrokeOpacity : - _DrawingWand -> _double*) - -;; DrawSetStrokeOpacity specifies the opacity of stroked object outlines. -(defmagick* DrawSetStrokeOpacity : - _DrawingWand (stroke-opacity : _double*) -> _void) - -;; DrawGetStrokeWidth returns the width of the stroke used to draw object -;; outlines. -(defmagick* DrawGetStrokeWidth : - _DrawingWand -> _double*) - -;; DrawSetStrokeWidth sets the width of the stroke used to draw object -;; outlines. -(defmagick* DrawSetStrokeWidth : - _DrawingWand (stroke-width : _double*) -> _void) - -;; DrawGetTextAntialias returns the current text antialias setting, which -;; determines whether text is antialiased. Text is antialiased by default. -(defmagick* DrawGetTextAntialias : - _DrawingWand -> _bool) - -;; DrawSetTextAntialias controls whether text is antialiased. Text is -;; antialiased by default. -(defmagick* DrawSetTextAntialias : - _DrawingWand (text-antialias? : _bool) -> _void) - -;; DrawGetTextDecoration returns the decoration applied when annotating with -;; text. -(defmagick* DrawGetTextDecoration : - _DrawingWand -> _DecorationType) - -;; DrawSetTextDecoration specifies a decoration to be applied when annotating -;; with text. -(defmagick* DrawSetTextDecoration : - _DrawingWand _DecorationType -> _void) - -;; DrawGetTextEncoding returns a null-terminated string which specifies the -;; code set used for text annotations. -(defmagick* DrawGetTextEncoding : - _DrawingWand -> _string) - -;; DrawSetTextEncoding specifies specifies the code set to use for text -;; annotations. The only character encoding which may be specified at this -;; time is "UTF-8" for representing Unicode as a sequence of bytes. Specify an -;; empty string to set text encoding to the system's default. Successful text -;; annotation using Unicode may require fonts designed to support Unicode. -(defmagick* DrawSetTextEncoding : - _DrawingWand (encoding : _string) -> _void) - -;; DrawGetTextUnderColor returns the color of a background rectangle to place -;; under text annotations. -(defmagick* DrawGetTextUnderColor : - _DrawingWand (c : _PixelWand = (NewPixelWand)) -> _void -> c) - -;; DrawSetTextUnderColor specifies the color of a background rectangle to place -;; under text annotations. -(defmagick* DrawSetTextUnderColor : - _DrawingWand _PixelWand -> _void) - -;; DrawTranslate applies a translation to the current coordinate system which -;; moves the coordinate system origin to the specified coordinate. -(defmagick* DrawTranslate : - _DrawingWand (x : _double*) (y : _double*) -> _void) - -;; DrawSetViewbox sets the overall canvas size to be recorded with the drawing -;; vector data. Usually this will be specified using the same size as the -;; canvas image. When the vector data is saved to SVG or MVG formats, the -;; viewbox is use to specify the size of the canvas image that a viewer will -;; render the vector data on. -(defmagick* DrawSetViewbox : - _DrawingWand (x1 : _ulong) (y1 : _ulong) (x2 : _ulong) (y2 : _ulong) - -> _void) - -;; NewDrawingWand returns a draw wand required for all other methods in the -;; API. -(defmagick* NewDrawingWand : - -> _DrawingWand) - -;; ===== Misc APIs ============================================================ - -;; These are not part of the Wand API, but they are used by it so we need -;; destructor functions when collecting them. - -;; DestroyImage dereferences an image, deallocating memory associated with the -;; image if the reference count becomes zero. -(defmagick DestroyImage : - _Image -> _void) - -(defmagick DestroyDrawInfo : - _DrawInfo -> _void) diff --git a/collects/ffi/objc.ss b/collects/ffi/objc.ss index edac8c149a..07ab0ddce8 100644 --- a/collects/ffi/objc.ss +++ b/collects/ffi/objc.ss @@ -11,7 +11,7 @@ #'(require (only-in . lib+ids)))])))) (provide-except-unsafe - racket/unsafe/ffi/objc objc-unsafe! + ffi/unsafe/objc objc-unsafe! objc_msgSend/typed objc_msgSendSuper/typed diff --git a/collects/ffi/sndfile.ss b/collects/ffi/sndfile.ss deleted file mode 100644 index 2ccaf9f5e9..0000000000 --- a/collects/ffi/sndfile.ss +++ /dev/null @@ -1,343 +0,0 @@ -#lang scheme/base - -(require mzlib/foreign) (unsafe!) - -(define libsndfile (ffi-lib "libsndfile")) - -;; ==================== Types etc ==================== - -;; This is the scheme represtenatation of the soundfile that is handeled by -;; libsndfile. - -;; In libsndfile the sndfile object is represented as a pointer. When -;; translating scheme->c the struct will just return the pointer. When -;; translating from c->scheme, ie. creating the object in scheme it will be -;; wrapped by an object finalizer that uses the libsndfile fuction sf_close that -;; returns a 0 upon successful termination or an error. -(define-struct sndfile (ptr [info #:mutable])) -(define _sndfile - (make-ctype _pointer sndfile-ptr - (lambda (p) - (if p - (make-sndfile p #f) - (error '_sndfile "got a NULL pointer (bad info?)"))))) - -;; sf_count_t is a count type that depends on the operating system however it -;; seems to be a long int for all the supported ones so in this scase we just -;; define it as two ints. -(define _sf-count-t _int64) - -(define _sf-mode - (_bitmask '(sfm-read = #x10 - sfm-write = #x20 - sfm-rdwrt = #x30))) - -(define str-types '(title copyright software artist comment date)) -(define _sf-str-type (_enum (cons "dummy" str-types))) ; begins from 1 - -(define _sf-format - (let ([majors ; Major formats - '((wav #x010000) ; Microsoft WAV format (little endian) - (aiff #x020000) ; Apple/SGI AIFF format (big endian) - (au #x030000) ; Sun/NeXT AU format (big endian) - (raw #x040000) ; RAW PCM data - (paf #x050000) ; Ensoniq PARIS file format - (svx #x060000) ; Amiga IFF / SVX8 / SV16 format - (nist #x070000) ; Sphere NIST format - (voc #x080000) ; VOC files - (ircam #x0A0000) ; Berkeley/IRCAM/CARL - (w64 #x0B0000) ; Sonic Foundry's 64 bit RIFF/WAV - (mat4 #x0C0000) ; Matlab (tm) V4.2 / GNU Octave 2.0 - (mat5 #x0D0000) ; Matlab (tm) V5.0 / GNU Octave 2.1 - (pvf #x0E0000) ; Portable Voice Format - (xi #x0F0000) ; Fasttracker 2 Extended Instrument - (htk #x100000) ; HMM Tool Kit format - (sds #x110000) ; Midi Sample Dump Standard - (avr #x120000) ; Audio Visual Research - (wavex #x130000) ; MS WAVE with WAVEFORMATEX - )] - [subtypes ; Subtypes from here on - '((pcm-s8 #x0001) ; Signed 8 bit data - (pcm-16 #x0002) ; Signed 16 bit data - (pcm-24 #x0003) ; Signed 24 bit data - (pcm-32 #x0004) ; Signed 32 bit data - (pcm-u8 #x0005) ; Unsigned 8 bit data (WAV and RAW only) - (float #x0006) ; 32 bit float data - (double #x0007) ; 64 bit float data - (ulaw #x0010) ; U-Law encoded - (alaw #x0011) ; A-Law encoded - (ima-adpcm #x0012) ; IMA ADPCM - (ms-adpcm #x0013) ; Microsoft ADPCM - (gsm610 #x0020) ; GSM 6.10 encoding - (vox-adpcm #x0021) ; OKI / Dialogix ADPCM - (g721-32 #x0030) ; 32kbs G721 ADPCM encoding - (g723-24 #x0031) ; 24kbs G723 ADPCM encoding - (g723-40 #x0032) ; 40kbs G723 ADPCM encoding - (dwvw-12 #x0040) ; 12 bit Delta Width Variable Word encoding - (dwvw-16 #x0041) ; 16 bit Delta Width Variable Word encoding - (dwvw-24 #x0042) ; 24 bit Delta Width Variable Word encoding - (dwvw-n #x0043) ; N bit Delta Width Variable Word encoding - (dpcm-8 #x0050) ; 8 bit differential PCM (XI only) - (dpcm-16 #x0051) ; 16 bit differential PCM (XI only) - )] - [endians ; Endian-ness options - '((file #x00000000) ; Default file endian-ness - (little #x10000000) ; Force little endian-ness - (big #x20000000) ; Force big endian-ness - (cpu #x30000000) ; Force CPU endian-ness - )] - [submask #x0000FFFF] - [typemask #x0FFF0000] - [endmask #x30000000]) - (define (rev-find n l) - (let loop ([l l]) - (cond [(null? l) #f] - [(eq? n (cadar l)) (caar l)] - [else (loop (cdr l))]))) - (make-ctype _int - (lambda (syms) - (let ([major #f] [subtype #f] [endian #f]) - (for-each - (lambda (sym) - (cond [(assq sym majors) => - (lambda (x) - (if major - (error 'sf-format "got two major modes: ~s" syms) - (set! major (cadr x))))] - [(assq sym subtypes) => - (lambda (x) - (if subtype - (error 'sf-format "got two subtype modes: ~s" syms) - (set! subtype (cadr x))))] - [(assq sym endians) => - (lambda (x) - (if endian - (error 'sf-format "got two endian modes: ~s" syms) - (set! endian (cadr x))))] - [else (error 'sf-format "got a bad symbol: ~s" sym)])) - (if (list? syms) syms (list syms))) - (bitwise-ior (or major 0) (or subtype 0) (or endian 0)))) - (lambda (n) - (let ([subtype (rev-find (bitwise-and n submask) subtypes)] - [major (rev-find (bitwise-and n typemask) majors)] - [endian (rev-find (bitwise-and n endmask) endians)]) - (unless subtype - (error 'sf-format "got a bad number from C for subtype: ~x" - (bitwise-and n submask))) - (unless major - (error 'sf-format "got a bad number from C for major: ~x" - (bitwise-and n typemask))) - (unless endian - (error 'sf-format "got a bad number from C for endian: ~x" - (bitwise-and n endmask))) - (list major subtype endian)))))) - -(define-cstruct _sf-info - ((frames _sf-count-t) - (samplerate _int) - (channels _int) - (format _sf-format) - (sections _int) - (seekable _bool))) - -;; ==================== Utilities ==================== - -(define-syntax defsndfile - (syntax-rules (:) - [(_ name : type ...) - (define name - (get-ffi-obj (regexp-replaces 'name '((#rx"-" "_"))) - libsndfile (_fun type ...)))])) - -(define (n-split l n) - (let loop ([l l][i 0][a2 null][a null]) - (cond - [(null? l) (let ([a (if (null? a2) - a - (cons (reverse a2) a))]) - (reverse a))] - [(= i n) (loop l 0 null (cons (reverse a2) a))] - [else (loop (cdr l) (add1 i) (cons (car l) a2) a)]))) - -;; ==================== sndfile API ==================== - -(defsndfile sf-close : _sndfile -> _int) - -(defsndfile sf-open : (path mode . info) :: - (path : _file) - (mode : _sf-mode) - (info : _sf-info-pointer - = (if (pair? info) (car info) (make-sf-info 0 0 0 '() 0 #f))) - -> (sf : _sndfile) - -> (begin (set-sndfile-info! sf info) sf)) - -(defsndfile sf-format-check : _sf-info-pointer -> _bool) - -(defsndfile sf-readf-short : _sndfile _pointer _sf-count-t -> _sf-count-t) -(defsndfile sf-readf-int : _sndfile _pointer _sf-count-t -> _sf-count-t) -(defsndfile sf-readf-double : _sndfile _pointer _sf-count-t -> _sf-count-t) - -(defsndfile sf-writef-short : _sndfile _pointer _sf-count-t -> _sf-count-t) -(defsndfile sf-writef-int : _sndfile _pointer _sf-count-t -> _sf-count-t) -(defsndfile sf-writef-double : _sndfile _pointer _sf-count-t -> _sf-count-t) - -(defsndfile sf-get-string : _sndfile _sf-str-type -> _string) -(defsndfile sf-set-string : _sndfile _sf-str-type _string -> _bool) - -;; ==================== Utilities for the Scheme interface ==================== - -(define (get-strings sndfile) - (let loop ([sts str-types] [r '()]) - (cond [(null? sts) (reverse r)] - [(sf-get-string sndfile (car sts)) => - (lambda (x) - (loop (cdr sts) (cons (list (car sts) (string-copy x)) r)))] - [else (loop (cdr sts) r)]))) - -(define (set-strings sndfile meta) - (for-each (lambda (st) - (cond [(assq st meta) => - (lambda (x) (sf-set-string sndfile st (cadr x)))])) - str-types)) - -(define (read-sound-internal file meta?) - (let* ([sndfile (sf-open file 'sfm-read)] - [strings (and meta? (get-strings sndfile))] - [info (sndfile-info sndfile)] - [frames (sf-info-frames info)] - [channels (sf-info-channels info)] - [stype (case (sample-type) - [(short) _int16] [(int) _int] [(float) _double*])] - [readf (case (sample-type) - [(short) sf-readf-short] - [(int) sf-readf-int] - [(float) sf-readf-double])] - [cblock (malloc (* frames channels) stype)] - [num-read (readf sndfile cblock frames)] - [data (cblock->list cblock stype (* num-read channels))] - [data (if (> channels 1) (n-split data channels) data)]) - (unless (= frames num-read) - (error 'read-sound-internal - "wanted ~s frames, but got ~s" frames num-read)) - (begin0 (if meta? - (values data `((frames ,frames) - (samplerate ,(sf-info-samplerate info)) - (channels ,channels) - (format ,(sf-info-format info)) - (sections ,(sf-info-sections info)) - ,@strings)) - data) - (sf-close sndfile)))) - -(define (frame-list->cblock data frames channels type) - (cond - [(null? data) #f] - [(and (= 1 channels) (not (pair? (car data)))) (list->cblock data type)] - [else - (let ([test (lambda (x) - (and (list? x) (= channels (length x)) (andmap number? x)))]) - (unless (andmap test data) - (error 'frame-list->cblock "got a bad frame: ~e" - (ormap (lambda (x) (and (not (test x)) x)) data)))) - (let ([cblock (malloc (* channels frames) type)] - [i 0]) - (let loop ([d data]) - (cond [(number? d) (ptr-set! cblock type i d) (set! i (add1 i))] - [(pair? d) (loop (car d)) (loop (cdr d))])) - cblock)])) - -(define (write-sound-internal file data meta) - (let* ([frames (length data)] - [channels (if (or (null? data) (not (pair? (car data)))) - 1 ; 1-channel if no data, or data is not made of lists - (length (car data)))] - [stype (case (sample-type) - [(short) _int16] [(int) _int] [(float) _double*])] - [writef (case (sample-type) - [(short) sf-writef-short] - [(int) sf-writef-int] - [(float) sf-writef-double])] - [cblock (frame-list->cblock data frames channels stype)] - [format (cond [(assq 'format meta) => cadr] - [else (guess-format file)])] - [samplerate (cond [(assq 'samplerate meta) => cadr] - [else (default-samplerate)])] - [info (make-sf-info frames samplerate channels format 1 #f)] - [_ (unless (sf-format-check info) - (error 'write-sound-internal "bad format: ~s" format))] - [sndfile (sf-open file 'sfm-write info)] - [_ (set-strings sndfile meta)] - [num-write (writef sndfile cblock frames)]) - (unless (= frames num-write) - (error 'write-sound-internal - "wanted to write ~s frames, but wrote only ~s" frames num-write)) - (sf-close sndfile) - (void))) - -(define file-format-table - '((#rx"\\.aiff?" (aiff pcm-16 file)) - (#rx"\\.wave?" (wav pcm-16 file)) - (#rx"\\.au" (au pcm-16 file)) - (#rx"\\.snd" (au pcm-16 file)) - (#rx"\\.svx" (svx pcm-16 file)) - (#rx"\\.paf" (paf pcm-16 big)) - (#rx"\\.fap" (paf pcm-16 little)) - (#rx"\\.nist" (nist pcm-16 little)) - (#rx"\\.ircam" (ircam pcm-16 little)) - (#rx"\\.sf" (ircam pcm-16 little)) - (#rx"\\.voc" (voc pcm-16 file)) - (#rx"\\.w64" (w64 pcm-16 file)) - (#rx"\\.raw" (raw pcm-16 cpu)) - (#rx"\\.mat4" (mat4 pcm-16 little)) - (#rx"\\.mat5" (mat5 pcm-16 little)) - (#rx"\\.mat" (mat4 pcm-16 little)) - (#rx"\\.pvf" (pvf pcm-16 file)) - (#rx"\\.sds" (sds pcm-16 file)) - (#rx"\\.xi" (xi dpcm-16 file)))) -(define (guess-format filename) - (let loop ([xs file-format-table]) - (cond [(null? xs) (default-file-format)] - [(regexp-match (caar xs) filename) (cadar xs)] - [else (loop (cdr xs))]))) - -;; ==================== Exposed Scheme interface ==================== - -;; types of samples we handle: 'short, 'int, or 'float -(provide sample-type) -(define sample-type - (make-parameter - 'float (lambda (x) - (if (memq x '(short int float)) - x (error 'sample-type "bad type: ~s" x))))) - -;; TODO: add a parameter that will determine if you get a list, vector or -;; srfi/4-like thing. possibly also determine if a list/vector gets automatic -;; treatment of 1-channel - not converting it into a list of singleton lists. - -(provide default-samplerate) -(define default-samplerate - (make-parameter - 11025 (lambda (x) - (if (and (integer? x) (positive? x)) - x (error 'default-samplerate "bad samplerate: ~s" x))))) - -(provide default-file-format) -(define default-file-format ; no guard, but should be good for _sf-format - (make-parameter '(wav pcm-16 file))) - -(provide read-sound) -(define (read-sound file) - (read-sound-internal file #f)) - -(provide read-sound*) -(define (read-sound* file) - (read-sound-internal file #t)) - -(provide write-sound) -(define (write-sound file data) - (write-sound-internal file data '())) - -;; meta is used only for samplerate & format -(provide write-sound*) -(define (write-sound* file data meta) - (write-sound-internal file data meta)) diff --git a/collects/ffi/tcl.ss b/collects/ffi/tcl.ss deleted file mode 100644 index 08979b4fbd..0000000000 --- a/collects/ffi/tcl.ss +++ /dev/null @@ -1,49 +0,0 @@ -#lang scheme/base - -(require mzlib/foreign) (unsafe!) - -(define libtcl (ffi-lib "libtcl")) - -(provide current-interp create-interp eval-tcl) - -(define current-interp - (make-parameter - #f (lambda (x) - (if (and x (cpointer? x)) - x - (error 'tcl:current-interp - "expecting a non-void C pointer, got ~s" x))))) - -;; This creates _interp as a type to be used for functions that return an -;; interpreter that should be destroyed with delete-interp. -(define _interp - (make-ctype _pointer #f ; no op when going to C - (lambda (interp) - (when interp (register-finalizer interp delete-interp)) - interp))) - -;; This is for arguments that always use the value of current-interp -(define-fun-syntax _interp* - (syntax-id-rules () - [_ (type: _interp expr: (current-interp))])) - -(define create-interp - (get-ffi-obj "Tcl_CreateInterp" libtcl (_fun -> _interp))) -(define delete-interp - (let ([f (get-ffi-obj "Tcl_DeleteInterp" libtcl (_fun _interp -> _void))]) - (lambda (i) (f i)))) - -(current-interp (create-interp)) - -(define get-string-result - (get-ffi-obj "Tcl_GetStringResult" libtcl (_fun _interp -> _string))) - -(define _tclret - (make-ctype (_enum '(ok error return break continue)) - (lambda (x) (error "tclret is only for return values")) - (lambda (x) - (when (eq? x 'error) (error 'tcl (get-string-result (current-interp)))) - x))) - -(define eval-tcl - (get-ffi-obj "Tcl_Eval" libtcl (_fun _interp* (expr : _string) -> _tclret))) diff --git a/collects/racket/unsafe/ffi.rkt b/collects/ffi/unsafe.rkt similarity index 88% rename from collects/racket/unsafe/ffi.rkt rename to collects/ffi/unsafe.rkt index 2ad92a982a..215eef1180 100644 --- a/collects/racket/unsafe/ffi.rkt +++ b/collects/ffi/unsafe.rkt @@ -974,201 +974,6 @@ [(_ . xs) (_bytes . xs)] [_ _bytes])) -;; ---------------------------------------------------------------------------- -;; Safe raw vectors - -(define-struct cvector (ptr type length)) - -(provide cvector? cvector-length cvector-type cvector-ptr - ;; make-cvector* is a dangerous operation - (protect-out (rename-out [make-cvector make-cvector*]))) - -(define _cvector* ; used only as input types - (make-ctype _pointer cvector-ptr - (lambda (x) - (error '_cvector - "cannot automatically convert a C pointer to a cvector")))) - -;; (_cvector [ ]) | _cevector -;; Same as _list etc above, except that it uses C vectors. -(provide _cvector) -(define-fun-syntax _cvector - (syntax-id-rules (i o io) - [(_ i ) _cvector*] - [(_ o t n) (type: _pointer ; needs to be a pointer, not a cvector* - pre: (malloc n t) - post: (x => (make-cvector x t n)))] - [(_ io ) (type: _cvector* - bind: tmp - pre: (x => (cvector-ptr x)) - post: (x => tmp))] - [(_ . xs) (_cvector* . xs)] - [_ _cvector*])) - -(provide (rename-out [allocate-cvector make-cvector])) -(define (allocate-cvector type len) - (make-cvector (if (zero? len) #f ; 0 => NULL - (malloc len type)) - type len)) - -(provide (rename-out [cvector-args cvector])) -(define (cvector-args type . args) - (list->cvector args type)) - -(define* (cvector-ref v i) - (if (and (exact-nonnegative-integer? i) (< i (cvector-length v))) - (ptr-ref (cvector-ptr v) (cvector-type v) i) - (error 'cvector-ref "bad index ~e for cvector bounds of 0..~e" - i (sub1 (cvector-length v))))) - -(define* (cvector-set! v i x) - (if (and (exact-nonnegative-integer? i) (< i (cvector-length v))) - (ptr-set! (cvector-ptr v) (cvector-type v) i x) - (error 'cvector-ref "bad index ~e for cvector bounds of 0..~e" - i (sub1 (cvector-length v))))) - -(define* (cvector->list v) - (cblock->list (cvector-ptr v) (cvector-type v) (cvector-length v))) - -(define* (list->cvector l type) - (make-cvector (list->cblock l type) type (length l))) - -;; ---------------------------------------------------------------------------- -;; SRFI-4 implementation - -(define-syntax (srfi-4-define/provide stx) - (syntax-case stx () - [(_ TAG type) - (identifier? #'TAG) - (let ([name (format "~avector" (syntax->datum #'TAG))]) - (define (id prefix suffix) - (let* ([name (if prefix (string-append prefix name) name)] - [name (if suffix (string-append name suffix) name)]) - (datum->syntax #'TAG (string->symbol name) #'TAG))) - (with-syntax ([TAG? (id "" "?")] - [TAG (id "" "")] - [s:TAG (id "s:" "")] - [make-TAG (id "make-" "")] - [TAG-ptr (id "" "-ptr")] - [TAG-length (id "" "-length")] - [allocate-TAG (id "allocate-" "")] - [TAG* (id "" "*")] - [list->TAG (id "list->" "")] - [TAG->list (id "" "->list")] - [TAG-ref (id "" "-ref")] - [TAG-set! (id "" "-set!")] - [TAG->cpointer (id "" "->cpointer")] - [_TAG (id "_" "")] - [_TAG* (id "_" "*")] - [TAGname name] - [f64? (if (eq? (syntax-e #'TAG) 'f64) #'#t #'#f)]) - #'(begin - (define-struct TAG (ptr length)) - (provide TAG? TAG-length (rename-out [TAG s:TAG])) - (provide (rename-out [allocate-TAG make-TAG])) - (define (allocate-TAG n . init) - (let* ([p (if (eq? n 0) #f (malloc n type))] - [v (make-TAG p n)]) - (when (and p (pair? init)) - (let ([init (car init)]) - (let loop ([i (sub1 n)]) - (unless (< i 0) - (ptr-set! p type i init) - (loop (sub1 i)))))) - v)) - (provide (rename-out [TAG* TAG])) - (define (TAG* . vals) - (list->TAG vals)) - (define* (TAG-ref v i) - (if (TAG? v) - (if (and (exact-nonnegative-integer? i) (< i (TAG-length v))) - (if f64? ;; use JIT-inlined operation - (unsafe-f64vector-ref v i) - (ptr-ref (TAG-ptr v) type i)) - (error 'TAG-ref "bad index ~e for ~a bounds of 0..~e" - i 'TAG (sub1 (TAG-length v)))) - (raise-type-error 'TAG-ref TAGname v))) - (define* (TAG-set! v i x) - (if (TAG? v) - (if (and (exact-nonnegative-integer? i) (< i (TAG-length v))) - (if (and f64? ;; use JIT-inlined operation - (inexact-real? x)) - (unsafe-f64vector-set! v i x) - (ptr-set! (TAG-ptr v) type i x)) - (error 'TAG-set! "bad index ~e for ~a bounds of 0..~e" - i 'TAG (sub1 (TAG-length v)))) - (raise-type-error 'TAG-set! TAGname v))) - (define* (TAG->list v) - (if (TAG? v) - (cblock->list (TAG-ptr v) type (TAG-length v)) - (raise-type-error 'TAG->list TAGname v))) - (define* (list->TAG l) - (make-TAG (list->cblock l type) (length l))) - (define* (TAG->cpointer v) - (if (TAG? v) - (TAG-ptr v) - (raise-type-error 'TAG->cpointer TAGname v))) - ;; same as the _cvector implementation - (provide _TAG) - (define _TAG* - (make-ctype _pointer TAG-ptr - (lambda (x) - (error - '_TAG - "cannot automatically convert a C pointer to a ~a" - TAGname)))) - (define-fun-syntax _TAG - (syntax-id-rules (i o io) - [(_ i ) _TAG*] - [(_ o n) (type: _pointer - pre: (malloc n type) - post: (x => (make-TAG x n)))] - [(_ io ) (type: _cvector* - bind: tmp - pre: (x => (TAG-ptr x)) - post: (x => tmp))] - [(_ . xs) (_TAG* . xs)] - [_ _TAG*])))))] - [(_ TAG type) - (identifier? #'TAG)])) - -;; check that the types that were used above have the proper sizes -(unless (= 4 (ctype-sizeof _float)) - (error 'foreign "internal error: float has a bad size (~s)" - (ctype-sizeof _float))) -(unless (= 8 (ctype-sizeof _double*)) - (error 'foreign "internal error: double has a bad size (~s)" - (ctype-sizeof _double*))) - -(srfi-4-define/provide s8 _int8) -(srfi-4-define/provide s16 _int16) -(srfi-4-define/provide u16 _uint16) -(srfi-4-define/provide s32 _int32) -(srfi-4-define/provide u32 _uint32) -(srfi-4-define/provide s64 _int64) -(srfi-4-define/provide u64 _uint64) -(srfi-4-define/provide f32 _float) -(srfi-4-define/provide f64 _double*) - -;; simply rename bytes* to implement the u8vector type -(provide (rename-out [bytes? u8vector? ] - [bytes-length u8vector-length] - [make-bytes make-u8vector ] - [bytes u8vector ] - [bytes-ref u8vector-ref ] - [bytes-set! u8vector-set! ] - [bytes->list u8vector->list ] - [list->bytes list->u8vector ] - [_bytes _u8vector ])) -;; additional `u8vector' bindings for srfi-66 -(provide (rename-out [bytes-copy u8vector-copy] [bytes=? u8vector=?])) -(define* (u8vector-compare v1 v2) - (cond [(bytes? v1 v2) 1] - [else 0])) -(define* (u8vector-copy! src src-start dest dest-start n) - (bytes-copy! dest dest-start src src-start (+ src-start n))) - ;; ---------------------------------------------------------------------------- ;; Tagged pointers diff --git a/collects/racket/unsafe/ffi/alloc.rkt b/collects/ffi/unsafe/alloc.rkt similarity index 100% rename from collects/racket/unsafe/ffi/alloc.rkt rename to collects/ffi/unsafe/alloc.rkt diff --git a/collects/racket/unsafe/ffi/atomic.rkt b/collects/ffi/unsafe/atomic.rkt similarity index 100% rename from collects/racket/unsafe/ffi/atomic.rkt rename to collects/ffi/unsafe/atomic.rkt diff --git a/collects/ffi/unsafe/cvector.rkt b/collects/ffi/unsafe/cvector.rkt new file mode 100644 index 0000000000..1fc83d00f5 --- /dev/null +++ b/collects/ffi/unsafe/cvector.rkt @@ -0,0 +1,66 @@ +#lang racket/base +(require "../unsafe.ss") + +(define-struct cvector (ptr type length)) + +(provide cvector? cvector-length cvector-type cvector-ptr + ;; make-cvector* is a dangerous operation + (protect-out (rename-out [make-cvector make-cvector*]))) + +(define-syntax define* + (syntax-rules () + [(_ (name . args) body ...) + (begin (provide name) (define (name . args) body ...))] + [(_ name expr) + (begin (provide name) (define name expr))])) + +(define _cvector* ; used only as input types + (make-ctype _pointer cvector-ptr + (lambda (x) + (error '_cvector + "cannot automatically convert a C pointer to a cvector")))) + +;; (_cvector [ ]) | _cevector +;; Same as _list etc above, except that it uses C vectors. +(provide _cvector) +(define-fun-syntax _cvector + (syntax-id-rules (i o io) + [(_ i ) _cvector*] + [(_ o t n) (type: _pointer ; needs to be a pointer, not a cvector* + pre: (malloc n t) + post: (x => (make-cvector x t n)))] + [(_ io ) (type: _cvector* + bind: tmp + pre: (x => (cvector-ptr x)) + post: (x => tmp))] + [(_ . xs) (_cvector* . xs)] + [_ _cvector*])) + +(provide (rename-out [allocate-cvector make-cvector])) +(define (allocate-cvector type len) + (make-cvector (if (zero? len) #f ; 0 => NULL + (malloc len type)) + type len)) + +(provide (rename-out [cvector-args cvector])) +(define (cvector-args type . args) + (list->cvector args type)) + +(define* (cvector-ref v i) + (if (and (exact-nonnegative-integer? i) (< i (cvector-length v))) + (ptr-ref (cvector-ptr v) (cvector-type v) i) + (error 'cvector-ref "bad index ~e for cvector bounds of 0..~e" + i (sub1 (cvector-length v))))) + +(define* (cvector-set! v i x) + (if (and (exact-nonnegative-integer? i) (< i (cvector-length v))) + (ptr-set! (cvector-ptr v) (cvector-type v) i x) + (error 'cvector-ref "bad index ~e for cvector bounds of 0..~e" + i (sub1 (cvector-length v))))) + +(define* (cvector->list v) + (cblock->list (cvector-ptr v) (cvector-type v) (cvector-length v))) + +(define* (list->cvector l type) + (make-cvector (list->cblock l type) type (length l))) + diff --git a/collects/racket/unsafe/ffi/define.rkt b/collects/ffi/unsafe/define.rkt similarity index 100% rename from collects/racket/unsafe/ffi/define.rkt rename to collects/ffi/unsafe/define.rkt diff --git a/collects/racket/unsafe/ffi/objc.rkt b/collects/ffi/unsafe/objc.rkt similarity index 99% rename from collects/racket/unsafe/ffi/objc.rkt rename to collects/ffi/unsafe/objc.rkt index da44db8d7d..0f93b08769 100644 --- a/collects/racket/unsafe/ffi/objc.rkt +++ b/collects/ffi/unsafe/objc.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/unsafe/ffi +(require ffi/unsafe racket/stxparam (for-syntax racket/base)) diff --git a/collects/ffi/vector.rkt b/collects/ffi/vector.rkt new file mode 100644 index 0000000000..0d7e661a15 --- /dev/null +++ b/collects/ffi/vector.rkt @@ -0,0 +1,145 @@ +#lang racket/base + +(require "unsafe.ss" + racket/unsafe/ops + (for-syntax racket/base)) + +(define-syntax define* + (syntax-rules () + [(_ (name . args) body ...) + (begin (provide name) (define (name . args) body ...))] + [(_ name expr) + (begin (provide name) (define name expr))])) + +(define-syntax (srfi-4-define/provide stx) + (syntax-case stx () + [(_ TAG type) + (identifier? #'TAG) + (let ([name (format "~avector" (syntax->datum #'TAG))]) + (define (id prefix suffix) + (let* ([name (if prefix (string-append prefix name) name)] + [name (if suffix (string-append name suffix) name)]) + (datum->syntax #'TAG (string->symbol name) #'TAG))) + (with-syntax ([TAG? (id "" "?")] + [TAG (id "" "")] + [s:TAG (id "s:" "")] + [make-TAG (id "make-" "")] + [TAG-ptr (id "" "-ptr")] + [TAG-length (id "" "-length")] + [allocate-TAG (id "allocate-" "")] + [TAG* (id "" "*")] + [list->TAG (id "list->" "")] + [TAG->list (id "" "->list")] + [TAG-ref (id "" "-ref")] + [TAG-set! (id "" "-set!")] + [TAG->cpointer (id "" "->cpointer")] + [_TAG (id "_" "")] + [_TAG* (id "_" "*")] + [TAGname name] + [f64? (if (eq? (syntax-e #'TAG) 'f64) #'#t #'#f)]) + #'(begin + (define-struct TAG (ptr length)) + (provide TAG? TAG-length (rename-out [TAG s:TAG])) + (provide (rename-out [allocate-TAG make-TAG])) + (define (allocate-TAG n . init) + (let* ([p (if (eq? n 0) #f (malloc n type))] + [v (make-TAG p n)]) + (when (and p (pair? init)) + (let ([init (car init)]) + (let loop ([i (sub1 n)]) + (unless (< i 0) + (ptr-set! p type i init) + (loop (sub1 i)))))) + v)) + (provide (rename-out [TAG* TAG])) + (define (TAG* . vals) + (list->TAG vals)) + (define* (TAG-ref v i) + (if (TAG? v) + (if (and (exact-nonnegative-integer? i) (< i (TAG-length v))) + (if f64? ;; use JIT-inlined operation + (unsafe-f64vector-ref v i) + (ptr-ref (TAG-ptr v) type i)) + (error 'TAG-ref "bad index ~e for ~a bounds of 0..~e" + i 'TAG (sub1 (TAG-length v)))) + (raise-type-error 'TAG-ref TAGname v))) + (define* (TAG-set! v i x) + (if (TAG? v) + (if (and (exact-nonnegative-integer? i) (< i (TAG-length v))) + (if (and f64? ;; use JIT-inlined operation + (inexact-real? x)) + (unsafe-f64vector-set! v i x) + (ptr-set! (TAG-ptr v) type i x)) + (error 'TAG-set! "bad index ~e for ~a bounds of 0..~e" + i 'TAG (sub1 (TAG-length v)))) + (raise-type-error 'TAG-set! TAGname v))) + (define* (TAG->list v) + (if (TAG? v) + (cblock->list (TAG-ptr v) type (TAG-length v)) + (raise-type-error 'TAG->list TAGname v))) + (define* (list->TAG l) + (make-TAG (list->cblock l type) (length l))) + (define* (TAG->cpointer v) + (if (TAG? v) + (TAG-ptr v) + (raise-type-error 'TAG->cpointer TAGname v))) + ;; same as the _cvector implementation + (provide _TAG) + (define _TAG* + (make-ctype _pointer TAG-ptr + (lambda (x) + (error + '_TAG + "cannot automatically convert a C pointer to a ~a" + TAGname)))) + (define-fun-syntax _TAG + (syntax-id-rules (i o io) + [(_ i ) _TAG*] + [(_ o n) (type: _pointer + pre: (malloc n type) + post: (x => (make-TAG x n)))] + [(_ io ) (type: _cvector* + bind: tmp + pre: (x => (TAG-ptr x)) + post: (x => tmp))] + [(_ . xs) (_TAG* . xs)] + [_ _TAG*])))))] + [(_ TAG type) + (identifier? #'TAG)])) + +;; check that the types that were used above have the proper sizes +(unless (= 4 (ctype-sizeof _float)) + (error 'foreign "internal error: float has a bad size (~s)" + (ctype-sizeof _float))) +(unless (= 8 (ctype-sizeof _double*)) + (error 'foreign "internal error: double has a bad size (~s)" + (ctype-sizeof _double*))) + +(srfi-4-define/provide s8 _int8) +(srfi-4-define/provide s16 _int16) +(srfi-4-define/provide u16 _uint16) +(srfi-4-define/provide s32 _int32) +(srfi-4-define/provide u32 _uint32) +(srfi-4-define/provide s64 _int64) +(srfi-4-define/provide u64 _uint64) +(srfi-4-define/provide f32 _float) +(srfi-4-define/provide f64 _double*) + +;; simply rename bytes* to implement the u8vector type +(provide (rename-out [bytes? u8vector? ] + [bytes-length u8vector-length] + [make-bytes make-u8vector ] + [bytes u8vector ] + [bytes-ref u8vector-ref ] + [bytes-set! u8vector-set! ] + [bytes->list u8vector->list ] + [list->bytes list->u8vector ] + [_bytes _u8vector ])) +;; additional `u8vector' bindings for srfi-66 +(provide (rename-out [bytes-copy u8vector-copy] [bytes=? u8vector=?])) +(define* (u8vector-compare v1 v2) + (cond [(bytes? v1 v2) 1] + [else 0])) +(define* (u8vector-copy! src src-start dest dest-start n) + (bytes-copy! dest dest-start src src-start (+ src-start n))) diff --git a/collects/ffi/xmmsctrl.ss b/collects/ffi/xmmsctrl.ss deleted file mode 100644 index ecccddcbe1..0000000000 --- a/collects/ffi/xmmsctrl.ss +++ /dev/null @@ -1,109 +0,0 @@ -#lang scheme/base - -(require mzlib/foreign) (unsafe!) - -(define libxmms (ffi-lib "libxmms")) - -(provide session) -(define session - (make-parameter - 0 (lambda (x) - (if (integer? x) - x - (error 'xmms-session "expecting an integer, got ~s" x))))) - -;; used for playlist position values -(define _pos _int) - -;; number of equalizer bands -(define eq-bands 10) - -;; used for getting the default session from the session parameter -(define-fun-syntax _session - (syntax-id-rules (_session) - [_session (type: _int pre: (session))])) - -(define-syntax defxmms - (syntax-rules (:) - [(_ name : x ...) - (begin - (provide name) - (define name - (get-ffi-obj - (regexp-replaces - 'name '((#rx"-" "_") (#rx"[?]$" "") (#rx"^" "xmms_remote_"))) - libxmms (_fun x ...))))])) - -(defxmms playlist : (files enqueue?) :: - _session - (files : (_list i _string)) - (_int = (length files)) - (enqueue? : _bool) - -> _void) -(defxmms get-version : _session -> _int) -;; The second argument is a GList (see glib/glist.h) which requires structs, -;; but the playlist function is sufficient (looks like this is for glib code). -;; (defxmms playlist-add : _session "GList * list" -> _void) -(defxmms playlist-delete : _session _pos -> _void) -(defxmms play : _session -> _void) -(defxmms pause : _session -> _void) -(defxmms stop : _session -> _void) -(defxmms is-playing? : _session -> _bool) -(defxmms is-paused? : _session -> _bool) -(defxmms get-playlist-pos : _session -> _pos) -(defxmms set-playlist-pos : _session _pos -> _void) -(defxmms get-playlist-length : _session -> _pos) -(defxmms playlist-clear : _session -> _void) -(defxmms get-output-time : _session -> _int) -(defxmms jump-to-time : _session _int -> _void) -(defxmms get-volume : _session (l : (_ptr o _int)) (r : (_ptr o _int)) - -> _void -> (list l r)) -(defxmms get-main-volume : _session -> _int) -(defxmms get-balance : _session -> _int) -(defxmms set-volume : _session (l : _int) (r : _int) -> _void) -(defxmms set-main-volume : _session _int -> _void) -(defxmms set-balance : _session _int -> _void) -(defxmms get-skin : _session -> _file) -(defxmms set-skin : _session _file -> _void) -(defxmms get-playlist-file : _session _pos -> _string) -(defxmms get-playlist-title : _session _pos -> _string) -(defxmms get-playlist-time : _session _pos -> _int) -(defxmms get-info : _session - (rate : (_ptr o _int)) - (freq : (_ptr o _int)) - (nch : (_ptr o _int)) - -> _void -> (list rate freq nch)) -(defxmms main-win-toggle : _session (show? : _bool) -> _void) -(defxmms pl-win-toggle : _session (show? : _bool) -> _void) -(defxmms eq-win-toggle : _session (show? : _bool) -> _void) -(defxmms is-main-win? : _session -> _bool) -(defxmms is-pl-win? : _session -> _bool) -(defxmms is-eq-win? : _session -> _bool) -(defxmms show-prefs-box : _session -> _void) -(defxmms toggle-aot : _session (ontop? : _bool) -> _void) -(defxmms eject : _session -> _void) -(defxmms playlist-prev : _session -> _void) -(defxmms playlist-next : _session -> _void) -(defxmms playlist-add-url-string : _session _string -> _void) -(defxmms is-running? : _session -> _bool) -(defxmms toggle-repeat : _session -> _void) -(defxmms toggle-shuffle : _session -> _void) -(defxmms is-repeat? : _session -> _bool) -(defxmms is-shuffle? : _session -> _bool) -(defxmms get-eq : _session - (preamp : (_ptr o _float)) - (bands : (_ptr o _pointer)) - -> _void - -> (cons preamp (cblock->list bands _float eq-bands))) -(defxmms get-eq-preamp : _session -> _float) -(defxmms get-eq-band : _session (band : _int) -> _float) -(defxmms set-eq : (l) :: - _session - (preamp : _float = (car l)) - (bands : (_list i _float) = (cdr l)) - -> _void) -(defxmms set-eq-preamp : _session (preamp : _float) -> _void) -(defxmms set-eq-band : _session (band : _int) _float -> _void) -(defxmms quit : _session -> _void) -(defxmms play-pause : _session -> _void) -(defxmms playlist-ins-url-string : _session _string _pos -> _void) diff --git a/collects/ffi/xosd.ss b/collects/ffi/xosd.ss deleted file mode 100644 index 8a074f20dc..0000000000 --- a/collects/ffi/xosd.ss +++ /dev/null @@ -1,104 +0,0 @@ -#lang scheme/base - -(require mzlib/foreign) (unsafe!) - -(define libxosd (ffi-lib "libxosd")) - -;; Use this type to properly destroy an xosd object -(define _xosd (make-ctype (_cpointer "xosd") #f - (lambda (p) - (if p - (register-finalizer p xosd-destroy) - (error '_xosd "got a NULL pointer")) - p))) - -(define-syntax defxosd - (syntax-rules (:) - [(_ name : type ...) - (define name - (get-ffi-obj (regexp-replaces 'name '((#rx"-" "_") (#rx"[*?]$" ""))) - libxosd (_fun type ...)))])) - -(define-syntax defxosd* - (syntax-rules () - [(_ name x ...) (begin (provide name) (defxosd name x ...))])) - -(define _status - (make-ctype _int #f - (lambda (x) - (if (eq? -1 x) - (error 'xosd "~a" - (or (get-ffi-obj "xosd_error" libxosd _string) - "unknown xosd error")) - x)))) - -(define _sbool - (make-ctype _status #f - (lambda (x) - (case x [(1) #t] [(0) #f] [else (error "bad boolean value: ~e" x)])))) - -;; ===== Initializing ========================================================= - -(defxosd* xosd-create : ; [num-lines = 1] -> xosd-obj - args :: (num-lines : _int = (if (pair? args) (car args) 1)) -> _xosd) -(defxosd xosd-destroy : _xosd -> _int) - -(defxosd* xosd-is-onscreen? : _xosd -> _sbool) - -;; ===== Displaying & Hiding ================================================== - -(defxosd xosd-show* : _xosd -> _status) -(provide xosd-show) -(define (xosd-show xosd) (unless (xosd-is-onscreen? xosd) (xosd-show* xosd))) -(defxosd xosd-hide* : _xosd -> _status) -(provide xosd-hide) -(define (xosd-hide xosd) (when (xosd-is-onscreen? xosd) (xosd-hide* xosd))) - -(defxosd* xosd-set-timeout : _xosd _int -> _status) -(defxosd* xosd-wait-until-no-display : _xosd -> _status) - -;; ===== Attributed =========================================================== - -(define _xosd-pos (_enum '(top bottom middle))) -(define _xosd-align (_enum '(left center right))) - -(defxosd* xosd-set-pos : _xosd _xosd-pos -> _status) -(defxosd* xosd-set-align : _xosd _xosd-align -> _status) -(defxosd* xosd-set-horizontal-offset : _xosd _int -> _status) -(defxosd* xosd-set-vertical-offset : _xosd _int -> _status) -(defxosd* xosd-set-shadow-offset : _xosd _int -> _status) -(defxosd* xosd-set-outline-offset : _xosd _int -> _status) -(defxosd* xosd-set-colour : _xosd _string -> _status) -(defxosd* xosd-set-shadow-colour : _xosd _string -> _status) -(defxosd* xosd-set-outline-colour : _xosd _string -> _status) -(defxosd* xosd-set-font : _xosd _string -> _status) - -(defxosd* xosd-get-colour : - _xosd (r : (_ptr o _int)) (g : (_ptr o _int)) (b : (_ptr o _int)) -> _status - -> (list r g b)) -(defxosd* xosd-get-number-lines : _xosd -> _status) - -;; ===== Content ============================================================== - -(define _xosd-command (_enum '(percentage string printf slider))) - -(define disp-int* - (get-ffi-obj "xosd_display" libxosd - (_fun _xosd _int _xosd-command _int -> _status))) -(define disp-string* - (get-ffi-obj "xosd_display" libxosd - (_fun _xosd _int _xosd-command _string -> _status))) - -(provide xosd-display-percentage xosd-display-string xosd-display-slider) -;; xosd-obj percent [line-num] -> int -(define (xosd-display-percentage xosd percent . line) - (disp-int* xosd (if (pair? line) (car line) 0) 'percentage percent)) -;; xosd-obj string [line-num] -> int -(define (xosd-display-string xosd str . line) - (disp-string* xosd (if (pair? line) (car line) 0) 'string str)) -;; xosd-obj percent [line-num] -> int -(define (xosd-display-slider xosd int . line) - (disp-int* xosd (if (pair? line) (car line) 0) 'slider int)) - -(defxosd* xosd-set-bar-length : _xosd _int -> _status) -(defxosd* xosd-scroll : _xosd _int -> _status) diff --git a/collects/scheme/foreign.rkt b/collects/scheme/foreign.rkt index a3e1b5bd78..facff8204c 100644 --- a/collects/scheme/foreign.rkt +++ b/collects/scheme/foreign.rkt @@ -1,16 +1,16 @@ #lang racket/base (require (for-syntax scheme/base)) -(define-syntax-rule (provide-except-unsafe lib u! id ...) +(define-syntax-rule (provide-except-unsafe (ulib ...) u! id ...) (begin - (require lib) - (provide (except-out (all-from-out lib) id ...)) + (require ulib ...) + (provide (except-out (all-from-out ulib ...) id ...)) (define-syntax (u! stx) (syntax-case stx () - [(_) (with-syntax ([lib+ids (datum->syntax stx '(lib id ...))]) + [(_) (with-syntax ([lib+ids (datum->syntax stx `((,#'combine-in ulib ...) id ...))]) #'(require (only-in . lib+ids)))])))) -(provide-except-unsafe racket/unsafe/ffi unsafe! +(provide-except-unsafe (ffi/unsafe ffi/unsafe/cvector ffi/vector) unsafe! free end-stubborn-change ptr-ref ptr-set! cast diff --git a/collects/scribblings/foreign/alloc.scrbl b/collects/scribblings/foreign/alloc.scrbl index 624392b2ac..965028c4af 100644 --- a/collects/scribblings/foreign/alloc.scrbl +++ b/collects/scribblings/foreign/alloc.scrbl @@ -1,13 +1,13 @@ #lang scribble/doc @(require "utils.ss" - (for-label racket/unsafe/ffi/alloc - racket/unsafe/ffi/define - racket/unsafe/ffi/atomic)) + (for-label ffi/unsafe/alloc + ffi/unsafe/define + ffi/unsafe/atomic)) @title{Allocation and Finalization} -@defmodule[racket/unsafe/ffi/alloc]{The -@schememodname[racket/unsafe/ffi/alloc] library provides utilities for +@defmodule[ffi/unsafe/alloc]{The +@schememodname[ffi/unsafe/alloc] library provides utilities for ensuring that values allocated through foreign functions are reliably deallocated.} diff --git a/collects/scribblings/foreign/atomic.scrbl b/collects/scribblings/foreign/atomic.scrbl index f85822eaac..854d14bd8d 100644 --- a/collects/scribblings/foreign/atomic.scrbl +++ b/collects/scribblings/foreign/atomic.scrbl @@ -1,10 +1,10 @@ #lang scribble/doc @(require "utils.ss" - (for-label racket/unsafe/ffi/atomic)) + (for-label ffi/unsafe/atomic)) @title{Atomic Execution} -@defmodule[racket/unsafe/ffi/atomic] +@defmodule[ffi/unsafe/atomic] @deftogether[( @defproc[(start-atomic) void?] diff --git a/collects/scribblings/foreign/cpointer.scrbl b/collects/scribblings/foreign/cpointer.scrbl new file mode 100644 index 0000000000..d27e407385 --- /dev/null +++ b/collects/scribblings/foreign/cpointer.scrbl @@ -0,0 +1,84 @@ +#lang scribble/doc +@(require "utils.ss") + +@title[#:tag "foreign:tagged-pointers"]{Tagged C Pointer Types} + +The unsafe @scheme[cpointer-has-tag?] and @scheme[cpointer-push-tag!] +operations manage tags to distinguish pointer types. + +@defproc*[([(_cpointer [tag any/c] + [ptr-type ctype? _xpointer] + [scheme-to-c (any/c . -> . any/c) values] + [c-to-scheme (any/c . -> . any/c) values]) + ctype] + [(_cpointer/null [tag any/c] + [ptr-type ctype? _xpointer] + [scheme-to-c (any/c . -> . any/c) values] + [c-to-scheme (any/c . -> . any/c) values]) + ctype])]{ + +Construct a kind of a pointer that gets a specific tag when converted +to Scheme, and accept only such tagged pointers when going to C. An +optional @scheme[ptr-type] can be given to be used as the base pointer +type, instead of @scheme[_pointer]. + +Pointer tags are checked with @scheme[cpointer-has-tag?] and changed +with @scheme[cpointer-push-tag!] which means that other tags are +preserved. Specifically, if a base @scheme[ptr-type] is given and is +itself a @scheme[_cpointer], then the new type will handle pointers +that have the new tag in addition to @scheme[ptr-type]'s tag(s). When +the tag is a pair, its first value is used for printing, so the most +recently pushed tag which corresponds to the inheriting type will be +displayed. + +Note that tags are compared with @scheme[eq?] (or @scheme[memq]), which means +an interface can hide its value from users (e.g., not provide the +@scheme[cpointer-tag] accessor), which makes such pointers un-fake-able. + +@scheme[_cpointer/null] is similar to @scheme[_cpointer] except that +it tolerates @cpp{NULL} pointers both going to C and back. Note that +@cpp{NULL} pointers are represented as @scheme[#f] in Scheme, so they +are not tagged.} + + +@defform*[[(define-cpointer-type _id) + (define-cpointer-type _id scheme-to-c-expr) + (define-cpointer-type _id scheme-to-c-expr c-to-scheme-expr)]]{ + +A macro version of @scheme[_cpointer] and @scheme[_cpointer/null], +using the defined name for a tag string, and defining a predicate +too. The @scheme[_id] must start with @litchar{_}. + +The optional expression produces optional arguments to @scheme[_cpointer]. + +In addition to defining @scheme[_id] to a type generated by +@scheme[_cpointer], @scheme[_id]@schemeidfont{/null} is bound to a +type produced by @scheme[_cpointer/null] type. Finally, +@schemevarfont{id}@schemeidfont{?} is defined as a predicate, and +@schemevarfont{id}@schemeidfont{-tag} is defined as an accessor to +obtain a tag. The tag is the string form of @schemevarfont{id}.} + +@defproc*[([(cpointer-has-tag? [cptr any/c] [tag any/c]) boolean?] + [(cpointer-push-tag! [cptr any/c] [tag any/c]) void])]{ + +These two functions treat pointer tags as lists of tags. As described +in @secref["foreign:pointer-funcs"], a pointer tag does not have any +role, except for Scheme code that uses it to distinguish pointers; +these functions treat the tag value as a list of tags, which makes it +possible to construct pointer types that can be treated as other +pointer types, mainly for implementing inheritance via upcasts (when a +struct contains a super struct as its first element). + +The @scheme[cpointer-has-tag?] function checks whether if the given +@scheme[cptr] has the @scheme[tag]. A pointer has a tag @scheme[tag] +when its tag is either @scheme[eq?] to @scheme[tag] or a list that +contains (in the sense of @scheme[memq]) @scheme[tag]. + +The @scheme[cpointer-push-tag!] function pushes the given @scheme[tag] +value on @scheme[cptr]'s tags. The main properties of this operation +are: (a) pushing any tag will make later calls to +@scheme[cpointer-has-tag?] succeed with this tag, and (b) the pushed tag +will be used when printing the pointer (until a new value is pushed). +Technically, pushing a tag will simply set it if there is no tag set, +otherwise push it on an existing list or an existing value (treated as +a single-element list).} diff --git a/collects/scribblings/foreign/cvector.scrbl b/collects/scribblings/foreign/cvector.scrbl new file mode 100644 index 0000000000..07efc91e34 --- /dev/null +++ b/collects/scribblings/foreign/cvector.scrbl @@ -0,0 +1,89 @@ +#lang scribble/doc +@(require "utils.ss") + +@title[#:tag "foreign:cvector"]{Safe C Vectors} + +@defmodule*[(ffi/cvector ffi/unsafe/cvector) + #:use-sources (ffi/unsafe/cvector)]{The +@schememodname[ffi/unsafe/cvector] library exports the bindings of +this section. The @schememodname[ffi/cvector] library exports the same +bindings, except for the unsafe @scheme[make-cvector*] operation.} + +The @scheme[cvector] form can be used as a type C vectors (i.e., a +pointer to a memory block). + +@defform*[[(_cvector mode type maybe-len) + _cvector]]{ + +Like @scheme[_bytes], @scheme[_cvector] can be used as a simple type +that corresponds to a pointer that is managed as a safe C vector on +the Scheme side. The longer form behaves similarly to the +@scheme[_list] and @scheme[_vector] custom types, except that +@scheme[_cvector] is more efficient; no Scheme list or vector is +needed.} + +@defproc[(make-cvector [type ctype?][length exact-nonnegative-integer?]) cvector?]{ + +Allocates a C vector using the given @scheme[type] and +@scheme[length].} + + +@defproc[(cvector [type ctype?][val any/c] ...) cvector?]{ + +Creates a C vector of the given @scheme[type], initialized to the +given list of @scheme[val]s.} + + +@defproc[(cvector? [v any/c]) boolean?]{ + +Returns @scheme[#t] if @scheme[v] is a C vector, @scheme[#f] otherwise.} + + +@defproc[(cvector-length [cvec cvector?]) exact-nonnegative-integer?]{ + +Returns the length of a C vector.} + + +@defproc[(cvector-type [cvec cvector?]) ctype?]{ + +Returns the C type object of a C vector.} + + +@defproc[(cvector-ptr [cvec cvector?]) cpointer?]{ + +Returns the pointer that points at the beginning block of the given C vector.} + + +@defproc[(cvector-ref [cvec cvector?] [k exact-nonnegative-integer?]) any]{ + +References the @scheme[k]th element of the @scheme[cvec] C vector. +The result has the type that the C vector uses.} + + +@defproc[(cvector-set! [cvec cvector?][k exact-nonnegative-integer?][val any]) void?]{ + +Sets the @scheme[k]th element of the @scheme[cvec] C vector to +@scheme[val]. The @scheme[val] argument should be a value that can be +used with the type that the C vector uses.} + + +@defproc[(cvector->list [cvec cvector?]) list?]{ + +Converts the @scheme[cvec] C vector object to a list of values.} + + +@defproc[(list->cvector [lst list?][type ctype?]) cvector?]{ + +Converts the list @scheme[lst] to a C vector of the given +@scheme[type].} + + +@defproc[(make-cvector* [cptr any/c] [type ctype?] + [length exact-nonnegative-integer?]) + cvector?]{ + +Constructs a C vector using an existing pointer object. This +operation is not safe, so it is intended to be used in specific +situations where the @scheme[type] and @scheme[length] are known.} + + diff --git a/collects/scribblings/foreign/define.scrbl b/collects/scribblings/foreign/define.scrbl index 8e827056d9..8de143f2c7 100644 --- a/collects/scribblings/foreign/define.scrbl +++ b/collects/scribblings/foreign/define.scrbl @@ -1,11 +1,11 @@ #lang scribble/doc @(require "utils.ss" - (for-label racket/unsafe/ffi/define - racket/unsafe/ffi/alloc)) + (for-label ffi/unsafe/define + ffi/unsafe/alloc)) @title{Defining Bindings} -@defmodule[racket/unsafe/ffi/define] +@defmodule[ffi/unsafe/define] @defform/subs[(define-ffi-definer define-id ffi-lib-expr option ...) diff --git a/collects/scribblings/foreign/derived.scrbl b/collects/scribblings/foreign/derived.scrbl index bd05846359..83b5d2539f 100644 --- a/collects/scribblings/foreign/derived.scrbl +++ b/collects/scribblings/foreign/derived.scrbl @@ -5,281 +5,10 @@ @local-table-of-contents[] -@; ------------------------------------------------------------ - +@include-section["vector.scrbl"] +@include-section["cvector.scrbl"] +@include-section["cpointer.scrbl"] @include-section["define.scrbl"] - -@; ------------------------------------------------------------ - -@section[#:tag "foreign:tagged-pointers"]{Tagged C Pointer Types} - -The unsafe @scheme[cpointer-has-tag?] and @scheme[cpointer-push-tag!] -operations manage tags to distinguish pointer types. - -@defproc*[([(_cpointer [tag any/c] - [ptr-type ctype? _xpointer] - [scheme-to-c (any/c . -> . any/c) values] - [c-to-scheme (any/c . -> . any/c) values]) - ctype] - [(_cpointer/null [tag any/c] - [ptr-type ctype? _xpointer] - [scheme-to-c (any/c . -> . any/c) values] - [c-to-scheme (any/c . -> . any/c) values]) - ctype])]{ - -Construct a kind of a pointer that gets a specific tag when converted -to Scheme, and accept only such tagged pointers when going to C. An -optional @scheme[ptr-type] can be given to be used as the base pointer -type, instead of @scheme[_pointer]. - -Pointer tags are checked with @scheme[cpointer-has-tag?] and changed -with @scheme[cpointer-push-tag!] which means that other tags are -preserved. Specifically, if a base @scheme[ptr-type] is given and is -itself a @scheme[_cpointer], then the new type will handle pointers -that have the new tag in addition to @scheme[ptr-type]'s tag(s). When -the tag is a pair, its first value is used for printing, so the most -recently pushed tag which corresponds to the inheriting type will be -displayed. - -Note that tags are compared with @scheme[eq?] (or @scheme[memq]), which means -an interface can hide its value from users (e.g., not provide the -@scheme[cpointer-tag] accessor), which makes such pointers un-fake-able. - -@scheme[_cpointer/null] is similar to @scheme[_cpointer] except that -it tolerates @cpp{NULL} pointers both going to C and back. Note that -@cpp{NULL} pointers are represented as @scheme[#f] in Scheme, so they -are not tagged.} - - -@defform*[[(define-cpointer-type _id) - (define-cpointer-type _id scheme-to-c-expr) - (define-cpointer-type _id scheme-to-c-expr c-to-scheme-expr)]]{ - -A macro version of @scheme[_cpointer] and @scheme[_cpointer/null], -using the defined name for a tag string, and defining a predicate -too. The @scheme[_id] must start with @litchar{_}. - -The optional expression produces optional arguments to @scheme[_cpointer]. - -In addition to defining @scheme[_id] to a type generated by -@scheme[_cpointer], @scheme[_id]@schemeidfont{/null} is bound to a -type produced by @scheme[_cpointer/null] type. Finally, -@schemevarfont{id}@schemeidfont{?} is defined as a predicate, and -@schemevarfont{id}@schemeidfont{-tag} is defined as an accessor to -obtain a tag. The tag is the string form of @schemevarfont{id}.} - -@defproc*[([(cpointer-has-tag? [cptr any/c] [tag any/c]) boolean?] - [(cpointer-push-tag! [cptr any/c] [tag any/c]) void])]{ - -These two functions treat pointer tags as lists of tags. As described -in @secref["foreign:pointer-funcs"], a pointer tag does not have any -role, except for Scheme code that uses it to distinguish pointers; -these functions treat the tag value as a list of tags, which makes it -possible to construct pointer types that can be treated as other -pointer types, mainly for implementing inheritance via upcasts (when a -struct contains a super struct as its first element). - -The @scheme[cpointer-has-tag?] function checks whether if the given -@scheme[cptr] has the @scheme[tag]. A pointer has a tag @scheme[tag] -when its tag is either @scheme[eq?] to @scheme[tag] or a list that -contains (in the sense of @scheme[memq]) @scheme[tag]. - -The @scheme[cpointer-push-tag!] function pushes the given @scheme[tag] -value on @scheme[cptr]'s tags. The main properties of this operation -are: (a) pushing any tag will make later calls to -@scheme[cpointer-has-tag?] succeed with this tag, and (b) the pushed tag -will be used when printing the pointer (until a new value is pushed). -Technically, pushing a tag will simply set it if there is no tag set, -otherwise push it on an existing list or an existing value (treated as -a single-element list).} - -@; ------------------------------------------------------------ - -@section[#:tag "foreign:cvector"]{Safe C Vectors} - -The @scheme[cvector] form can be used as a type C vectors (i.e., a -pointer to a memory block). - -@defproc[(make-cvector [type ctype?][length exact-nonnegative-integer?]) cvector?]{ - -Allocates a C vector using the given @scheme[type] and -@scheme[length].} - - -@defproc[(cvector [type ctype?][val any/c] ...) cvector?]{ - -Creates a C vector of the given @scheme[type], initialized to the -given list of @scheme[val]s.} - - -@defproc[(cvector? [v any/c]) boolean?]{ - -Returns @scheme[#t] if @scheme[v] is a C vector, @scheme[#f] otherwise.} - - -@defproc[(cvector-length [cvec cvector?]) exact-nonnegative-integer?]{ - -Returns the length of a C vector.} - - -@defproc[(cvector-type [cvec cvector?]) ctype?]{ - -Returns the C type object of a C vector.} - - -@defproc[(cvector-ptr [cvec cvector?]) cpointer?]{ - -Returns the pointer that points at the beginning block of the given C vector.} - - -@defproc[(cvector-ref [cvec cvector?] [k exact-nonnegative-integer?]) any]{ - -References the @scheme[k]th element of the @scheme[cvec] C vector. -The result has the type that the C vector uses.} - - -@defproc[(cvector-set! [cvec cvector?][k exact-nonnegative-integer?][val any]) void?]{ - -Sets the @scheme[k]th element of the @scheme[cvec] C vector to -@scheme[val]. The @scheme[val] argument should be a value that can be -used with the type that the C vector uses.} - - -@defproc[(cvector->list [cvec cvector?]) list?]{ - -Converts the @scheme[cvec] C vector object to a list of values.} - - -@defproc[(list->cvector [lst list?][type ctype?]) cvector?]{ - -Converts the list @scheme[lst] to a C vector of the given -@scheme[type].} - - -@defproc[(make-cvector* [cptr any/c] [type ctype?] - [length exact-nonnegative-integer?]) - cvector?]{ - -Constructs a C vector using an existing pointer object. This -operation is not safe, so it is intended to be used in specific -situations where the @scheme[type] and @scheme[length] are known.} - - -@; ------------------------------------------------------------ - -@section[#:tag "homogeneous-vectors"]{Homogenous Vectors} - -Homogenous vectors are similar to C vectors (see -@secref["foreign:cvector"]), except that they define different types -of vectors, each with a hard-wired type. - -An exception is the @schemeidfont{u8} family of bindings, which are -just aliases for byte-string bindings: @scheme[make-u8vector], -@scheme[u8vector]. @scheme[u8vector?], @scheme[u8vector-length], -@scheme[u8vector-ref], @scheme[u8vector-set!], -@scheme[list->u8vector], @scheme[u8vector->list]. - -@(begin - (require (for-syntax scheme/base)) - (define-syntax (srfi-4-vector stx) - (syntax-case stx () - [(_ id elem) - #'(srfi-4-vector/desc id elem - "Like " (scheme make-vector) ", etc., but for " (scheme elem) " elements.")])) - (define-syntax (srfi-4-vector/desc stx) - (syntax-case stx () - [(_ id elem . desc) - (let ([mk - (lambda l - (datum->syntax - #'id - (string->symbol - (apply string-append - (map (lambda (i) - (if (identifier? i) - (symbol->string (syntax-e i)) - i)) - l))) - #'id))]) - (with-syntax ([make (mk "make-" #'id "vector")] - [vecr (mk #'id "vector")] - [? (mk #'id "vector?")] - [length (mk #'id "vector-length")] - [ref (mk #'id "vector-ref")] - [! (mk #'id "vector-set!")] - [list-> (mk "list->" #'id "vector")] - [->list (mk #'id "vector->list")] - [->cpointer (mk #'id "vector->cpointer")] - [_vec (mk "_" #'id "vector")]) - #`(begin - (defproc* ([(make [len exact-nonnegative-integer?]) ?] - [(vecr [val number?] (... ...)) ?] - [(? [v any/c]) boolean?] - [(length [vec ?]) exact-nonnegative-integer?] - [(ref [vec ?][k exact-nonnegative-integer?]) number?] - [(! [vec ?][k exact-nonnegative-integer?][val number?]) void?] - [(list-> [lst (listof number?)]) ?] - [(->list [vec ?]) (listof number?)] - [(->cpointer [vec ?]) cpointer?]) - . desc) - ;; Big pain: make up relatively-correct source locations - ;; for pieces in the _vec definition: - (defform* [#,(datum->syntax - #'_vec - (cons #'_vec - (let loop ([l '(mode maybe-len)] - [col (+ (syntax-column #'_vec) - (syntax-span #'_vec) - 1)] - [pos (+ (syntax-position #'_vec) - (syntax-span #'_vec) - 1)]) - (if (null? l) - null - (let ([span (string-length (symbol->string (car l)))]) - (cons (datum->syntax - #'_vec - (car l) - (list (syntax-source #'_vec) - (syntax-line #'_vec) - col - pos - span)) - (loop (cdr l) - (+ col 1 span) - (+ pos 1 span))))))) - (list (syntax-source #'_vec) - (syntax-line #'_vec) - (sub1 (syntax-column #'vec)) - (sub1 (syntax-position #'vec)) - 10)) - _vec] - "Like " (scheme _cvector) ", but for vectors of " (scheme elem) " elements."))))]))) - - -@srfi-4-vector/desc[u8 _uint8]{ - -Like @scheme[_cvector], but for vectors of @scheme[_byte] elements. These are -aliases for @schemeidfont{byte} operations.} - -@srfi-4-vector[s8 _int8] -@srfi-4-vector[s16 _int16] -@srfi-4-vector[u16 _uint16] -@srfi-4-vector[s32 _int32] -@srfi-4-vector[u32 _uint32] -@srfi-4-vector[s64 _int64] -@srfi-4-vector[u64 _uint64] -@srfi-4-vector[f32 _float] -@srfi-4-vector[f64 _double*] - -@; ------------------------------------------------------------ - @include-section["alloc.scrbl"] - -@; ------------------------------------------------------------ - @include-section["atomic.scrbl"] - -@; ------------------------------------------------------------ - @include-section["objc.scrbl"] diff --git a/collects/scribblings/foreign/foreign.scrbl b/collects/scribblings/foreign/foreign.scrbl index 1089ed3704..80727cda40 100644 --- a/collects/scribblings/foreign/foreign.scrbl +++ b/collects/scribblings/foreign/foreign.scrbl @@ -5,9 +5,9 @@ @author["Eli Barzilay"] -@defmodule[racket/unsafe/ffi #:use-sources ('#%foreign)] +@defmodule[ffi/unsafe #:use-sources ('#%foreign)] -The @schememodname[racket/unsafe/ffi] library enables the direct use of +The @schememodname[ffi/unsafe] library enables the direct use of C-based APIs within Racket programs---without writing any new C code. From the Racket perspective, functions and data with a C-based API are @idefterm{foreign}, hence the term @defterm{foreign @@ -21,8 +21,8 @@ interface}, abbreviated @deftech{FFI}. @include-section["libs.scrbl"] @include-section["types.scrbl"] @include-section["pointers.scrbl"] -@include-section["misc.scrbl"] @include-section["derived.scrbl"] +@include-section["misc.scrbl"] @include-section["unexported.scrbl"] @index-section[] diff --git a/collects/scribblings/foreign/objc.scrbl b/collects/scribblings/foreign/objc.scrbl index 4d6562985f..2d384c68d2 100644 --- a/collects/scribblings/foreign/objc.scrbl +++ b/collects/scribblings/foreign/objc.scrbl @@ -3,8 +3,8 @@ scribble/eval (for-label racket/base racket/contract - racket/unsafe/ffi/objc - (except-in racket/unsafe/ffi ->) + ffi/unsafe/objc + (except-in ffi/unsafe ->) (only-in ffi/objc objc-unsafe!) (only-in scheme/foreign unsafe!))) @@ -16,9 +16,9 @@ @title{Objective-C FFI} -@defmodule[racket/unsafe/ffi/objc]{The -@racketmodname[racket/unsafe/ffi/objc] library builds on -@racketmodname[racket/unsafe/ffi] to support interaction with +@defmodule[ffi/unsafe/objc]{The +@racketmodname[ffi/unsafe/objc] library builds on +@racketmodname[ffi/unsafe] to support interaction with @link["http://developer.apple.com/documentation/Cocoa/Conceptual/ObjectiveC/"]{Objective-C}.} The library supports Objective-C interaction in two layers. The upper @@ -333,12 +333,12 @@ Constructor and FFI C type use for super calls.} @section{Legacy Library} @defmodule[ffi/objc]{The @racketmodname[ffi/objc] library is a -deprecated entry point to @racketmodname[racket/unsafe/ffi/objc]. It +deprecated entry point to @racketmodname[ffi/unsafe/objc]. It exports only safe operations directly, and unsafe operations are imported using @racket[objc-unsafe!].} @defform[(objc-unsafe!)]{ Analogous to @racket[(unsafe!)], makes unsafe bindings of -@racketmodname[racket/unsafe/ffi/objc] available in the importing +@racketmodname[ffi/unsafe/objc] available in the importing module.} diff --git a/collects/scribblings/foreign/types.scrbl b/collects/scribblings/foreign/types.scrbl index 93810f0009..61f3572c02 100644 --- a/collects/scribblings/foreign/types.scrbl +++ b/collects/scribblings/foreign/types.scrbl @@ -709,17 +709,6 @@ like @scheme[_bytes], since the string carries its size information is present for consistency with the above macros).} -@defform*[[(_cvector mode type maybe-len) - _cvector]]{ - -Like @scheme[_bytes], @scheme[_cvector] can be used as a simple type -that corresponds to a pointer that is managed as a safe C vector on -the Scheme side; see @secref["foreign:cvector"]. The longer form -behaves similarly to the @scheme[_list] and @scheme[_vector] custom -types, except that @scheme[_cvector] is more efficient; no Scheme -list or vector is needed.} - - @; ------------------------------------------------------------ @section{C Struct Types} diff --git a/collects/scribblings/foreign/unexported.scrbl b/collects/scribblings/foreign/unexported.scrbl index 3b2a81e303..65ec7568fd 100644 --- a/collects/scribblings/foreign/unexported.scrbl +++ b/collects/scribblings/foreign/unexported.scrbl @@ -9,8 +9,8 @@ @declare-exporting['#%foreign] -Parts of the @schememodname[scheme/foreign] library are implemented by -the MzScheme built-in @schememodname['#%foreign] module. The +Parts of the @schememodname[ffi/unsafe] library are implemented by +the Racket built-in @schememodname['#%foreign] module. The @schememodname['#%foreign] module is not intended for direct use, but it exports the following procedures. If you find any of these useful, please let us know. diff --git a/collects/scribblings/foreign/unsafe-foreign.ss b/collects/scribblings/foreign/unsafe-foreign.ss deleted file mode 100644 index e3eccbb4a8..0000000000 --- a/collects/scribblings/foreign/unsafe-foreign.ss +++ /dev/null @@ -1,31 +0,0 @@ -#lang scheme/base -(require scheme/foreign - (for-syntax scheme/base - scheme/provide-transform)) - -(error 'unsafe! "only `for-label' use in the documentation") - -(unsafe!) - -;; This is like `all-defined-out', but it ignores the 'not-provide-all-defined -;; property, so that the bindings introduced by `unsafe!' are exported. -(define-syntax all-unsafe-defined-out - (make-provide-transformer - (lambda (stx modes) - (syntax-case stx () - [(_) - (let-values ([(ids stx-ids) (syntax-local-module-defined-identifiers)] - [(same-ctx?) (lambda (free-identifier=?) - (lambda (id) - (free-identifier=? id - (datum->syntax - stx - (syntax-e id)))))]) - (map (lambda (id) - (make-export id (syntax-e id) 0 #f stx)) - (filter (same-ctx? free-identifier=?) - ids)))])))) - -(provide (protect-out (all-unsafe-defined-out)) - (all-from-out scheme/foreign)) - diff --git a/collects/scribblings/foreign/utils.ss b/collects/scribblings/foreign/utils.ss index 60e78cc8b5..51438d46a8 100644 --- a/collects/scribblings/foreign/utils.ss +++ b/collects/scribblings/foreign/utils.ss @@ -7,14 +7,18 @@ (for-syntax racket/base) (for-label racket/base racket/contract - (except-in racket/unsafe/ffi ->))) + (except-in ffi/unsafe ->) + ffi/unsafe/cvector + ffi/vector)) (provide cpp InsideMzScheme (all-from-out scribble/manual) (for-label (all-from-out racket/base racket/contract - racket/unsafe/ffi))) + ffi/unsafe + ffi/unsafe/cvector + ffi/vector))) (define InsideMzScheme diff --git a/collects/scribblings/foreign/vector.scrbl b/collects/scribblings/foreign/vector.scrbl new file mode 100644 index 0000000000..c48cd68a59 --- /dev/null +++ b/collects/scribblings/foreign/vector.scrbl @@ -0,0 +1,110 @@ +#lang scribble/doc +@(require "utils.ss") + +@title[#:tag "homogeneous-vectors"]{Safe Homogenous Vectors} + +@defmodule[ffi/vector] + +Homogenous vectors are similar to C vectors (see +@secref["foreign:cvector"]), except that they define different types +of vectors, each with a hard-wired type. + +An exception is the @schemeidfont{u8} family of bindings, which are +just aliases for byte-string bindings: @scheme[make-u8vector], +@scheme[u8vector]. @scheme[u8vector?], @scheme[u8vector-length], +@scheme[u8vector-ref], @scheme[u8vector-set!], +@scheme[list->u8vector], @scheme[u8vector->list]. + +@(begin + (require (for-syntax scheme/base)) + (define-syntax (srfi-4-vector stx) + (syntax-case stx () + [(_ id elem) + #'(srfi-4-vector/desc id elem + "Like " (scheme make-vector) ", etc., but for " (scheme elem) " elements.")])) + (define-syntax (srfi-4-vector/desc stx) + (syntax-case stx () + [(_ id elem . desc) + (let ([mk + (lambda l + (datum->syntax + #'id + (string->symbol + (apply string-append + (map (lambda (i) + (if (identifier? i) + (symbol->string (syntax-e i)) + i)) + l))) + #'id))]) + (with-syntax ([make (mk "make-" #'id "vector")] + [vecr (mk #'id "vector")] + [? (mk #'id "vector?")] + [length (mk #'id "vector-length")] + [ref (mk #'id "vector-ref")] + [! (mk #'id "vector-set!")] + [list-> (mk "list->" #'id "vector")] + [->list (mk #'id "vector->list")] + [->cpointer (mk #'id "vector->cpointer")] + [_vec (mk "_" #'id "vector")]) + #`(begin + (defproc* ([(make [len exact-nonnegative-integer?]) ?] + [(vecr [val number?] (... ...)) ?] + [(? [v any/c]) boolean?] + [(length [vec ?]) exact-nonnegative-integer?] + [(ref [vec ?][k exact-nonnegative-integer?]) number?] + [(! [vec ?][k exact-nonnegative-integer?][val number?]) void?] + [(list-> [lst (listof number?)]) ?] + [(->list [vec ?]) (listof number?)] + [(->cpointer [vec ?]) cpointer?]) + . desc) + ;; Big pain: make up relatively-correct source locations + ;; for pieces in the _vec definition: + (defform* [#,(datum->syntax + #'_vec + (cons #'_vec + (let loop ([l '(mode maybe-len)] + [col (+ (syntax-column #'_vec) + (syntax-span #'_vec) + 1)] + [pos (+ (syntax-position #'_vec) + (syntax-span #'_vec) + 1)]) + (if (null? l) + null + (let ([span (string-length (symbol->string (car l)))]) + (cons (datum->syntax + #'_vec + (car l) + (list (syntax-source #'_vec) + (syntax-line #'_vec) + col + pos + span)) + (loop (cdr l) + (+ col 1 span) + (+ pos 1 span))))))) + (list (syntax-source #'_vec) + (syntax-line #'_vec) + (sub1 (syntax-column #'vec)) + (sub1 (syntax-position #'vec)) + 10)) + _vec] + "Like " (scheme _cvector) ", but for vectors of " (scheme elem) " elements."))))]))) + + +@srfi-4-vector/desc[u8 _uint8]{ + +Like @scheme[_cvector], but for vectors of @scheme[_byte] elements. These are +aliases for @schemeidfont{byte} operations.} + +@srfi-4-vector[s8 _int8] +@srfi-4-vector[s16 _int16] +@srfi-4-vector[u16 _uint16] +@srfi-4-vector[s32 _int32] +@srfi-4-vector[u32 _uint32] +@srfi-4-vector[s64 _int64] +@srfi-4-vector[u64 _uint64] +@srfi-4-vector[f32 _float] +@srfi-4-vector[f64 _double*] + diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl index 438ad742cd..fb6dcce88b 100644 --- a/collects/scribblings/reference/numbers.scrbl +++ b/collects/scribblings/reference/numbers.scrbl @@ -956,7 +956,7 @@ unsafe operations on @tech{flvector}s (see @schememodname[racket/unsafe/ops]) can execute more efficiently than unsafe operations on @tech{vectors} of inexact reals. -An f64vector as provided by @schememodname[racket/unsafe/ffi] stores the +An f64vector as provided by @schememodname[ffi/vector] stores the same kinds of values as an @tech{flvector}, but with extra indirections that make f64vectors more convenient for working with foreign libraries. The lack of indirections make unsafe diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl index 564a6d788d..30ccae242b 100644 --- a/collects/scribblings/reference/unsafe.scrbl +++ b/collects/scribblings/reference/unsafe.scrbl @@ -2,7 +2,7 @@ @(require "mz.ss" (for-label racket/unsafe/ops racket/flonum - (only-in racket/unsafe/ffi + (only-in ffi/vector f64vector? f64vector-ref f64vector-set!)))