projects
/
mudsync.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
8c357c8
)
We can finally move around!
author
Christopher Allan Webber
<cwebber@dustycloud.org>
Wed, 4 May 2016 03:31:18 +0000
(22:31 -0500)
committer
Christopher Allan Webber
<cwebber@dustycloud.org>
Wed, 4 May 2016 03:31:18 +0000
(22:31 -0500)
mudsync/game-master.scm
patch
|
blob
|
history
mudsync/gameobj.scm
patch
|
blob
|
history
mudsync/player.scm
patch
|
blob
|
history
mudsync/room.scm
patch
|
blob
|
history
worlds/goblin-hq.scm
patch
|
blob
|
history
diff --git
a/mudsync/game-master.scm
b/mudsync/game-master.scm
index 595a9032ee391b9dc1b29dc6e4b361750490ca92..732427850fc72b5e9601a112b95afd077b53cd01 100644
(file)
--- 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"
(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
(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)
;; 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)
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)
#: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-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"
(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))
(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)))
#: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
;; 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 351abe7c22a9094f0666938b73620f7669406ca9..37f8bfefa8d07ebb85be81a9e17705089703f2b8 100644
(file)
--- 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
(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
(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))
(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 3aa22873a257155d994c5aced4310f12738e3060..bf19a16a6b0e1a0a4716f70333cddaec2a757b8e 100644
(file)
--- 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))
(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
(define player-actions*
(append player-actions
@@
-93,6
+95,9
@@
(<- player (gameobj-gm player) 'write-home
#:text text))
(<- player (gameobj-gm player) 'write-home
#:text text))
+(define-mhandler (player-look-room player message)
+ (player-look-around player))
+
;;; player methods
;;; player methods
diff --git
a/mudsync/room.scm
b/mudsync/room.scm
index 4e5fd9e9e23909303b0fba8cbeed342bbe2741cc..5c93be3d5b615e666d789177b2cf1c4001b0a7e3 100644
(file)
--- a/
mudsync/room.scm
+++ b/
mudsync/room.scm
@@
-35,16
+35,14
@@
(define-class <exit> ()
;; Used for wiring
(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
;; 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 of the room (@@: Should this be names?)
- (name #:
accesso
r exit-name
+ (name #:
gette
r exit-name
#:init-keyword #: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.
;; *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
(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))
- (s
et! (exit-to-address exit)
new-exit))
+ (s
lot-set! exit 'to-address
new-exit))
(room-exits room)))
(room-exits room)))
@@
-120,10
+120,12
@@
claim to point to."
(find
(lambda (exit)
(equal? (exit-name exit) direct-obj))
(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 7f417da43255ddfa5f3f9fccd964223b23bcf38a..e0d9d8297a8ffcbce3fb469166e4123d68a38a99 100644
(file)
--- a/
worlds/goblin-hq.scm
+++ b/
worlds/goblin-hq.scm
@@
-1,4
+1,5
@@
-(use-modules (mudsync))
+(use-modules (mudsync)
+ (oop goops))
;; MEDIAGOBLIN HQ
;; .-------------.--.--------.-----------.-----------.
;; 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.
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"
(north-hallway
,<room>
#: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."
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>
(code-a-plex
,<room>
@@
-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."
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))
(define (goblin-demo . args)
(run-demo "/tmp/goblin-game.db" goblin-rooms 'north-hallway))