Changeset 12156 in project


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

Port imlib2 to chicken 4

Location:
release/4/imlib2
Files:
3 deleted
3 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/imlib2/trunk/imlib2.meta

    r10055 r12156  
    33((egg "imlib2.egg")
    44 (synopsis "Chicken bindings for the Imlib2 image library")
    5  (needs syntax-case)
    65 (author "Peter Bex")
    76 (category graphics)
    87 (license "BSD")
    9  (files "imlib2.scm" "imlib2.setup" "imlib2-eggdoc.scm" "imlib2.html"))
     8 (files "imlib2.scm" "imlib2.setup" "imlib2.html"))
  • release/4/imlib2/trunk/imlib2.scm

    r10055 r12156  
    77;;;
    88;
    9 ; Version 0.4
     9; Version 0.7
    1010;
    11 ; Copyright (c) 2005, 2006 Peter Bex (Peter.Bex@xs4all.nl)
     11; Copyright (c) 2005-2008 Peter Bex (Peter.Bex@xs4all.nl)
    1212; All rights reserved.
    1313;
     
    3838;; XXX The bools in the C interface are really all chars
    3939
    40 (declare
    41   (export imlib:create imlib:destroy imlib:clone imlib:load imlib:save
    42           imlib:image? imlib:format-set! imlib:format imlib:width imlib:height
    43           imlib:filename imlib:alpha? imlib:alpha-set!
    44           imlib:track-changes-on-disk
    45           imlib:flip-horizontal imlib:flip-horizontal! imlib:flip-vertical
    46           imlib:flip-vertical! imlib:flip-diagonal imlib:flip-diagonal!
    47           imlib:orientate imlib:orientate! imlib:sharpen imlib:sharpen!
    48           imlib:blur imlib:blur! imlib:tile imlib:tile! imlib:tile-horizontal
    49           imlib:tile-horizontal! imlib:tile-vertical imlib:tile-vertical!
    50           imlib:crop imlib:scale
    51           imlib:crop&scale imlib:pixel/rgba imlib:pixel/hsva imlib:pixel/hlsa
    52           imlib:pixel/cmya imlib:color/rgba imlib:color/hsva imlib:color/hlsa
    53           imlib:color/cmya imlib:color?
    54           imlib:draw-pixel imlib:draw-line imlib:draw-rectangle
    55           imlib:fill-rectangle))
     40(module imlib2
     41  (image-create image-destroy image-clone image-load image-save
     42   image? image-format-set! image-format image-width image-height
     43   image-filename image-alpha? image-alpha-set!
     44   image-track-changes-on-disk
     45   image-flip-horizontal image-flip-horizontal! image-flip-vertical
     46   image-flip-vertical! image-flip-diagonal image-flip-diagonal!
     47   image-orientate image-orientate! image-sharpen image-sharpen!
     48   image-blur image-blur! image-tile image-tile! image-tile-horizontal
     49   image-tile-horizontal! image-tile-vertical image-tile-vertical!
     50   image-crop image-scale
     51   image-crop&scale image-pixel/rgba image-pixel/hsva image-pixel/hlsa
     52   image-pixel/cmya color/rgba color/hsva color/hlsa color/cmya color?
     53   image-draw-pixel image-draw-line image-draw-rectangle
     54   image-fill-rectangle)
     55
     56(import chicken scheme foreign)
    5657
    5758; Not needed with the latest Imlib2 (1.2.2)
     
    6263(foreign-declare "#include <Imlib2.h>")
    6364
    64 (use syntax-case)
    65 
    66 (define-record imlib:image ptr)
    67 (define-record imlib:color setter one two three alpha)
     65(define-record image ptr)
     66(define-record color setter one two three alpha)
    6867
    6968(define-foreign-type image      c-pointer)
     
    119118;; Internal convenience macros
    120119(define (assert-image img loc . args)
    121   (when (not (imlib:image-ptr img))
     120  (when (not (image-ptr img))
    122121    (imlib-err loc "Invalid image parameter" args)))
    123122
     
    128127     (define (func img arg ...)
    129128       (assert-image img (quote func) arg ...)
    130        (imlib-context-set-image (imlib:image-ptr img))
     129       (imlib-context-set-image (image-ptr img))
    131130       body ...))))
    132131
    133 (define (imlib:load filename)
     132(define (image-load filename)
    134133  (let-location ([err int])  ; int should really be imlib-load-error
    135134    (let* ((load-image (foreign-lambda  image
     
    139138           (image (load-image filename (location err))))
    140139      (if (= err IMLIB_LOAD_ERROR_NONE)
    141           (set-finalizer! (make-imlib:image image) imlib:collect)
     140          (set-finalizer! (make-image image) gc-collect)
    142141          (abort
    143142            (make-composite-condition
    144143              (make-property-condition  'exn 'i/o 'file
    145                                         'location 'imlib:load
     144                                        'location 'image-load
    146145                                        'message (load-error->message err)
    147146                                        'arguments (list filename))
    148147              (make-property-condition 'imlib)))))))
    149148
    150 (define/img (imlib:save img filename)
     149(define/img (image-save img filename)
    151150  (let-location ([err int])  ; int should really be imlib-load-error
    152151    ((foreign-lambda  void
     
    160159          (make-composite-condition
    161160            (make-property-condition 'exn 'i/o 'file
    162                                      'location 'imlib:save
     161                                     'location 'image-save
    163162                                     'message (load-error->message err)
    164163                                     'arguments (list filename))
     
    168167;; Create a new image, completely transparent.
    169168;;
    170 (define (imlib:create width height)
     169(define (image-create width height)
    171170  (if (or (< width 0) (< height 0))
    172       (imlib-err 'imlib:create "Width and height must be positive" width height)
    173       (let ((img (make-imlib:image ((foreign-lambda image imlib_create_image int int) width height))))
     171      (imlib-err 'image-create "Width and height must be positive" width height)
     172      (let ((img (make-image ((foreign-lambda image imlib_create_image int int) width height))))
    174173        (if (not img)
    175             (imlib-err 'imlib:create "Could not create new image" (list width height))
     174            (imlib-err 'image-create "Could not create new image" (list width height))
    176175            (begin
    177               (imlib:alpha-set! img #t)
    178               (imlib:fill-rectangle img (imlib:color/rgba 0 0 0 0) 0 0 width height)
    179               (set-finalizer! img imlib:collect))))))
    180 
    181 (define (imlib:collect img)
    182   (when (imlib:image-ptr img)
     176              (image-alpha-set! img #t)
     177              (image-fill-rectangle img (color/rgba 0 0 0 0) 0 0 width height)
     178              (set-finalizer! img gc-collect))))))
     179
     180(define (gc-collect img)
     181  (when (image-ptr img)
    183182        (let ((old (imlib-context-get-image)))
    184           (imlib-context-set-image (imlib:image-ptr img))
     183          (imlib-context-set-image (image-ptr img))
    185184          ((foreign-lambda void imlib_free_image))
    186185          (imlib-context-set-image old))))
    187186
    188 (define/img (imlib:destroy img)
     187(define/img (image-destroy img)
    189188  ((foreign-lambda void imlib_free_image))
    190   (imlib:image-ptr-set! img #f))
    191 
    192 (define/img (imlib:format-set! img format)
     189  (image-ptr-set! img #f))
     190
     191(define/img (image-format-set! img format)
    193192  ((foreign-lambda void imlib_image_set_format c-string) format))
    194193
    195 (define/img (imlib:format img)
     194(define/img (image-format img)
    196195  ((foreign-lambda c-string imlib_image_format)))
    197196
    198 (define/img (imlib:width img)
     197(define/img (image-width img)
    199198  ((foreign-lambda int imlib_image_get_width)))
    200199
    201 (define/img (imlib:height img)
     200(define/img (image-height img)
    202201  ((foreign-lambda int imlib_image_get_height)))
    203202
    204 (define/img (imlib:filename img)
     203(define/img (image-filename img)
    205204  ((foreign-lambda c-string imlib_image_get_filename)))
    206205
     
    211210    ((define/clone ?name ?name!)
    212211     (define (?name img . args)
    213        (let ((new-img (imlib:clone img)))
     212       (let ((new-img (image-clone img)))
    214213         (apply ?name! new-img args)
    215214         new-img)))))
    216215
    217 (define/img (imlib:flip-horizontal! img)
     216(define/img (image-flip-horizontal! img)
    218217  ((foreign-lambda void imlib_image_flip_horizontal)))
    219 (define/clone imlib:flip-horizontal imlib:flip-horizontal!)
    220 
    221 (define/img (imlib:flip-vertical! img)
     218(define/clone image-flip-horizontal image-flip-horizontal!)
     219
     220(define/img (image-flip-vertical! img)
    222221  ((foreign-lambda void imlib_image_flip_vertical)))
    223 (define/clone imlib:flip-vertical imlib:flip-horizontal!)
    224 
    225 (define/img (imlib:flip-diagonal! img)
     222(define/clone image-flip-vertical image-flip-horizontal!)
     223
     224(define/img (image-flip-diagonal! img)
    226225  ((foreign-lambda void imlib_image_flip_diagonal)))
    227 (define/clone imlib:flip-diagonal imlib:flip-diagonal!)
    228 
    229 (define/img (imlib:orientate! img orientation)
     226(define/clone image-flip-diagonal image-flip-diagonal!)
     227
     228(define/img (image-orientate! img orientation)
    230229  (if (or (< orientation 0) (> orientation 7))
    231       (imlib-err 'imlib:orientate
     230      (imlib-err 'image-orientate
    232231                 "Orientation must be between 0 and 7 inclusive"
    233232                 (list orientation))
    234233      ((foreign-lambda void imlib_image_orientate int) orientation)))
    235 (define/clone imlib:orientate imlib:orientate!)
    236 
    237 (define/img (imlib:sharpen! img radius) ;; XXX: What does a radius < 0 mean?!
     234(define/clone image-orientate image-orientate!)
     235
     236(define/img (image-sharpen! img radius) ;; XXX: What does a radius < 0 mean?!
    238237  ((foreign-lambda void imlib_image_sharpen int) radius))
    239 (define/clone imlib:sharpen imlib:sharpen!)
    240 
    241 (define/img (imlib:blur! img radius)
     238(define/clone image-sharpen image-sharpen!)
     239
     240(define/img (image-blur! img radius)
    242241  (if (< radius 0)
    243       (imlib-err 'imlib:blur "Radius cannot be less than 0" (list radius))
     242      (imlib-err 'image-blur "Radius cannot be less than 0" (list radius))
    244243      ((foreign-lambda void imlib_image_blur int) radius)))
    245 (define/clone imlib:blur imlib:blur!)
    246 
    247 (define/img (imlib:tile-horizontal! img)
     244(define/clone image-blur image-blur!)
     245
     246(define/img (image-tile-horizontal! img)
    248247  ((foreign-lambda void imlib_image_tile_horizontal)))
    249 (define/clone imlib:tile-horizontal imlib:tile-horizontal!)
    250 
    251 (define/img (imlib:tile-vertical! img)
     248(define/clone image-tile-horizontal image-tile-horizontal!)
     249
     250(define/img (image-tile-vertical! img)
    252251  ((foreign-lambda void imlib_image_tile_vertical)))
    253 (define/clone imlib:tile-vertical imlib:tile-vertical!)
    254 
    255 (define/img (imlib:tile! img)
     252(define/clone image-tile-vertical image-tile-vertical!)
     253
     254(define/img (image-tile! img)
    256255  ((foreign-lambda void imlib_image_tile)))
    257 (define/clone imlib:tile imlib:tile!)
     256(define/clone image-tile image-tile!)
    258257
    259258;; imlib_image_get_data
     
    261260;; imlib_image_put_back_data
    262261
    263 (define/img (imlib:alpha? img)
     262(define/img (image-alpha? img)
    264263  ((foreign-lambda bool imlib_image_has_alpha)))
    265264
    266 (define/img (imlib:alpha-set! img val)
     265(define/img (image-alpha-set! img val)
    267266  ((foreign-lambda void imlib_image_set_has_alpha bool) val))
    268267
    269 (define/img (imlib:track-changes-on-disk img)
     268(define/img (image-track-changes-on-disk img)
    270269  ((foreign-lambda void imlib_image_set_changes_on_disk)))
    271270
    272271
    273272;; XXX What does cropping/scaling mean when x/y are out of bounds? It is allowed
    274 (define/img (imlib:crop img x y width height)
     273(define/img (image-crop img x y width height)
    275274  (set-finalizer!
    276    (make-imlib:image
     275   (make-image
    277276    ((foreign-lambda image imlib_create_cropped_image int int int int)
    278277     x y width height))
    279    imlib:collect))
    280 
    281 (define/img (imlib:crop&scale img src-x src-y src-width src-height dest-width dest-height)
     278   gc-collect))
     279
     280(define/img (image-crop&scale img src-x src-y src-width src-height dest-width dest-height)
    282281  (set-finalizer!
    283    (make-imlib:image
     282   (make-image
    284283    ((foreign-lambda image imlib_create_cropped_scaled_image int int int
    285284                     int int int)
    286285     src-x src-y src-width src-height dest-width dest-height))
    287    imlib:collect))
    288 
    289 (define/img (imlib:scale img width height)
    290   (imlib:crop&scale img 0 0 (imlib:width img) (imlib:height img) width height))
    291 
    292 (define (imlib:clone img)
    293   (set-finalizer! (make-imlib:image (imlib-clone-image img)) imlib:collect))
     286   gc-collect))
     287
     288(define/img (image-scale img width height)
     289  (image-crop&scale img 0 0 (image-width img) (image-height img) width height))
     290
     291(define (image-clone img)
     292  (set-finalizer! (make-image (imlib-clone-image img)) gc-collect))
    294293
    295294(define/img (imlib-clone-image img)
     
    298297
    299298(define (check-coords loc img x y)
    300   (let ((width  (imlib:width img))
    301         (height (imlib:height img))
     299  (let ((width  (image-width img))
     300        (height (image-height img))
    302301        (fail   (lambda (msg)
    303302                  (imlib-err loc msg (list x y)))))
     
    306305      ((or (>= y height) (< y 0)) (fail "Y coordinate out of range")))))
    307306
    308 (define (imlib:pixel/rgba img x y)
    309   (check-coords 'imlib:pixel/rgba img x y)
     307(define (image-pixel/rgba img x y)
     308  (check-coords 'image-pixel/rgba img x y)
    310309  (let ((query-func (foreign-lambda* void ([int x]
    311310                                           [int y]
     
    324323      (values r g b a))))
    325324
    326 (define/img (imlib:pixel/hsva img x y)
    327   (check-coords 'imlib:pixel/hsva img x y)
     325(define/img (image-pixel/hsva img x y)
     326  (check-coords 'image-pixel/hsva img x y)
    328327  (let-location ([h float] [s float] [v float] [a int])
    329328    ((foreign-lambda void imlib_image_query_pixel_hsva int int (c-pointer float) (c-pointer float) (c-pointer float) (c-pointer int)) x y (location h) (location s) (location v) (location a))
    330329    (values h s v a)))
    331330
    332 (define/img (imlib:pixel/hlsa img x y)
    333   (check-coords 'imlib:pixel/hlsa img x y)
     331(define/img (image-pixel/hlsa img x y)
     332  (check-coords 'image-pixel/hlsa img x y)
    334333  (let-location ([h float] [l float] [s float] [a int])
    335334    ((foreign-lambda void imlib_image_query_pixel_hlsa int int (c-pointer float) (c-pointer float) (c-pointer float) (c-pointer int)) x y (location h) (location l) (location s) (location a))
    336335    (values h l s a)))
    337336
    338 (define/img (imlib:pixel/cmya img x y)
    339   (check-coords 'imlib:pixel/cmya img x y)
     337(define/img (image-pixel/cmya img x y)
     338  (check-coords 'image-pixel/cmya img x y)
    340339  (let-location ([c int] [m int] [y int] [a int])
    341340    ((foreign-lambda void imlib_image_query_pixel_cmya int int (c-pointer int) (c-pointer int) (c-pointer int) (c-pointer int)) x y (location c) (location m) (location y) (location a))
     
    373372      (imlib-err loc "Cyan, Magenta, Yellow and Alpha values must be between 0 and 255" c m y a)))
    374373
    375 (define (imlib:color/rgba r g b a)
    376   (check-colorvalues/rgba 'imlib:color/rgba r g b a)
    377   (make-imlib:color imlib-context-set-color/rgba r g b a))
    378 
    379 (define (imlib:color/cmya c m y a)
    380   (check-colorvalues/cmya 'imlib:color/cmya c m y a)
    381   (make-imlib:color imlib-context-set-color/cmya c m y a))
    382 
    383 (define (imlib:color/hlsa h l s a)
    384   (check-colorvalues/hlsa 'imlib:color/hlsa h l s a)
    385   (make-imlib:color imlib-context-set-color/hlsa h l s a))
    386 
    387 (define (imlib:color/hsva h s v a)
    388   (check-colorvalues/hsva 'imlib:color/hsva h s v a)
    389   (make-imlib:color imlib-context-set-color/hsva h s v a))
     374(define (color/rgba r g b a)
     375  (check-colorvalues/rgba 'color/rgba r g b a)
     376  (make-color imlib-context-set-color/rgba r g b a))
     377
     378(define (color/cmya c m y a)
     379  (check-colorvalues/cmya 'color/cmya c m y a)
     380  (make-color imlib-context-set-color/cmya c m y a))
     381
     382(define (color/hlsa h l s a)
     383  (check-colorvalues/hlsa 'color/hlsa h l s a)
     384  (make-color imlib-context-set-color/hlsa h l s a))
     385
     386(define (color/hsva h s v a)
     387  (check-colorvalues/hsva 'color/hsva h s v a)
     388  (make-color imlib-context-set-color/hsva h s v a))
    390389
    391390(define (context-set-color color)
    392   ((imlib:color-setter color) (imlib:color-one color)
    393                               (imlib:color-two color)
    394                               (imlib:color-three color)
    395                               (imlib:color-alpha color)))
     391  ((color-setter color) (color-one color)
     392                        (color-two color)
     393                        (color-three color)
     394                        (color-alpha color)))
    396395
    397396;;;
     
    404403;;  without having an exception thrown.
    405404;;
    406 (define/img (imlib:draw-pixel img color x y)
     405(define/img (image-draw-pixel img color x y)
    407406  (context-set-color color)
    408   (check-coords 'imlib:draw-pixel img x y)
     407  (check-coords 'image-draw-pixel img x y)
    409408  ((foreign-lambda updates imlib_image_draw_pixel int int bool) x y #f))
    410409
    411 (define/img (imlib:draw-line img color x1 y1 x2 y2)
     410(define/img (image-draw-line img color x1 y1 x2 y2)
    412411  (context-set-color color)
    413412  ((foreign-lambda updates imlib_image_draw_line int int int int bool) x1 y1 x2 y2 #f))
    414413
    415 (define/img (imlib:draw-rectangle img color x y width height)
     414(define/img (image-draw-rectangle img color x y width height)
    416415  (context-set-color color)
    417416  ((foreign-lambda void imlib_image_draw_rectangle int int int int) x y width height))
    418417
    419 (define/img (imlib:fill-rectangle img color x y width height)
     418(define/img (image-fill-rectangle img color x y width height)
    420419  (context-set-color color)
    421420  ((foreign-lambda void imlib_image_fill_rectangle int int int int) x y width height))
     
    503502(define (imlib-context-set-color/cmya c m y a)
    504503   ((foreign-lambda void imlib_context_set_color_cmya int int int int) c m y a))
     504)
  • release/4/imlib2/trunk/imlib2.setup

    r10056 r12156  
    1 (define has-exports? (string>=? (chicken-version) "2.310"))
    2 
    31#+(and unix (not macosx))
    42(define RPATH-FLAGS "-Wl,-R/usr/X11R6/lib")
     
    119(if with-x?
    1210  (compile -feature with-x -s -O2 -d0
    13     ,@(if has-exports? '(-check-imports -emit-exports imlib2.exports) '())
    1411    imlib2.scm
    1512    -I/usr/X11R6/include
    16     -lImlib2 "`freetype-config --libs`" -L/usr/X11R6/lib ,RPATH-FLAGS -lX11 -lXext)
     13    -lImlib2 "`freetype-config --libs`" -L/usr/X11R6/lib ,RPATH-FLAGS -lX11 -lXext
     14    -j imlib2)
    1715  (compile -s -O2 -d0
    18     ,@(if has-exports? '(-check-imports -emit-exports imlib2.exports) '())
    19     imlib2.scm -C -DX_DISPLAY_MISSING))
     16    imlib2.scm -C -DX_DISPLAY_MISSING
     17    -j imlib2))
     18
     19(compile -s -O2 imlib2.import.scm)
    2020
    2121(install-extension 'imlib2
    22         '("imlib2.so" "imlib2.html")
    23         `((version "0.6")
    24     ,@(if has-exports? `((exports "imlib2.exports")) '())
    25                 (documentation "imlib2.html") ) )
     22  '("imlib2.so" "imlib2.import.so")
     23  `((version "0.6")
     24    (documentation "imlib2.html") ) )
Note: See TracChangeset for help on using the changeset viewer.