Changeset 12154 in project


Ignore:
Timestamp:
10/14/08 20:29:09 (12 years ago)
Author:
sjamaan
Message:

Port epeg to chicken 4

Location:
release/4/epeg
Files:
2 deleted
3 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/epeg/epeg.meta

    r872 r12154  
    44 (synopsis "Chicken bindings for the JPEG thumbnail creation library epeg")
    55 (author "Peter Bex")
    6  (needs syntax-case)
    76 (category graphics)
    87 (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  
    11;;; epeg.scm
    22;
    3 ; Version 2.1
    4 ;
    5 ; Copyright (c) 2004-2006 Peter Bex (Peter.Bex@student.kun.nl)
     3; Version 2.2
     4;
     5; Copyright (c) 2004-2008 Peter Bex (Peter.Bex@xs4all.nl)
    66; All rights reserved.
    77;
     
    3030; SUCH DAMAGE.
    3131
    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>")
    3847
    3948(define-foreign-type image (pointer "Epeg_Image"))
    4049
    41 (define-record epeg:image ptr)
     50(define-record image ptr)
    4251
    4352(define (epeg-err loc msg . args)
     
    5160;; Internal convenience macros
    5261(define (assert-image img loc . args)
    53   (when (not (epeg:image-ptr img))
     62  (when (not (image-ptr img))
    5463    (epeg-err loc "Invalid image parameter" args)))
    5564
     
    6271       ?body ...))))
    6372
    64 (define (epeg:file-open filename)
     73(define (image-open filename)
    6574  (let ((img ((foreign-lambda image epeg_file_open c-string) filename)))
    6675        (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:collect img)
    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)))
    7281    (if ptr
    7382        ((foreign-lambda void epeg_close image) ptr))))
    7483
    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-get img)
     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)
    8089  (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))
    8291    (values width height)))
    8392
    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))
    8998
    9099; From the Chicken manual.  Why isn't this extremely useful macro in
     
    94103    ((define-foreign-enum)
    95104     (void))
    96     ((define-foreign-enum
    97        (?name ?realname)
    98        ?rest ...)
     105    ((define-foreign-enum (?name ?realname) ?rest ...)
    99106     (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
    101109       (define-foreign-enum ?rest ...)))
    102110    ((define-foreign-enum
     
    107115       (define-foreign-enum ?rest ...)))))
    108116
    109 (define-foreign-type epeg:colorspace (enum "_Epeg_Colorspace"))
     117(define-foreign-type colorspace (enum "_Epeg_Colorspace"))
    110118(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"))
    119127
    120128;;
     
    123131;; It is in the Doxygen file, so we can assume it may be used nonetheless.
    124132;;
    125 (define/img (epeg:colorspace-get img)
     133(define/img (image-colorspace img)
    126134  (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))
    128136    space))
    129137
    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))))
    135143
    136144(define memerr? (foreign-lambda* bool ()
     
    159167;; must be freed with epeg_pixels_free, BEFORE epeg_close is called on the
    160168;; image.  This freeing can be taken care of by attaching a list of pixel
    161 ;; info blocks to the epeg:image structure which is freed upon close.
     169;; info blocks to the 'image' structure which is freed upon close.
    162170;; The real question is, how to deal with this data in a safe and
    163171;; userfriendly way?
     
    184192          (make-property-condition 'epeg))))))
    185193
    186 #;(define/img (epeg:pixels-get img x y width height)
     194#;(define/img (image-pixels-get img x y width height)
    187195  (pixels-get-caller
    188196   (foreign-lambda* (const c-pointer) ([image im]
     
    193201                    "errno = 0;
    194202                     return (epeg_pixels_get(im, x, y, w, h));")
    195    'epeg:pixels-get
    196    (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)
    199207  (pixels-get-caller
    200208   (foreign-lambda* (const c-pointer) ([image im]
     
    205213                    "errno = 0;
    206214                     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))
    215220
    216221; Unused
    217222;(define-foreign-type epeg-thumbnail-info (pointer "Epeg_Thumbnail_Info"))
    218223
    219 (define/img (epeg:thumbnail-comments-get img)
     224(define/img (image-thumbnail-info img)
    220225  (let ([thc-get
    221226          (foreign-lambda* void ([image im]
     
    232237    (let-location ([uri c-string] [width int] [height int] [mimetype c-string])
    233238      (thc-get
    234         (epeg:image-ptr img)
     239        (image-ptr img)
    235240        (location uri)
    236241        (location width)
     
    239244      (values uri width height mimetype))))
    240245
    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))
    249257
    250258; 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))
    256264
    257265;
    258266; Not really useful and perhaps a bit dangerous in Scheme
    259267;
    260 #;(define/img (epeg:memory-output-set! img ptr size)
     268#;(define/img (image-memory-output-set! img ptr size)
    261269  ((foreign-lambda void epeg_memory_output_set image
    262270                        (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)
    266274  (let ((img ((foreign-lambda image epeg_memory_open byte-vector int) data size)))
    267275    (if img
    268         (set-finalizer! (make-epeg:image img) epeg:collect)
     276        (set-finalizer! (make-image img) gc-image)
    269277        (abort
    270278         (make-composite-condition
     
    278286; Badly documented, no idea what it does.
    279287;
    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)
    23
    34(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.