Merge branch 'master' of tilde.institute:public_repos/lsp

2 files changed, 60 insertions, 1 deletions

diff --git a/dbc2.lsp b/dbc2.lsp
index afc3006..552bc44 100644
--- a/dbc2.lsp
+++ b/dbc2.lsp
@@ -15,6 +15,6 @@
   (let ((res (quotient (sum (mapcar #'abs values)) (length values))))
        ;; must ensure positive result
        (assert (>= res 0))
-       (assure <fixnum> res)))
+       (assure <float> res)))
 ;; (average-of-absolutes '(1 3))
 ;; (average-of-absolutes '())
diff --git a/guess.lsp b/guess.lsp
new file mode 100644
index 0000000..d03d2e3
--- /dev/null
+++ b/guess.lsp
@@ -0,0 +1,59 @@
+;;; gopherlib
+;;; Distantly descended from Perl code that is (c) 2001, 2004 Cameron Kaiser.
+(import "unix")
+
+(defconstant +tab-chr+ (convert 9 <character>))
+(defconstant +cr-chr+ (convert 13 <character>))
+
+(defun offer (type name resc server port extent)
+   (format (standard-output) "~C~A~C~A~C~A~C~D" type name +tab-chr+ resc +tab-chr+ server +tab-chr+ port)
+   (if (not (null extent))
+       (format (standard-output) "~C~A" +tab-chr+ extent))
+   (format (standard-output) "~C~%" +cr-chr+))
+
+(defun dirname (path)
+   (if (null (char-index #\/ path))
+       path
+       (for ((prev-slash 0 next-slash)
+             (next-slash 0 (char-index #\/ path (+ prev-slash 1))))
+            ((null next-slash) (subseq path 0 (+ prev-slash 1))))))
+
+(defun offer-file (type name resc server port extent)
+   (assure <character> type)(assure <string> name)(assure <string> resc)(assure <fixnum> port)
+   (if (null server)
+       (setq server (getenv "SERVER_HOST")))
+   (if (= port 0)
+       (setq port (convert (getenv "SERVER_PORT") <integer>)))
+   (if (and (> (length resc) 0) (char/= (elt resc 0) #\/))
+       (setq resc (string-append (dirname (getenv "SELECTOR")) resc)))
+   (offer type name resc server port extent))
+
+(defun print-string (msg)
+   (assure <string> msg)
+   (offer-file #\i msg "" "null.host" 1 nil))
+
+;;; Main program
+(defconstant +target+ 45)
+
+(defun try-guess (guess)
+   (cond ((< guess +target+)
+          (let ((str (create-string-output-stream)))
+               (format str "Your guess of ~A was too low." guess)
+               (print-string (get-output-stream-string str)))
+          (offer-file #\7 "Guess again." "guess.cgi" nil 0 nil))
+         ((= guess +target+)
+          (print-string "Congratulations, you won!"))
+         ((> guess +target+)
+          (let ((str (create-string-output-stream)))
+               (format str "Your guess of ~A was too high." guess)
+               (print-string (get-output-stream-string str)))
+          (offer-file #\7 "Guess again." "guess.cgi" nil 0 nil))))
+
+(defun main ()
+   (let ((guess-str (getenv "QUERY_STRING")))
+        (if (null guess-str)
+            (print-string "No guess supplied")
+            (try-guess (convert guess-str <integer>)))))
+
+(main)
+(quit)