;******************************************************************************
;                               QUEST.DEF
;
; This file contains the object class definitions needed by Quest.
;
; PLEASE NOTE: In the methods below the term "self" does not refer to the 
; adventurer! Instead it refers to the object being defined. For example
; if we said: (send skeleton vanish) all references to "self" in the "vanish"
; method refer to the skeleton, not the adventurer.
;
;                        PARENT, CHILD, and the SIBLING CHAIN
;
; Rooms and containers can both "contain" other objects. They have a CHILD
; property which says which item the room or container holds. Likewise all
; objects have a PARENT property which indicates which room or container holds
; them.
;
; All objects also have a SIBLING property. Because an object can't hold more 
; than one item the first item held by a room or container uses the SIBLING
; property to point to the next object held by the parent.
;
; Thus the contained objects form a chain, linked by the SIBLING property.
; When adding or removing items to a sibling chain you have to be careful not
; to break the chain, or things get misplaced!
;
;*****************************************************************************

;-----------------------------------------------------------------------------
;                               basic-thing
;
; The "basic-thing" super-class is a fundamental object, meaning it uses the 
; most basic object definition.  The BASIC-THING super-class is used only as
; a building block for more complex classes. It lets us define properties 
; and methods that more complex objects can inherit. Of course many methods
; are simply empty shells intended to simplify programming.
;
; Methods: put-self-in obj          - How to put self in object/location
;          vanish                   - how to vanish
;          knock? obj               - shell for Location class
;          enter obj                - shell for Location class
;          leave obj dir            - shell for Location Class
;          how-hear                 - How object emits sound.
;          how-smell                - How you smell the object
;          describe                 - How object describes itself
;          open                     - shell for Portal & Container classes
;          close                    - shell for Portal & Container classes
;          exchange                 - shell for Actor class
;          lock thekey              - shell for Portal & Container classes
;          unlock thekey            - shell for Portal & Container classes
;          move dir                 - shell for Actor class
;          take obj                 - shell for Actor class
;          drop obj                 - How object drops items
;          carrying? obj            - Does object contain item?
;          inventory                - Object lists it's own contents
;          turn-on                  - shell for flashlight
;          turn-off                 - shell for flashlight
;          effective-ac             - shell for Monster class
;          effective-TH0            - shell for Monster class
;          say-hit                  - shell for Monster class
;          say-missed               - shell for Monster class
;          wounded damage           - shell for Monster class
;          attack target roll ld hd - shell for Monster class
;          attack-adventurer        - shell for Monster class
;          travel                   - shell for Monster class
;          drain                    - shell for battery class objects
;          total-value              - object's value
;          ele                      - shell for phial
;          elentari                 - shell for phial
;          fill-self                - shell for phial
;          nirna-zap                - shell for mandala
;          wave-self                - How to wave object
;          move-self                - shell for Thing class
;          content-weight           - the weight of the object's contents
;          total-weight             - the weight of the object + contents
;
;-----------------------------------------------------------------------------

