; Author:   Kathi Dutton 
; Filename: quid_2.l 
; Abstract: a third implemenation of JK Rowling imaginary game of quidditch. 
;    an implemenation of a simple rule base 
 
(in-package "pcl") 
 
;****************************************************************************
;               C L A S S        S E C T I O N
;****************************************************************************

; game 
 
( defclass game() 
  (  
   ( pitch :accessor game-pitch :initarg :pitch ) 
   ( teams :accessor game-teams :initarg :teams )
   ( balls :accessor game-balls :initarg :balls )
   ( score :accessor game-score :initarg :score :initform '() ) 
   ( north :accessor game-north :initarg :north :initform '() ) 
   ( south :accessor game-south :initarg :south :initform '() ) 
  ) 
) 
 
; pitch class - represents the playing field.  it has 3 properties north 
;  and south represent the 2 opposite scoring zones and points is a list 
;  of all valid points within the playing field 
 
( defclass pitch() 
  (  
   ( nhoops :accessor pitch-nhoops :initarg :nhoops :initform '() ) 
   ( shoops :accessor pitch-shoops :initarg :shoops :initform '() ) 
   ( points :accessor pitch-points :initarg :points :initform '() ) 
   ( midfld :accessor pitch-midfld :initarg :midfld :initform '() ) 
   ( ngzone :accessor pitch-ngzone :initarg :ngzone :initform '() ) 
   ( sgzone :accessor pitch-sgzone :initarg :sgzone :initform '() ) 
  ) 
) 
 
; hoop class - the hoop used to score points, each scoring zone contains 
;  3 hoops. 
 
( defclass hoop()  
  (  
   ( location :accessor hoop-location :initarg :location )  
  ) 
) 

; Point class -- has 4 properties to represent a point in space coordinates 
;  and if it is currently occupied. 
 
( defclass point() 
  ( 
   ( x :accessor point-x :initarg :x ) 
   ( y :accessor point-y :initarg :y ) 
   ( z :accessor point-z :initarg :z ) 
   ( occupied :accessor point-occupied :initarg :occupied :initform 'nil ) 
  ) 
) 
 
 
;team class - a team consists of a name, a list of players a captain and 
;  a record of the wins and losses 
 
( defclass team() 
  ( 
   ( name :accessor team-name :initarg :name ) 
   ( roster :accessor team-roster :initarg :roster :initform () ) 
   ( captain :accessor team-captain :initarg :captain ) 
   ( history :accessor team-history :initarg :history ) 
   ) 
) 
 
 
; history class - history has 2 properties number of wins and losses 
 
( defclass history() 
  ( 
   ( wins :accessor history-wins :initarg :wins ) 
   ( losses :accessor history-losses :initarg :losses ) 
  ) 
) 

; person class - a person has a name, a team position, a location in space, 
;  and some amount of knowledge 
 
( defclass person() 
  ( 
   ( name :accessor person-name :initarg :name ) 
   ( position :accessor person-position :initarg :position ) 
   ( location :accessor person-location :initarg :location ) 
   ( knowledge :accessor person-knowledge :initarg :knowledge :initform () ) 
  ) 
) 
 
 
; ball class - has 3 properties type of ball, ball's location and a name for 
;  easier human referencing 
 
( defclass ball() 
  (  
   ( type :accessor ball-type :initarg :type ) 
   ( location :accessor ball-location :initarg :location ) 
   ( name :accessor ball-name :initarg :name ) 
  ) 
) 
 
; snitch - snitch class is a type of ball.  a snitch can be either 
;  visable or invisable; free or captured. 
 
( defclass snitch() 
  ( 
   ( visable :accessor snitch-visable :initarg :visable :initform '0 ) 
   ( free :accessor snitch-free :initarg :free :initform '0 ) 
  ) 
) 
 
; bludger - bludger class is a type of ball. it has one property  
 
( defclass bludger() 
  ( 
   ( behavior :accessor bludger-behavior :initarg :behavior ) 
  ) 
) 
 

; quaffle - quaffle is a type of ball.  it has one property who is carrying 
;  it. 
 
( defclass quaffle() 
  ( 
   ( owner :accessor quaffle-owner :initarg :owner ) 
  ) 
) 

;**********************
;end of class section *
;**********************

;**************************************************************************
;             A C T I O N    M E T H O D      S E C T I O N
;**************************************************************************

; to make a point to be used as a location for either a person or ball 
;   the point is generated randomly within the bounds of the environment 
 
( defmethod location-0 ((s symbol) )  
  ( setf lset (get-loc-set *length* 0 *depth*) ) 
  ( setf point (get-point lset) ) 
  ( if ( eq (point-occupied point) 'nil ) 
      ( setf (point-occupied point) s  ) 
    ( location-0 s ) ) 
  point 
) 

; location-1 -  on command each player will fly to approp. location for start

( defmethod location-1 ( (tm team))
  ( setf *init-fly* 't )
  ( setf players (team-roster tm) )
  ( dolist (pl players)
    ( fly pl )
  )
  ( setf *init-fly* 'nil )
  ( display-flat *pitch* )
)

; release - places the game balls randomly inthe pitch except for the 
;           quaffle which must place itself somewhere mid-fld

( defmethod release-balls ()
  ( cond
    ( (release-p)
      ( open-cage )
      ( display-flat *pitch* )
    )
    ( t
      ( princ "game balls already on field" ) (terpri) 
    )  
  )
 
)

( defmethod open-cage () 
  ( setf balls (game-balls *game*) )
  ( setf i-pt (get-point '(0 0 0) ) )
  ( dolist (b balls)
    ( setf (ball-location b) i-pt )
    ( move b )
  )
)


; fly 
 
( defmethod fly ( (p person) ) 
  ( cond 
    ( ( eq (person-position p) 'keeper ) 
      ( move-keeper p ) 
    ) 
    ( ( eq (person-position p) 'chaser ) 
      ( move-chaser p ) 
    ) 
    ( ( not (eq (person-knowledge p) 'nil) )
      ( move-smartish p )
    ) 
    ( t 
      ( move-randomish p ) 
    ) 
  ) 
) ;endof fly


; move 
 
( defmethod move-randomish ( ( p person) ) 
  ( setf lset (get-loc-set *length* *height* *depth*) ) 
  ( setf point (get-point lset) ) 
  ( cond
    ( ( valid-loc-p point p )
      ( setf (point-occupied point) (person-name p) )
      ( setf old (person-location p ) )
      ( setf (person-location p) point )
      ( setf (point-occupied old) 'nil )
    ) 
    ( t
      ( move-randomish p )
    )
    ( sight-bad p )
  )
) ; endof move


; move-smartish - allows the person to use acquired knowlegde

( defmethod move-smartish ( (p person) )
  ( setf klst (person-knowledge p) )
  ( dolist (k klst)
    ( cond
      ( ( bludg-p k p)
        ( protect-self k p)
      )
      ( ( quaf-p k p)
        ( catch-quaf p )
      )
      ( ( snitch-p k p)
        ( catch-snitch p )
      )
      ( t
        ( move-randomish p )
      )
    )
  )
) ;endof move-smartish 

; protect-self - a bludger is about to hit you. 
;      if you are a beater hit it
;          else move away from it

( defmethod protect-self ( (pt point) (per person) )
  ( cond
    ( ( eq (person-position per) 'beater )
      ( hit-bludg pt per )
    )
    ( t
      ( move-randomish per )
    )
  )
) ;endof protect-self

; hit-bludg 

( defmethod hit-bludg ( (pt point) (per person) )
  ( setf balls (game-balls *game*) )
  ( dolist (b balls)
    ( if ( eq (ball-name b) (point-occupied pt) )
        ( setf it b)
    )
  )
  ( move it )
  ( setf (point-occupied pt) (person-name p) )
  ( setf old (person-location per) )
  ( setf (point-occupied old) 'nil )
  ( setf (person-location p) pt )
  ( sight-bad per )
)


; move-keeper  
 
( defmethod move-keeper ( (p person) ) 
  ( setf lset (get-loc-set *length* *height* *depth*) ) 
  ( setf point (get-point lset) ) 
  ( cond 
    ( ( valid-loc-p point p )  
      ( setf (point-occupied point) (person-name p) )
      ( setf old (person-location p) )
      ( setf (point-occupied old) 'nil )
      ( setf (person-location p) point ) 
       
    )
    ( t 
      ( move-keeper p ) 
    ) 
  ) 
) 
 

; move-chaser

( defmethod move-chaser ( (p person) )
  ( setf lset (get-loc-set *length* *height* *depth*) )
  ( setf point (get-point lset) )
  ( cond
    ( ( equal *init-fly* 't ) 
      ( setf it (get-midfld-spt) )
      ( setf old (person-location p) )
      ( setf (point-occupied old) 'nil )
      ( setf (person-location p) it )
      ( setf (point-occupied it) ( person-name p) )             
    ) 
    ( t
      ( move p )
    )
  )
)

; move

( defmethod move ( ( b ball ) )  
  ( setf lset (get-loc-set *length* *height* *depth*) )
  ( setf point (get-point lset) )
  ( cond
    ( ( valid-point-p point )
      ( setf (point-occupied point) (ball-name b) )
      ( setf old (ball-location b ) )
      ( setf (ball-location b) point )
      ( setf (point-occupied old) 'nil )
    )
    ( t
      ( move b )
    )
  )
) ; endof move


; sight-bad: can only see what is "right next" to him

( defmethod sight-bad ( (p person) )
  ( setf h (person-location p) )
  ( setf nbors () )
  ( if ( < (+ (point-x h) 1 ) (+ *length* 1) )
      ( setf nbors ( cons (get-point (list (+ (point-x h) 1) (point-y h) (point-z h)))
                          nbors ) ) 
  )
  ( if ( < -1 (- (point-x h) 1) )
      ( setf nbors ( cons (get-point (list (- (point-x h) 1) (point-y h) (point-z h)))
                          nbors ) )
  )
  ( if ( < (+ (point-z h) 1) (+ *depth* 1) )
      ( setf nbors ( cons (get-point (list (point-x h) (point-y h) (+ (point-z h) 1)))
                          nbors ) )
  )
  ( if ( < -1 (- (point-z h) 1) )
      ( setf nbors ( cons (get-point (list (point-x h) (point-y h) (- (point-z h) 1)))
                          nbors ) )
  )
  ( if ( < (+ (point-x h) 1) (+ *length* 1) )
      ( if ( < (+ (point-z h) 1) (+ *depth* 1) )
          ( setf nbors (cons (get-point (list (+ (point-x h) 1) (point-y h) (+ (point-z h) 1)))
                             nbors ) )
      )
  )
  ( if ( < -1 (-(point-x h) 1) )
      ( if ( < -1 (- (point-z h) 1) )
          ( setf nbors ( cons (get-point (list (- (point-x h) 1) (point-y h) (- (point-z h) 1)))
                              nbors ) )
      )
  )
  ( if ( < (+ (point-x h) 1 ) (+ *length* 1) )
      ( if (  < -1 (- (point-z h) 1) )
          ( setf nbors (cons (get-point (list (+ (point-x h) 1) (point-y h) (- (point-z h) 1)))
                             nbors ) )
      )
  )
  ( if ( < -1 (-(point-x h) 1) )
      ( if ( < (+ (point-z h) 1) (+ *depth* 1) )
          ( setf nbors (cons (get-point (list (- (point-x h) 1) (point-y h) (+ (point-z h) 1)))
                             nbors ) )
      )
  )
 

 ( setf (person-knowledge p) nbors )
)






      

;***************************************************************************
;               M A I N       M E T H O D          S E C T I O N
;***************************************************************************

; practice method  -- practice method establishes a playing field & 1 team

( defmethod game ( )
  ( setf *pitch* (establish-pitch) )
  ( setf teams (establish-teams) )
  ( setf balls (make-balls) )
  ( setf *game* (make-instance 'game :pitch *pitch* :teams teams 
                               :balls balls :score '() 
                               :north (team-name (car teams) ) 
                               :south nil )
                
  )               
  ( display-flat *pitch* )
)


( defmethod establish-pitch () 
  ( princ "establish the size of the pitch...." ) (terpri) 
  ( princ "enter desired length " )  
  ( setf *length* (read) ) 
  ( princ "enter desired height " ) 
  ( setf *height* (read) ) 
  ( princ "enter desired depth " ) 
  ( setf *depth* (read) ) 
  ( terpri ) 
  ( setf pitch (make-pitch) ) 
  pitch
)

( defmethod establish-teams () 
  ( princ "establish team....") (terpri) 
  ( princ "enter desired team name -- gryffindor or slytherin " ) 
  ( setf name (read) ) 
  ( setf team (make-team name) )
  ( setf team2 'nil )
  ( princ "Practice (Y/N) " )
  ( cond
    ( (not (practice-p))
      ( princ "currently can only practice.  your practice team is... " )
      ( prin1 name )
      ;( setf other (second-team-p name) )
      ;( setf team2 (make-team other) )
    )
  )
  ( setf teams (list team team2) )
  teams
)






;-----------------------------------------------------------------------
;          pitch method section
;-----------------------------------------------------------------------

; to initialize the playing field  
 
( defmethod make-pitch () 
  ( setf coord-lst ( make-pcoord ) ) 
  ( setf ptslst ( make-points coord-lst ) ) 
  ( setf top ( find-top ptslst ) ) 
  ( setf n-hoops ( make-nhoops top ) ) 
  ( setf s-hoops ( make-shoops top ) ) 
  ( setf midfld ( find-midfld ptslst ) ) 
  ( setf n-gzone ( find-north-gzone ptslst ) ) 
  ( setf s-gzone ( find-south-gzone ptslst ) ) 
  ( setf pitch (make-instance 'pitch :nhoops n-hoops  
                              :shoops s-hoops 
                              :points ptslst 
                              :midfld midfld 
                              :ngzone n-gzone 
                              :sgzone s-gzone) )  
  pitch 
) ; end of make-pitch

;---------------------------------
;         pitch helper methods
;---------------------------------

; method to make points in space from a list of coordinates 
                              
( defmethod make-points ( (clst list) ) 
  ( setf ptslst '() ) 
  ( dolist (c clst) 
    ( setf pt (make-instance 'point :x (car c) :y (second c) :z (third c) ) ) 
    ( setf ptslst (cons pt ptslst) ) 
  ) 
  ptslst 
) ;endof make-points
 
; create a list of coordinates for the playing area 
 
( defmethod make-pcoord ( )  
  ( setf xlst (iota *length*) ) 
  ( setf ylst (iota *height*) ) 
  ( setf zlst (iota *depth*) ) 
  ( setf p-lst '() ) 
  ( dolist (x xlst) 
    ( dolist (y ylst)  
      ( dolist (z zlst)  
        ( setf lst (list x y z) ) 
        ( setf p-lst (cons lst p-lst) ) 
      ) 
    ) 
  ) 
  p-lst 
) ;endof make-pcoord

; create a list of numbers of n-length 
 
( defun iota (nr)  
  ( cond  
    ( ( = nr -1)  
      ()  
    )  
    ( t  
      (append (iota (- nr 1)) (list nr) ) 
    ) 
  ) 
) ;endof iota
 
; to find the top of the playing field  
   
( defmethod find-top ((ptlst list))  
  ( setf top '() )  
  ( dolist (pt ptlst)  
    ( if ( = (point-y pt) *height*)  
        ( setf top (cons pt top) )  
    )  
  )  
  top  
) ; end of find-top 
 

;-------------MIDFIELD-------------------

; to find the middle of the playing field 
 
( defmethod find-midfld ( (ptlst list) ) 
  ( setf midpts '() ) 
  ( setf mid (find-mid-pt *depth*) ) 
  ( dolist (pt ptlst) 
    ( if ( = (point-z pt) mid ) 
        ( setf midpts (cons pt midpts) ) 
    ) 
  ) 
  midpts 
) ; end of find-midfld

;---------------NORTH END OF FIELD---------------------

; to establish north goal zone 
 
( defmethod find-north-gzone ( (ptlst list)  ) 
  ( setf nzone '() ) 
  ( setf zn (find-mid-pt *depth*) ) 
  ( setf z (find-mid-pt zn) ) 
  ( dolist (pt ptlst) 
    ( if (nzone-p pt z) 
        ( setf nzone (cons pt nzone) ) 
    ) 
  ) 
  nzone 
) ; end of find-north-gzone

; make-nhoops

( defmethod make-nhoops ( (top list)  ) 
  ( setf hoops '() ) 
  ( setf n-side ( get-n-pts top ) ) 
  ( setf h1 (make-hoop1 n-side) ) 
  ( setf h2 (make-hoop2 n-side) ) 
  ( setf h3 (make-hoop3 n-side) )  
  ( setf hoops (list h1 h2 h3)) 
  hoops 
) ; endof make-nhoops

( defmethod get-n-pts ((ptlst list) ) 
  ( setf north '() ) 
  ( dolist (pt ptlst) 
    ( if ( = (point-z pt) '0 ) 
        ( setf north (cons pt north) ) 
    ) 
  ) 
    
  north 
)

;-----------SOUTH END OF FIELD------------------------

; to establish south goal zone 
 
( defmethod find-south-gzone ( (ptlst list)  ) 
  ( setf szone '() ) 
  ( setf sz (find-mid-pt *depth*) )
  ( setf s (find-mid-pt sz) )
  ( setf z ( - *depth* s ) )
  ( dolist (pt ptlst) 
    ( if ( szone-p pt z) 
        ( setf szone (cons pt szone) ) 
    ) 
  ) 
  szone 
) ; end of find-south-gzone

; make-shoops

( defmethod make-shoops ( (top list) ) 
  ( setf s-side ( get-s-pts top ) ) 
  ( setf h1 (make-hoop1 s-side) ) 
  ( setf h2 (make-hoop2 s-side) ) 
  ( setf h3 (make-hoop3 s-side) ) 
  ( setf hoops (list h1 h2 h3) ) 
  hoops 
) ;endof make-shoops

( defmethod get-s-pts ((ptlst list)  )  
  ( setf south '() ) 
  ( setf hoops '() ) 
  ( dolist (pt ptlst)  
    ( if ( = (point-z pt) *depth* )  
        ( setf south (cons pt south) )  
    )  
  )  
  south 
)  


;-------hoop making aux methods

; to set the hoop locations by creating instance of hoops 
 
( defmethod make-hoop ( (hlist list) ) 
  ( setf hoops '() ) 
  ( dolist ( h hlist ) 
    (setf hoops (cons (make-instance 'hoop :location h) hoops) ) 
  ) 
  hoops 
)  ; end of make-hoop


; make-hoop1 
 
( defmethod make-hoop1 ( (lst list) ) 
  ( setf middle (find-mid-pt *length*) ) 
  ( setf mid (find-mid-pt middle) ) 
  ( dolist ( l lst)  
    ( setf x (point-x l) ) 
    ( if ( = mid x ) 
        ( setf it l ) 
    ) 
  ) 
  ( setf hoop (make-instance 'hoop :location it) ) 
  hoop  
) 

; make-hoop2 
 
( defmethod make-hoop2 ( (lst list)  ) 
  ( setf mid (find-mid-pt *length*) ) 
  ( dolist (l lst)  
    ( setf x (point-x l) ) 
    ( if ( = mid x ) 
        ( setf it l ) 
    ) 
  ) 
  (setf hoop (make-instance 'hoop :location it) ) 
  hoop 
) 

; make-hoop3 
 
( defmethod make-hoop3 ( (lst list) ) 
  ( setf middle ( find-mid-pt *length* ) ) 
  ( setf mid (find-mid middle *length*) ) 
  ( dolist ( l lst) 
    ( setf x (point-x l) ) 
    ( if ( = mid x ) 
        ( setf it l ) 
    ) 
    
  ) 
  ( setf hoop (make-instance 'hoop :location it) ) 
  hoop 
) 


;-----------------------------------------------------------------------
;    game balls  method section
;-----------------------------------------------------------------------

; to make the set of balls necessary to play the game of quidditch 
;   and display them 
 
( defmethod make-balls ( ) 
  ( setf s (make-instance 'snitch :visable (random-num 1 0) :free '0) ) 
  ( setf b1 (make-instance 'bludger :behavior (random-num 1 0)) ) 
  ( setf b2 (make-instance 'bludger :behavior (random-num 1 0)) ) 
  ( setf q1 (make-instance 'quaffle :owner '0) ) 
  ( setf golden (make-instance 'ball :name 'gn :type s  
                               :location 'nil ) ) 
  ( setf bludg1 (make-instance 'ball :name 'b1 :type b1  
                           :location 'nil ) ) 
  ( setf bludg2 (make-instance 'ball :name 'b2 :type b2 
                           :location 'nil ) ) 
  ( setf quaffle (make-instance 'ball :name 'qu :type q1 
                                :location 'nil ) ) 
  ( setf balls (list golden bludg1 bludg2 quaffle) )
  ( display golden ) 
  ( display bludg1 ) 
  ( display bludg2 ) 
  ( display quaffle ) 
  balls
)


;------------------------------------------------------------------------
;    team method section
;------------------------------------------------------------------------

; to make a team 
 
( defmethod make-team ((name symbol) ) 
  ( setf tlst (get-team-info name) ) 
  ( setf tname (car tlst) )  
  ( setf ros (make-players (cdr tlst)) ) 
  ( setf hist (make-history) ) 
  ( cond 
    ( (eq tname 'gryffindor) 
      ( setf cap 'wood ) ) 
    ( (eq tname 'slytherin) 
      ( setf cap 'flint) ) 
  ) 
   
  ( setf team (make-instance 'team :name tname :roster ros :captain cap 
                             :history hist) ) 
  team 
) ;endof make-team

; to make a players 
 
( defmethod make-players (( plst list)  ) 
  ( setf players '() ) 
  ( dolist ( pl plst ) 
    ( setf player ( make-person pl ) ) 
    ( setf players (cons player players) ) 
    ( setf plst ( cdr plst ) ) 
  ) 
  players 
) ;endof make-players

; to make an instance of history  
  
( defmethod make-history ( &aux h )  
  ( setf h (make-instance 'history :wins 0 :losses 0) )  
) 

; get-team-info

( defmethod get-team-info ( (nm symbol) ) 
  ( cond 
    ( ( equal nm 'gryffindor ) 
      ( setf info (team-gryffindor) ) 
    ) 
    ( ( equal nm 'slytherin )  
      ( setf info (team-slytherin) ) 
    )  
  ) 
  info 
) 
 
 
( defmethod team-gryffindor () 
  ( setf glst '(gryffindor (ow keeper) (kb chaser) (as chaser)  
                    (aj chaser) (fw beater) (gw beater) (hp seeker) ) ) 
  glst 
) 
 
( defmethod team-slytherin () 
  ( setf slst '(slytherin (mf chaser) (bl keeper) (ap chaser) (wa chaser) 
                    (bo beater) (de beater) (dm seeker) ) ) 
  slst 
)

;---------------------------------------------------------------------
;    person method section
;---------------------------------------------------------------------

; to make a person  
 
( defmethod make-person (( l list)) 
  ( setf n (car l) ) 
  ( setf p (second l) ) 
  ( setf loc (location-0 n) )  
  ( setf pers (make-instance 'person :name n :position p  
                             :location loc 
                             :knowledge '()) ) 
  pers 
) 


;----------------------------------------------------------------------
;       point method section
;----------------------------------------------------------------------

; to get randomly generated cooordinate set 
 
( defmethod get-loc-set ( (x number) (y number) (z number)  )  
  ( setf a ( random-num x 0) ) 
  ( setf b ( random-num y 0) ) 
  ( setf c ( random-num z 0) ) 
  ( setf l (list a b c) ) 
  l 
) 
 
; to find a specific point 
 
( defmethod get-point ((l list)  ) 
  ( setf points (pitch-points *pitch*) ) 
  ( setf poss-xs ( find-xs points (car l) ) ) 
  ( setf poss-ys ( find-ys poss-xs (second l) ) ) 
  ( setf it ( find-z poss-ys (third l) ) ) 
  it 
) 
  

;***************************************************************************
;               P R E D I C A T E        S E C T I O N 
;***************************************************************************

; nzone-p method -- is point within the north goal zone 
 
( defmethod nzone-p ((p point) (x number))  
  
  ( < (point-z p) x )  

) ; end of nzone-p

; szone-p method -- is point within the south goal zone

( defmethod szone-p ( (p point) (x number)) 
  
  ( > (point-z p) x) 
    
) ; end of szone-p

; valid-point-p 
 
( defmethod valid-point-p ( (pt point) ) 
  ( and 
    ( eq (point-occupied pt) 'nil ) 
    ( in-flight-p pt ) 
  ) 
) ;endof valid-point-p
 
; valid-loc-p 
 
( defmethod valid-loc-p ( (pt point) (per person)) 
  ( and 
    ( in-bounds-p pt per ) 
    ( valid-point-p pt ) 
  ) 
) ;endof valid-loc-p
 

; in-bounds-p -- is person inbounds

( defmethod in-bounds-p ( (pt point) (per person) ) 
  ( cond 
    ( ( eq ( person-position per) 'keeper ) 
      ( keeper-position-p pt ) 
    ) 
    ( t 
       
    ) 
  ) 
) ;endof in-bounds-p

; in-flight-p - player must be in air ( height > 0 ) 
 
( defmethod in-flight-p ( (p point) )

  ( if ( > (point-y p) 0 ) t )
) ;endof in-flight-p
 
; keeper-position-p - a keeper must stay within his goal area 
 
( defmethod keeper-position-p ( (p point) ) 
  ( setf nzone (pitch-ngzone *pitch*) ) 
  ( setf szone (pitch-sgzone *pitch*) ) 
  ( cond
    ( ( member p nzone ) t )
    ( ( member p szone ) t )
  ) 
) ;endof keeper-position-p

; release-p - asks if balls are ready to take the field

( defmethod release-p ( )
  ( setf blst (game-balls *game*) )
  ( setf release 'nil )
  ( dolist ( b blst)
    ( if (equal (ball-location b) 'nil)
        ( setf release t )
    )
  )
  release
)  ;endof release-p


; bludg-p - checks to see if neighboring point is a blugder

( defmethod bludg-p ( (pt point) (per person) )
  ( and
    ( eq (person-position per) 'beater )
    ( or 
      ( eq (point-occupied pt) 'b1 )
      ( eq (point-occupied pt) 'b2 )
    )
  )
)  ;endof bludg-p

; quaf-p - if person is a chaser or keeper, checks to see if neighboring point is a quaffle

( defmethod quaf-p ( (pt point) (per person) )
  ( or
    ( and
      ( eq (person-position per) 'chaser )
      ( eq (point-name pt) 'qu )
    )
    ( and
      ( eq (person-position per) 'keeper )
      ( eq (point-name pt) 'qu )
    )
  )
    
) ;endof quaf-p

; snitch-p - if person is the seeker, checks to see if neighboring point is the snitch

( defmethod snitch-p ( (pt point) (per person) )
  ( and
    ( eq (person-position per) 'seeker )
    ( eq (point-name pt) 'gn )
  )
)  ;endof snitch-p


; practice-p - asks if this is a practice (currently only one team can "take the field" at a time)

( defmethod practice-p () 
  ( or
    ( eq (read) 'Y )
    ( eq (read) 'y )
  )
)

; second-team - determines second team

( defmethod second-team-p ((s symbol))
  ( cond
    ( (eq s 'gryffindor)
      ( setf o 'slytherin)
    )
    ( (eq s 'slytherin)
      ( setf o 'gryffindor)
    )
  )
  o
)

;***************************************************************************
;               M I S C      M E T H O D      S E C T I O N
;***************************************************************************

; find-mid-pt 
 
( defmethod find-mid-pt (( n number)) 
  ( if ( = ( mod n 2 ) 1 ) 
      ( setf mid ( / ( + n 1 ) 2 ) ) 
    ( setf mid ( / n 2 ) ) 
  ) 
) ;endof find-mid-pt
 
; find-mid
( defmethod find-mid ( (low number) (high number) ) 
  ( if ( = ( mod ( - high low ) 2 ) 1 ) 
      ( setf mid ( + (/ (+ high 1) 2) low ) ) 
    ( setf mid ( + ( / (- high low) 2 ) low ) ) 
  ) 
) ;endof find-mid

; to find all poss x-coord that match one length  
  
( defmethod find-xs ( (plist list) (n number) )  
  ( setf xs '() )  
  ( dolist (p plist)  
    ( if ( = (point-x p) n )  
        ( setf xs (cons p xs) ) )  
  )  
  xs  
)  ;endof find-xs
  
; to find all poss y-coord that match one height and length  
  
( defmethod find-ys ( (plist list) (n number) )  
  ( setf ys '() )  
  ( dolist (p plist)  
    ( if ( = (point-y p) n )  
        ( setf ys (cons p ys) ) )  
  )  
  ys  
)  ;endof find-ys

; to find one specific point that matches depth  
  
( defmethod find-z ( (plist list) (n number) )  
  ( dolist (p plist)  
    ( if ( = (point-z p) n )  
        ( setf it p )  
    )  
  )  
  it  
)  ;endof find-z

; get-midfld-spt

( defmethod get-midfld-spt () 
  ( setf it 'nil )
  ( setf count '0 )
  ( setf midlst ( pitch-midfld *pitch* ) )
  ( setf len (length midlst) )
  ( setf n (random-num len 1 ) )
  ( dolist (m midlst)
    ( if ( and
           ( = n count)
           ( in-flight-p m )
         )
        (setf it m) 
    )  
    ( setf count (+ count 1) )
  )
  ( if ( eq it 'nil )
      ( get-midfld-spt )
  )
  it
) ;endof get-midfld-spt


; random number generator 
 
( defun random-num (high low  ) 
  ( setf spread ( + ( - high low ) 1 ) ) 
  ( setf xrn ( random spread ) ) 
  ( setf rn ( + low xrn ) ) 
    rn 
) 

;****************************************************************************
;                D I S P L A Y       S E C T I O N
;****************************************************************************

; display methods 
 
; pitch 
 
( defmethod display ((p pitch)  ) 
  ( setf plist (pitch-points p) ) 
  ( setf hoops (get-hoops p) ) 
  ( setf szone (pitch-sgzone p) ) 
  ( setf nzone (pitch-ngzone p) ) 
  ( dolist (p plist) 
    ( display p ) 
    ( if (member p szone) 
        ( princ " south goal zone") 
    ) 
    ( if ( member p nzone ) 
        ( princ " north goal zone" ) 
    ) 
    ( if ( member p hoops ) 
        ( princ " hoop" )  
    )   
    ( terpri ) 
  ) 
 
) 
 
; pitch display helper function

( defmethod get-hoops ( (p pitch)  ) 
  ( setf h-loc '() ) 
  ( setf n (pitch-nhoops p) ) 
  ( setf s (pitch-shoops p) ) 
  ( setf hoops (append n s) ) 
  ( dolist ( h hoops ) 
    ( setf h-loc ( cons (hoop-location h) h-loc ) ) 
  ) 
  h-loc 
) 

; display-flat

( defmethod display-flat ( (p pitch)   )
  ( setf plst ( pitch-points p ) )
  ( display-tiers plst *height* )
)

( defmethod display-tiers ( (plst list) ( h number ) &aux tier )
  ( terpri )
  ( princ "tier " ) ( prin1 h ) (terpri) 
  ( setf tier (get-tier plst h) )
  ( display-tier tier *length*)
  ( if ( not ( = h 0 ) )
      ( display-tiers plst (- h 1) )
  )
)  ;endof display-tiers  

( defmethod get-tier ( (plst list) ( h number) )
  ( setf tier '() )
  ( dolist ( pl plst )
    ( if ( = (point-y pl) h )
        ( setf tier (cons pl tier) )
    )
  )
  tier
)  ;endof get-tier

( defmethod display-tier ( (pl list) (len number) )
  ( display-row pl len )
  ( if ( not ( = len  0 ))
      ( display-tier pl (- len 1) )
  )
  
) ;endof display-tier


( defmethod display-row ( (pl list) (len number))
  ( dolist (p pl)
   ( cond
     ( ( = (point-x p) len)
        ( cond
          ( ( not ( eq (point-occupied p) 'nil) )
            ( prin1 (point-occupied p) )
            ( princ " " )
          )
          ( (member p (pitch-midfld *pitch* ) )
            ( princ "md" )
            ( princ " " )
          )
          ( (member p (pitch-sgzone *pitch*) )
            ( princ "sz" )
            ( princ " " )
          )
          ( (member p (pitch-ngzone *pitch*))
            ( princ "nz")
            ( princ " " )
          )
          ( t
            ( princ "**" )
            ( princ " " )
          )
        )
     )
   )
  )
  ( terpri )
)  ;endof display-row 
    


    

;*******************************
; person 
 
( defmethod display ((p person)  ) 
  ( princ "name: " ) 
  ( princ ( person-name p ) ) 
  ( princ "    " ) 
  ( princ " position: " ) 
  ( princ ( person-position p ) ) 
  ( princ " knowledge: " ) 
  ( display-know ( person-knowledge p ) ) 
  ( princ " location: " ) 
  ( setf l ( person-location p ) ) 
  ( display l ) 
  ( terpri ) 
) 
 

; person knowledge

( defmethod display-know ( (klst list) )
  ( princ "neighbors are..." ) (terpri)
  ( dolist (k klst)
    ( display k )
    ( terpri )
  )
)  


;************************************
; balls 
 
( defmethod display ((b ball) ) 
  ( princ "name: " ) 
  ( princ (ball-name b) ) 
  ( princ " type: " ) 
  ( setf type (ball-type b) ) 
  ( display type ) 
  ( setf l (ball-location b) ) 
  ( if (not (eq l 'nil)) 
      ( display l ) ) 
  ( terpri ) 
) 

; display balls helper functions

( defmethod display ((s snitch)) 
  ( if ( = (snitch-visable s) 1 ) 
      ( princ "snitch is visable" ) 
    ( princ "snitch is not visable" ) 
     
  ) 
  ( if ( = (snitch-free s) 0 ) 
    ( princ ", snitch is free" ) 
    (princ ", snitch is not free") 
     
  ) 
  
) 
 
( defmethod display ((b bludger)) 
  ( cond 
    ( ( = (bludger-behavior b) 0 ) 
      ( princ "bludger is friendly" ) ) 
    ( ( = (bludger-behavior b) 1 ) 
      ( princ "bludger is not friendly") ) 
  ) 
) 
 
( defmethod display ((q quaffle)) 
  ( cond 
    ( ( = (quaffle-owner q) 0 ) 
      ( princ "quaffle is unpossessed" ) ) 
    ( ( = (quaffle-owner q) 1 ) 
      ( princ "someone has quaffle" ) ) 
  ) 
) 

;******************************************** 
; point 
 
( defmethod display ((p point)) 
  ( princ "x: " ) ( prin1 (point-x p) ) ( princ "  " ) 
  ( princ "y: " ) ( prin1 (point-y p) ) ( princ "  " ) 
  ( princ "z: " ) ( prin1 (point-z p) ) ( princ "  " ) 
  ( princ "occupied: " ) 
  ( if ( eq (point-occupied p) 'nil )
      ( princ "empty" )
    ( prin1 (point-occupied p) )
  )  
) 

;**********************************************
; history 
 
( defmethod display ((h history)) 
  ( princ "wins: " ) (prin1 (history-wins h) ) 
  ( princ " losses: " ) (prin1 (history-losses h) ) 
  ( terpri ) 
) 

;******************************************** 
; team 
 
( defmethod display ((tm team)  ) 
  ( princ "TEAM NAME: " ) ( princ (team-name tm) ) (terpri) 
  ( princ "Captain: " ) ( princ (team-captain tm) ) (princ "  ") 
  ( setf h (team-history tm) ) 
  ( princ "History: ") (display h ) (terpri) 
  ( setf players (team-roster tm) ) 
  ( dolist (pl players) 
    ( display pl ) 
  ) 
) 

;**************************
; end of display section  *
;**************************