diff options
| -rw-r--r-- | main.scm | 68 |
1 files changed, 2 insertions, 66 deletions
@@ -4,6 +4,7 @@ (chicken process-context) (chicken irregex) (chicken condition) (chicken blob) spiffy intarweb uri-common html-parser spiffy-request-vars multipart-form-data sqlite3 sql-null + crypt srfi-69 ;hash tables srfi-1 ;list functions srfi-4 ;u8vector @@ -104,78 +105,13 @@ WHERE id = ? AND user_id = ? RETURNING parent_id" post-id current-user)) -;(define (top-posts) (map-row list db -; "SELECT id, user_id, content, created_at -; FROM posts -; WHERE parent_id IS NULL -; ORDER BY created_at DESC LIMIT 25")) - - (define (id p) (first p)) (define (user p) (second p)) (define (content p) (third p)) (define (created-at p) (fourth p)) (define (parent-id p) (fifth p)) (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) - (let-values - ([(fd file-path) (file-mkstemp "/tmp/image-temp.XXXXXX")]) - (file-write fd raw-img) - (file-close fd) - ((foreign-lambda void "setExifOrientation" nonnull-c-string unsigned-int) - file-path - orientation) - (let* - ([port (open-input-file file-path #:binary)] - [result (u8vector->blob/shared (read-u8vector #f port))]) - (delete-file file-path) - result))) - -(define dim-max 512) - -(define (target-dimensions width height) - ; case: both within limits -> return values - (if (and (> dim-max width) (> dim-max height)) - (values width height) - ; case: either larger -> scale largest down to limit, scale smallest down by same amount - (let* ( - [width-is-bigger (> width height)] - [big-dim (if width-is-bigger width height)] - [small-dim (if width-is-bigger height width)] - [scale-factor (quotient big-dim dim-max)] - [scaled-small-dim (quotient small-dim scale-factor)]) - (if width-is-bigger - (values dim-max scaled-small-dim) - (values scaled-small-dim dim-max) - )))) - -(define (img->jpeg-blob img) - (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) - ))) + (define users (alist->hash-table '(("lawrence" . "pw") ("demo" . "pw") ("dan" . "pw")))) |