parent
77cd3e0d28
commit
1e93e430ed
|
@ -319,7 +319,8 @@
|
||||||
(td "My spaceship's drive is ")
|
(td "My spaceship's drive is ")
|
||||||
(td (table ,@(table-radios drive-radios drives))))
|
(td (table ,@(table-radios drive-radios drives))))
|
||||||
(tr))
|
(tr))
|
||||||
,(make-submit-button "Submit choices")))))
|
,(make-submit-button "Submit choices"))
|
||||||
|
,(return-links main-return-link))))
|
||||||
|
|
||||||
;;; Size page HTML.
|
;;; Size page HTML.
|
||||||
(define (generate-size-page new-url update-text class size-input)
|
(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 ")
|
(tr (td "My ship is for a crew of ")
|
||||||
(td ,size-input)
|
(td ,size-input)
|
||||||
(td "people"))
|
(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.
|
;;; Text displayed if crew size is too big for the spaceship's class.
|
||||||
(define (complain-size class size)
|
(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:")
|
(p "Please specify the amount of energy you want to spent for your shields:")
|
||||||
(table (tr (td ,shield-input) (td "TJ"))))
|
(table (tr (td ,shield-input) (td "TJ"))))
|
||||||
'(h2 "Step 4 -- Done: No shields"))
|
'(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.
|
;;; Text displayed, if arms' energy is not positive.
|
||||||
(define positive-energy
|
(define positive-energy
|
||||||
|
@ -429,7 +432,8 @@ specify a positive number.")
|
||||||
extras))
|
extras))
|
||||||
(servlet-form ,new-url
|
(servlet-form ,new-url
|
||||||
POST
|
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.
|
;;; HTML page generator for the extras page.
|
||||||
;;; Shows a list of possible extras of this spaceship class for selection.
|
;;; Shows a list of possible extras of this spaceship class for selection.
|
||||||
|
@ -439,14 +443,15 @@ specify a positive number.")
|
||||||
(body
|
(body
|
||||||
(h2 "Step 5 -- Extras")
|
(h2 "Step 5 -- Extras")
|
||||||
(p "Select one or more extras that are available for
|
(p "Select one or more extras that are available for
|
||||||
spaceships of class " ,class)
|
spaceships of class " ,class ":")
|
||||||
(servlet-form ,new-url
|
(servlet-form ,new-url
|
||||||
GET
|
GET
|
||||||
(table ,@(map (lambda (checkbox+text)
|
(table ,@(map (lambda (checkbox+text)
|
||||||
`(tr (td ,(car checkbox+text))
|
`(tr (td ,(car checkbox+text))
|
||||||
(td ,(cdr checkbox+text))))
|
(td ,(cdr checkbox+text))))
|
||||||
checkboxes+text))
|
checkboxes+text))
|
||||||
,(make-submit-button "OK")))))
|
,(make-submit-button "OK"))
|
||||||
|
,(return-links main-return-link first-page-return-link))))
|
||||||
|
|
||||||
;;; HTML page generator.
|
;;; HTML page generator.
|
||||||
;;; Shows the final page with a "Thank you" and an estimate for the
|
;;; 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 ("
|
"We will contact you ("
|
||||||
,(host-name-or-ip (socket-remote-address (request-socket req)))
|
,(host-name-or-ip (socket-remote-address (request-socket req)))
|
||||||
") as soon as the ship is built.")
|
") 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
|
;; Helping functions
|
||||||
|
|
Loading…
Reference in New Issue