path: root/guess.lsp

;;; gopherlib
;;; Distantly descended from Perl code that is (c) 2001, 2004 Cameron Kaiser.
(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)