Newer
Older
atlantis / lisp / client.lisp
;;;
;;; Atlantis is a framework for creating multi-user dungeon worlds.
;;; This is the Common Lisp implementation.
;;;
;;; The client module is responsible for the actual user interface presented
;;; to a player. (Warning: this will likely change significantly, currently
;;; I am only implementing a mock-up before I get the networking part working.)
;;;
;;; Licensed under the terms of the MIT license.
;;; author: Daniel Vedder
;;; date: 21/05/2015
;;;

(let ((player NIL))
	(defun play-game (&optional player-name)
		"The main game loop"
		;; XXX Development
		(when (y-or-n-p "~&Load the test world?")
			(load-file "../ATL/lisp-test.atl"))
		;; Initialize the player if necessary
		(when (null player)
			(if player-name
				(setf player (get-game-object 'player player-name))
				(error "~&No player name specified!")))
		(when (null player)
			(create-player player-name))))

(defun create-player (player-name)
	"The user creates a new player"
	;; This function feels somewhat inelegant - lot's of repetetive stuff.
	;; Is it worth cleaning up?
	(let ((player (make-player :name player-name))
			 (race NIL) (character-class NIL)
			 (strength 0) (dexterity 0)
			 (constitution 0) (intelligence 0)
			 (items NIL) (weapons NIL)
			 (character-attributes '(strength dexterity
										constitution intelligence))
			 (character-points NIL))
		(format t "~&The name you have chosen is not registered on this game.")
		(unless (y-or-n-p "~&Create a new player?") (start-menu))
		;; Chose race and class
		(format t "~&Please chose a race:")
		(format t "~&Options: ~A" (string-from-list (list-objects 'race) " - "))
		(setf race (input-string))
		(while (not (member race (list-objects 'race) :test #'equalp))
			(format t "~&Invalid choice. Please reenter:")
			(setf race (input-string)))
		(setf race (get-game-object 'race race))
		(format t "~&Please chose a class:")
		(format t "~&Options: ~A" (string-from-list
									  (list-objects 'character-class) " - "))
		(setf character-class (input-string))
		(while (not (member character-class
						(list-objects 'character-class) :test #'equalp))
			(format t "~&Invalid choice. Please reenter:")
			(setf character-class (input-string)))
		(setf character-class
			(get-game-object 'character-class character-class))
		;; Set character attributes
		(while (< (reduce #'+ character-points) 24) ; Warning: magic number!
			(set-list (random 20) a b c d)
			(setf character-points (list a b c d)))
		(setf text "
Now distribute your attribute points. Random numbers have been chosen, 
you may assign one number to each of the following attributes:")
		(format t "~&~A~%~A~%~%The numbers are: ~%~A"
			text (string-from-list character-attributes " - ")
			(string-from-list character-points " - "))
		;; FIXME Rewrite this section ? >>>
		(dolist (attr character-attributes)
			(simple-input (symbol-value attr)
				(concatenate 'string (string-downcase (symbol-name attr)) ":"))
			;(break)
			(while (not (member attr character-points))
				(format t "~&Sorry, invalid number chosen. Please reenter:")
				(simple-input attr
					(concatenate 'string
						(string-downcase (symbol-name attr)) ":")))
			(setf character-points
				(remove-if #'(lambda (x)
								 (= x (symbol-value attr)))
					character-points)))
		;; Update the player
		(setf (player-race player) race)
		(setf (player-class player) character-class)
		(setf (player-strength player) strength)
		(setf (player-constitution player) constitution)
		(setf (player-dexterity player) dexterity)
		(setf (player-intelligence player) intelligence)
		player))