Changeset 12154 in project

Timestamp:

10/14/08 20:29:09 (12 years ago)

Author:

sjamaan

Message:

Port epeg to chicken 4

Location:

release/4/epeg

Files:

• . (copied) (copied from release/3/epeg)
• epeg-eggdoc.scm (deleted)
• epeg.html (deleted)
• epeg.meta (modified) (1 diff)
• epeg.scm (modified) (14 diffs)
• epeg.setup (modified) (1 diff)

release/4/epeg/epeg.meta

@@ -4 +4 @@
  (synopsis "Chicken bindings for the JPEG thumbnail creation library epeg")
  (author "Peter Bex")
- (needs syntax-case)
  (category graphics)
  (license "BSD")
- (files "epeg.scm" "epeg.setup" "epeg-eggdoc.scm" "epeg.html"))
+ (files "epeg.scm" "epeg.setup" "epeg.html"))

release/4/epeg/epeg.scm

@@ -1 +1 @@
 ;;; epeg.scm
 ;
-; Version 2.1
-;
-; Copyright (c) 2004-2006 Peter Bex (Peter.Bex@student.kun.nl)
+; Version 2.2
+;
+; Copyright (c) 2004-2008 Peter Bex (Peter.Bex@xs4all.nl)
 ; All rights reserved.
 ; 
@@ -30 +30 @@
 ; SUCH DAMAGE.
 
-(declare
-  (hide epeg:collect sizeerr? memerr? pixels-get-caller)
-  (foreign-declare "#include <errno.h>")
-  (foreign-declare "#include <Epeg.h>") )
-
-(use syntax-case)
+(module epeg
+  (image? image-open image-close image-size image-size-set!
+   image-bounds-set! image-colorspace image-colorspace-set!
+   image-encode
+   image-comment image-comment-set! image-thumbnail-info
+   image-comment-enable image-comment-disable
+   image-quality-set! image-file-output-set! image-trim
+   colorspace-gray8 colorspace-yuv8 colorspace-rgb8
+   colorspace-bgr8 colorspace-rgba8 colorspace-bgra8
+   colorspace-argb32 colorspace-cmyk)
+
+(import chicken scheme foreign)
+
+(foreign-declare "#include <errno.h>")
+(foreign-declare "#include <Epeg.h>")
 
 (define-foreign-type image (pointer "Epeg_Image"))
 
-(define-record epeg:image ptr)
+(define-record image ptr)
 
 (define (epeg-err loc msg . args)
@@ -51 +60 @@
 ;; Internal convenience macros
 (define (assert-image img loc . args)
-  (when (not (epeg:image-ptr img))
+  (when (not (image-ptr img))
     (epeg-err loc "Invalid image parameter" args)))
 
@@ -62 +71 @@
        ?body ...))))
 
