listit/servlets/view.scm
;;; view.scm

(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")
  
  ;;;
  ;;; SITE WIDE DEFAULTS
  ;;;
  
  (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))))
  
  ;;;
  ;;; FRONT PAGE(S)
  ;;;
  
  (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)))))))
  
  ; html-redirect-page
  ;   a standard text to show, when redirecting
  (define (html-redirect-page body)
    (html-page #:title "Redirecting"
               #:body  body))
  
  )