(define (gm-init-rooms gm rooms-spec)
"Initialize the prebuilt rooms"
- ;; @@: Would it be nicer to just allow passing in
- ;; #:exits to the room spec itself?
- (define (exit-from-spec exit-spec)
- "Take room exits syntax from the spec, turn it into exits"
- (match exit-spec
- ((name to-symbol desc)
- (make (@@ (mudsync room) <exit>)
- #:name name
- #:to-symbol to-symbol
- #:desc desc))))
-
(define rooms
(map
(match-lambda
((room-symbol room-class
- room-args ...
- (room-exits ...))
+ room-args ...)
;; initialize the room
(let ((room
(apply create-actor* gm room-class "room"
#:gm (actor-id gm)
- #:exits (map exit-from-spec (pk 'dem-exits room-exits))
room-args)))
;; register the room
(hash-set! (gm-room-dir gm) room-symbol room)
#:input input))
(define-mhandler (gm-lookup-room actor message symbol)
- (define room-id
- (slot-ref (gm-room-dir actor) symbol))
- (<-reply actor message room-id))
+ (<-reply actor message
+ #:room-id (hash-ref (slot-ref actor 'room-dir) symbol)))
(define-mhandler (gm-write-home actor message text)
(define client-id (hash-ref (gm-reverse-client-dir actor)
(define (make-default-room-conn-handler default-room)
"Make a handler for a GM that dumps people in a default room
with an anonymous persona"
+ (display "right before breakage?\n")
(let ((count 0))
(lambda (gm client-id)
(set! count (+ count 1))
#:username guest-name
#:gm (actor-id gm)
#:client client-id)))
+ (display "Are we broke yet?\n")
;; Register the player in our database of players -> connections
(gm-register-client! gm client-id player)
;; Dump the player into the default room
(set! (gameobj-loc actor) loc)
;; Change registation of where we currently are
(if loc
- (<- actor loc 'add-occupant! #:who (actor-id actor)))
+ (<-wait actor loc 'add-occupant! #:who (actor-id actor)))
(if old-loc
- (<- actor old-loc 'remove-occupant! #:who (actor-id actor))))
+ (<-wait actor old-loc 'remove-occupant! #:who (actor-id actor))))
(define gameobj-get-name (simple-slot-getter 'name))
(define gameobj-get-desc (simple-slot-getter 'desc))
(build-actions
(init (wrap-apply player-init!))
(handle-input (wrap-apply player-handle-input))
- (tell (wrap-apply player-tell))))
+ (tell (wrap-apply player-tell))
+ ;; @@: We really need to unify / make sensible this look stuff
+ (look-room (wrap-apply player-look-room))))
(define player-actions*
(append player-actions
(<- player (gameobj-gm player) 'write-home
#:text text))
+(define-mhandler (player-look-room player message)
+ (player-look-around player))
+
;;; player methods
(define-class <exit> ()
;; Used for wiring
- (to-symbol #:accessor exit-to-symbol
- #:init-keyword #:to-symbol)
+ (to-symbol #:init-keyword #:to-symbol)
;; The actual address we use
- (to-address #:accessor exit-to-address
- #:init-keyword #:address)
+ (to-address #:init-keyword #:address)
;; Name of the room (@@: Should this be names?)
- (name #:accessor exit-name
+ (name #:getter exit-name
#:init-keyword #:name)
- (desc #:accessor exit-desc
- #:init-keyword #:desc)
+ (desc #:init-keyword #:desc
+ #:init-value #f)
;; *Note*: These two methods have an extra layer of indirection, but
;; it's for a good reason.
(for-each
(lambda (exit)
(define new-exit
- (<-wait room (gameobj-gm room) 'lookup-room
- #:symbol (exit-to-symbol exit)))
+ (message-ref
+ (<-wait room (gameobj-gm room) 'lookup-room
+ #:symbol (slot-ref exit 'to-symbol))
+ 'room-id))
- (set! (exit-to-address exit) new-exit))
+ (slot-set! exit 'to-address new-exit))
(room-exits room)))
(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")))
-
+ (room-exits room)))
+ (cond
+ (exit
+ (<-wait room (message-from message) 'set-loc!
+ #:loc (slot-ref exit 'to-address))
+ (<- room (message-from message) 'look-room))
+ (else
+ (<- room (message-from message) 'tell
+ #:text "I don't know where that is?\n"))))
-(use-modules (mudsync))
+(use-modules (mudsync)
+ (oop goops))
;; MEDIAGOBLIN HQ
;; .-------------.--.--------.-----------.-----------.
Still, you have to admit that all the machines look pretty nice."
;; TODO: Allow walking around further in the dootacenter.
- ;;
- (("east" north-hallway
- ,wooden-unlocked-door))) ; eventually make this locked so you have
- ; to kick it down, joeyh style!
+ #:exits
+ ,(list (make <exit>
+ #:name "east"
+ #:to-symbol 'north-hallway
+ #:desc wooden-unlocked-door))) ; eventually make this locked so you have
+ ; to kick it down, joeyh style!
(north-hallway
,<room>
#:name "North hallway"
looking lawn.
The hallway continues to the south."
- (("west" server-room ,wooden-unlocked-door)
- ("east" code-a-plex ,metal-stiff-door)
- ("south" center-hallway #f)))
+ #:exits
+ ,(list (make <exit>
+ #:name "west"
+ #:to-symbol 'server-room
+ #:desc wooden-unlocked-door)
+ (make <exit>
+ #:name "east"
+ #:to-symbol 'code-a-plex
+ #:desc metal-stiff-door)
+ ;; (make <exit>
+ ;; #:name "south"
+ ;; #:to-symbol 'center-hallway)
+ ))
(code-a-plex
,<room>
There's a row of computer desks. Most of them have computers already on them,
But one looks invitingly empty."
- ((north-hallway
- "west" ,metal-stiff-door)))))
+ #:exits
+ ,(list (make <exit>
+ #:name "west"
+ #:to-symbol 'north-hallway
+ #:desc metal-stiff-door)))))
(define (goblin-demo . args)
(run-demo "/tmp/goblin-game.db" goblin-rooms 'north-hallway))
projects / mudsync.git / commitdiff