;;; 3e8 html utilities
(use matchable)
(require-library simple-xml)
(define doctype-html "")
;;; configurables
(define (home-link)
(link "http://3e8.org" "3e8.org"))
(define *categories*
'((home "/" "Home")
(photos "/gallery/" "Photos")
(hacks "/hacks/" "Hacks")
(music "/music/" "Music")
(writings "/writings/" "Writings")
(hits "/searches/" "Hits")
(zb "/zb/" "Scheme")
(about "/about/" "?")))
(define *subcategories*
'((brkout "/hacks/dc/" "Dreamcast")
(dc "/hacks/dc/" "Dreamcast")
(ultima6 "/hacks/ultima6/" "pu6e")))
(define *all-categories*
(append *categories* *subcategories*))
(define (blog-feed-uri) ;; must currently be relative URI, is used to write files
"/blog/atom10.xml")
;;; utils
;; URL
(define (link href . body)
`(a (@ (href ,href)) ,@body))
;; Entity
(define (& ent)
(xml-literal (sprintf "&~A;" ent)))
;; Suffix text with » -- useful for emphasizing links
(define (raquo text)
`(,text
,(& 'nbsp)
(span (@ (class "raquo"))
,(& 'raquo))))
(define (navbar selected)
`(div (@ (id "nav"))
(ul
,@(map (match-lambda
((id path title)
`(li (@ (id ,(conc "nav-" id))
,(if (eq? id selected)
`(class "selected")
'()))
(a (@ (href ,path)) (span ,title)))))
*categories*))))
(define (navskip)
`(p (@ (id "navskip"))
(a (@ (href "#content")) "Skip navigation.")))
(define (side-section title . body)
`((div (@ (class "sidetitle")) ,title)
(div (@ (class "side")) ,@body)))
(define (sidebar)
`(div (@ (id "sub"))
(div (@ (id "links"))
,(side-section "Deep Links"
`(ul (li (a (@ (href "http://api.call-cc.org/doc/")) "chickadee - Chicken API browser"))
(li (a (@ (href "/hacks/brkout/")) "brkout - DC breakout clone"))
(li (a (@ (href "/hacks/ultima6/")) "pu6e - Ultima 6 editor"))
(li (a (@ (href "/hacks/dc/")) "Dreamcast hacks"))
;; (li (a (@ (href "/gallery/Japan-2007/")) "Japan photos"))
(li (a (@ (href "/zb/")) "Zbigniew's Scheme page"))))
,(side-section "Shallow links"
`(ul (li (a (@ (href "https://github.com/ursetto/")) "Github repos"))
(li (a (@ (href "https://bitbucket.org/ursetto/")) "Bitbucket repos"))
(li (a (@ (href "http://theemptypen.wordpress.com/")) "The Empty Pen"))))
,(side-section "Feeds"
`(ul (li (a (@ (href "http://3e8.org" ,(blog-feed-uri))) "Atom 1.0"))))
,(side-section "3e8.org is" "Jim Ursetto")
,(side-section "Contact"
`(a (@ (href "https://twitter.com/jim3e8")) "@jim3e8"))
;; (div (@ (class "sidetitle") (id "validated")) "and I feel validated")
;; (div (@ (class "side") (id "validator"))
;; (ul
;; (li ,(link "http://validator.w3.org/check?uri=referer"
;; `(img (@ (src "/images/valid-xhtml10-blue.png")
;; (alt "Valid XHTML 1.0 Strict")
;; (height "31")
;; (width "88")))))
;; (li ,(link "http://jigsaw.w3.org/css-validator/check/referer"
;; `(img (@ (style "border:0;width:88px;height:31px")
;; (src "/images/vcss-blue.gif")
;; (alt "Valid CSS")))))))
)))
;; tables
(define (section name id . body)
`(div (@ (class "section")
(id ,id))
(h3 ,name)
(table ,@body)))
(define (program name . desc)
`(tr (td (@ (class "prog"))
,name)
(td (@ (class "desc"))
,@desc)))
;; Not used. L is a list of symbols abbreviating each language.
;; Would require: knowledge of our page filename, or a mod_rewrite rule.
(define (languages . L)
(define abbrs '((en . "English") (eo . "Esperanto")))
`(div (@ (class "language"))
(ul ,@(map (lambda (x)
(cond ((alist-ref x abbrs)
=> (cut list 'li <>))
(else '())))
L))))
;; Alternatively: have a path like '(hacks dreamcast) and automatically
;; generate the links and the 3e8.org >> hacks >> dreamcast text. However,
;; some pages have different names vs. filenames and some (like brkout)
;; are even colorful.
(define (call-resp path desc)
`(div (@ (class "call"))
(h1 ,(intersperse path
(list " " (& 'raquo) " ")))
(h2 ,desc)))
;; Create a path for call-resp. Symbols are looked up in *all-categories*
;; and the associated links and text are used. Everything else is inserted
;; verbatim. This weirdness is because the text, pathname, category path
;; and category name aren't always regular. Unfortunately, that also means
;; we can't derive regular paths.
;; Example use: (call-resp (category 'writings "Proverbs.e38") "Annoy roommate")
(define (category . cats)
(define (cat c)
(cond ((not (symbol? c)) c)
((alist-ref c *all-categories*)
=> (cut apply link <>))
(else c)))
(cons (home-link)
(map cat cats)))
;;; screenshots
(define (thumb url w h . alt)
(let ((alt (if (null? alt) '("screenshot") alt)))
`(img (@ (src ,url)
(width ,w)
(height ,h)
(alt ,@alt)))))
(define (shot url thumb desc #!optional (size #f))
`(div (@ (class "screenshot"))
,(link url thumb)
,(if size
`(p ,desc " "
(span (@ (class size)) "(" ,size ")"))
`(p ,desc))))
(define (screenshots . shots)
;; The empty div gives the screenshot contents mass (otherwise, they don't take up any space).
;; I feel this method is a kludge.
(define (mass-kludge)
`(div (@ (class mass-kludge))
,(& 'nbsp)))
`(div (@ (class "screenshots"))
,(mass-kludge)
,shots
,(mass-kludge)))
;;; page render
(define (main . body)
`(div (@ (id "content"))
(div (@ (id "main"))
,@body)
,(sidebar)))
(define (main1 . body) ;; single calumny
`(div (@ (id "content"))
(div (@ (id "main1"))
,@body)))
(define (xhtml-page title . body)
`(,(xml-literal doctype-html)
,(xml-comment "Generated with Chicken Scheme " (chicken-version))
(html (@ (lang "en") (id "3e8-org"))
(head (meta (@ (http-equiv "Content-Type")
(content "text/html; charset=utf-8")))
(meta (@ (name "description")
(content "Jim Ursetto's code, photos, music and writings.")))
(meta (@ (name "viewport")
(content "initial-scale=1")))
(title ,title)
(link (@ (rel "stylesheet")
(href "/css/screen.css")
(type "text/css")))
(link (@ (rel "stylesheet")
(href "/css/prettify.css")
(type "text/css")))
(link (@ (rel "alternate")
(href ,(blog-feed-uri))
(type "application/atom+xml")))
(script (@ (type "text/javascript")
(src "/js/prettify-bundle.js")))
)
(body (@ (onload "prettyPrint();"))
. ,body))))
(define (render-page title . body)
(print (xml (apply xhtml-page title body))))