git @ Cat's Eye Technologies Robin / master eg / adventure.robin
master

Tree @master (Download .tar.gz)

adventure.robin @master — raw · history · 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
(require fun)
(require empty?)
(require bind-vals)

(define command (fexpr (args env)
  (list (head args) (eval env (head (tail args))))))

(reactor (line-terminal) (list 0 0)
  (fexpr (args env)
    (bind-vals ((event-type event-payload) (x y)) args
      (let ((state (list x y))
            (room-message (fun (x y)
              (append
                (literal ''You are in room #'')
                (list (add x 55) (add y 55)))))
            (move (fun (msg dx dy state)
              (let ((newx (add x dx))
                    (newy (add y dy))
                    (newstate (list newx newy)))
                (list newstate
                      (command writeln msg)
                      (command writeln (room-message newx newy))))))
            (dont-understand (fun (state)
              (list state (command writeln (literal ''Please enter n, s, e, or w, or q to quit.''))))))
        (choose
          ((equal? event-type (literal init))
            (list state (command writeln (literal ''Welcome to Not Quite an Adventure!''))
                        (command writeln (room-message x y))))
          ((equal? event-type (literal readln))
            (if (empty? event-payload)
              (dont-understand state)
              (bind letter (list (head event-payload))
                (choose
                  ((equal? letter (literal ''n''))
                    (move (literal ''North!'') 0 1 state))
                  ((equal? letter (literal ''s''))
                    (move (literal ''South!'') 0 (subtract 0 1) state))
                  ((equal? letter (literal ''e''))
                    (move (literal ''East!'') 1 0 state))
                  ((equal? letter (literal ''w''))
                    (move (literal ''West!'') (subtract 0 1) 0 state))
                  ((equal? letter (literal ''q''))
                    (list state (command writeln (literal ''Bye!'')) (command stop 0)))
                  (else
                    (dont-understand state))))))
           (else
             (list state)))))))