From: Christopher Allan Webber Date: Tue, 3 May 2016 19:40:49 +0000 (-0500) Subject: gameobj refactor mostly working now X-Git-Tag: fosdem-2017~191 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=a841e7c04e355dd1d25c0c0a5a254bbd185cdc38;p=mudsync.git gameobj refactor mostly working now --- diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm index f839931..0abadb3 100644 --- a/mudsync/game-master.scm +++ b/mudsync/game-master.scm @@ -206,7 +206,7 @@ with an anonymous persona" ;; Register the player in our database of players -> connections (gm-register-client! gm client-id player) ;; Dump the player into the default room - (<-wait gm player 'set-loc! #:id room-id) + (<-wait gm player 'set-loc! #:loc room-id) ;; Initialize the player (<- gm player 'init))))) diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 6a5e369..ba0d829 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -42,10 +42,13 @@ (build-actions (get-commands (wrap-apply gameobj-get-commands)) (get-container-commands (wrap-apply gameobj-get-container-commands)) - (get-children (wrap-apply gameobj-get-children)) - (add-occupant! (wrap-apply gameobj-add-child!)) - (remove-occupant! (wrap-apply gameobj-remove-child!)) - (set-loc! (wrap-apply gameobj-set-loc!)))) + (get-occupants (wrap-apply gameobj-get-occupants)) + (add-occupant! (wrap-apply gameobj-add-occupant!)) + (remove-occupant! (wrap-apply gameobj-remove-occupant!)) + (set-loc! (wrap-apply gameobj-set-loc!)) + (get-name (wrap-apply gameobj-get-name)) + (get-desc (wrap-apply gameobj-get-desc)) + )) ;;; *all* game components that talk to players should somehow ;;; derive from this class. @@ -92,25 +95,48 @@ ;;; gameobj message handlers ;;; ======================== +;; Kind of a useful utility, maybe? +(define (simple-slot-getter slot) + (lambda (actor message) + (reply-message actor message + #:val (slot-ref actor slot)))) + (define-mhandler (gameobj-get-commands actor message verb) (<-reply actor message #:commands (slot-ref actor 'commands))) (define-mhandler (gameobj-get-container-commands actor message verb) (<-reply actor message #:commands (slot-ref actor 'container-commands))) -(define-mhandler (gameobj-get-children actor message) - (define children - (hash-map->list (lambda (key val) key) - (gameobj-children actor))) +(define-mhandler (gameobj-add-occupant! actor message who) + (hash-set! (slot-ref actor 'occupants) + who #t)) - (<-reply actor message - #:children children)) +(define-mhandler (gameobj-remove-occupant! actor message who) + (hash-remove! (slot-ref actor 'occupants) who)) -(define-mhandler (gameobj-set-loc! player message id) - (format #t "DEBUG: Location set to ~s for player ~s\n" - id (actor-id-actor player)) - (set! (gameobj-loc player) id)) +(define-mhandler (gameobj-get-occupants actor message) + (define occupants + (hash-map->list (lambda (key val) key) + (gameobj-occupants actor))) + (<-reply actor message + #:occupants occupants)) + +;; @@: Should it really be #:id ? Maybe #:loc-id or #:loc? +(define-mhandler (gameobj-set-loc! actor message loc) + (define old-loc (gameobj-loc actor)) + (format #t "DEBUG: Location set to ~s for ~s\n" + loc (actor-id-actor actor)) + + (set! (gameobj-loc actor) loc) + ;; Change registation of where we currently are + (if loc + (<- actor loc 'add-occupant! #:who (actor-id actor))) + (if old-loc + (<- 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)) (define (gameobj-simple-name-f gameobj) "Simplest version: return ourselves for our name."