commit 72e03ebb9a51a989e58924ea211b744e8a2e3bb9
Author: Simon Watson <spw01@protonmail.com>
Date: Tue Feb 14 11:30:45 2023 -0500
CLOS code now has feature parity with old defstruct version
diff --git a/economy.lisp b/economy.lisp
index 9cdb9cd..51ee887 100644
--- a/economy.lisp
+++ b/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)))))
diff --git a/game.lisp b/game.lisp
index 77c18a1..287b324 100644
--- a/game.lisp
+++ b/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 (cons 'ship-info *player-ship*))
- (cons 'si (cons 'ship-info *player-ship*))
- (cons '2 (cons 'ship-info *player-ship*))
- (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)))
diff --git a/plumbing.lisp b/plumbing.lisp
index b530265..e30e34a 100644
--- a/plumbing.lisp
+++ b/plumbing.lisp
@@ -62,4 +62,4 @@
"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 (car handler) (cdr handler)) (format t "Invalid opt~%~%"))))
+ (if handler (funcall handler) (format t "Invalid opt~%~%"))))
diff --git a/structs.lisp b/structs.lisp
index 35f0bfe..b3a0515 100644
--- a/structs.lisp
+++ b/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
@@ -132,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 ()
@@ -152,7 +175,7 @@
(defclass market ()
((price-of-petrofuel
- :initarg :price-of-petrofuel
+ :initarg :petrofuel
:accessor price-of-petrofuel
:initform 10)
(price-of-gruel
@@ -172,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)))