projects
/
mudsync.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Document why the clerk-act-update-loop calls itself
[mudsync.git]
/
mudsync
/
thing.scm
diff --git
a/mudsync/thing.scm
b/mudsync/thing.scm
index 341371f7531dbccdd4de448b878524f5224e90da..762775d318a6a16a1ab85a2d65ab49c4c4e63654 100644
(file)
--- a/
mudsync/thing.scm
+++ b/
mudsync/thing.scm
@@
-28,25
+28,27
@@
#:use-module (ice-9 format)
#:export (<thing>
thing-commands
#:use-module (ice-9 format)
#:export (<thing>
thing-commands
+ thing-commands*
thing-contained-commands
thing-contained-commands
- thing-actions))
+ thing-contained-commands*
+ thing-actions
+ thing-actions*))
(define thing-commands
(list
(direct-command "take" 'cmd-take)))
(define thing-commands
(list
(direct-command "take" 'cmd-take)))
-;;; Are these kinds of things useful?
-;; ;; Doesn't inherit anything (gameobj has no commands)
-;; ;; so it's an alias.
-;; (define thing-commands* thing-commands)
+;; Doesn't inherit anything (gameobj has no commands)
+;; so it's an alias.
+(define thing-commands* thing-commands)
(define thing-contained-commands
(list
(define thing-contained-commands
(list
- (
empty
-command "drop" 'cmd-drop)))
+ (
direct
-command "drop" 'cmd-drop)))
-;;
;;
Doesn't inherit anything (gameobj has no contained-commands)
-;;
;;
so it's an alias.
-
;;
(define thing-contained-commands* thing-contained-commands)
+;; Doesn't inherit anything (gameobj has no contained-commands)
+;; so it's an alias.
+(define thing-contained-commands* thing-contained-commands)
(define thing-actions
(build-actions
(define thing-actions
(build-actions
@@
-77,12
+79,12
@@
#:init-value
(wrap-apply thing-dispatcher)))
#:init-value
(wrap-apply thing-dispatcher)))
-(define
-mhandler (thing-cmd-take thing message
direct-obj)
+(define
* (thing-cmd-take thing message #:key
direct-obj)
(define player (message-from message))
(define player-name
(define player (message-from message))
(define player-name
- (m
essage-ref
- (<-wait thing player 'get-name)
-
'val
))
+ (m
sg-val (<-wait thing player 'get-name)))
+ (define player-loc
+
(msg-val (<-wait thing player 'get-loc)
))
(define thing-name (slot-ref thing 'name))
(define should-take
(slot-ref-maybe-runcheck thing 'takeable player))
(define thing-name (slot-ref thing 'name))
(define should-take
(slot-ref-maybe-runcheck thing 'takeable player))
@@
-93,7
+95,7
@@
(<- thing player 'tell
#:text (format #f "You pick up ~a.\n"
thing-name))
(<- thing player 'tell
#:text (format #f "You pick up ~a.\n"
thing-name))
- (<- thing
(gameobj-loc thing)
'tell-room
+ (<- thing
player-loc
'tell-room
#:text (format #f "~a picks up ~a.\n"
player-name
thing-name)
#:text (format #f "~a picks up ~a.\n"
player-name
thing-name)
@@
-102,16
+104,12
@@
#:text (format #f "It doesn't seem like you can pick up ~a.\n"
thing-name))))
#:text (format #f "It doesn't seem like you can pick up ~a.\n"
thing-name))))
-(define
-mhandler (thing-cmd-drop thing message
direct-obj)
+(define
* (thing-cmd-drop thing message #:key
direct-obj)
(define player (message-from message))
(define player-name
(define player (message-from message))
(define player-name
- (message-ref
- (<-wait thing player 'get-name)
- 'val))
+ (msg-val (<-wait thing player 'get-name)))
(define player-loc
(define player-loc
- (message-ref
- (<-wait thing player 'get-loc)
- 'val))
+ (msg-val (<-wait thing player 'get-loc)))
(define thing-name (slot-ref thing 'name))
(define should-drop
(slot-ref-maybe-runcheck thing 'dropable player))
(define thing-name (slot-ref thing 'name))
(define should-drop
(slot-ref-maybe-runcheck thing 'dropable player))