(let ((room
(apply create-actor* gm room-class "room"
#:gm (actor-id gm)
- #:exits (map exit-from-spec room-exits)
+ #:exits (map exit-from-spec (pk 'dem-exits room-exits))
room-args)))
;; register the room
(hash-set! (gm-room-dir gm) room-symbol room)
(define player-actions
(build-actions
(init (wrap-apply player-init!))
- (handle-input (wrap-apply player-handle-input))))
+ (handle-input (wrap-apply player-handle-input))
+ (tell (wrap-apply player-tell))))
(define player-actions*
(append player-actions
(<- player (gameobj-gm player) 'write-home
#:text "Huh?\n"))))
+(define-mhandler (player-tell player message text)
+ (<- player (gameobj-gm player) 'write-home
+ #:text text))
+
;;; player methods
#:use-module (8sync systems actors)
#:use-module (8sync agenda)
#:use-module (oop goops)
+ #:use-module (srfi srfi-1)
#:export (<room>
room-actions
room-actions*
<exit>))
-;;; Rooms
+\f
+;;; Exits
;;; =====
(define-class <exit> ()
#:optional (target-actor (actor-id actor)))
((slot-ref exit 'traverse-check) exit actor target-actor))
+
+\f
+;;; Rooms
+;;; =====
+
(define %room-contain-commands
(list
(loose-direct-command "look" 'cmd-look-at)
(define-class <room> (<gameobj>)
;; A list of <exit>
(exits #:init-value '()
+ #:init-keyword #:exits
#:getter room-exits)
(container-commands
(define room-actions
(build-actions
;; desc == description
- (wire-exits! (wrap-apply room-wire-exits!))))
+ (wire-exits! (wrap-apply room-wire-exits!))
+ (cmd-go (wrap-apply room-cmd-go))))
(define room-actions*
(append room-actions gameobj-actions))
(room-exits room)))
+(define-mhandler (room-cmd-go room message direct-obj)
+ (define exit
+ (find
+ (lambda (exit)
+ (equal? (exit-name exit) direct-obj))
+ (pk 'later-exits (room-exits room))))
+ (if exit
+ (<- room (message-from message) 'tell
+ #:text "Yeah you can go there...\n")
+ (<- room (message-from message) 'tell
+ #:text "I don't know where that is?\n")))
+