commit 11c0fa4dd01672df684c6589920b51e86ba15c9d
Author: Simon Watson <spw01@protonmail.com>
Date: Tue Feb 7 19:42:17 2023 -0500
WIP fleshing out buy menu
diff --git a/README.md b/README.md
index 9bc68c5..7f51902 100644
--- a/README.md
+++ b/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
diff --git a/clwars.lisp b/clwars.lisp
index 43daf61..257d730 100644
--- a/clwars.lisp
+++ b/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: ")
diff --git a/game.lisp b/game.lisp
index 765da92..f351889 100644
--- a/game.lisp
+++ b/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))
diff --git a/plumbing.lisp b/plumbing.lisp
index bda1f01..d9abeb9 100644
--- a/plumbing.lisp
+++ b/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*))
diff --git a/structs.lisp b/structs.lisp
index 8d93f6a..d101426 100644
--- a/structs.lisp
+++ b/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