feat: set exif orientation data on stored jpegs

1 files changed, 29 insertions, 26 deletions

diff --git a/main.scm b/main.scm
index acb9363..2dce9b0 100644
--- a/main.scm
+++ b/main.scm
@@ -1,5 +1,5 @@
 (import
-  scheme (chicken base)
+  scheme (chicken base) (chicken foreign)
   (chicken format) (chicken port) (chicken io) (chicken random) (chicken time)
   (chicken process-context) (chicken irregex) (chicken condition) (chicken blob)
   spiffy intarweb uri-common html-parser spiffy-request-vars multipart-form-data
@@ -138,9 +138,18 @@
 (define (children-count p) (sixth p))
 (define (has-image? p) (= 1 (seventh p)))
 
+(foreign-declare "#include \"exif_wrapper.h\"")
 
+(define (get-exif-orientation raw-img-vec)
+  ((foreign-lambda unsigned-int "getExifOrientation" u8vector unsigned-int)
+   raw-img-vec
+   (u8vector-length raw-img-vec)))
 
-
+(define (set-exif-orientation! raw-img orientation)
+  ((foreign-lambda void "setExifOrientation" blob unsigned-int unsigned-int)
+   raw-img
+   (blob-size raw-img)
+   orientation))
 
 (define dim-max 512)
 
@@ -161,29 +170,24 @@
       ))))
 
 (define (img->jpeg-blob img)
-  
-(with-output-to-file "/tmp/raw.jpg" (lambda () (display (blob->string (u8vector->blob img)))))
-
-
-  (let*-values ([(raw width height channels) (load-image img)]
-                [(target-width target-height) (target-dimensions width height)])
-(with-output-to-file "/tmp/test2.png"
-        (lambda ()
-          (write-png
-            raw
-            width
-            height
-            channels)
-          ))
-    (string->blob
-      (with-output-to-string
-        (lambda ()
-          (write-jpg
-            (image-resize raw width height channels target-width target-height)
-            target-width
-            target-height
-            channels)
-          )))))
+  (and img
+       (let*-values
+         ([(orientation) (get-exif-orientation img)]
+          [(raw width height channels) (load-image img)]
+          [(target-width target-height) (target-dimensions width height)]
+          [(resized-jpg)
+              (string->blob
+                (with-output-to-string
+                  (lambda ()
+                    (write-jpg
+                      (image-resize raw width height channels target-width target-height)
+                      target-width
+                      target-height
+                      channels)
+                    )))])
+         (set-exif-orientation! resized-jpg orientation)
+         resized-jpg
+         )))
 
 
 (define users (alist->hash-table '(("lawrence" . "pw") ("demo" . "pw") ("dan" . "pw"))))
@@ -238,7 +242,6 @@
                                   [target "_blank"]
                                   [rel "noreferrer"])
                                ,x)) (irregex-extract r content))])
-        (display `(,texts ,links))
         (define (go xs ys take-y?)
           (cond
             [(and (not (null-list? ys)) take-y?)