;;; File:
;;;   greeting.ss
;;; Version:
;;;   1.1 of September 2002
;;; Author:
;;;   Samuel A. Rebelsky
;;; Contents:
;;;   A simple example of some Scheme procedures for CGI
;;; Organization:
;;;   Preparation - Stuff I need to do to get started
;;;   Sam's HTML Helpers - Procedures for generating HTML
;;;   Page Generators - Procedures for generating specific kinds of
;;;     pages (when given particular values)
;;;   Interface - Stuff to extract important values and then
;;;     call the page generators.  You'll find (page) here.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Preparation

;;; Look!  We're going to use the CGI library.  What fun.
(require (lib "cgi.ss" "net"))

;;; Are we testing?
(define testing #f)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sam's HTML Helpers

;;; Procedure:
;;;   markup
;;; Parameters:
;;;   tag, the role that the text plays
;;;   text, some text to mark up
;;; Purpose:
;;;   Generates some nice happy HTML for me.
;;; Produces:
;;;   A string for HTML that represents the marked text.
;;; Preconditions:
;;;   Both parameters are strings.
;;;   The text is valid HTML.
;;;   The tag contains only alphanumeric characters and 
;;;     corresponds to a valid HTML tag.
;;; Postconditions:
;;;   You get some nice HTML.
(define markup 
  (lambda (tag text)
    (string-append "<" tag ">" text "</" tag ">")))

;;; Procedure:
;;;   heading
;;; Parameters:
;;;   level, a heading level (1-6)
;;;   text, some text to mark up
;;; Purpose:
;;;   Generates some nice happy HTML that represents the heading of
;;;   a section of text.
;;; Produces:
;;;   A string for HTML that represents the heading.
;;; Preconditions:
;;;   Level is an exact integer between 1 and 6, inclusive.
;;;   text is a string.
;;;   text is valid HTML.
;;; Postconditions:
;;;   You get some nice HTML which a normal browser displays
;;;   as a heading.
(define heading
  (lambda (level text)
    (markup (string-append "h" (number->string level)) text)))

;;; Procedure:
;;;   head
;;; Parameters:
;;;   title, the title of the page
;;; Purpose:
;;;   Generates some nice happy HTML that represents the head of
;;;   a page with a particular title.
;;; Produces:
;;;   A string for HTML that represents the head.
;;; Preconditions:
;;;   The title is a string with no internal HTML.
;;; Postconditions:
;;;   You get some nice HTML which a normal browser displays
;;;   as the titlebar of a window.
(define head
  (lambda (title)
    (markup "head" 
      (string-append
        "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=US-ASCII\">"
        (string #\newline)
        (markup "title" title)))))

;;; Procedure:
;;;   body
;;; Parameters:
;;;   contents, the intended contents of a page
;;; Purpose:
;;;   Generates some nice happy HTML that represents the body of
;;;   a page with a particular contents.
;;; Produces:
;;;   A string for HTML that represents the body.
;;; Preconditions:
;;;   contents is a string
;;;   contents represents valid, though partial, HTML
;;; Postconditions:
;;;   You get some nice HTML which you can join with a
;;;     head and some html tags to make a full page.
;;;   The result may contain carriage returns (newlines).
(define body
  (lambda (contents)
    (markup "body"
            (string-append (string #\newline)
                           contents 
                           (string #\newline)))))

;;; Procedure:
;;;   paragraph
;;; Parameters:
;;;   contents, the contents of the paragraph
;;; Purpose:
;;;   Generates some nice happy HTML that represents on paragraph.
;;;   Also to annoy the world with introductory comments that are
;;;     significantly longer than the procedure needs.
;;; Produces:
;;;   A string for HTML that represents the paragraph.
;;; Preconditions:
;;;   The contents is (are?) valid HTML with no block-level elements.
;;; Postconditions:
;;;   You get some nice HTML which a normal browser displays
;;;   appropriately.
(define paragraph
  (lambda (contents)
    (markup "p" contents)))

;;; Procedure:
;;;   paragraph
;;; Parameters:
;;;   head, the head of a page
;;;   body, the body of a page
;;; Purpose:
;;;   Shoves the head and the body together to make a page.
;;; Produces:
;;;   HTML for a full page.  Wow!
;;; Preconditions:
;;;   head was created by the head procedure
;;;   body was created by the body procedure
;;; Postconditions:
;;;   You get some nice HTML which a normal browser displays
;;;   appropriately.
(define make-page
  (lambda (head body)
    (string-append 
      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
      (string #\newline)
      "<html lang=\"en\">"
      (string #\newline)
      head
      (string #\newline)
      body
      (string #\newline)
      "</html>"
      (string #\newline)
    )
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Page Generators

;;; Procedure
;;;   greeting-page
;;; Parameters:
;;;   name, a string
;;; Purpose:
;;;   Generates an HTML page that can greet the named person.
;;; Produces:
;;;   A string that corresponds to that page.
;;; Preconditions:
;;;   The string must be nonempty.
;;; Postconditions:
;;;   The returned page is valid HTML.
(define greeting-page
  (lambda (name)
    (make-page 
      (head "Greetings")
      (body (string-append
              (heading 1 "Welcome")
              (string #\newline)
              (paragraph (string-append "Hi " name "!")))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Interface

;;; Value:
;;;   user
;;; Purpose:
;;;   Names the user.  Intended as input for greeting-page.
(define user 
  (if testing
      "Sam"
      (extract-binding/single 'user (get-bindings))))

;;; Procedure:
;;;   page
;;; Parameters:
;;;   None
;;; Purpose:
;;;   Builds an HTML page according to specifications.
;;; Produces:
;;;   A string that corresponds to the HTML page.
;;; Preconditions:
;;;   Variable "user" must be defined.
;;;   greeting-page must be definedk, take one parameter, and generate a page.
;;; Postconditions:
;;;   The returned page is as valid as anything greeting-page produces.
(define page
  (lambda ()
    (greeting-page user)))