-(define (epeg:file-open filename)
+(define (image-open filename)
   (let ((img ((foreign-lambda image epeg_file_open c-string) filename)))
         (if img
-            (set-finalizer! (make-epeg:image img) epeg:collect)
-            (epeg-err 'epeg:file-open "cannot open file" (list filename)))))
-
-(define (epeg:collect img)
-  (let ((ptr (epeg:image-ptr img)))
+            (set-finalizer! (make-image img) gc-image)
+            (epeg-err 'image-open "cannot open file" (list filename)))))
+
+(define (gc-image img)
+  (let ((ptr (image-ptr img)))
     (if ptr
         ((foreign-lambda void epeg_close image) ptr))))
 
-(define/img (epeg:close img)
-  ((foreign-lambda void epeg_close image) (epeg:image-ptr img))
-  (epeg:image-ptr-set! img #f))
-
-(define/img (epeg:size-get img)
+(define/img (image-close img)
+  ((foreign-lambda void epeg_close image) (image-ptr img))
+  (image-ptr-set! img #f))
+
+(define/img (image-size img)
   (let-location ([width int] [height int])
-    ((foreign-lambda void epeg_size_get image (pointer int) (pointer int)) (epeg:image-ptr img) (location width) (location height))
+    ((foreign-lambda void epeg_size_get image (pointer int) (pointer int)) (image-ptr img) (location width) (location height))
     (values width height)))
 
-(define/img (epeg:decode-size-set! img width height)
-  ((foreign-lambda void epeg_decode_size_set image int int) (epeg:image-ptr img) width height))
-
-(define/img (epeg:decode-bounds-set! img x y width height)
-  ((foreign-lambda void epeg_decode_bounds_set image int int int int) (epeg:image-ptr img) x y width height))
+(define/img (image-size-set! img width height)
+  ((foreign-lambda void epeg_decode_size_set image int int) (image-ptr img) width height))
+
+(define/img (image-bounds-set! img x y width height)
+  ((foreign-lambda void epeg_decode_bounds_set image int int int int) (image-ptr img) x y width height))
 
 ; From the Chicken manual.  Why isn't this extremely useful macro in
@@ -94 +103 @@
     ((define-foreign-enum)
      (void))
-    ((define-foreign-enum
-       (?name ?realname)
-       ?rest ...)
+    ((define-foreign-enum (?name ?realname) ?rest ...)
      (begin
-       (define-foreign-variable ?name int realname)
+       (define-foreign-variable foo int ?realname)
+       (define ?name foo) ;; Workaround - directly exporting foo doesn't work
        (define-foreign-enum ?rest ...)))
     ((define-foreign-enum
@@ -107 +115 @@
        (define-foreign-enum ?rest ...)))))
 
-(define-foreign-type epeg:colorspace (enum "_Epeg_Colorspace"))
+(define-foreign-type colorspace (enum "_Epeg_Colorspace"))
 (define-foreign-enum
-  (epeg:colorspace-gray8 "EPEG_GRAY8")
-  (epeg:colorspace-yuv8 "EPEG_YUV8")
-  (epeg:colorspace-rgb8 "EPEG_RGB8")
-  (epeg:colorspace-bgr8 "EPEG_BGR8")
-  (epeg:colorspace-rgba8 "EPEG_RGBA8")
-  (epeg:colorspace-bgra8 "EPEG_BGRA8")
-  (epeg:colorspace-argb32 "EPEG_ARGB32")
-  (epeg:colorspace-cmyk "EPEG_CMYK"))
+  (colorspace-gray8 "EPEG_GRAY8")
+  (colorspace-yuv8 "EPEG_YUV8")
+  (colorspace-rgb8 "EPEG_RGB8")
+  (colorspace-bgr8 "EPEG_BGR8")
+  (colorspace-rgba8 "EPEG_RGBA8")
+  (colorspace-bgra8 "EPEG_BGRA8")
+  (colorspace-argb32 "EPEG_ARGB32")
+  (colorspace-cmyk "EPEG_CMYK"))
 
 ;;
@@ -123 +131 @@
 ;; It is in the Doxygen file, so we can assume it may be used nonetheless.
 ;;
-(define/img (epeg:colorspace-get img)
+(define/img (image-colorspace img)
   (let-location ([space int])
-    ((foreign-lambda void epeg_colorspace_get image (pointer int)) (epeg:image-ptr img) (location space))
+    ((foreign-lambda void epeg_colorspace_get image (pointer int)) (image-ptr img) (location space))
     space))
 
-(define/img (epeg:decode-colorspace-set! img space)
-  ((foreign-lambda void epeg_decode_colorspace_set image epeg:colorspace) (epeg:image-ptr img) space))
-
-(define/img (epeg:encode img)
-  (not ((foreign-lambda bool epeg_encode image) (epeg:image-ptr img))))
+(define/img (image-colorspace-set! img space)
+  ((foreign-lambda void epeg_decode_colorspace_set image colorspace) (image-ptr img) space))
+
+(define/img (image-encode img)
+  (not ((foreign-lambda bool epeg_encode image) (image-ptr img))))
 
 (define memerr? (foreign-lambda* bool ()
@@ -159 +167 @@
 ;; must be freed with epeg_pixels_free, BEFORE epeg_close is called on the
 ;; image.  This freeing can be taken care of by attaching a list of pixel
-;; info blocks to the epeg:image structure which is freed upon close.
+;; info blocks to the 'image' structure which is freed upon close.
 ;; The real question is, how to deal with this data in a safe and
 ;; userfriendly way?
@@ -184 +192 @@
           (make-property-condition 'epeg))))))
 
-#;(define/img (epeg:pixels-get img x y width height)
+#;(define/img (image-pixels-get img x y width height)
   (pixels-get-caller
    (foreign-lambda* (const c-pointer) ([image im]
@@ -193 +201 @@
                     "errno = 0;
                      return (epeg_pixels_get(im, x, y, w, h));")
-   'epeg:pixels-get
-   (epeg:image-ptr img) x y width height))
-
-#;(define/img (epeg:pixels-get-as-RGB8 img x y width height)
+   'image-pixels-get
+   (image-ptr img) x y width height))
+
+#;(define/img (image-pixels-get-as-RGB8 img x y width height)
   (pixels-get-caller
    (foreign-lambda* (const c-pointer) ([image im]
@@ -205 +213 @@
                     "errno = 0;
                      return (epeg_pixels_get_as_RGB8(im, x, y, w, h));")
-   'epeg:pixels-get-as-RGB8
-   (epeg:image-ptr img) x y width height))
-
-#;(define/img (epeg:pixels-free img pixels)
-  ((foreign-lambda void epeg_pixels_free image c-pointer) (epeg:image-ptr img) pixels))
-
-(define/img (epeg:comment-get img)
-  ((foreign-lambda c-string epeg_comment_get image) (epeg:image-ptr img)))
+   'image-pixels-get-as-RGB8
+   (image-ptr img) x y width height))
+
+#;(define/img (image-pixels-free img pixels)
+  ((foreign-lambda void epeg_pixels_free image c-pointer) (image-ptr img) pixels))
 
 ; Unused
 ;(define-foreign-type epeg-thumbnail-info (pointer "Epeg_Thumbnail_Info"))
 
-(define/img (epeg:thumbnail-comments-get img)
+(define/img (image-thumbnail-info img)
   (let ([thc-get
           (foreign-lambda* void ([image im]
@@ -232 +237 @@
     (let-location ([uri c-string] [width int] [height int] [mimetype c-string])
       (thc-get
-        (epeg:image-ptr img)
+        (image-ptr img)
         (location uri)
         (location width)
@@ -239 +244 @@
       (values uri width height mimetype))))
 
-(define/img (epeg:thumbnail-comments-enable img)
-  ((foreign-lambda void epeg_thumbnail_comments_enable image bool) (epeg:image-ptr img) #t))
-
-(define/img (epeg:thumbnail-comments-disable img)
-  ((foreign-lambda void epeg_thumbnail_comments_enable image bool) (epeg:image-ptr img) #f))
-
-(define/img (epeg:comment-set! img string)
-  ((foreign-lambda void epeg_comment_set image c-string) (epeg:image-ptr img) string))
+(define/img (image-comment-enable img)
+  ((foreign-lambda void epeg_thumbnail_comments_enable image bool) (image-ptr img) #t))
+
+(define/img (image-comment-disable img)
+  ((foreign-lambda void epeg_thumbnail_comments_enable image bool) (image-ptr img) #f))
+
+(define/img (image-comment img)
+  ((foreign-lambda c-string epeg_comment_get image) (image-ptr img)))
+
+(define/img (image-comment-set! img string)
+  ((foreign-lambda void epeg_comment_set image c-string) (image-ptr img) string))
 
 ; Integer values between 0 and 100
-(define/img (epeg:quality-set! img qual)
-  ((foreign-lambda void epeg_quality_set image int) (epeg:image-ptr img) qual))
-
-(define/img (epeg:file-output-set! img file)
-  ((foreign-lambda void epeg_file_output_set image c-string) (epeg:image-ptr img) file))
+(define/img (image-quality-set! img qual)
+  ((foreign-lambda void epeg_quality_set image int) (image-ptr img) qual))
+
+(define/img (image-file-output-set! img file)
+  ((foreign-lambda void epeg_file_output_set image c-string) (image-ptr img) file))
 
 ;
 ; Not really useful and perhaps a bit dangerous in Scheme
 ;
-#;(define/img (epeg:memory-output-set! img ptr size)
+#;(define/img (image-memory-output-set! img ptr size)
   ((foreign-lambda void epeg_memory_output_set image
                         (pointer byte-vector) (pointer int))
-   (epeg:image-ptr img) ptr size))
-
-#;(define (epeg:memory-open data size)
+   (image-ptr img) ptr size))
+
+#;(define (image-memory-open data size)
   (let ((img ((foreign-lambda image epeg_memory_open byte-vector int) data size)))
     (if img
-        (set-finalizer! (make-epeg:image img) epeg:collect)
+        (set-finalizer! (make-image img) gc-image)
         (abort
          (make-composite-condition
@@ -278 +286 @@
 ; Badly documented, no idea what it does.
 ;
-(define/img (epeg:trim img)
-  (not ((foreign-lambda bool epeg_trim image) (epeg:image-ptr img))))
+(define/img (image-trim img)
+  (not ((foreign-lambda bool epeg_trim image) (image-ptr img))))
+)

release/4/epeg/epeg.setup

@@ -1 @@
-(compile -s -O2 -d0 epeg.scm -L -lepeg)
+(compile -s -O2 epeg.scm -L -lepeg -j epeg)
+(compile -s -O2 epeg.import.scm)
 
 (install-extension 'epeg
-  '("epeg.so" "epeg.html")
-  '((version "2.1") (documentation "epeg.html")))
+  '("epeg.so" "epeg.import.so")
+  '((version 2.2)
+    (documentation "epeg.html")))