:addword :word2dic :addword2dic\r
:split-to-words :sprint\r
:parser :description :article :glance \r
- :initnames :addnames\r
- :read-property :read-property-string :read-property-number\r
- :read-property-integer :read-property-object :read-property-execute\r
- :read-property-other :read-property-list :exec :exec*\r
+ :initnames :addnames \r
+ :read-property :rp :read-property- \r
+ :exec :exec*\r
:abstractobject :name :names :parent :children :flags\r
- :initflags :add-flags :has :hasnt :-> :give\r
+ :initflags :add-flags :has :hasnt :-> :give :child\r
:ifclass :object :defaction :*meta*\r
- :move :rmv :ofclass :among\r
+ :move :rmv :ofclass :among :below\r
:verb :extend-verb :extend-verb-first\r
:extend-verb-only :extend-verb-only-first\r
:deftoken :string== :matchp :!last!\r
- :in :objectloop :provides\r
+ :in :notin :objectloop :provides\r
:wordlist :tokenlist\r
:nosuchword :nosuchword-word\r
:parse-command :unknown-verb :run-action :run-action-after\r
"make defvars for names"\r
`(progn\r
,@(loop for x in names\r
- collect `(defvar ,x))))\r
+ collect `(defvar ,x nil))))\r
\r
;;SECTION 2: Global parameters and definitions\r
\r
"Tests whether flag2 unsets flag1"\r
(let ((fl1 (symbol-name flag1))\r
(fl2 (symbol-name flag2)))\r
- (and (char= (aref fl2 0) #\~) (string= fl1 fl2 :start 1))))\r
+ (and (char= (aref fl2 0) #\~) (string= fl1 fl2 :start2 1))))\r
\r
(defun combine-flags (flaglist)\r
"Combine a list of flags into a _set_ of flags"\r
\r
(defun give (obj &rest flags) \r
"Informish synonim to add-flags." \r
- (setf (flags obj) (combine-flags (append (flags obj) flags))))\r
+ (setf (flags obj) (combine-flags (append (flags obj) flags))) nil)\r
\r
(defun has (obj &rest flags)\r
"Informish macro has. Unlike Inform, can accept several flags."\r
(not (intersection flags (flags obj))))\r
;(not (subsetp flags (flags obj))))\r
\r
+(defun child (obj)\r
+ "Returns the first child of the object"\r
+ (car (children obj)))\r
+\r
(defmethod parser ((obj abstractobject) words) \r
"Default parser. Really bad one."\r
(when (zerop (length words)) (return-from parser 0))\r
(glance (apply #'read-property-string (slot-value self property) args))\r
(t (slot-value self property))))\r
\r
+(defun read-property- (method self property &rest args)\r
+ "read-property using specific method. method is one of keywords:\r
+ :string :number :object :integer :execute :list"\r
+ (case method\r
+ (:string (apply #'read-property-string (slot-value self property) args))\r
+ (:number (apply #'read-property-number (slot-value self property) args))\r
+ (:integer (apply #'read-property-integer (slot-value self property) args))\r
+ (:object (apply #'read-property-object (slot-value self property) args))\r
+ (:execute (apply #'read-property-execute (slot-value self property) args))\r
+ (:list (apply #'read-property-list (slot-value self property) args))\r
+ (t (slot-value self property))))\r
\r
;;SECTION 7: IfClass macro and its hairy surroundings\r
\r
(defun notin (obj &rest what)\r
"Test whether the object is not in any of other arguments"\r
(notany (lambda (x) (eql (parent obj) x)) what))\r
- \r
+\r
+(defun below (obj1 obj2)\r
+ "Tests whether obj1 is strictly below obj2 in object structure"\r
+ (loop for x = obj1 then (parent x)\r
+ while x\r
+ when (eql x obj2) do (return t)\r
+ finally (return nil)))\r
+\r
;;SECTION 9: Verb functions\r
\r
(defstruct patternlist value)\r
;;React after?\r
t)\r
\r
-(defun run-action (action args &key (time 0))\r
+(defun run-action (action args &key (time 0) no-output)\r
"Run an action with a given args"\r
(unless (listp args) (setf args (list args)))\r
(setf *after* nil)\r
(let ((*action* action)\r
(*args* args)\r
(*noun* (first args))\r
- (*second* (second args)))\r
+ (*second* (second args))\r
+ (*no-output* no-output))\r
(when *debug* \r
(format t "[running action: ~a ~a]~%" *action* *args*))\r
(when *meta* ;;Just do the darn thing!\r