Merge branch 'clos' of swatson/clwars into master

clwars.lisp

@@ -1,3 +1,4 @@
+(ql:quickload "closer-mop")
 (load "~/Repos/clwars/game.lisp")
 
 (defun reload()

economy.lisp

@@ -1,10 +1,9 @@
 ;;; TRADING ;;;
-(defparameter *trade-opt-lookup* (list (cons '1 'buy-menu)
-				       (cons 'b 'buy-menu)
-				       (cons '2 'sell-menu)
-				       (cons 's 'sell-menu)
-				       (cons '3 'top-level-game-menu)
-				       (cons 'r 'top-level-game-menu)))
+(defparameter *trade-opt-lookup* (list (cons '1 (lambda ()
+						  (buy-menu (player-ship-obj *sector*) (market *sector*))))
+				       (cons '2 (lambda ()
+						  (sell-menu (player-ship-obj *sector*) (market *sector*))))
+				       (cons '3 'top-level-game-menu)))
 
 (defvar *trade-menu-options-display* "
 Actions:
@@ -13,137 +12,81 @@ Actions:
 3 | Return to top level | r
 ")
 
-(defun buy-transaction (resource quantity)
+(defun buy-transaction (resource quantity player-ship-obj market-obj)
   "Do they actual purchase transaction, not intended to be called interactively"
-  (let* ((available-player-funds (player-ship-credits *player-ship*))
-	 (inventory (player-ship-inventory *player-ship*))
-	 (price (funcall (symbol-function (find-symbol (string-upcase
-							(concatenate 'string "market-price-of-" resource))))
-			 (sector-market *sector*)))
+  (let* ((available-player-funds (credits player-ship-obj))
+	 (inventory-obj (inventory player-ship-obj))
+	 (price (slot-value market-obj (read-from-string (concatenate 'string "price-of-" resource))))
 	 (total-cost (* quantity price)))
     (if (> total-cost available-player-funds)
 	(progn
 	  (format T "Not enough credits to buy ~A ~A at ~A credits~%" quantity resource price)
-	  (format T "~%PLAYER CREDITS: ~A~%" (player-ship-credits *player-ship*))
+	  (format T "~%PLAYER CREDITS: ~A~%" (credits player-ship-obj))
 	  (return-from buy-transaction NIL))
 	(progn
 	  (let ((resource-sym (read-from-string resource))
 		(minus-funds (lambda (amount)
 			       (let ((remainder (- available-player-funds amount)))
-				 (setf (player-ship-credits *player-ship*) remainder)))))
-	    (case resource-sym
-	      ;;; This is insanely annoying, and will need to be duplicated
-	      ;;; for the sell logic, but don't know how else to handle this here
-	      (gruel (progn
-			(funcall minus-funds total-cost)
-			(setf (player-inventory-gruel inventory)
-			      (+ (player-inventory-gruel inventory) quantity))))
-	      (archeotech (progn
-			(funcall minus-funds total-cost)
-			(setf (player-inventory-archeotech inventory)
-			      (+ (player-inventory-archeotech inventory) quantity))))
-	      (petrofuel (progn
-			(funcall minus-funds total-cost)
-			(setf (player-inventory-petrofuel inventory)
-			      (+ (player-inventory-petrofuel inventory) quantity))))
-	      (spice (progn
-			(funcall minus-funds total-cost)
-			(setf (player-inventory-spice inventory)
-			      (+ (player-inventory-spice inventory) quantity))))
-	      (ammo (progn
-			(funcall minus-funds total-cost)
-			(setf (player-inventory-ammo inventory)
-			      (+ (player-inventory-ammo inventory) quantity))))))
-	  (format T "Successfully purchased ~A ~A~%" quantity resource)))))
+				 (setf (credits player-ship-obj) remainder)))))
+	    (setf (slot-value inventory-obj resource-sym) (+ quantity (slot-value inventory-obj resource-sym)))
+	    (funcall minus-funds total-cost)
+	    (format T "Successfully purchased ~A ~A~%" quantity resource))))))
 
-(defun buy-menu ()
+(defun buy-menu (player-ship-obj market-obj)
   (let ((item-to-buy (prompt-read "Enter a resource to buy: "))
 	(quantity (parse-integer (prompt-read "Enter a quantity to buy: "))))
     (if (member item-to-buy '("gruel" "ammo" "petrofuel" "archeotech" "spice") :test #'string=)
 	(progn
-	  (buy-transaction item-to-buy quantity)
-	(trade-menu)))))
-	
+	  (buy-transaction item-to-buy quantity player-ship-obj market-obj)))))
 
