From 4738c5ae39e26b65cdba3bec005bfe034c4ea2c2 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Tue, 3 May 2016 22:31:18 -0500 Subject: [PATCH] We can finally move around! --- mudsync/game-master.scm | 22 +++++----------------- mudsync/gameobj.scm | 4 ++-- mudsync/player.scm | 7 ++++++- mudsync/room.scm | 36 +++++++++++++++++++----------------- worlds/goblin-hq.scm | 36 ++++++++++++++++++++++++++---------- 5 files changed, 58 insertions(+), 47 deletions(-) diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm index 595a903..7324278 100644 --- a/mudsync/game-master.scm +++ b/mudsync/game-master.scm @@ -79,28 +79,15 @@ (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) ) - #: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) @@ -149,9 +136,8 @@ #: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) @@ -184,6 +170,7 @@ (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)) @@ -197,6 +184,7 @@ with an anonymous persona" #: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 diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 351abe7..37f8bfe 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -146,9 +146,9 @@ (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)) diff --git a/mudsync/player.scm b/mudsync/player.scm index 3aa2287..bf19a16 100644 --- a/mudsync/player.scm +++ b/mudsync/player.scm @@ -39,7 +39,9 @@ (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 @@ -93,6 +95,9 @@ (<- player (gameobj-gm player) 'write-home #:text text)) +(define-mhandler (player-look-room player message) + (player-look-around player)) + ;;; player methods diff --git a/mudsync/room.scm b/mudsync/room.scm index 4e5fd9e..5c93be3 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -35,16 +35,14 @@ (define-class () ;; 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. @@ -108,10 +106,12 @@ claim to point to." (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))) @@ -120,10 +120,12 @@ claim to point to." (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")))) diff --git a/worlds/goblin-hq.scm b/worlds/goblin-hq.scm index 7f417da..e0d9d82 100644 --- a/worlds/goblin-hq.scm +++ b/worlds/goblin-hq.scm @@ -1,4 +1,5 @@ -(use-modules (mudsync)) +(use-modules (mudsync) + (oop goops)) ;; MEDIAGOBLIN HQ ;; .-------------.--.--------.-----------.-----------. @@ -32,10 +33,12 @@ din. Who'd choose to work in such a place? 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 + #: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 , #:name "North hallway" @@ -45,9 +48,19 @@ and the curtains dance merrily in the wind. Outside appears to be a pleasant 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 + #:name "west" + #:to-symbol 'server-room + #:desc wooden-unlocked-door) + (make + #:name "east" + #:to-symbol 'code-a-plex + #:desc metal-stiff-door) + ;; (make + ;; #:name "south" + ;; #:to-symbol 'center-hallway) + )) (code-a-plex , @@ -59,8 +72,11 @@ now. 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 + #:name "west" + #:to-symbol 'north-hallway + #:desc metal-stiff-door))))) (define (goblin-demo . args) (run-demo "/tmp/goblin-game.db" goblin-rooms 'north-hallway)) -- 2.31.1