blob: 5a1f3ab53a4b29b7700b4c2097e2c050eb9d6969 (
plain) (
tree)
|
|
;;; To make a labyrinth underneath sproul-plaza, say
;;; (instantiate labyrinth sproul-plaza)
;;; now go down from sproul to enter
;;; You might also want your character to maintain a list of rooms visited on
;;; its property list so you can find your way back to the earth's surface.
(define-class (labyrinth connect-place)
(instance-vars (places (make-populated-places 100 60 4 'underground-room)))
(initialize
(can-go connect-place 'down (car places))
(can-go (car places) 'up connect-place)
(connect-places places)
'okay))
;;; You may find this helpful for moving around
;;; You may want to modify it so that you can look around
;;; in nearby rooms before entering so that you can avoid thieves.
(define (fancy-move-loop who)
(newline)
(let ((things (ask who 'look-around)))
(if things
(begin (print "You see")
(for-each (lambda (thing)
(display thing)
(display " "))
things))))
(newline)
(print (ask who 'exits))
(display "? > ")
(let ((dir (read)))
(if (equal? dir 'stop)
(newline)
(begin (ask who 'go dir)
(fancy-move-loop who)))))
(define (make-places count name)
(define (iter n)
(if (> n count)
'()
(cons (instantiate place (word name '- n))
(iter (1+ n)) )))
(iter 1))
(define *object-types* '(gold lead pizza potstickers burritos))
(define (make-populated-places n-places n-objects n-thieves place-name)
(let ((places (make-places n-places place-name)))
(dotimes n-objects
(lambda (count)
(ask (pick-random places)
'appear
(instantiate thing (pick-random *object-types*)))))
(dotimes n-thieves
(lambda (count)
(instantiate thief
(word 'Nasty '- count)
(pick-random places))))
places))
(define direction-pairs '((north . south) (south . north)
(east . west) (west . east)
(up . down) (down . up)))
(define (connect-places places)
(for-each (lambda (place)
(connect-pair place (pick-random places)))
places))
(define (connect-pair place1 place2)
(define (c-p-helper place1 place2 dir-pairs)
(cond ((null? dir-pairs) 'done)
((and (can-connect? place1 (caar dir-pairs))
(can-connect? place2 (cdar dir-pairs)))
(can-go place1 (caar dir-pairs) place2)
(can-go place2 (cdar dir-pairs) place1))
(else (c-p-helper place1 place2 (cdr dir-pairs)))))
(c-p-helper place1 place2 direction-pairs))
(define (can-connect? place direction)
(not (member? direction (ask place 'exits))))
(define (dotimes limit f)
;; dotimes calls the procedure f on the numbers from 1 to the limit
;; dotimes is for side effect only
(define (dotimes-iter count)
(if (> count limit)
'done ;; dotimes is for side-effect
(begin (f count)
(dotimes-iter (1+ count)))))
(dotimes-iter 1))
|