; form.ss

; Copyright 2008 Christopher Michael Rasch
;
; This file is part of Wishforge.

; Wishforge is free software: you can redistribute it and/or modify
; it under the terms of the GNU Affero General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.

; Wishforge is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU Affero General Public License for more details.

; You should have received a copy of the GNU Affero General Public License
; along with Wishforge.  If not, see <http://www.gnu.org/licenses/>.

(module form mzscheme

  (provide (all-defined))	

  (define mk-mk-input
    (lambda (type)
      (lambda (s len)
	(let ([maxlen (number->string len)]
	      [szlen (number->string (- len 20))])
	  `(INPUT ((TYPE ,type) (NAME ,s) (MAXLENGTH ,maxlen) (SIZE ,szlen)))))))

  (define mk-input (mk-mk-input "text"))
  (define mk-passwd (mk-mk-input "password"))

  (define mk-text
    (lambda (s rows cols)
      `(TEXTAREA ((ROWS ,(number->string rows)) (COLS ,(number->string cols)) (NAME ,s)) ""))) ; empty string forces end tag

  (define input-text
    (lambda (prompt field)
      `(TR (TD ,prompt) (TD ,(mk-text field 6 60)))))

  (define input-line
    (lambda (prompt field)
      `(TR (TD ,prompt) (TD ,(mk-input field 80)))))

  (define drop-down-items
    (lambda (field items)
      (let ([mk-option (lambda (it)
			 (let ([txt (car it)]
			       [val (cadr it)])
			   (list `(OPTION ((VALUE ,val))) txt)))])
	`(TD (SELECT ((NAME ,field))
		     ,@(apply append (map mk-option items)))))))

  (define drop-down-line
    (lambda (prompt field items)
      `(TR (TD ,prompt) 
	   (TD ,(drop-down-items field items)))))

  (define auction-drop-down
    (lambda ()
      (drop-down-items "auction_length"
		       '(("3 days" "3") 
			("7 days" "7")
			("14 days" "14")))))

  (define hidden-line
    (lambda (field s)
      `(TR (TD "") 
	   (TD	(INPUT ((TYPE "hidden") (NAME ,field) (VALUE ,s)) "")))))

  (define passwd-line
    (lambda (prompt field)
       `(TR (TD ,prompt) (TD ,(mk-passwd field 80)))))
  
  (define mk-form-button 
    (lambda (s label len)
      `(INPUT ((TYPE "submit") (VALUE ,label) 
	       (NAME ,s) (MAXLENGTH ,(number->string len))))))

  (define submit-button
    (lambda ()
      `(TR (TD ((COLSPAN "2") (ALIGN "center"))
	       ,(mk-form-button "submit login" "Submit" 20)))))
  
)