commit 5d6d653c1b02b085bfd7b2ab0e557c96c3840abe
Author: spesk <spw01@protonmail.com>
Date: Sat Feb 11 13:21:46 2023 -0500
WIP breaking game.lisp out into files
diff --git a/clwars.lisp b/clwars.lisp
index 257d730..9180486 100644
--- a/clwars.lisp
+++ b/clwars.lisp
@@ -3,6 +3,9 @@
(load "~/Repos/clwars/game.lisp")
(load "~/Repos/clwars/plumbing.lisp")
+;;; TODO use quicklisp
+(load "~/quicklisp/local-projects/lazy/lazy.lisp") ; Not needed, using for fun/learning
+
(defun reload()
(load "~/Repos/clwars/clwars.lisp"))
diff --git a/economy.lisp b/economy.lisp
new file mode 100644
index 0000000..0fbce13
--- /dev/null
+++ b/economy.lisp
@@ -0,0 +1,168 @@
+;;; 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
+")
+
+(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))))))
+ (format T "Successfully purchased ~A ~A~%" quantity resource)))))
+
+(defun buy-menu ()
+ (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)))))
+
+
+(defun sell-transaction (resource quantity)
+ "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*)))
+ (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 ((new-credits (+ available-player-funds total-profit)))
+ (setf (player-ship-credits *player-ship*) new-credits))
+ (- available-player-resource amount)))) ; This is pretty convoluted
+ ;;; 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)))))
+
+(defun sell-menu ()
+ (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 work
+(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))
+
+(defmacro dynamic-slot-setting (predicate slotname accessor value)
+ `(setf ,(funcall (symbol-function (find-symbol (string-upcase (concatenate 'string predicate slotname)))) accessor) ,value))
+
+(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*))
+ (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 ;;;
+
+;;; MARKET ;;;
+(defun range (start end)
+ "Basic function to generate a list that
+ contains a range of ints"
+ (loop for i from start below end collect i))
+
+;;; Use this parameter when randomizing market prices. Used to lookup how
+;;; 'random' prices should really be."
+(defparameter *market-price-bounds*
+ (list (cons 'petrofuel (range 10 41))
+ (cons 'ammo (range 5 31))
+ (cons 'archeotech (range 750 2001))
+ (cons 'spice (range 5 101))
+ (cons 'gruel (range 1 16))))
+
+(defun randomize-market-prices (market)
+ (loop for resource in *market-price-bounds*
+ do (progn
+ (
diff --git a/game.lisp b/game.lisp
index 35e837d..e8f8b86 100644
--- a/game.lisp
+++ b/game.lisp
@@ -1,3 +1,6 @@
+(load "~/Repos/clwars/economy.lisp")
+(load "~/Repos/clwars/plumbing.lisp")
+
(defvar *player-ship*)
(defvar *sector*)
@@ -93,151 +96,6 @@ Actions:
(display-inventory))
;;; SHIP INFO END ;;;
-;;; 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
-")
-
-(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))))))
- (format T "Successfully purchased ~A ~A~%" quantity resource)))))
-
-(defun buy-menu ()
- (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)))))
-
-
-(defun sell-transaction (resource quantity)
- "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*)))
- (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 ((new-credits (+ available-player-funds total-profit)))
- (setf (player-ship-credits *player-ship*) new-credits))
- (- available-player-resource amount)))) ; This is pretty convoluted
- ;;; 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)))))
-
-(defun sell-menu ()
- (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 work
-(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))
-
-(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*))
- (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 ()
@@ -261,9 +119,6 @@ Actions:
(cons 'l 'leave)
(cons '5 'leave)))
-(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*)
diff --git a/plumbing.lisp b/plumbing.lisp
index d9abeb9..e30e34a 100644
--- a/plumbing.lisp
+++ b/plumbing.lisp
@@ -57,3 +57,9 @@
(format *query-io* "~a" prompt)
(force-output *query-io*)
(read-line *query-io*))
+
+(defun handle-opt (opt lookup-table)
+ "When given a string and a list 'lookup table' call the
+ function associated with the opt used"
+ (let ((handler (cdr (assoc opt lookup-table))))
+ (if handler (funcall handler) (format t "Invalid opt~%~%"))))
diff --git a/sector.lisp b/sector.lisp
new file mode 100644
index 0000000..e69de29