mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

start to improve dashboard handling of images

Browse Source
pull/9/head
Matthew Butterick 10 years ago
parent d47e9246b8
commit ca84dad697
3 changed files with 86 additions and 9 deletions
Show Stats Download Patch File Download Diff File

12
file-tools.rkt
Unescape Escape View File

@ -7,6 +7,18 @@
(module+ test (require rackunit))
;; for files like svg that are not source in pollen terms,
;; but have a textual representation separate from their display.
(define/contract (sourceish? x)
(any/c . -> . boolean?)
(define sourceish-extensions
(list "svg"))
(with-handlers ([exn:fail? (λ(e) #f)])
(->boolean ((get-ext x) . in? . sourceish-extensions))))
(module+ test
(check-true (sourceish? "foo.svg"))
(check-false (sourceish? "foo.gif")))
;; if something can be successfully coerced to a url,
;; it's urlish.

28
foobar/sample.svg
Unescape Escape View File

@ -0,0 +1,28 @@
<?xml version="1.0" encoding="utf-8"?>
<!-- Generator: Adobe Illustrator 15.1.0, SVG Export Plug-In . SVG Version: 6.00 Build 0) -->
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd" [
<!ENTITY st0 "fill:#231F20;">
]>
<svg version="1.1" id="Layer_1" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" x="0px" y="0px"
width="265.39453px" height="171.71484px" viewBox="0 0 265.39453 171.71484"
style="enable-background:new 0 0 265.39453 171.71484;" xml:space="preserve">
<path style="&st0;" d="M191.73047,71.71484v-4.39844c0-5.51562-0.89453-9.82812-2.6875-12.92969
c-1.80469-3.10547-6.29297-7.32812-13.46484-12.67188l-25.92578,21.45703l2.99219,3.78516
c3.26562-3.17188,5.71875-4.75391,7.34766-4.75391c1.55859,0,2.9375,1.05469,4.16406,3.16797
c1.79688,3.07812,2.69922,9.04688,2.69922,17.89453V145.5l-9.14844,8.71484l21.64844,17.5l21.52344-17.5L191.73047,145.5V77.83203
l20.80859-16.69531l10.77734,11.38281v66.73828c0,8.72656,0.96094,15.03906,2.875,18.95312
c1.92188,3.92188,6.26953,8.42188,13.04688,13.50391l26.15625-21.46094l-2.98828-3.78125
c-4.24609,3.16797-6.94531,4.75391-8.08203,4.75391c-1.30469,0-2.49609-0.85547-3.55078-2.57031
c-1.71484-2.60547-2.57422-6.61328-2.57422-11.99609V78.52344c0-6.28516,0.81641-11.22266,2.45703-14.81641
c1.23047-2.69141,4.72266-6.65234,10.46875-11.875l-3.47266-3.29297l-11.89062,11.46875l-16.65234-18.29297L191.73047,71.71484z
M91.78125,59.69922l9.14844,9.32812v68.05469c0,10.24609,0.9375,17.42578,2.8125,21.52734
c1.87891,4.10938,6.08203,8.47266,12.61328,13.10547L142.51562,150.5l-2.98828-3.78125
c-3.22656,2.68359-5.35938,4.30859-6.39062,4.87891c-0.73047,0.40234-1.53906,0.60156-2.42578,0.60156
c-1.24609,0-2.45703-1.05469-3.62891-3.16016c-1.17969-2.12109-1.75781-6.67188-1.75781-13.66797V69.02734l9.62891-9.32812
L113.3125,41.71484L91.78125,59.69922z M116.29688,26.34375h4.875L137.99609,0h-15.48438L116.29688,26.34375z M63.58984,89.44922
l-32.125,22.51172v-55.375l1.71094-0.84766L63.58984,89.44922z M25.97656,54.64062
c-5.04297,2.27734-11.37891,4.79688-19.02344,7.5625v69.75391c0,7.97266-0.46875,13.15625-1.40625,15.55859
C4.61719,149.91016,2.76172,151.91797,0,153.54688v3.05078c9.61328,2.03516,17.01562,3.98438,22.22656,5.85156
c5.21484,1.875,11.85156,4.96094,19.91016,9.26562l39.45312-27.5625l-2.68359-3.65625l-19.14453,13.05078l-28.29688-11.22266
v-22.19141l54.64062-38.29688L51.71094,41.71484C38.21094,48.625,29.63672,52.92969,25.97656,54.64062"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 2.5 KiB

55
server-routes.rkt
Unescape Escape View File

@ -79,14 +79,49 @@
(xexpr? . -> . tagged-xexpr?)
(body-wrapper `(tt ,x)))
(define/contract (bytecount->string bytecount)
(integer? . -> . string?)
(define (format-with-threshold threshold suffix)
;; upconvert by factor of 100 to get two digits after decimal
(format "~a ~a" (exact->inexact (/ (round ((* bytecount 100) . / . threshold)) 100)) suffix))
(define threshold-gigabyte 1000000000)
(define threshold-megabyte (threshold-gigabyte . / . 1000))
(define threshold-kilobyte (threshold-megabyte . / . 1000))
(cond
[(bytecount . > . threshold-gigabyte) (format-with-threshold threshold-gigabyte "GB")]
[(bytecount . > . threshold-megabyte) (format-with-threshold threshold-megabyte "MB")]
[(bytecount . > . threshold-kilobyte) (format-with-threshold threshold-kilobyte "KB")]
[else (format "~a bytes" bytecount)]))
(define/contract (make-binary-info-page path)
(complete-path? . -> . xexpr?)
(define-syntax-rule (when/splice test body) (if test (list body) '()))
(require 2htdp/image)
(define (handle-image-path p)
(pathish? . -> . xexpr?)
(define path (->complete-path p))
(define img (bitmap/file path))
(define relative-path (->string (find-relative-path PROJECT_ROOT path)))
(define img-url (format "/~a" relative-path))
`(div
(p "filename =" ,(->string relative-path))
(p "size = " ,(bytecount->string (file-size path)))
,@(when/splice (not (equal? (get-ext path) "svg"))
`(p "width = " ,(->string (image-width img)) " "
"height = " ,(->string (image-height img))))
(a ((href ,img-url)) (img ((style "width:100%")(src ,img-url))))))
(define/contract (make-binary-info-page p)
(pathish? . -> . xexpr?)
(define path (->complete-path p))
(cond
[((get-ext path) . in? . '("gif" "jpg" "jpeg" "png"))
`(div
(img ((src ,(path->string path))))
(p "path =" ,(path->string path)))]
[((get-ext path) . in? . '("gif" "jpg" "jpeg" "png" "svg"))
(handle-image-path path)]
[else '(p "We got some other kind of binary file.")]))
;; server routes
@ -102,7 +137,7 @@
(define/contract (out path)
(complete-path? . -> . xexpr?)
(cond
[(has-binary-ext? path) (make-binary-info-page path)]
[(or (has-binary-ext? path) (sourceish? path)) (make-binary-info-page path)]
[else (format-as-code (slurp path #:render #t))]))
(define route-out (route-wrapper out))
@ -146,6 +181,7 @@
(cond ; in cell
[(has-ext? filename POLLEN_TREE_EXT) (cons (format "in/~a" filename) "ptree")]
[source (cons (format "in/~a" source) "in")]
[(sourceish? filename) (cons (format "in/~a" filename) "in")]
[else empty-cell])
(cond ; out cell
@ -213,5 +249,6 @@
(module+ main
(parameterize ([current-directory (build-path (current-directory) "foobar")])
(reset-project-root)
(message PROJECT_ROOT)
(dashboard (build-path "poldash.html"))))
; (message PROJECT_ROOT)
; (make-binary-info-page (build-path "foo.gif"))
))
Write Preview
Loading…
Cancel
Save