(module view mzscheme
(provide (all-defined))
(require (lib "kw.ss")
(planet "42.ss" ("soegaard" "srfi.plt"))
(planet "html.scm" ("soegaard" "web.plt" 2 1))
(planet "web.scm" ("soegaard" "web.plt" 2 1))
"config.scm")
(override-default current-page-title "List it!")
(override-default current-page-header '(h1 ((class "page_header")) "List it!"))
(override-default current-page-style-sheet (format "http://localhost~a/stylesheet.css"
(if (= port 80) "" (format ":~a" port))))
(define (html-front-page page-number rank-of-first-entry entries)
(html-page
#:body `(div
,(html-menu)
,(html-list-of-entries page-number rank-of-first-entry entries))))
(define (html-menu)
`(a ((href "control.scm?action=submitnew")) "submit-new-link"))
(define (html-submit-new-page)
(html-page
#:title "List it! - submit"
#:header '(h1 "List it!")
#:body
`(div (h2 "Submit a new entry")
,(html-form
"submitnewform" "control.scm"
(html-input "action" #:value "submit" #:type 'hidden)
`(table (tr (td "url") (td ,(html-input "url" #:type 'text #:value "http://")))
(tr (td "title") (td ,(html-input "title" #:type 'text #:value "A title"))))
(html-input "submit" #:value "submit")))))
(define/kw (html-icon name #:key (class #f))
(define (icon-absolute-url name)
(format "/~a.png" name))
(if class
`(img ((class ,class) (src ,(icon-absolute-url name))))
`(img ( (src ,(icon-absolute-url name))))))
(define (html-list-of-entries page-number rank-of-first-entry entries)
`(div ((class "entries"))
,@(list-ec
(if (not (null? entries)))
(:list entry (index i) (cdr entries))
(:match #(id header url score) entry)
`(table ((class "entry"))
(tr (td ((class "rank")) ,(number->string (+ i rank-of-first-entry)))
(td ,(let ((form (format "arrowform~a" id)))
(html-form form "control.scm"
#:atts '((class "arrows"))
(html-input "arrowitem" #:type 'hidden)
(html-input "entry_id" #:type 'hidden #:value id)
(html-input "action" #:type 'hidden #:value "updown")
`(div ,(html-a-submit form "arrowitem" "up" (html-icon 'go-up #:class "arrow")))
(html-a-submit form "arrowitem" "down" (html-icon 'go-down #:class "arrow")))))
(td (div (a ((href ,url)) ,header))
(span ((class "score")) "score: " ,score)))))))
(define (html-redirect-page body)
(html-page #:title "Redirecting"
#:body body))
)