WIP fleshing out buy menu

README.md

@@ -13,6 +13,9 @@ In CL-Wars you are a rogue trader on the edge of an poorly charted
 and unfriendly galaxy. Ply your wares, capture archeotech, and
 purge xenomorphs in the fires of your guns.
 
+NOTE: This 'game' is just a playground for me to play with Lisp. It is not a reference for
+'good'/idomatic CL software and is not really intended to be useful or playable.
+
 ** Systems
 *** Systems
 - Ship Systems

clwars.lisp

@@ -6,15 +6,6 @@
 (defun reload()
   (load "~/Repos/clwars/clwars.lisp"))
 
-;; https://stackoverflow.com/questions/4882361/which-command-could-be-used-to-clear-screen-in-clisp
-(defun cls()
-  (format t "~A[H~@*~A[J" #\escape))
-
-(defun prompt-read (prompt)
-  (format *query-io* "~a" prompt)
-  (force-output *query-io*)
-  (read-line *query-io*))
-
 (defun main ()
   (format t *menu-splash*)
   (format t "Press any key to start or q to quit: ")

game.lisp

@@ -13,7 +13,6 @@
 					:rep-shield-val 10
 					:warp-drive (list 1 5)
 					:reactor-str 1
-					:ammo 20
 					:warp-field 1
 					:weapons (list (make-weapon :name "Plamsa"
 								    :shield-dmg 3
@@ -72,28 +71,132 @@ Actions:
 	 (crew-names 
 	   (loop for member in crew-struct
 		 collect (list (uniq-crew-mem-name member) NIL NIL))))
-    (format T "CREW DETAILS~%~%")
+    (format T "~%CREW DETAILS~%~%")
     (format-table T (list (list (crew-sanity-val (player-ship-crew *player-ship*)))) :column-label '("Sanity"))
     (format T "~%")
     (format-table T crew-names :column-label '("Name" "Buff" "Buff Amount"))))
 
 (defun display-inventory ()
-  (let ((inventory-list (list 
+  (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*))))))
-    (format T "INVENTORY~%")
+    (format T "~%INVENTORY~%")
     (format-table T inventory-list :column-label '("Resource" "Amount"))))
 
 
 (defun ship-info ()
-  (format t "Called ship-info"))
+  (display-crew)
+  (display-inventory))
 ;;; SHIP INFO END ;;;
 
-(defun trade ()
-  (format t "Called trade"))
+;;; TRADING ;;;
+(defparameter *trade-opt-lookup* (list (cons '1 'buy-menu)
+				       (cons 'b 'buy-menu)
+				       (cons '2 'sell-menu)
+				       (cons 's 'sell-menu)
+				       (cons '3 'display-prices)
+				       (cons 'd 'display-prices)
+				       (cons '4 'top-level-game-menu)
+				       (cons 'r 'top-level-game-menu)))
+
+(defvar *trade-menu-options-display* "
+Actions:
+1 | Buy | b
+2 | Sell | s
+3 | Display Prices | d
+4 | Return to top level | r
+")
+
+(defparameter *resource-opt-lookup* (list (cons 'pf "petrofuel")
+					  (cons 'petrofuel "petrofuel")
+					  (cons 'gr "gruel")
+					  (cons 'gruel "gruel")
+					  (cons 'sp "spice")
+					  (cons 'spice "spice")
+					  (cons 'am "ammo")
+					  (cons 'ammo "ammo")
+					  (cons 'ar "archeotech")
+					  (cons 'archeotech "archeotech")))
+
+(defun handle-str-lookup (input-str lookup-table)
+  (let ((handler (cdr (assoc input-str lookup-table))))
+    (if handler (return-from handle-str-lookup handler) (format t "Invalid resource~%~%"))))
+
+(defun buy-transaction (resource quantity)
+  "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*)))
+	 (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*))
+	  (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))))
+	      (otherwise (format T "Invalid"))))))))
+
+(defun buy-menu ()
+  (let ((item-to-buy (prompt-read "Enter a resource to buy: "))
+	(quantity (prompt-read "Enter a quantity to buy: ")))
+    (handle-str-lookup (read-from-string item-to-buy) *resource-opt-lookup*)))
+
+(defun sell-menu ()
+  (format T "Called sell menu~%"))
+
+(defun display-prices ()
+;;; (funcall (symbol-function (find-symbol (string-upcase (concatenate 'string "market-price-of-" item)))) (sector-market *sector*)) ;;; A call by string reference method for function calls
+  (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*))
+    (format T "~%MARKET PRICES~%")
+    (format-table T market-list :column-label '("Resource" "Cost"))))
+
+(defun trade-menu ()
+  (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))
+
+;;; END TRADING ;;;
 (defun scout ()
   (format t "Called scout"))
 (defun leave ()
@@ -107,9 +210,9 @@ Actions:
 				 (cons 'ship-info 'ship-info)
 				 (cons 'si 'ship-info)
 				 (cons '2 'ship-info)
-				 (cons 'trade 'trade)
-				 (cons 't 'trade)
-				 (cons '3 'trade)
+				 (cons 'trade 'trade-menu)
+				 (cons 't 'trade-menu)
+				 (cons '3 'trade-menu)
 				 (cons 'scout 'scout)
 				 (cons 's 'scout)
 				 (cons '4 'scout)
@@ -117,14 +220,14 @@ Actions:
 				 (cons 'l 'leave)
 				 (cons '5 'leave)))
 
-(defun handle-opt (opt)
-  (let ((handler (cdr (assoc opt *opt-lookup*))))
+(defun handle-opt (opt lookup-table)
+  (let ((handler (cdr (assoc opt lookup-table))))
     (if handler (funcall handler) (format t "Invalid opt~%~%"))))
 
 (defun top-level-game-menu ()
   (format t *top-level-options-display*)
   (let ((option (prompt-read "Enter an option: ")))
     (format t "~%")
-    (handle-opt (read-from-string option)))
+    (handle-opt (read-from-string option) *opt-lookup*))
   (top-level-game-menu))
 	  

plumbing.lisp

@@ -49,3 +49,11 @@
               (apply #'format stream row-fmt (mapcan #'list widths row))))))
 
 
+;; https://stackoverflow.com/questions/4882361/which-command-could-be-used-to-clear-screen-in-clisp
+(defun cls()
+  (format t "~A[H~@*~A[J" #\escape))
+
+(defun prompt-read (prompt)
+  (format *query-io* "~a" prompt)
+  (force-output *query-io*)
+  (read-line *query-io*))

structs.lisp

@@ -3,7 +3,6 @@
   rep-shield-val
   warp-drive ; tuple, first ele is power state (0,1), second is fuel cost 
   reactor-str ; 0 - low power, 1 - full power, 2 - overdrive
-  ammo
   warp-field ; 0 - low power, 1 - full power
   weapons
   credits