;****************************************************************************** ;* Module: VERB.BOA Version: 1.21 * ;* Last Update: Sept.29, 87 By: Bruce MacKay * ;* * ;* 29/09/87 LOOK IN * ;* 06/08/87 LIGHT and EXTINGUISH * ;* 13/10/87 (setp %dobject $invisible? nil) added * ;* to take - a basic-thing can now be invisible * ;* when the player enters the room. Problem - * ;* when it was taken, the command 'inventory' * ;* did not show the item! Now it does and it * ;* also shows it in the room, if it is dropped. * ;* 17/10/87 REMOVE added to verb TAKE * ;* * ;****************************************************************************** ;;; ;;; These routines do the basic object checking: making sure that the player ;;; can access the objects he is talking about, they then typically send a ;;; message to the direct object (v-read will send read, for example). The ;;; basic-thing class should handle the standard cases ("There's nothing on ;;; it to read!"), while special cases can be overridden by the specific ;;; objects (see obelisk/read in OBELISK.ADV). ;;; (action v-inventory (verb i inventory) (code (do-inv))) ;(action v-score ; (verb score) ; (code ; (do-score))) (action v-save (verb save) (code (save))) (action v-restore (verb restore) (code (restore))) (action v-restart (verb restart) (code (restart))) (action v-quit (verb quit) (code (print "Are you sure you want to quit? ") (if (yes-or-no) (progn (print "\nListen bub, this is really a fantastic adventure so I'll give you another chance. Do you really really really really want to quit? ") (if (yes-or-no) (progn (print "\n\nThankyou for playing Elves! \n\n") (print "Hit to exit. ") (if (yes-or-no) (exit) (exit))) (print "\nI didn't think you really wanted to quit!\n"))) (print "\nI didn't think you really wanted to quit!\n")))) (action v-go-north (verb north n (go north)) (code (send curloc go-north) (move north))) (action v-go-south (verb south s (go south)) (code (send curloc go-south) (move south))) (action v-go-east (verb east e (go east)) (code (send curloc go-east) (move east))) (action v-go-west (verb west w (go west)) (code (send curloc go-west) (move west))) (action v-go-northeast (verb northeast ne (go northeast)) (code (send curloc go-northeast) (move northeast))) (action v-go-northwest (verb northwest nw (go northwest)) (code (send curloc go-northwest) (move northwest))) (action v-go-southeast (verb southeast se (go southeast)) (code (send curloc go-southeast) (move southeast))) (action v-go-southwest (verb southwest sw (go southwest)) (code (send curloc go-southwest) (move southwest))) (action v-go-up (verb up u (go up)) (code (send curloc go-up) (move up))) (action v-go-down (verb down d (go down)) (code (send curloc go-down) (move down))) (action v-look (verb l look) (code (setq look_about? t) (setq long_desc? t))) (action v-take (verb take remove get (pick up) wear) (direct-object) (preposition from) (indirect-object optional) (code (setq %dobject (CanReach $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (if (> (Weight %dobject) CAPAC) (complain "The " $dobject " weighs much too much to carry!\n")) (if (= (class %dobject) integral-part) (complain "You can't take the " $dobject ". It seems to be attached!\n")) (if (IsIn? %dobject %actor) (complain "You are already carrying the " $dobject "!\n")) (if (and(< (SpaceIn %actor) (Weight %dobject)) (not (IsInRec? %dobject %actor))) (progn (print "You are carrying too much already!\n") (abort))) (take-it %actor %dobject) (setp %dobject $invisible? nil) (send %dobject take) (send %iobject take) (print-noun $dobject) (print " taken.\n"))) (action v-drop (verb drop (put down)) (direct-object) (code (setq %dobject (Holding $dobject)) (drop-it %actor %dobject) (print-noun $dobject) (print " dropped.\n"))) (action v-give (verb give) (direct-object) (preposition to) (indirect-object) (code (setq %dobject (Holding $dobject)) (setq %iobject (CanReach $iobject)) (if (not (= Floor (getp %iobject $onfloor?))) (complain "You don't see a " $iobject " here!\n")) (if (= (class %iobject) actor) (progn(send %iobject give %dobject) (send %dobject give %iobject) (complain "" $iobject " ignores your kind offer.\n")) (complain5 "You can't give " $dobject " to " $iobject "!\n")))) (action v-put (verb put place) (direct-object) (preposition in on) (indirect-object) (code (setq %dobject (Holding $dobject)) (setq %iobject (CanReach $iobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (if (not (= Floor (getp %iobject $onfloor?))) (complain "You don't see a " $iobject " here!\n")) (send %iobject put %dobject) (send %dobject put %iobject) (if (not (Opens? %iobject)) (Bizarre)) (if (not (Open? %iobject)) (complain "The " $iobject " is not open!\n ")) (if (= %iobject %dobject) (complain "You can't put the " $dobject " inside itself! ")) (if (< (SpaceIn %iobject) (Weight %dobject)) (complain5 "The " $dobject " won't fit in the " $iobject "!\n ")) (drop-it %actor %dobject) (take-it %iobject %dobject) (print "done.\n "))) (action v-open (verb open) (direct-object) (code (setq %dobject (CanReach $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (if (Open? %dobject) (complain "The " $dobject " is already open!\n ")) (if (not (Opens? %dobject)) (Bizarre)) (if (Locked? %dobject) (complain "The " $dobject " is locked! \n")) (if (= (class %dobject) portal) (Set-Open (getp %dobject $Pair) t)) (Set-Open %dobject t) (send %dobject open) (print "done.\n "))) (action v-close (verb close shut) (direct-object) (code (setq %dobject (CanReach $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (if (not (Opens? %dobject)) (Bizarre)) (if (not (Open? %dobject)) (complain "The " $dobject " is already closed!\n ")) (if (= (class %dobject) portal) (Set-Open (getp %dobject $Pair) nil)) (Set-Open %dobject nil) (print "done.\n "))) (action v-lock (verb lock) (direct-object) (preposition with) (indirect-object) (code (setq %dobject (CanReach $dobject)) (setq %iobject (Holding $iobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (if (not (= Floor (getp %iobject $onfloor?))) (complain "You don't see a " $iobject " here!\n")) (if (Locked? %dobject) (progn (complain "The " $dobject " is already locked!\n ") (abort))) (if (not (Locks? %dobject)) (progn (Bizarre) (abort))) (if (not (= %iobject (getp %dobject $key))) (progn (print "Nope! You need the right key.\n") (abort))) (progn(send %dobject lock %iobject) (print "Locked.\n") (setp %dobject $locked? T)))) (action v-unlock (verb unlock) (direct-object) (preposition with) (indirect-object) (code (setq %dobject (CanReach $dobject)) (setq %iobject (Holding $iobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (if (not (Locks? %dobject)) (progn (Bizarre) (abort))) (if (not (Locked? %dobject)) (progn (complain "The " $dobject " is already unlocked!\n ") (abort))) (if (not (= %iobject (getp %dobject $key))) (progn (print "Guess again, Sherlock!\n") (abort))) (progn(send %dobject unlock %iobject) (print "Unlocked.\n") (setp %dobject $locked? nil)))) ;(action v-eat ; (verb eat taste) ; (direct-object) ; (code ; (setq %dobject (Holding $dobject)) ; (send %dobject eat %iobject) ; (complain "You can't eat the " $dobject "!\n"))) (action v-drink (verb drink quaff eat) (direct-object) (code (setq %dobject (Holding $dobject)) (send %dobject drink %iobject) (complain "You can't eat or drink the " $dobject "!\n"))) (action v-light (verb light (turn on)) (direct-object) (code (setq %dobject (CanReach $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (send %dobject light %iobject) (complain "You can't light the " $dobject "!\n"))) (action v-extinguish (verb extinguish (turn off)) (direct-object) (code (setq %dobject (CanReach $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (send %dobject extinguish %iobject) (complain "You can't extinguish the " $dobject "!\n"))) ;(action v-rub ; (verb rub) ; (direct-object) ; (code ; (setq %dobject (CanReach $dobject)) ; (if (not (= Floor (getp %dobject $onfloor?))) ; (complain "You don't see a " $dobject " here!\n")) ; (send %dobject rub %iobject) ; (print "Nothing happens.\n"))) (action v-read (verb read) (direct-object) (code (setq %dobject (CanSee $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (progn (send %dobject read) (if (getp %dobject $RDESC) (print (getp %dobject $RDESC)) (progn (print "There's nothing on the ") (print-noun $dobject) (print " to read.\n")))))) (action v-examine (verb examine find search (l at) (look at) smell) (direct-object optional) (code (if $dobject (progn(setq %dobject (CanSee $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "There is no " $dobject " here!\n")) (if (getp %dobject $EDESC) (print (getp %dobject $EDESC)) (progn (print "There is nothing special about the ") (print-noun $dobject) (print ".\n")))) (if (getp (parent me) $EDESC) (print (getp (parent me) $EDESC)) (print "There is nothing special here.\n"))))) (action v-look-in (verb (l in) (look in)) (direct-object) (code (setq %dobject (CanSee $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (if (and (SeeIn? %dobject)(VisibleChild? %dobject)) (progn (print "The ") (print-noun $dobject) (print " contains:") (terpri) (desc-obj (Child %dobject) 2 0) (abort))) (if (= (class %dobject) mirror) (progn(print (getp mirror $EDESC)) (abort))) (if (not(Opens? %dobject)) (complain "You can't look in the " $dobject "!\n")) (if (setq %dobject (Open? %dobject)) (complain "The " $dobject " is empty.\n") (complain "The " $dobject " is closed.\n")))) (action v-tie (verb tie) (direct-object) (preposition to) (indirect-object) (code (setq %dobject (Holding $dobject)) (setq %iobject (CanReach $iobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (if (not (= Floor (getp %iobject $onfloor?))) (complain "You don't see a " $iobject " here!\n")) (send %dobject tie %iobject) (error5 "You can't tie the " %dobject " to the " %iobject ".\n"))) (action v-untie (verb untie) (direct-object) (code (setq %dobject (CanReach $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (send %dobject untie) (print "You can't untie that.\n"))) (action v-climb (verb climb) (direct-object) (code (setq %dobject (CanReach $dobject)) (if (not (= Floor (getp %dobject $onfloor?))) (complain "You don't see a " $dobject " here!\n")) (send %dobject climb)))