(defvar *player-ship*) (defvar *sector*) (defun init-game-state () (setq *sector* (make-sector :market (make-market :price-of-petrofuel 20 :price-of-ammo 10 :price-of-archeotech 1000 :price-of-spice 50 :price-of-gruel 5) :hazards NIL :boons NIL)) (setq *player-ship* (make-player-ship :armor-val 10 :rep-shield-val 10 :warp-drive (list 1 5) :reactor-str 1 :warp-field 1 :weapons (list (make-weapon :name "Plamsa" :shield-dmg 3 :hull-dmg 3 :ammo-cost 5) (make-weapon :name "Mega Bolter" :shield-dmg 1 :hull-dmg 2 :ammo-cost 1) (make-weapon :name "Beam" :shield-dmg 1 :hull-dmg 3 :ammo-cost 3)) :credits 1000 :crew (make-crew :sanity-val 100 :crew-members (loop for x in '(1 2 3 4) collect (make-uniq-crew-mem :name (make-crew-mem-name)))) :inventory (make-player-inventory :petrofuel 20 :gruel 20 :spice 0 :ammo 20 :archeotech 0)))) (defun new-game () (init-game-state) (game-intro) (top-level-game-menu)) (defun game-intro () (cls) (format t "In the grim darkness of the far future, there is only COMMERCE...~%") (sleep 2) (format t "You embark across a bleak galaxy to ply your wares and discover untold riches!~%") (sleep 2) (format t *intro-ship*) (prompt-read "")) ;; Options for top level menu ;; This is the main "gameplay" interface (defvar *top-level-options-display* " Actions: 1 | Sector info | sei 2 | Ship info | si 3 | Trade | t 4 | Scout | s 5 | Leave | l ") (defun sector-info () (format t "Called sector-info")) ;;; SHIP INFO ;;; (defun display-crew () (let* ((crew-struct (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)))) (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 (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-table T inventory-list :column-label '("Resource" "Amount")))) (defun ship-info () (display-crew) (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 () (format t "Called leave")) ;; Use lookup table to handle top level loop arguments ;; See: https://dnaeon.github.io/common-lisp-lookup-tables-alists-and-plists/ (defparameter *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 '4 'scout) (cons 'leave 'leave) (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*) (let ((option (prompt-read "Enter an option: "))) (format t "~%") (handle-opt (read-from-string option) *opt-lookup*)) (top-level-game-menu))