about summary refs log blame commit diff stats
path: root/crpg.lisp
blob: 7674b6ba603fcfa47f84f809d9cb2cbdc0cda603 (plain) (tree)
1
2
3
4
5
6
7
8







                                


                                                      
                                              






                                                                     

                                                             
                                                        



                                                         









                                                                                              




















                                                              



                                                       
                          
                                           

                    






                                         
                                       
                                         




                                                        
                    








                                      
                                        

                                       










                                                                               
           
                                  
                                      
                                                          
                                                   
                                   
                                      
                                                          
                                                   
                                  
                                      
                                                          
                                                  
                                   
                                      
                                                          

                                                  

                                           
                                                




















                                                                                                 
                                   



































                                                                                                                


                       
                           
                     
                           
                     
                           
                     
                           
                     

                                       


                                                      
                 
                     
           












                            
                                                                
                
                                                 
               
                                   



                                        
                                                                                     
                            





                                                                          


                                                                               
                                        











                                                                                                                                







                                             
                                                                              

                                  


                                                                 





                            
#!/usr/local/bin/clisp
(load "cscreen")
(require "cscreen")
(defpackage #:crpg
  (:use #:common-lisp #:cscreen)
  (:export
   #:main))
(in-package #:crpg)
(defclass <coord> () ((row :initarg r :accessor row)
		      (col :initarg c :accessor col)))
(defmethod print-object ((obj <coord>) stream)
  (format stream "~A ~A" (row obj) (col obj)))
(defclass <location> () ((monster :initarg m :accessor monster)
			 (item :initarg i :accessor item)))
(defmethod initialize-instance :after ((self <location>) &key)
  (setf (monster self) nil)
  (setf (item self) nil))
(defvar *map* (make-array '(10 10)))
(defvar *curr-coord* (make-instance (find-class '<coord>) 'r 5 'c 5))
(defconstant +move-err+ "You cannot move in that direction!")
(defconstant +press-key+ "Press Enter to continue.")
(defconstant +exit+ (make-instance (find-class '<coord>)
				   'r (+ (random 10) 1)
				   'c (+ (random 10) 1)))
;; (format *standard-output* "~A~%" +exit+)
;; (sleep 3)
(defclass <player> () ((gold :accessor gold)
		       (health :accessor health)
		       (weapon :accessor weapon)))
(defmethod initialize-instance :after ((self <player>) &key)
  (setf (gold self) 0)
  (setf (health self) 20)
  (setf (weapon self) 1))
(defmethod print-object ((obj <player>) stream)
  (format stream "Gold: ~A   Health: ~A   Weapon: ~A~%" (gold obj) (health obj) (weapon obj)))
(defvar *the-player* (make-instance (find-class '<player>)))
(defclass <monster> () ((name :initarg n :reader name)
			(attack :initarg a :reader attack)
			(health :initarg h :accessor health)))
(defmethod print-object ((obj <monster>) stream)
  (format stream "~A" (name obj)))
(defun create-monster (n a h)
  (make-instance (find-class '<monster>) 'n n 'a a 'h h))
(defconstant +monsters+
  (vector
   (create-monster "blind bat" 2 1)
   (create-monster "rat" 1 1)
   (create-monster "snake" 3 1)
   (create-monster "goblin" 2 3)
   (create-monster "troll" 4 4)
   (create-monster "bear" 5 5)
   (create-monster "lion" 5 4)
   (create-monster "sabretooth" 6 5)
   (create-monster "elephant" 7 8)
   (create-monster "dragon" 9 8)))
(defclass <item> () ((name :initarg n :reader name)
		     (class :initarg c :reader class)
		     (value :initarg v :reader value)))
(defclass <food> (<item>) ())
(defclass <weapon> (<item>) ())
(defclass <trap> (<item>) ())
(defun create-item (n c v)
  (make-instance (find-class c) 'n n 'v v))
(defconstant +items+
  (vector
   (create-item "apple     " '<food> 1)
   (create-item "bread     " '<food> 2)
   (create-item "chicken   " '<food> 3)
   (create-item "dagger    " '<weapon> 2)
   (create-item "sword     " '<weapon> 3)
   (create-item "halberd   " '<weapon> 4)
   (create-item "smoke     " '<trap> 1)
   (create-item "noose trap" '<trap> 2)
   (create-item "pit trap  " '<trap> 3)))
(defgeneric copy (obj))
(defmethod copy ((obj <monster>))
  (create-monster (name obj) (attack obj) (health obj)))
(defvar *curr-monster*)
(defvar *monster-gold*)
(defvar *curr-item*)
(defun my-print (x)
  (format *standard-output* "~A~%" x))
(defun print-help ()
  (cursor 14 1)
  (my-print "Commands:   n - north")
  (my-print "            s - south")
  (my-print "            e - east")
  (my-print "            w - west")
  (my-print "            a - attack")
  (my-print "            t - take item")
  (my-print "            x - use exit")
  (write-char #\newline)
  (my-print "            q - quit")
  (cursor 14 40)
  (format *standard-output* "+~A+~%" (make-string 10 :initial-element #\-))
  (cursor 15 40)
  (format *standard-output* "|~A|~%" (make-string 10 :initial-element #\space))
  (cursor 16 40)
  (format *standard-output* "+~A+~%" (make-string 10 :initial-element #\-))
  (cursor 17 44)
  (my-print "ITEM"))
(defgeneric move (coord dir))
(defmethod move ((coord <coord>) dir)
  (case dir
	((n) (if (= (row coord) 1)
		 (my-print +move-err+)
	       (progn (setf (row coord) (- (row coord) 1))
		      (my-print "You go north."))))
	((s) (if (= (row coord) 10)
		 (my-print +move-err+)
	       (progn (setf (row coord) (+ (row coord) 1))
		      (my-print "You go south."))))
	((w) (if (= (col coord) 1)
		 (my-print +move-err+)
	       (progn (setf (col coord) (- (col coord) 1))
		      (my-print "You go west."))))
	((e) (if (= (col coord) 10)
		 (my-print +move-err+)
	       (progn (setf (col coord) (+ (col coord) 1))
		      (my-print "You go east."))))
	(t (error "bad dir"))))
(defgeneric coord= (l r))
(defmethod coord= ((l <coord>) (r <coord>))
  (and (= (row l) (row r)) (= (col l) (col r))))
(defun attack-cmd ()
  (if (null *curr-monster*)
      (my-print "There's nothing to attack!")
    (progn (loop while (and (> (health *curr-monster*) 0) (> (health *the-player*) 0))
		 do (cursor 10 1) (clrtoeol)
		 (cursor 11 1) (clrtoeol)
		 (cursor 12 1) (clrtoeol)
		 (cursor 10 1)
		 (let ((attack (+ (weapon *the-player*) (random 9)))
		       (monster-attack (attack *curr-monster*)))
		   (cond
		    ((= attack monster-attack)
		     (my-print "No one wins this round."))
		    ((> attack monster-attack)
		     (format *standard-output* "You deal the ~A a blow!~%" (name *curr-monster*))
		     (setf (health *curr-monster*) (- (health *curr-monster*) 1)))
		    ((< attack monster-attack)
		     (my-print "You have been wounded!")
		     (setf (health *the-player*) (- (health *the-player*) 1))))
		   (my-print +press-key+)
		   (read-line)))
	   (cursor 10 1) (clrtoeol)
	   (if (> (health *the-player*) 0)
	       (progn (clrtoeol)
		      (my-print "You won the fight!")
		      (format *standard-output* "You found ~A pieces of gold!~%" *monster-gold*)
		      (setf (gold *the-player*) (+ (gold *the-player*) *monster-gold*))
		      (setq *curr-monster* nil)
		      (setf (monster (aref *map* (row *curr-coord*) (col *curr-coord*))) nil)
		      (my-print +press-key+)
		      (read-line))
	     (progn (format *standard-output* "The ~A killed you!~%" (name *curr-monster*))
		    (my-print "Game over!")
		    (throw 'quit nil))))))
(defun take()
  (if (null *curr-item*)
      (progn (cursor 10 1)
	     (my-print "Nothing to take!")
	     (my-print +press-key+)
	     (read-line))
    (progn (case (class-of *curr-item*)
		 ((find-class '<food>)
		  (cursor 10 1)
		  (format *standard-output* "You eat the ~A.~%" (name *curr-item*))
		  (if (>= (health *the-player*) 20)
		      (my-print "You had no wounds, so the food is wasted.~%")
		    (progn (setf (health *the-player*) (+ (health *the-player*) (value *curr-item*)))
			   (format *standard-output* "You gain ~A health points ~%" (value *curr-item*)))))
		 ((find-class '<weapon>)
		  (cursor 10 1)
		  (if (>= (weapon *the-player*) (value *curr-item*))
		      (my-print "You have a similar or better weapon.")
		    (progn (format *standard-output* "You pick up a ~A!")
			   (setf (weapon *the-player*) (value *curr-item*))
			   (format *standard-output* "Your weapon rating is now ~A.~%" (weapon *the-player))))))
	   (my-print +press-key+)
	   (read-line)
	   (setf (item (aref *map* (row *curr-coord*) (col *curr-coord))) nil))))
(defun handle-cmd (cmd)
  (cond
   ((string= cmd "n")
    (move *curr-coord* 'n))
   ((string= cmd "s")
    (move *curr-coord* 's))
   ((string= cmd "w")
    (move *curr-coord* 'w))
   ((string= cmd "e")
    (move *curr-coord* 'e))
   ((string= cmd "x")
    (if (coord= *curr-coord* +exit+)
	(if (< (gold *the-player*) 100)
	    (my-print "You dont have enough gold!")
	  (my-print "You have escaped! Well done!"))))
   ((string= cmd "a")
    (attack-cmd))
   ((string= cmd "t")
    (take))
   ((string= cmd "q")
    (my-print "Bye!")
    (throw 'quit nil))))
(defun get-next-cmd ()
  (cursor 8 1)
  (my-print "What now")
  (let ((reply (read-line)))
    (cursor 10 1)
    (clrtoeol)
    reply))
(defun main-loop ()
  (loop
   (cursor 1 1)
   (format *standard-output* "Your position: ~A~%" *curr-coord*)
   (cursor 1 25)
   (format *standard-output* "~A~%" *the-player*)
   (cursor 2 1)
   (if (coord= *curr-coord* +exit+)
       (my-print "You are at the exit!")
     (clrtoeol))
   (cursor 3 1)
   (clrtoeol)
   (let ((monster-type (monster (aref *map* (row *curr-coord*) (col *curr-coord*)))))
     (if (null monster-type)
         (progn (setq *curr-monster* nil)
                (format *standard-output* "Monster: nothing~%")
                (setq *monster-gold* 0))
         (progn (setq *curr-monster* (copy (elt +monsters+ monster-type)))
                (format *standard-output* "Monster: ~A~%" *curr-monster*)
                (setq *monster-gold* (* monster-type (random 6))))))
   (let ((item-type (item (aref *map* (row *curr-coord*) (col *curr-coord*)))))
     (if (null item-type)
	 (progn (cursor 15 41)
		(my-print "nothing   "))
       (progn (setq *curr-item* (elt +items+ item-type))
	      (cursor 15 41)
	      (my-print (name *curr-item*))
	      (if (eq (class-of *curr-item*) (find-class '<trap>))
		  (progn (cursor 10 1)
			 (format *standard-output* "The ~A damages you for ~A points!~%" (name *curr-item*) (value *curr-item*))
			 (setf (health *the-player*) (- (health *the-player*) (value *curr-item*)))
			 (setf (item (aref *map* (row *curr-coord*) (col *curr-coord*))) nil)
			 (if (<= (health *the-player*) 0)
			     (progn (my-print "You die!")
				    (my-print "Game over!")
				    (throw 'quit nil))))))))
   (handle-cmd (get-next-cmd))))
(defun init ()
  (page)
  (setq *random-state* (make-random-state t))
  (do ((row 1 (+ row 1)))
      ((>= row 10))
      (do ((col 1 (+ col 1)))
	  ((>= col 10))
	  (setf (aref *map* row col) (make-instance (find-class '<location>)))
	  (let ((rnd (random 11)))
	    (if (/= rnd 0)
		(setf (monster (aref *map* row col)) (- rnd 1))))
	  (if (< (random 1.0) 0.2)
	      (setf (item (aref *map* row col)) (random 9))))))
(defun main ()
  (init)
  (print-help)
  (catch 'quit (main-loop)))
(provide "crpg")
(crpg:main)