scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ add navigation links 

+ typo corrected
This commit is contained in:
interp 2002-12-02 08:58:24 +00:00
parent 77cd3e0d28
commit 1e93e430ed
1 changed files with 28 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
scheme/httpd/surflets/web-server/root/surflets/spaceship.scm
View File

@ -319,7 +319,8 @@
(td "My spaceship's drive is ")
(td (table ,@(table-radios drive-radios drives))))
(tr))
,(make-submit-button "Submit choices")))))
,(make-submit-button "Submit choices"))
,(return-links main-return-link))))
;;; Size page HTML.
(define (generate-size-page new-url update-text class size-input)
@ -337,7 +338,8 @@ fullfill UFP Spaceship Crew's Rights Act 023/1000285.0/AB")
(tr (td "My ship is for a crew of ")
(td ,size-input)
(td "people"))
(tr (td ,(make-submit-button))))))))
(tr (td ,(make-submit-button)))))
,(return-links main-return-link first-page-return-link))))
;;; Text displayed if crew size is too big for the spaceship's class.
(define (complain-size class size)
@ -379,7 +381,8 @@ specify a positive number.")
(p "Please specify the amount of energy you want to spent for your shields:")
(table (tr (td ,shield-input) (td "TJ"))))
'(h2 "Step 4 -- Done: No shields"))
,(make-submit-button "OK")))))
,(make-submit-button "OK"))
,(return-links main-return-link first-page-return-link))))
;;; Text displayed, if arms' energy is not positive.
(define positive-energy
@ -429,7 +432,8 @@ specify a positive number.")
extras))
(servlet-form ,new-url
POST
,(make-submit-button "Order now")))))
,(make-submit-button "Order now"))
,(return-links main-return-link first-page-return-link))))
;;; HTML page generator for the extras page.
;;; Shows a list of possible extras of this spaceship class for selection.
@ -439,14 +443,15 @@ specify a positive number.")
(body
(h2 "Step 5 -- Extras")
(p "Select one or more extras that are available for
spaceships of class " ,class)
spaceships of class " ,class ":")
(servlet-form ,new-url
GET
(table ,@(map (lambda (checkbox+text)
`(tr (td ,(car checkbox+text))
(td ,(cdr checkbox+text))))
checkboxes+text))
,(make-submit-button "OK")))))
,(make-submit-button "OK"))
,(return-links main-return-link first-page-return-link))))
;;; HTML page generator.
;;; Shows the final page with a "Thank you" and an estimate for the
@ -460,7 +465,23 @@ spaceships of class " ,class)
"We will contact you ("
,(host-name-or-ip (socket-remote-address (request-socket req)))
") as soon as the ship is built.")
(p "This will take about " ,months " months."))))
(p "This will take about " ,months " months.")
,(return-links main-return-link first-page-return-link))))
(define main-return-link
'(URL "/" "Return to main menu."))
(define (previous-page-return-link prev)
`(URL ,prev "Return to previous page."))
(define first-page-return-link
'(URL "/servlet/spaceship.scm" "Return to spaceship builder entry page."))
(define (return-links . links)
`(p
(hr)
,@(map (lambda (link) (list link '(br)))
links)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helping functions