diff options
Diffstat (limited to 'main.scm')
| -rw-r--r-- | main.scm | 55 |
1 files changed, 29 insertions, 26 deletions
@@ -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?) |