(object basic-thing
  (property                                ; Properties
    parent nil                             ; Parent of object
    sibling nil                            ; sibling of object
  )                                        ; EPROPERTY
  
;-------------------
; Put-Self-In Method
;-------------------
;
; This method places the object inside another object. Be sure the object in
; question has a PARENT property, otherwise things will get very sticky...

  (method (put-self-in obj)                ; How to put self in object/location
    (setp self parent obj)                 ; Set PARENT to object
    (setp self sibling (getp obj child))   ; Set SIBLING to object's child
    (setp obj child self)                  ; Set object's CHILD to self
  )                                        ; EMETHOD

;--------------
; Vanish Method
;--------------
;
; This method makes self disappear from the game world, in effect the object
; has no parent, is contained by nothing, and thus appears nowhere.

  (method (vanish &aux this prev)          ; how to vanish
    (setq this (first-sibling self))       ; get first child in sibling chain
    (setq prev nil)                        ; no previous sibling yet
    
    (while this                            ; for each child in chain
      (if (= this self)                    ;   current object self?
	(progn                             ;     Yes, BEGIN...
	  (if prev                         ;       Is there a previous child in chain?
	    (setp prev sibling (getp this sibling)); Yes, PREV sibling=THIS sibling
	    (setp (getp this parent) child (getp this sibling)); No, THIS parent's child=THIS sibling
	  )                                ;       EIF Previous Child
	  (setp this parent nil)           ;       THIS parent=NIL
	  (setq this nil)                  ;       Force loop to end
	)                                  ;     EBEGIN Yes
	(progn                             ;   No, Begin...
	  (setq prev this)                 ;     PREV=self
	  (setq this (getp this sibling))  ;     Next sibling...
	)                                  ;   EBegin No
      )                                    ; EIF THIS=OBJ
    )                                      ; EWHILE
  )                                        ; EMETHOD

;-------------
; Knock Method
;-------------

; Can OBJ enter this object? Most objects won't allow this action

  (method (knock? obj2)                     ; Can object enter?
    (nil)                                  ; No
  )                                        ; EMETHOD

;-------------
; Enter Method
;-------------
  
; How OBJ enters this object. (It can't).

  (method (enter obj)                   ; How to enter this object (loc)
    (print "You can't put the ")        ; Start the complaint
    (print-noun $IOBJECT)               ; print the indirect object name
    (complain " into the " $DOBJECT ".") ; finish complaint.
  )                                     ; EMETHOD

;-------------
; Leave Method
;-------------

; How obj leaves this item in a given direction (It doesn't)

  (method (leave obj dir &aux loc)      ; How to leave this object
    nil                                 ; Return nil (to indicate failure)
  )                                     ; EMETHOD

;----------------
; How-Hear Method
;----------------

; How does the object emit a sound? (Most don't).

  (method (how-hear)                    ; How you hear something in loc
    (complain "The " $DOBJECT " isn't making a sound.\n")
  )                                     ; EMETHOD

;-----------------
; How-Smell Method
;-----------------

; How does the object smell? (Most don't)

  (method (how-smell)                   ; How you smell something in loc
    (complain "The " $DOBJECT " has no odor.\n")
  )                                     ; EMETHOD

;----------------
; Describe Method
;----------------

; How an object describes itself. If there's a DEF-MSG property, use that,
; otherwise complain it looks like an ordinary whatever.

  (method (describe)                    ; How object describes itself
    (if (getp obj def-msg)              ; Have definition?
      (progn                            ;   Yes, BEGIN
	(print (getp obj def-msg))      ;     print message
	(terpri)                        ;     cr/lf
	(abort)                         ;     description only takes seconds
      )                                 ;   EBEGIN
      (complain "Looks like an ordinary  " $dobject " to me.\n"); No, 
    )                                   ; EIF
  )                                     ; EMETHOD

;------------
; Open Method
;------------

; How to open the item (most can't be).

  (method (open)                        ; How to open the item
    (complain "You can't open the " $dobject "!\n")
  )                                     ; EMETHOD
  
;-------------
; Close Method
;-------------

; How to close the item (most can't be).

  (method (close)                       ; How item is closed
    (complain "You can't close the " $dobject "!\n")
  )                                     ; EMETHOD
  
;----------------
; Exchange Method
;----------------

; How item does an exchange (most don't).

  (method (exchange)                    ; Item initiates exchange
    nil                                 ; Most can't
  )                                     ; EMETHOD

;------------
; Lock Method
;------------

; How item locks itself.

  (method (lock thekey)                 ; lock the item
    (complain "The " $DOBJECT " doesn't have a lock!")
  )                                     ; EMETHOD

;--------------
; Unlock Method
;--------------

; How item unlocks itself.

  (method (unlock thekey)               ; Unlock portal
    (complain "The " $DOBJECT " doesn't have a lock!")
  )                                     ; EMETHOD

;------------
; Move Method
;------------

; How item moves around. Most don't, but it's a short method so there's no 
; harm giving the ability to everything. Other code still has to invoke the
; method.

  (method (move dir)                    ; How to Move in direction DIR
    (send (getp self parent) leave self dir); Send parent leave command
  )                                     ; EMETHOD

;------------
; Take Method
;------------

; Most objects can't take an object (this requires a sentient to understand
; and take the object. Since most items (like a ring, for instance) can't,
; we simply complain.

  (method (take obj)                    ; How to take an object
    (nil)                               ; No, does nothing.
  )                                     ; EMETHOD

;------------
; Drop Method
;------------

; It doesn't take brains to drop something (a vending machine, for instance)
; so all items have the potential.

  (method (drop obj)                    ; How to drop an object
    (setq obj (getp self child))        ; make sure OBJ set to contents
    (if obj                             ; Object contains something?
      (progn                            ; Yes, BEGIN
	(send obj vanish)               ; Make it vanish
	(send obj put-self-in (getp self parent)); Connect it to self's parent
      )                                 ; EBEGIN
    )                                   ; EIF
  )                                     ; EMETHOD

;-----------------
; Carrying? Method
;-----------------

; This function returns T or Nil. It tests to see if the object being tested
; has a parent of self--in other words is the object directly inside self.
; Note this function returns false if the item is inside an item inside self.
; In other words, this function is only good for 1 deep containment.

  (method (carrying? obj)               ; Carrying object?
    (= (getp obj parent) self)          ; Is object parent's self? (T/nil)
  )                                     ; EMETHOD

;---------------------
; List-Contents Method
;---------------------
;
; Arguments: prop - property to list
;            lev  - level down (for objects within objects within objects...)
;
; Local Variables: desc - work variable to hold descriptive property
;                  l    - while loop counter
;
; List the contents of an object (used for "inventory")

  (method (list-contents obj prop lev)    ; Function List-Contents
;   (setq obj (getp obj child))           ; OBJ=object's child
    (while obj                            ; while we have an ojbect...
      (if (setq desc (getp obj prop))     ; Is there something to print?
	(progn                            ; Yes, BEGIN...
	  (setq l (* lev 4))              ; L=LEV*4
	  (indent l)                      ; indent the description
	  (print desc)                    ; Print the description
	  (terpri)                        ; Terminate print line
	  (if (and (getp obj child) 
		   (or (getp obj transparent)
		       (not (getp obj closed))))  ; If contains & open or transparent...
	    (progn                        ; BEGIN
	      (print "The ")              ; print the
	      (print (getp obj prop))     ; short description
	      (print " contains:\n")      ; print contains
	      (send obj list-contents prop (+ lev 1)); print object's contents (recursive call)
	    )                             ; END
	  )                               ; EIF
	)                                 ; END
      )                                   ; EIF
      (setq obj (next-sibling obj))       ; Next object in sibling chain...
    )                                     ; EWHILE
  )                                       ; EMETHOD

;-----------------
; Inventory Method
;-----------------

; The inventory method lets an item list it's own contents (The actor class
; defines things a bit differently).

  (method (inventory)                   ; How to list contents
    (if (getp self child)             ; Has a child?
      (progn                            ;   Yes, Begin        
	(print "The ")                  ;     The
	(print (getp self short-description)); name of self
	(print " contains:\n")          ;     contains
	(send self list-contents self short-description 1); List item's inventory
      )                                 ;   EBEGIN (has a child)
      (progn                            ;   No, Begin
	(print "The ")                  ;     The
	(print (getp self short-description)); name of item
	(print " is empty.\n")           ;     Is empty
      )                                 ;   EBEGIN
    )                                   ; EIF has child
  )                                     ; EMETHOD

;---------------
; Turn-On Method
;---------------

; Most objects can't be turned on.

  (method (turn-on)                     ; How to turn on object
    (complain "You can't turn on the " $DOBJECT "!\n"); can't
  )                                     ; EMETHOD

;----------------
; Turn-Off Method
;----------------

; Most objects can't be turned off.

  (method (turn-off)                    ; How to turn off object
    (complain "You can't turn the " $DOBJECT " off!\n"); Can't
  )                                     ; EMETHOD

;--------------------
; Effective-AC Method
;--------------------

; Most objects don't have an AC (AC 0 since nil is 0)


  (method (effective-ac)                ; Effective AC
    nil                                 ; normally none
  )                                     ; EMETHOD

;---------------------
; Effective-TH0 Method
;---------------------

; Most objects don't have an TH0 (TH0 is 0 since nil is 0)

  (method (effective-TH0)               ; Effective TH0
    nil                                 ; normally none
  )                                     ; EMETHOD

;---------------
; Say-Hit Method
;---------------

; Most objects don't say anything if they hit player since most don't.

  (method (say-hit)                     ; What says when hits player
    nil                                 ; normally nothing
  )                                     ; EMETHOD
  
;---------------
; Say-Hit Method
;---------------

; Most objects don't say anything if they miss player since most don't.

  (method (say-missed)                  ; What says when misses player
    nil                                 ; normally nothing
  )                                     ; EMETHOD
  
;---------------
; Wounded Method
;---------------

; Most objects don't get wounded.

  (method (wounded damage)              ; How reacts to wounds
    nil                                 ; normally doesn't
  )                                     ; EMETHOD
  
;--------------
; Attack Method
;--------------

; Most objects don't attack.

  (method (attack target roll-needed ld hd); How item attacks
    nil                                 ; normally doesn't
  )                                     ; EMETHOD

;-------------------------
; Attack-Adventurer Method
;-------------------------

; Most objects don't attack.

  (method (attack-adventurer)           ; item attacks player
    nil                                 ; doesn't
  )                                     ; EMETHOD

;-------------------------
; Attack-Adventurer Method
;-------------------------

; Most objects don't attack.

  (method (travel)                      ; How item travels
    nil                                 ; normally doesn't
  )                                     ; EMETHOD
  
;-------------
; Drain Method
;-------------

; Most items can't be drained (of energy, water, whatever).

  (method (drain)                       ; drain object?
    nil                                 ; most have nothing to drain
  )                                     ; EMETHOD

;-------------------
; Total-Value Method
;-------------------

; Most items simply return their own value (not their contents value!)
; Only the horde returns the value of it's contents.

  (method (total-value)                 ; object's combined value
    (getp self value)                   ; return object's value
  )                                     ; EMETHOD

;-----------
; Ele Method
;-----------

; Most items simply ignore this request, since it's given by an action verb.
; The filled phial reacts by dimming.

  (method (ele)                         ; How to ELE
    (nil)                               ; can't
  )                                     ; EMETHOD

;----------------
; Elentari Method
;----------------

; Most items simply ignore this request, since it's given by an action verb.
; The filled phial reacts by brightening.

  (method (elentari)                    ; How to ELENTARI
    (nil)                               ; can't
  )                                     ; EMETHOD

;-----------------
; Fill-Self Method
;-----------------

; Most items simply ignore this request, since it's given by an action verb.
; The phial can be filled. It has it's own method.


  (method (fill-self)                   ; How to fill object
    (complain "The " $DOBJECT " can't be filled.")
  )                                     ; EMETHOD

;-----------------
; Nirna-Zap Method
;-----------------

; Most items simply ignore this request, since it's given by an action verb.
; The mandala reacts, it has it's own method.

  (method (nirna-zap)                   ; How to nirnaa
    (nil)                               ; can't
  )                                     ; EMETHOD

;-----------------
; Wave Self Method
;-----------------

; When you wave most objects nothing happens. Stationary objects have their 
; own wave-self method.

  (method (wave-self)                   ; How to wave object
    (print "Nothing happens.\n")        ; Normally can't
    (abort)                             ; abort to update handler                                
  )                                     ; EMETHOD

;-----------------
; Move-Self Method
;-----------------

; Most items simply ignore this request, since it's given by an action verb.

  (method (move-self)                   ; How to move-self
    (nil)                               ; can't
  )                                     ; EMETHOD

;--------------------
; Total-Weight Method
;--------------------
;
; Determine the weight of an object and its contents

  (method (total-weight)                        ; Total weight of item+contents
    (setq enc 0)                                ; weight of self is not considered
    (setq obj (getp self child))                ; object's child
    (while obj                                  ; while we have an ojbect...
      (setq enc (+ enc (send obj total-weight))); Add child's total weight
      (setq obj (next-sibling obj))             ; Next object in sibling chain...
    )                                           ; EWHILE
    (setq enc (+ enc (getp self weight)))       ; add weight of self
    (return enc)                                ; return encumberance
  )                                             ; EMETHOD

;----------------------
; Content Weight Method
;----------------------

; This method returns the weight of this object's contents--excluding the 
; object's own weight.

  (method (content-weight)                      ; Function content-weight
    (setq enc 0)                                ; weight of self is not considered
    (setq obj (getp self child))                ; object's child
    (while obj                                  ; while we have an ojbect...
      (setq enc (+ enc (send obj total-weight))); Add child's total weight
      (setq obj (next-sibling obj))             ; Next object in sibling chain...
    )                                           ; EWHILE
    (return enc)                                ; return encumberance
  )                                             ; EMETHOD
)                                               ; EOBJECT

;-----------------------------------------------------------------------------
;                               location
;
; The "location" super-class is created from the BASIC-THING super-class 
; above, this object class can be used to define objects, not just object 
; classes.
;
; Methods: knock? obj     - can object be entered (always Yes)
;          enter obj      - how this object is entered
;          leave obj dir  - how this object is left in direction dir
;          how-hear       - sound object returns
;          how-smell      - smell object returns
;          print-contents - print objects in room
;          describe       - description object returns
;
;-----------------------------------------------------------------------------

(basic-thing location
  (property                             ; Properties
    child nil                           ; first object in this location
    lighted nil                         ; is light present?
    visited nil                         ; has player been here yet?
    sound "I don't hear anything."      ; sound
    odor "I don't smell anything."      ; smell
  )                                     ; EPROPERTY

;--------------
; Knock? Method
;--------------

; This knock? method replaces the one inherited from the basic-thing class.
; Unless overridden for a specific room, all rooms can be entered.

  (method (knock? obj)                  ; Entry Requirements
    T                                   ; none, can always enter
  )                                     ; EMETHOD

;-------------
; Enter Method
;-------------

; This enter method replaces the one inherited from the basic-thing class.
; Unless overridden for a specific room, all rooms can be entered.

  (method (enter obj)                   ; How to enter this object (loc)
    (send obj put-self-in self)         ; put self into object
    T                                   ; Return True to indicate entry
  )                                     ; EMETHOD

;-------------
; Leave Method
;-------------

; This leave method replaces the one inherited from the basic-thing class.
; Unless overridden for a specific room, all rooms can be left, although not
; always in all directions.

  (method (leave obj dir &aux loc)      ; How to leave this object (Loc)
    (if (setq loc (getp self dir))      ; Has exit in that direction?
      (if (send loc knock? obj)         ; Allowed to enter?
	(progn                          ; BEGIN entry
	  (send obj vanish)             ; Disappear from current loc
	  (send loc enter obj)         ; tell loction to take in object
	  (setq curloc nil)             ; 0 current location
	)                               ; END entry
      )                                 ; EIF Allowed to enter
      (progn                            ; BEGIN (Has no exit - else for has exit)
	(if (not (getp self side-error)); side-error present?
	  (progn                        ; No, Begin
	    (print "There is no exit in that direction.\n")
	    nil                         ; indicate failure
	  )                             ; END no side-error
	  (progn                        ; Yes, BEGIN side-error
	    (print (getp self side-error)); Print error message
	    (terpri)                    ; terminate print line
	  )                             ; END side-error 
	)                               ; EIF side-error present
	nil                             ; Return nil (to indicate failure)
      )                                 ; END no exit
    )                                   ; EIF exit check
  )                                     ; EMETHOD

;----------------
; How-Hear Method
;----------------

; This How-Hear method replaces the one inherited from the basic-thing class.

  (method (how-hear)                    ; How you hear something in loc
    (print (getp self sound))           ; print sound
    (terpri)                            ; terminate print line
  )                                     ; EMETHOD
  
;-----------------
; How-Smell Method
;-----------------

; This knock method replaces the one inherited from the basic-thing class.

  (method (how-smell)                   ; How you smell something in loc
    (print (getp self odor))            ; print odor
    (terpri)                            ; terminate print line
  )                                     ; EMETHOD
  
;---------------------
;Print-Contents Method
;---------------------
;
; Arguments: prop - property to use in describing object
;
; Print the contents of an object (used by "look")

  (method (print-contents prop)           ; Function Print-Contents
    (setq obj (getp self child))          ; OBJ=Object's child...
    (while obj                            ; While there's an object...
      (if (setq desc (getp obj prop))     ; Is there something to print?
	(progn                            ; BEGIN...
	  (print " ")                     ; Print a space
	  (print desc)                    ; Print DESCription
	)                                 ; END
      )                                   ; EIF 
      (setq obj (next-sibling obj))       ; Next OBJect...
    )                                     ; EWHILE
  )                                       ; EMETHOD


;----------------
; Describe Method
;----------------

; This describe method replaces the one inherited from the basic-thing class.

  (method (describe)                            ; describe location
    (if (not (light-present self))              ; Dark?
      (progn                                    ; Yes, BEGIN
	(print "I can't see a thing, it's too dark.\n"); Complain
	(abort)                                 ; continue with update handler
      )                                         ; END yes dark
    )                                           ; EIF dark
    
    (if (getp self visited)                     ; Visited?
      (progn                                    ; Yes, BEGIN
	(print (getp self short-description))   ; print short description
	(terpri)                                ; end line
	(send self print-contents description)  ; print loc contents
      )                                         ; END yes visited
      (progn                                    ; No, BEGIN
	(print (getp self description))         ; print long description
	(send self print-contents description)       ; print loc contents
	(setp self visited T)                   ; Set location to visited
	(setp adventurer value (+ (getp adventurer value)
				  (getp self value))); Add room's value to score
	(setp self value 0)                     ; 0 Room's value
      )                                         ; END Not visited
    )                                           ; EIF Visited

    (terpri)                                    ; Terminate print line
  )                                             ; EMETHOD
)                                               ; EOBJECT

;-----------------------------------------------------------------------------
;                               portal
;
;       The portal class is defined as a basic-thing, meaning it inherits the
; properties of parent and sibling from the BASIC-THING super-class.  The
; portal generally is invisible, the description being part of the long
; description of the room it's in, rather than in itself, as is the case with
; normal objects.  Portals may be opened, closed, locked, unlocked, or entered.
; Unlike a location, with which it shares many attributes, a portal may not be
; left, as it is not a room.
;
; Methods: knock obj      - Portal may not be entered when closed
;          enter obj      - method of entry (teleport to other side's parent)
;          open           - opening the portal
;          close          - closing the portal
;          lock thekey    - lock portal with thekey
;          unlock thekey  - unlock the portal
;
;-----------------------------------------------------------------------------

(basic-thing portal

  (method (knock? obj)                          ; Entry requirements
    (if (getp self closed)                      ; is portal closed
      (progn                                    ; Yes, BEGIN...
	(print "The ")                          ; Print "The "
	(print (getp self short-description))   ; print portal short description
	(print " is closed!\n")                 ; print "is closed"
	nil                                     ; return nil for req. failure
      )                                         ; END portal closed
      T                                         ; else return T indicating OK
    )                                           ; EIF portal closed
  )                                             ; EMETHOD

  (method (enter obj)                           ; Portal Entry
    (send obj put-self-in (getp (getp self other-side) parent))
  )                                             ; EMETHOD

  (method (open)                                ; How to open portal
    (if (not (getp self closed))                ; Is portal already open?
      (progn                                    ; Yes, BEGIN...
	(print "The ")                          ; Print "The"
	(print (getp self short-description))   ; Print portal's short desc
	(print " is already open!\n")           ; Print complaint
	nil                                     ; indicate failure
      )                                         ; END portal already open
      (if (getp self locked)                    ; Is portal locked?
	(progn                                  ; Yes, BEGIN...
	  (print "The ")                        ; Print "The "
	  (print (getp self short-description)) ; Print portal's short desc
	  (print " is locked!\n")               ; Print complaint
	  nil                                   ; Indicate failure
	)                                       ; END portal locked
	(progn                                  ; No, BEGIN
	  (setp self closed nil)                ; open it
	  T                                     ; indicate success
	  (print "The ")                        ; print "The"
	  (print (getp self short-description)) ; print portal's short desc.
	  (print " ")                           ; print a space
	  (print (getp self open-desc))         ; print opening description
	  (terpri)                              ; terminate print line
	)                                       ; END successful open
      )                                         ; EIF (locked)
    )                                           ; EIF (closed)
  )                                             ; EMETHOD

  (method (close)                               ; Close a portal
    (if (getp self closed)                      ; Already closed?
      (progn                                    ; Yes, BEGIN
	(print "The ")                          ; Print "The "
	(print (getp self short-description))   ; Print portal short desc
	(print " is already closed!\n")         ; Print complaint
	nil                                     ; indicate failure
      )                                         ; END poral already closed
      (progn                                    ; No, BEGIN
	(setp self closed T)                    ; Close it
	T                                       ; Indicate success
	    (print "The ")                      ; print "the"
	    (print (getp self short-description)); print portal's short description
	    (print " ")                         ; print a space
	    (print (getp self close-desc))      ; print the closing description
	    (terpri)                            ; terminate print line
      )                                         ; END successful close
    )                                           ; EIF close check
  )                                             ; EMETHOD

  (method (lock thekey)                         ; lock the portal
    (if (not (getp self closed))                ; Not closed?
      (progn                                    ; Not closed, BEGIN
	(print "The ")                          ; Print "The"
	(print (getp self short-description))   ; Print portal short desc
	(print " is not closed!\n")             ; Print complaint
	nil                                     ; Indicate failure
      )                                         ; END not closed
      (if (getp self locked)                    ; Closed, but already locked?
	(progn                                  ; locked, BEGIN
	  (print "The ")                        ; Print "The "
	  (print (getp self short-description)) ; Print portal short desc
	  (print " is already locked!\n")       ; Print rest of complaint
	  nil                                   ; indicate failure
	)                                       ; END already locked
	(if (not (= thekey (getp self key)))    ; Have the right key?
	  (progn                                ; No, BEGIN
	    (print "It doesn't fit the lock!\n"); Complain
	    nil                                 ; Indicate failure
	  )                                     ; END wrong key
	  (progn                                ; Yes, BEGIN
	    (setp self locked t)                ; Lock portal
	    T                                   ; Indicate success
	    (print "The ")                      ; print "the"
	    (print (getp self short-description)); print portal short description
	    (print " ")                         ; print space
	    (print (getp self lock-desc))       ; print locking description
	    (terpri)                            ; terminate print line
	  )                                     ; END successful lock
	)                                       ; EIF (have key)
      )                                         ; EIF (locked)
    )                                           ; EIF (closed)
  )                                             ; EMETHOD

  (method (unlock thekey)                       ; Unlock portal
    (if (not (getp self closed))                ; Open?
      (progn                                    ; Yes, BEGIN
	(print "The ")                          ; Print "The "
	(print (getp self short-description))   ; Print portal short desc
	(print " is already unlocked, AND OPEN!\n"); Print complaint
	nil                                     ; Indicate failure
      )                                         ; END already open
      (if (not (getp self locked))              ; No, locked?
	(progn                                  ; No, BEGIN
	  (print "The ")                        ; Print "The "
	  (print (getp self short-description)) ; Print portal short desc
	  (print " is not locked!\n")           ; Print Complaint
	  nil                                   ; indicate failure
	)                                       ; END already unlocked.
	(if (not (= thekey (getp self key)))    ; Yes (locked), Have right key?
	  (progn                                ; No, BEGIN
	    (print "It doesn't fit the lock!\n"); Complain
	    nil                                 ; indicate failure
	  )                                     ; END have wrong key
	  (progn                                ; Yes, BEGIN
	    (setp self locked nil)              ; unlock portal
	    T                                   ; indicate success
	    (print "The ")                      ; print "the"
	    (print (getp self short-description)); print portal short desc
	    (print " ")                         ; print space
	    (print (getp self unlock-desc))     ; print unlock desc
	    (terpri)                            ; terminate print line
	  )                                     ; END successful unlock
	)                                       ; EIF (have right key)
      )                                         ; EIF (locked)
    )                                           ; EIF (closed
  )                                             ; EMETHOD

  (method (wave-self)
    (print "And just how am I supposed to do that?\n")
  )
)                                               ; EOJBECT

;-----------------------------------------------------------------------------
;                               Actor
;
; The "actor" class is defined as a basic-thing, meaning it has inherited 
; the parent and sibling properties.  In addition the child property is added
; to allow an actor to have an inventory.
;
; Methods: open          - how actor is opened (can't be)
;          close         - how actor is closed (can't be)
;          exchange      - how actor exchanges some object with player
;          move dir      - how actor moves in direction dir
;          take obj      - how actor takes object
;          drop obj      - how actor drops object
;          carrying? obj - True if actor carrying object
;          inventory     - lists inventory for this actor
;          turn-on       - How to turn on actor (can't be, snide remark)
;          turn-off      - How to turn off actor (can't be, snide remark)
;-----------------------------------------------------------------------------

(basic-thing actor
  (property                                     ; Begin property descriptions
    child nil                                   ; First object in inventory
  )                                             ; EPROPERTIES

  (method (turn-on)                             ; How to turn on actor
    (print "I'm going to pretend you didn't say that.  Pervert.\n")
    (abort)                                     ; return to update handler
  )                                             ; EMETHOD
  
  (method (turn-off)                            ; How to turn off actor
    (print "I think you've already managed to accomplish that!\n")
    (abort)                                     ; return to update handler
  )                                             ; EMETHOD

  (method (move dir)                            ; How to Move in direction DIR
    (send (getp self parent) leave self dir)    ; Send parent leave command
  )                                             ; EMETHOD

  (method (take obj)                            ; How to take an object

    (if (< (getp self capacity) 
	   (+ (send self content-weight) 
	      (send %dobject total-weight)
	   )
	)                                       ; Too heavy? 
      (progn                                    ;   Yes, BEGIN
	(if (= self adventurer)                 ;     Is player trying?
	  (progn                                ;       Yes, BEGIN
	    (print "You can't carry anything else.  Your load is too heavy.\n")
	    (abort)                             ;       return to update handler
	  )                                     ;   END too heavy for player
	  (complain "The " $IOBJECT " refuses to take it.\n"); No, complain actor refuses order.
	)                                       ; EIF is player
      )                                         ; END too heavy
    )                                           ; EIF too heavy

    (if (getp obj special)                      ; Object has special take routine?
      (progn                                    ; Yes, BEGIN
	(send obj take)                         ; send object take message
	(return)                                ; return to caller
      )                                         ; END special take
    )                                           ; EIF special take
    (send obj vanish)                           ; disconnect it
    (send obj put-self-in self)
  )                                             ; EMETHOD

  (method (drop obj)                            ; How to drop an object
    (send obj vanish)                           ; Make object vanish
    (send obj put-self-in (getp self parent))   ; Connect it to actor's parent
  )                                             ; EMETHOD

  (method (carrying? obj)                       ; Carrying object?
    (= (getp obj parent) self)                  ; Is object parent's self? (T/nil)
  )                             

  (method (inventory)                           ; How to take inventory
    (if (getp %actor child)                     ; Has a child?
      (progn                                    ; Yes, BEGIN
	(if (= %actor adventurer)               ; Actor self?
	  (print "You are carrying:\n")         ; yes, print "you"
	  (progn                                ; no, BEGIN
	    (print "The ")                      ; The
	    (print-noun $actor)                 ; name of actor
	    (print " is carrying:\n")           ; is carrying
	  )                                     ; END not actor
	)                                       ; EIF actor
	(list-contents %actor short-description 1); List actor's inventory
      )                                         ; END (has a child)
      (print "You are empty-handed.\n")         ; No, has no child
    )                                           ; EIF has child
  )                                             ; EMETHOD

  (method (wave-self)
    (complain "Wave the " $DOBJECT "? And just how am I supposed to do that?\n")
  )

  (method (hello)
    (if (not (getp self hello-msg))           ; has hello message?
	(complain "The " $ACTOR " doesn't say anything.")
    )                                           ; EIF

    (print (getp self hello-msg))               ; print actor's hello message
    (terpri)                                    ; terminate print line
    (send self exchange)                        ; send actor exchange message
  )                                             ; EMethod


)                                               ; EOBJECT

;-----------------------------------------------------------------------------
;                                       monster
;
; A monster is an actor that can fight.  Additional methods for combat have 
; been added.
;
; Methods: attack target roll-needed ld hd - How monster attacks
;          attack-adventurer               - How monster attacks adventurer
;-----------------------------------------------------------------------------

(actor monster

  (method (attack target roll-needed ld hd)     ; How monster attacks
    (setq roll (+ 1 (rand 19)))                 ; find to hit roll
    (if (< roll roll-needed)                    ; Missed?
      (send self say-missed)                    ; Yes, Tell player
      (progn                                    ; No, BEGIN
	(send self say-hit)                     ; Tell player
	(send target wounded (+ ld (+ (rand (- hd 1)) 1))); Tell target how much damage
      )                                         ; END missed
    )                                           ; EIF missed
  )                                             ; EMETHOD

  (method (attack-adventurer)                   ; monster attacks player
    (if (< (getp self hit-points) 1)            ; Is monster dead?
      (return)                                  ; Yes, return w/o action
    )                                           ; EIF monster dead

    (if (not (= (getp adventurer parent)
		(getp self parent)))            ; monster same room as player?
      (return)                                  ; No, return w/o action
    )                                           ; EIF in same room

    (send self attack adventurer 
      (- (send self effective-TH0) (send adventurer effective-ac))
      (getp self low-damage) (getp self high-damage)); Attack message to self
  )                                             ; EMETHOD

)                                               ; EOBJECT

;-----------------------------------------------------------------------------
;                               thing
;
; The "thing" class is defined as a basic-thing which can be taken.  Examples
; might be a shovel, a diamond ring, or a sword.  Anything the player (or any
; actor) can pick up is a thing.
;
; Methods: move-self - if item has a different first description (hanging over
;                      a mantel, for instance.)
;
;-----------------------------------------------------------------------------

(basic-thing thing
  (class-property                               ; Begin describing class properties
    takeable t                                  ; Object can be taken
  )                                             ; ECLASSPROPERTIES

  (method (move-self)                           ; Original move

    (if (not (getp self been-moved))            ; Has object been moved?
      (if (getp self first-move)                ; No, Is there a first move?
	(progn                                  ; Yes, BEGIN
	  (print (getp self first-move))        ; print the first move response
	  (terpri)                              ; terminate print line
	  (setp self description (getp self normal-description));set description to normal
	  (setp self been-moved T)              ; Object has been moved
	  (chain)                               ; chain to next handler
	)                                       ; END object's first move
      )                                         ; EIF has first move
    )                                           ; EIF been moved

    (print-noun $dobject)                       ; print noun phrase
    (print " taken.\n")                         ; print "taken" (and a CR/LF)
    T                                           ; indicate success
  )                                             ; EMETHOD
)                                               ; EOJBECT

;-----------------------------------------------------------------------------
;                               stationary-thing
;
; The "stationary-thing" class is really just a synonym for "basic-thing".
; It's used for clarity.  Stationary things can't be taken.  They are in all 
; respects basic-things.
;-----------------------------------------------------------------------------

(basic-thing stationary-thing)

;-----------------------------------------------------------------------------
;                                       weapon
;
;       A weapon is a tool used to kill monsters.  It has various attributes 
; assigned on a per object basis.
;-----------------------------------------------------------------------------

(thing weapon
  (property
    kills T
  )
)

;-----------------------------------------------------------------------------
;                                       container
;
;       A container is a normal thing which can be opened, closed, and possibly
; locked.  It contains other objects.
;
; Methods: open        - how to open this object
;          close       - how to close this object
;          total-value - Object's combined value (for horde)
;-----------------------------------------------------------------------------

(thing container
  (class-property
    transparent nil
    closed T
    locked nil
    key nil
  )

  (property
    child nil
  )
  
  (method (open)                                ; How object is opened

    (if (not (getp self closed))                ; Already open?
      (complain "The " $dobject " is already open!\n"); Yes, complain
    )                                           ; EIF alreay open

    (setp self closed nil)                      ; Set to not closed (open)
    (if (not (getp self child))                 ; Contains objects?
      (complain "Opening the " $dobject " reveals that it is empty.\n"); No
    )                                           ; EIF contains
    (print "Opening the ")                      ; print head
    (print (getp self short-description))       ; print obj short desc
    (print " reveals:\n")                       ; print tail
    (list-contents self short-description 1)    ; list contents
  )                                             ; EMETHOD

  (method (close)                               ; How to close object
    (if (getp self closed)                      ; Already closed?
      (complain "The " $dobject " is already closed!\n"); complain
    )                                           ; EIF already closed
    (setp self closed T)                        ; close it
    (print-noun $dobject)                       ; print obj noun
    (print " closed.\n")                        ; print "closed"
  )                                             ; EMETHOD

)                                               ; EOBJECT

;*****************************************************************************
;                               End Of Object Defintions
;*****************************************************************************