Changeset 12154 in project
- Timestamp:
- 10/14/08 20:29:09 (12 years ago)
- Location:
- release/4/epeg
- Files:
-
- 2 deleted
- 3 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
release/4/epeg/epeg.meta
r872 r12154 4 4 (synopsis "Chicken bindings for the JPEG thumbnail creation library epeg") 5 5 (author "Peter Bex") 6 (needs syntax-case)7 6 (category graphics) 8 7 (license "BSD") 9 (files "epeg.scm" "epeg.setup" "epeg -eggdoc.scm" "epeg.html"))8 (files "epeg.scm" "epeg.setup" "epeg.html")) -
release/4/epeg/epeg.scm
r1804 r12154 1 1 ;;; epeg.scm 2 2 ; 3 ; Version 2. 14 ; 5 ; Copyright (c) 2004-200 6 Peter Bex (Peter.Bex@student.kun.nl)3 ; Version 2.2 4 ; 5 ; Copyright (c) 2004-2008 Peter Bex (Peter.Bex@xs4all.nl) 6 6 ; All rights reserved. 7 7 ; … … 30 30 ; SUCH DAMAGE. 31 31 32 (declare 33 (hide epeg:collect sizeerr? memerr? pixels-get-caller) 34 (foreign-declare "#include <errno.h>") 35 (foreign-declare "#include <Epeg.h>") ) 36 37 (use syntax-case) 32 (module epeg 33 (image? image-open image-close image-size image-size-set! 34 image-bounds-set! image-colorspace image-colorspace-set! 35 image-encode 36 image-comment image-comment-set! image-thumbnail-info 37 image-comment-enable image-comment-disable 38 image-quality-set! image-file-output-set! image-trim 39 colorspace-gray8 colorspace-yuv8 colorspace-rgb8 40 colorspace-bgr8 colorspace-rgba8 colorspace-bgra8 41 colorspace-argb32 colorspace-cmyk) 42 43 (import chicken scheme foreign) 44 45 (foreign-declare "#include <errno.h>") 46 (foreign-declare "#include <Epeg.h>") 38 47 39 48 (define-foreign-type image (pointer "Epeg_Image")) 40 49 41 (define-record epeg:image ptr)50 (define-record image ptr) 42 51 43 52 (define (epeg-err loc msg . args) … … 51 60 ;; Internal convenience macros 52 61 (define (assert-image img loc . args) 53 (when (not ( epeg:image-ptr img))62 (when (not (image-ptr img)) 54 63 (epeg-err loc "Invalid image parameter" args))) 55 64 … … 62 71 ?body ...)))) 63 72 64 (define ( epeg:file-open filename)73 (define (image-open filename) 65 74 (let ((img ((foreign-lambda image epeg_file_open c-string) filename))) 66 75 (if img 67 (set-finalizer! (make- epeg:image img) epeg:collect)68 (epeg-err ' epeg:file-open "cannot open file" (list filename)))))69 70 (define ( epeg:collectimg)71 (let ((ptr ( epeg:image-ptr img)))76 (set-finalizer! (make-image img) gc-image) 77 (epeg-err 'image-open "cannot open file" (list filename))))) 78 79 (define (gc-image img) 80 (let ((ptr (image-ptr img))) 72 81 (if ptr 73 82 ((foreign-lambda void epeg_close image) ptr)))) 74 83 75 (define/img ( epeg:close img)76 ((foreign-lambda void epeg_close image) ( epeg:image-ptr img))77 ( epeg:image-ptr-set! img #f))78 79 (define/img ( epeg:size-getimg)84 (define/img (image-close img) 85 ((foreign-lambda void epeg_close image) (image-ptr img)) 86 (image-ptr-set! img #f)) 87 88 (define/img (image-size img) 80 89 (let-location ([width int] [height int]) 81 ((foreign-lambda void epeg_size_get image (pointer int) (pointer int)) ( epeg:image-ptr img) (location width) (location height))90 ((foreign-lambda void epeg_size_get image (pointer int) (pointer int)) (image-ptr img) (location width) (location height)) 82 91 (values width height))) 83 92 84 (define/img ( epeg:decode-size-set! img width height)85 ((foreign-lambda void epeg_decode_size_set image int int) ( epeg:image-ptr img) width height))86 87 (define/img ( epeg:decode-bounds-set! img x y width height)88 ((foreign-lambda void epeg_decode_bounds_set image int int int int) ( epeg:image-ptr img) x y width height))93 (define/img (image-size-set! img width height) 94 ((foreign-lambda void epeg_decode_size_set image int int) (image-ptr img) width height)) 95 96 (define/img (image-bounds-set! img x y width height) 97 ((foreign-lambda void epeg_decode_bounds_set image int int int int) (image-ptr img) x y width height)) 89 98 90 99 ; From the Chicken manual. Why isn't this extremely useful macro in … … 94 103 ((define-foreign-enum) 95 104 (void)) 96 ((define-foreign-enum 97 (?name ?realname) 98 ?rest ...) 105 ((define-foreign-enum (?name ?realname) ?rest ...) 99 106 (begin 100 (define-foreign-variable ?name int realname) 107 (define-foreign-variable foo int ?realname) 108 (define ?name foo) ;; Workaround - directly exporting foo doesn't work 101 109 (define-foreign-enum ?rest ...))) 102 110 ((define-foreign-enum … … 107 115 (define-foreign-enum ?rest ...))))) 108 116 109 (define-foreign-type epeg:colorspace (enum "_Epeg_Colorspace"))117 (define-foreign-type colorspace (enum "_Epeg_Colorspace")) 110 118 (define-foreign-enum 111 ( epeg:colorspace-gray8 "EPEG_GRAY8")112 ( epeg:colorspace-yuv8 "EPEG_YUV8")113 ( epeg:colorspace-rgb8 "EPEG_RGB8")114 ( epeg:colorspace-bgr8 "EPEG_BGR8")115 ( epeg:colorspace-rgba8 "EPEG_RGBA8")116 ( epeg:colorspace-bgra8 "EPEG_BGRA8")117 ( epeg:colorspace-argb32 "EPEG_ARGB32")118 ( epeg:colorspace-cmyk "EPEG_CMYK"))119 (colorspace-gray8 "EPEG_GRAY8") 120 (colorspace-yuv8 "EPEG_YUV8") 121 (colorspace-rgb8 "EPEG_RGB8") 122 (colorspace-bgr8 "EPEG_BGR8") 123 (colorspace-rgba8 "EPEG_RGBA8") 124 (colorspace-bgra8 "EPEG_BGRA8") 125 (colorspace-argb32 "EPEG_ARGB32") 126 (colorspace-cmyk "EPEG_CMYK")) 119 127 120 128 ;; … … 123 131 ;; It is in the Doxygen file, so we can assume it may be used nonetheless. 124 132 ;; 125 (define/img ( epeg:colorspace-getimg)133 (define/img (image-colorspace img) 126 134 (let-location ([space int]) 127 ((foreign-lambda void epeg_colorspace_get image (pointer int)) ( epeg:image-ptr img) (location space))135 ((foreign-lambda void epeg_colorspace_get image (pointer int)) (image-ptr img) (location space)) 128 136 space)) 129 137 130 (define/img ( epeg:decode-colorspace-set! img space)131 ((foreign-lambda void epeg_decode_colorspace_set image epeg:colorspace) (epeg:image-ptr img) space))132 133 (define/img ( epeg:encode img)134 (not ((foreign-lambda bool epeg_encode image) ( epeg:image-ptr img))))138 (define/img (image-colorspace-set! img space) 139 ((foreign-lambda void epeg_decode_colorspace_set image colorspace) (image-ptr img) space)) 140 141 (define/img (image-encode img) 142 (not ((foreign-lambda bool epeg_encode image) (image-ptr img)))) 135 143 136 144 (define memerr? (foreign-lambda* bool () … … 159 167 ;; must be freed with epeg_pixels_free, BEFORE epeg_close is called on the 160 168 ;; image. This freeing can be taken care of by attaching a list of pixel 161 ;; info blocks to the epeg:imagestructure which is freed upon close.169 ;; info blocks to the 'image' structure which is freed upon close. 162 170 ;; The real question is, how to deal with this data in a safe and 163 171 ;; userfriendly way? … … 184 192 (make-property-condition 'epeg)))))) 185 193 186 #;(define/img ( epeg:pixels-get img x y width height)194 #;(define/img (image-pixels-get img x y width height) 187 195 (pixels-get-caller 188 196 (foreign-lambda* (const c-pointer) ([image im] … … 193 201 "errno = 0; 194 202 return (epeg_pixels_get(im, x, y, w, h));") 195 ' epeg:pixels-get196 ( epeg:image-ptr img) x y width height))197 198 #;(define/img ( epeg:pixels-get-as-RGB8 img x y width height)203 'image-pixels-get 204 (image-ptr img) x y width height)) 205 206 #;(define/img (image-pixels-get-as-RGB8 img x y width height) 199 207 (pixels-get-caller 200 208 (foreign-lambda* (const c-pointer) ([image im] … … 205 213 "errno = 0; 206 214 return (epeg_pixels_get_as_RGB8(im, x, y, w, h));") 207 'epeg:pixels-get-as-RGB8 208 (epeg:image-ptr img) x y width height)) 209 210 #;(define/img (epeg:pixels-free img pixels) 211 ((foreign-lambda void epeg_pixels_free image c-pointer) (epeg:image-ptr img) pixels)) 212 213 (define/img (epeg:comment-get img) 214 ((foreign-lambda c-string epeg_comment_get image) (epeg:image-ptr img))) 215 'image-pixels-get-as-RGB8 216 (image-ptr img) x y width height)) 217 218 #;(define/img (image-pixels-free img pixels) 219 ((foreign-lambda void epeg_pixels_free image c-pointer) (image-ptr img) pixels)) 215 220 216 221 ; Unused 217 222 ;(define-foreign-type epeg-thumbnail-info (pointer "Epeg_Thumbnail_Info")) 218 223 219 (define/img ( epeg:thumbnail-comments-getimg)224 (define/img (image-thumbnail-info img) 220 225 (let ([thc-get 221 226 (foreign-lambda* void ([image im] … … 232 237 (let-location ([uri c-string] [width int] [height int] [mimetype c-string]) 233 238 (thc-get 234 ( epeg:image-ptr img)239 (image-ptr img) 235 240 (location uri) 236 241 (location width) … … 239 244 (values uri width height mimetype)))) 240 245 241 (define/img (epeg:thumbnail-comments-enable img) 242 ((foreign-lambda void epeg_thumbnail_comments_enable image bool) (epeg:image-ptr img) #t)) 243 244 (define/img (epeg:thumbnail-comments-disable img) 245 ((foreign-lambda void epeg_thumbnail_comments_enable image bool) (epeg:image-ptr img) #f)) 246 247 (define/img (epeg:comment-set! img string) 248 ((foreign-lambda void epeg_comment_set image c-string) (epeg:image-ptr img) string)) 246 (define/img (image-comment-enable img) 247 ((foreign-lambda void epeg_thumbnail_comments_enable image bool) (image-ptr img) #t)) 248 249 (define/img (image-comment-disable img) 250 ((foreign-lambda void epeg_thumbnail_comments_enable image bool) (image-ptr img) #f)) 251 252 (define/img (image-comment img) 253 ((foreign-lambda c-string epeg_comment_get image) (image-ptr img))) 254 255 (define/img (image-comment-set! img string) 256 ((foreign-lambda void epeg_comment_set image c-string) (image-ptr img) string)) 249 257 250 258 ; Integer values between 0 and 100 251 (define/img ( epeg:quality-set! img qual)252 ((foreign-lambda void epeg_quality_set image int) ( epeg:image-ptr img) qual))253 254 (define/img ( epeg:file-output-set! img file)255 ((foreign-lambda void epeg_file_output_set image c-string) ( epeg:image-ptr img) file))259 (define/img (image-quality-set! img qual) 260 ((foreign-lambda void epeg_quality_set image int) (image-ptr img) qual)) 261 262 (define/img (image-file-output-set! img file) 263 ((foreign-lambda void epeg_file_output_set image c-string) (image-ptr img) file)) 256 264 257 265 ; 258 266 ; Not really useful and perhaps a bit dangerous in Scheme 259 267 ; 260 #;(define/img ( epeg:memory-output-set! img ptr size)268 #;(define/img (image-memory-output-set! img ptr size) 261 269 ((foreign-lambda void epeg_memory_output_set image 262 270 (pointer byte-vector) (pointer int)) 263 ( epeg:image-ptr img) ptr size))264 265 #;(define ( epeg:memory-open data size)271 (image-ptr img) ptr size)) 272 273 #;(define (image-memory-open data size) 266 274 (let ((img ((foreign-lambda image epeg_memory_open byte-vector int) data size))) 267 275 (if img 268 (set-finalizer! (make- epeg:image img) epeg:collect)276 (set-finalizer! (make-image img) gc-image) 269 277 (abort 270 278 (make-composite-condition … … 278 286 ; Badly documented, no idea what it does. 279 287 ; 280 (define/img (epeg:trim img) 281 (not ((foreign-lambda bool epeg_trim image) (epeg:image-ptr img)))) 288 (define/img (image-trim img) 289 (not ((foreign-lambda bool epeg_trim image) (image-ptr img)))) 290 ) -
release/4/epeg/epeg.setup
r2146 r12154 1 (compile -s -O2 -d0 epeg.scm -L -lepeg) 1 (compile -s -O2 epeg.scm -L -lepeg -j epeg) 2 (compile -s -O2 epeg.import.scm) 2 3 3 4 (install-extension 'epeg 4 '("epeg.so" "epeg.html") 5 '((version "2.1") (documentation "epeg.html"))) 5 '("epeg.so" "epeg.import.so") 6 '((version 2.2) 7 (documentation "epeg.html")))
Note: See TracChangeset
for help on using the changeset viewer.