-(defun sell-transaction (resource quantity)
+(defun sell-transaction (resource quantity player-ship-obj market-obj)
   "Do the sale transaction, not intended to be called interactively"
-  (let* ((available-player-funds (player-ship-credits *player-ship*))
-	 (inventory (player-ship-inventory *player-ship*))
-	 (available-player-resource (funcall (symbol-function (find-symbol (string-upcase
-									    (concatenate 'string "player-inventory-" resource))))
-					     inventory))
-	 (price (funcall (symbol-function (find-symbol (string-upcase
-							(concatenate 'string "market-price-of-" resource))))
-			 (sector-market *sector*)))
+  (let* ((resource-sym (read-from-string resource))
+	 (available-player-funds (credits player-ship-obj))
+	 (inventory (inventory player-ship-obj))
+	 (available-player-resource (slot-value inventory resource-sym))
+	 (price (slot-value market-obj (read-from-string (concatenate 'string "price-of-" resource))))
 	 (total-profit (* quantity price)))
     (if (> quantity available-player-resource)
 	(progn
 	  (format T "Not enough ~A to sell ~A. You have ~A~%" resource quantity available-player-resource)
 	  (return-from sell-transaction NIL))
 	(progn
-	  (let ((resource-sym (read-from-string resource))
-		(remove-resource (lambda (amount)
+	  (let ((remove-resource (lambda (amount)
 				   (let ((new-credits (+ available-player-funds total-profit)))
-				     (setf (player-ship-credits *player-ship*) new-credits))
+				     (setf (credits player-ship-obj) new-credits))
 				   (- available-player-resource amount)))) ; This is pretty convoluted
-	    ;;; remove-resource lambda is a pretty bad idea
+	    ;;; remove-resource lambda is a pretty bad idea?
 	    ;;; it is used to set the new credits amount and then return the amount needed to
 	    ;;; be removed from the resource in the player inventory. I did it this way
 	    ;;; to keep the logic concise, but it smells bad and is probably stupid
-	    (case resource-sym
-	      ;;; This is insanely annoying, and will need to be duplicated
-	      ;;; for the sell logic, but don't know how else to handle this here
-	      (gruel (progn
-		       (setf (player-inventory-gruel inventory) (funcall remove-resource quantity))))
-	      (petrofuel (progn
-			(setf (player-inventory-petrofuel inventory) (funcall remove-resource quantity))))
-	      (spice (progn
-			(setf (player-inventory-spice inventory) (funcall remove-resource quantity))))
-	      (ammo (progn
-			(setf (player-inventory-ammo inventory) (funcall remove-resource quantity))))
-	      (archeotech (progn
-			    (setf (player-inventory-archeotech inventory) (funcall remove-resource quantity))))))
-	  (format T "Successfully sold ~A ~A~%" quantity resource)))))
+	    (setf (slot-value inventory resource-sym) (funcall remove-resource quantity))
+	      ;; (archeotech (progn
+			    ;; (setf (player-inventory-archeotech inventory) (funcall remove-resource quantity))))))
+	  (format T "Successfully sold ~A ~A~%" quantity resource))))))
 
-(defun sell-menu ()
+(defun sell-menu (player-ship-obj market-obj)
   (let ((item-to-sell (prompt-read "Enter a resource to sell: "))
 	(quantity (parse-integer (prompt-read "Enter a quantity to sell: "))))
     (if (member item-to-sell '("gruel" "ammo" "petrofuel" "archeotech" "spice") :test #'string=)
 	(progn
-	  (sell-transaction item-to-sell quantity)
-	(trade-menu)))))
-
-;;; This is kept around in case I need it. I'm not sure
-;;; this is any less 'bad' than how buy/sell-transaction
-;;; currently works
-(defmacro dynamic-slot-access (predicate slotname accessor)
-  "Given a predicate where the predicate is a struct slot accessor like 'market-price-of-',
-   a slotname like 'petrofuel', and a struct location, return the result of the slot accessor function"
-  `(funcall ,(symbol-function (find-symbol (string-upcase (concatenate 'string predicate slotname)))) ,accessor))
-
-;; Can't get this to work how I expect, need to experiment morex
-;; (defmacro dynamic-slot-setting (predicate slotname accessor value)
-;;   `(setf (funcall (symbol-function (find-symbol (string-upcase (concatenate 'string predicate slotname)))) accessor) ,value))
+	  (sell-transaction item-to-sell quantity player-ship-obj market-obj)))))
 
-(defun display-prices ()
-  (let ((market-list (list
-		      (list "Petrofuel" (market-price-of-petrofuel (sector-market *sector*)))
-		      (list "Gruel" (market-price-of-gruel (sector-market *sector*)))
-		      (list "Spice" (market-price-of-spice (sector-market *sector*)))
-		      (list "Ammo" (market-price-of-ammo (sector-market *sector*)))
-		      (list "Archeotech" (market-price-of-archeotech (sector-market *sector*))))))
-    (format T "~%PLAYER CREDITS: ~A~%" (player-ship-credits *player-ship*))
+(defun display-prices (market-obj player-credits)
+  (let ((market-list (loop for resource in (return-slots market-obj)
+			   collect (list resource (slot-value market-obj resource)))))
+    (format T "~%PLAYER CREDITS: ~A~%" player-credits)
     (format T "~%MARKET PRICES~%")
     (format-table T market-list :column-label '("Resource" "Cost"))))
 
-(defun trade-menu ()
-  (display-prices)
-  (display-inventory)
+(defun trade-menu (sector)
+  (display-prices (market sector) (credits (player-ship-obj sector)))
+  (display-inventory (player-ship-obj sector))
   (format t *trade-menu-options-display*)
   (let ((option (prompt-read "Enter an option: ")))
     (format t "~%")
     (handle-opt (read-from-string option) *trade-opt-lookup*))
-  (trade-menu))
+  (trade-menu sector))
 
 ;;; END TRADING ;;;
 
@@ -152,20 +95,15 @@ Actions:
 ;;; Use this parameter when randomizing market prices. Used to lookup how
 ;;; 'random' prices should really be."
 (defparameter *market-price-bounds*
-  (list (cons 'petrofuel '(10 41))
-	(cons 'ammo '(5 31))
-	(cons 'archeotech '(750 2001))
-	(cons 'spice '(5 101))
-	(cons 'gruel '(1 16))))
+  (list (cons 'price-of-petrofuel '(10 41))
+	(cons 'price-of-ammo '(5 31))
+	(cons 'price-of-archeotech '(750 2001))
+	(cons 'price-of-spice '(5 101))
+	(cons 'price-of-gruel '(1 16))))
 
 (defun randomize-market-prices (market)
   (let ((get-random-val (lambda (resource-arg)
 			  (+ (cadr resource-arg)
 			     (random (caddr resource-arg))))))
     (loop for resource in *market-price-bounds*
-	do (case (car resource)
-	     (gruel (setf (market-price-of-gruel market) (funcall get-random-val resource)))
-	     (ammo (setf (market-price-of-ammo market) (funcall get-random-val resource)))
-	     (spice (setf (market-price-of-spice market) (funcall get-random-val resource)))
-	     (archeotech (setf (market-price-of-archeotech market) (funcall get-random-val resource)))
-	     (petrofuel (setf (market-price-of-petrofuel market) (funcall get-random-val resource)))))))
+	  do (setf (slot-value market (car resource)) (funcall get-random-val resource)))))

game.lisp

@@ -1,43 +1,43 @@
+(load "~/Repos/clwars/structs.lisp")
 (load "~/Repos/clwars/economy.lisp")
 (load "~/Repos/clwars/plumbing.lisp")
 (load "~/Repos/clwars/sector.lisp")
 (load "~/Repos/clwars/ship.lisp")
 (load "~/Repos/clwars/ascii-assets.lisp")
-(load "~/Repos/clwars/structs.lisp")
 
 
-(defvar *player-ship*)
-(defvar *sector*)
+(defvar *sector* NIL)
 	
 (defun init-game-state ()
-  (setq *sector* (make-instance 'sector :market (make-instance 'market)))
-  
-  (setq *player-ship* (make-instance 'player-ship :weapons (list (make-instance 'weapon
-										:name "Plamsa"
-										:shield-dmg 3
-										:hull-dmg 3
-										:ammo-cost 5)
-								 (make-instance 'weapon
-										:name "Mega Bolter"
-										:shield-dmg 1
-										:hull-dmg 2
-										:ammo-cost 1)
-								 (make-instance 'weapon
-										:name "Beam"
-										:shield-dmg 1
-										:hull-dmg 3
-										:ammo-cost 3))
-						  :crew (make-instance 'crew
-								       :sanity-val 100
-								       :moral-val 100
-								       :crew-members (loop for x in '(1 2 3 4)
-											   collect (make-instance 'uniq-crew-mem :name (make-crew-mem-name *name-prefixes* *name-values*))))
-						  :inventory (make-instance 'player-inventory
-									    :petrofuel 20
-									    :gruel 20
-									    :spice 0
-									    :ammo 20
-									    :archeotech 0))))
+  (setq *sector* (make-instance 'sector :market (make-instance 'market)
+					:player-ship-obj
+					(make-instance 'player-ship
+						       :weapons (list (make-instance 'weapon
+										     :name "Plamsa"
+										     :shield-dmg 3
+										     :hull-dmg 3
+										     :ammo-cost 5)
+								      (make-instance 'weapon
+										     :name "Mega Bolter"
+										     :shield-dmg 1
+										     :hull-dmg 2
+										     :ammo-cost 1)
+								      (make-instance 'weapon
+										     :name "Beam"
+										     :shield-dmg 1
+										     :hull-dmg 3
+										     :ammo-cost 3))
+						       :crew (make-instance 'crew
+									    :sanity-val 100
+									    :moral-val 100
+									    :crew-members (loop for x in '(1 2 3 4)
+												collect (make-instance 'uniq-crew-mem :name (make-crew-mem-name *name-prefixes* *name-values*))))
+						       :inventory (make-instance 'player-inventory
+										 :petrofuel 20
+										 :gruel 20
+										 :spice 0
+										 :ammo 20
+										 :archeotech 0)))))
 
 
 (defun new-game ()
@@ -69,18 +69,11 @@ Actions:
 ;; See: https://dnaeon.github.io/common-lisp-lookup-tables-alists-and-plists/
 (defparameter *top-level-opt-lookup* (list (cons 'sector-info 'sector-info)
 				 (cons '1 'sector-info)
-				 (cons 'sei 'sector-info)
-				 (cons 'ship-info 'ship-info)
-				 (cons 'si 'ship-info)
-				 (cons '2 'ship-info)
-				 (cons 'trade 'trade-menu)
-				 (cons 't 'trade-menu)
-				 (cons '3 'trade-menu)
-				 (cons 'scout 'scout)
-				 (cons 's 'scout)
+				 (cons '2 (lambda ()
+						    (ship-info (player-ship-obj *sector*))))
+				 (cons '3 (lambda ()
+					    (trade-menu *sector*)))
 				 (cons '4 'scout)
-				 (cons 'leave 'leave)
-				 (cons 'l 'leave)
 				 (cons '5 'leave)))
 
 

ship.lisp

@@ -1,27 +1,23 @@
 ;;; SHIP INFO ;;;
-(defun display-crew ()
-  (let* ((crew (crew-crew-members (player-ship-crew *player-ship*)))
-	 (crew-names 
-	   (loop for member in crew-struct
-		 collect (list (uniq-crew-mem-name member) NIL NIL))))
+(defun display-crew (player-ship-obj)
+  (let ((crew-names 
+	   (loop for member in (crew-members (crew player-ship-obj))
+		 collect (list (name member)))))
     (format T "~%CREW DETAILS~%~%")
-    (format-table T (list (list (crew-sanity-val (player-ship-crew *player-ship*)))) :column-label '("Sanity"))
+    (format-table T (list (list (sanity-val (crew player-ship-obj)))) :column-label '("Sanity"))
     (format T "~%")
     (format-table T crew-names :column-label '("Name" "Buff" "Buff Amount"))))
 
-(defun display-inventory ()
-  (let ((inventory-list (list
-			 (list "Credits" (player-ship-credits *player-ship*))
-			 (list "Petrofuel" (player-inventory-petrofuel (player-ship-inventory *player-ship*)))
-			 (list "Gruel" (player-inventory-gruel (player-ship-inventory *player-ship*)))
-			 (list "Spice" (player-inventory-spice (player-ship-inventory *player-ship*)))
-			 (list "Ammo" (player-inventory-ammo (player-ship-inventory *player-ship*)))
-			 (list "Archeotech" (player-inventory-archeotech (player-ship-inventory *player-ship*))))))
+(defun display-inventory (player-ship-obj)
+  (let* ((inventory (inventory player-ship-obj))
+	(inventory-list (loop for slot in (return-slots inventory)
+			     collect (list
+				      slot (slot-value inventory slot))))) 
     (format T "~%INVENTORY~%")
     (format-table T inventory-list :column-label '("Resource" "Amount"))))
 
 
-(defun ship-info ()
-  (display-crew)
-  (display-inventory))
+(defun ship-info (player-ship-obj)
+  (display-crew player-ship-obj)
+  (display-inventory player-ship-obj))
 ;;; SHIP INFO END ;;;

structs.lisp

@@ -1,3 +1,26 @@
+;; This gets created when travelling to a
+;; new sector
+(defclass sector ()
+  ((market
+    :initarg :market
+    :accessor market)
+   (hazards
+    :initarg :hazards
+    :accessor hazards
+    :initform NIL)
+   (boons
+    :initarg :boons
+    :accessor boons
+    :initform NIL)
+   (player-ship-obj
+    :initarg :player-ship-obj
+    :accessor player-ship-obj
+    :initform NIL)
+   (enemy-ships
+    :initarg :enemy-ships
+    :accessor enemy-ships
+    :initform NIL)))
+
 (defclass player-ship ()
   ((armor-val
     :initarg :armor-val
@@ -68,6 +91,10 @@
     :initarg :crew-members  ; List of *uniq-crew-mem*
     :accessor crew-members)))
 
+;; "Given an object, return the names of it's slots"
+(defun return-slots (obj)
+  (map 'list #'closer-mop:slot-definition-name (closer-mop:class-slots (class-of obj))))
+
 ;;; Unique crew member that can provide an abstract buff
 ;;; or nerf to some internal game system
 (defclass uniq-crew-mem ()
@@ -128,8 +155,8 @@
 (defun make-crew-mem-name (name-prefixes name-values)
   "Expects a list of strings to use as prefixes for a name, and a list
    of possible names"
-  (let ((name (nth (random (length *name-values*)) *name-values*))
-	(prefix (nth (random (length *name-prefixes*)) *name-prefixes*)))
+  (let ((name (nth (random (length name-values)) name-values))
+	(prefix (nth (random (length name-prefixes)) name-prefixes)))
     (concatenate 'string prefix " " name)))
 
 (defclass weapon ()
@@ -148,7 +175,7 @@
 
 (defclass market ()
     ((price-of-petrofuel
-      :initarg :price-of-petrofuel
+      :initarg :petrofuel
       :accessor price-of-petrofuel
       :initform 10)
      (price-of-gruel
@@ -168,18 +195,3 @@
       :accessor price-of-archeotech
       :initform 2000)))
 
-
-;; This gets created when travelling to a
-;; new sector
-(defclass sector ()
-  ((market
-    :initarg :market
-    :accessor market)
-   (hazards
-    :initarg :hazards
-    :accessor hazards
-    :initform NIL)
-   (boons
-    :initarg :boons
-    :accessor boons
-    :initform NIL)))