blob: d03d2e3e682d7ef5777097fcb2928df87cb6c416 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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)
|