scale images using graphicsmagic

main.fnl

@@ -4,6 +4,7 @@
 (local cqueues (require :cqueues))
 (local url (require :net.url))
 (local unistd (require :posix.unistd))
+(local magick (require :graphicsmagick))
 
 (local server (require :server))
 (local textile  (require :textile))
@@ -35,6 +36,14 @@
            [ :month { :year (tonumber year) :month (tonumber month) } ]
            foo (print :fo foo)
            )
+        #(case (string.match $2 "^/static/images/(%g+)")
+           path
+           (let [{ : path : query } (url.parse path)
+                 w (case query.w
+                     "full" nil
+                     pixels (tonumber pixels)
+                     nil 1024)]
+             [ :image { : path :width w }]))
         #(case (string.match $2 "^/(static/%g+)")
            path
            [ :static { : path } ])
@@ -66,11 +75,18 @@
   (expect= (route-request :get "/2004/7/" route-matchers)
            [ :month {:year 2004 :month 7 } ])
 
-  (expect= (route-request :get "/static/cripslock.png" route-matchers)
-           [ :static {:path "/static/cripslock.png" } ])
+  (expect= (route-request :get "/static/cripslock.css" route-matchers)
+           [ :static {:path "static/cripslock.css" } ])
+
+  (expect= (route-request :get "/static/images/broken.png" route-matchers)
+           [ :image {:path "broken.png" :width 1024} ])
+  (expect= (route-request :get "/static/images/broken.png?w=42" route-matchers)
+           [ :image {:path "broken.png" :width 42} ])
+  (expect= (route-request :get "/static/images/broken.png?w=full" route-matchers)
+           [ :image {:path "broken.png" } ])
 
   (expect= (route-request :get "/static/README" route-matchers)
-           [ :static {:path "/static/README" } ])
+           [ :static {:path "static/README" } ])
 
   (expect= (route-request :get "/foo/static/README" route-matchers) nil)
   (expect= (route-request :get "foo/static/README" route-matchers) nil)
@@ -358,6 +374,22 @@ href=\"https://axillae.telent.net/\">@dan@axillae.telent.net</a>
   (let [n (tostring name)]
     (and (unistd.access n) n)))
 
+
+
+(fn write-scaled-image [path stream target-width]
+  (if target-width
+      (let [wand (magick.newMagickWand)
+            image (wand:readImage path)
+            w (wand:getImageWidth)
+            h (wand:getImageHeight)
+            target-height (// (* h target-width) w)]
+        (if (> w target-width)
+            (wand:scaleImage target-width target-height))
+        (stream:write_body_from_string (wand:writeImageBlob)))
+      (with-open [f (io.open path :r)]
+        (stream:write_body_from_file f))))
+
+
 (fn dispatch [route stream collection]
   (print (view route))
   (case route
@@ -373,6 +405,23 @@ href=\"https://axillae.telent.net/\">@dan@axillae.telent.net</a>
       (collection:refresh))
     [:month { : month : year }]
     (send-month-page stream collection year month)
+    [:image { : path : width }]
+    (let [path (/ (Path "static/images") path)
+          realpath
+          (or (existing-file (collection:static-file path))
+              (existing-file (/ cripslock-dir path)))]
+      (if realpath
+          (do
+            (server.headers stream
+                            { :content-type (content-type-for-path realpath) })
+            (write-scaled-image realpath stream width))
+          (do
+            (server.headers stream
+                            { :content-type "text/plain"
+                              ":status" "404"
+                              })
+            (stream:write_body_from_string "Not found"))))
+
     [:static { : path }]
     (let [realpath
           (or (existing-file (collection:static-file path))