introduce data structure for spaceship class' boundary data

scheme/httpd/surflets/web-server/root/surflets/spaceship.scm

@@ -4,7 +4,9 @@
 	servlets
 	let-opt
 	receiving
-	(subset srfi-13 (string-downcase)))
+	define-record-types
+	(subset srfi-13 (string-downcase))
+	(subset srfi-1 (find)))
 (begin
 
 ;;; Spaceship components
@@ -15,8 +17,25 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; DATA
-(define classes
-  '("Constitution" "Excelsior" "Ambassador" "Galaxy"))
+(define-record-type ship-data :ship-data
+  (make-ship-data class max-crew med-sections)
+  ship-data?
+  (class ship-data-class)
+  (max-crew ship-data-max-crew)
+  (med-sections ship-data-med-sections))
+
+(define ships
+  (map (lambda (data)
+	 (make-ship-data (list-ref data 0)
+			 (list-ref data 1)
+			 (list-ref data 2)))
+       ;; class-name		max-crew med-sections
+       '(("Constitution"	400	14) 
+	 ("Excelsior"		570	14) 
+	 ("Ambassador"		550	15) 
+	 ("Galaxy"		760	17))))
+
+(define classes (map ship-data-class ships))
 
 (define drives
   '("Impuls" "Warp"))
@@ -60,14 +79,21 @@
       (get-size req class)
     (resulting-page
      class
-     (and armed? (get-armed))
-     (and shields? (get-shields))
+     (and armed? (get-armed req class))
+     (and shields? (get-shields req class))
      drive
      size
      med-beds)))
 
-(define (get-armed) 13)
-(define (get-shields) 14)
+(define (get-armed req class . maybe-update-text)
+  (let-optionals maybe-update-text
+      ((update-text #f))
+    "nothing-done-yet"))
+    
+(define (get-shields req class . maybe-update-text)
+  (let-optionals maybe-update-text
+      ((update-text #f))
+    "nothing-done-yet"))
 
 (define (resulting-page class armed shields drive size med-beds)
   (send-html/finish
@@ -77,7 +103,7 @@
 	   (p "Your spaceship is of class " ,class
 	      " containing " ,size " crew members, "
 	      ,med-beds " treatment beds, "
-	      ,(and armed (list armed " armed,"))
+	      ,(and armed (list armed " armed, "))
 	      ,(and shields (list shields " shields"))
 	      " and has a " ,(string-downcase drive) " drive.")))))
 
@@ -113,28 +139,11 @@ fullfill UFP Spaceship Crew's Rights Act 023/1000285.0/AB")
 	(get-size req class "According to UFP Spaceship Crew Consistence Act 
 025/100030.2/BX there must be at least one person on each spaceship. Thus, please 
 specify a positive number.")
-	(cond
-	 ((string=? class "Constitution")
-	  (if (<= size 400)
-	      (values size 14)
-	      (get-size req class (complain class 400))))
-	 ((string=? class "Excelsior")
-	  (if (<= size 570)
-	      (values size 17)
-	      (get-size req class (complain class 570))))
-	 ((string=? class "Ambassador")
-	  (if (<= size 550)
-	      (values size 16)
-	      (get-size req class (complain class 550))))
-	 ((string=? class "Galaxy")
-	  (if (<= size 760)
-	      (values size 50)
-	      (get-size req class (complain class 760))))
-	 (else
-	  (get-size req class "Something is wrong. You cannot pass this point, sorry.")
-	  )))))
-;	 (send-html/finish
-;	  `(html (body "Done"))))
+	(let* ((ship (ship-ref class))
+	       (max-size (ship-data-max-crew ship) ))
+	  (if (<= size max-size)
+	      (values size (ship-data-med-sections ship))
+	      (get-size req class (complain class max-size)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Page generating
@@ -181,4 +190,9 @@ specify a positive number.")
 	     elem))
        list))
 
+(define (ship-ref name)
+  (find (lambda (ship) (string=? (ship-data-class ship) name))
+	ships))
+
   ))
+