|
@@ -1,3 +1,11 @@
|
|
|
|
+(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 *player-ship*)
|
|
(defvar *sector*)
|
|
(defvar *sector*)
|
|
|
|
|
|
@@ -28,6 +36,7 @@
|
|
:ammo-cost 3))
|
|
:ammo-cost 3))
|
|
:credits 1000
|
|
:credits 1000
|
|
:crew (make-crew :sanity-val 100
|
|
:crew (make-crew :sanity-val 100
|
|
|
|
+ :moral-val 100
|
|
:crew-members (loop for x in '(1 2 3 4)
|
|
:crew-members (loop for x in '(1 2 3 4)
|
|
collect (make-uniq-crew-mem :name (make-crew-mem-name))))
|
|
collect (make-uniq-crew-mem :name (make-crew-mem-name))))
|
|
:inventory (make-player-inventory :petrofuel 20
|
|
:inventory (make-player-inventory :petrofuel 20
|
|
@@ -59,193 +68,12 @@ Actions:
|
|
2 | Ship info | si
|
|
2 | Ship info | si
|
|
3 | Trade | t
|
|
3 | Trade | t
|
|
4 | Scout | s
|
|
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
|
|
|
|
|
|
+5 | Leave sector | l
|
|
")
|
|
")
|
|
|
|
|
|
-(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
|
|
;; Use lookup table to handle top level loop arguments
|
|
;; See: https://dnaeon.github.io/common-lisp-lookup-tables-alists-and-plists/
|
|
;; See: https://dnaeon.github.io/common-lisp-lookup-tables-alists-and-plists/
|
|
-(defparameter *opt-lookup* (list (cons 'sector-info 'sector-info)
|
|
|
|
|
|
+(defparameter *top-level-opt-lookup* (list (cons 'sector-info 'sector-info)
|
|
(cons '1 'sector-info)
|
|
(cons '1 'sector-info)
|
|
(cons 'sei 'sector-info)
|
|
(cons 'sei 'sector-info)
|
|
(cons 'ship-info 'ship-info)
|
|
(cons 'ship-info 'ship-info)
|
|
@@ -261,14 +89,11 @@ Actions:
|
|
(cons 'l 'leave)
|
|
(cons 'l 'leave)
|
|
(cons '5 '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 ()
|
|
(defun top-level-game-menu ()
|
|
(format t *top-level-options-display*)
|
|
(format t *top-level-options-display*)
|
|
(let ((option (prompt-read "Enter an option: ")))
|
|
(let ((option (prompt-read "Enter an option: ")))
|
|
(format t "~%")
|
|
(format t "~%")
|
|
- (handle-opt (read-from-string option) *opt-lookup*))
|
|
|
|
|
|
+ (handle-opt (read-from-string option) *top-level-opt-lookup*))
|
|
(top-level-game-menu))
|
|
(top-level-game-menu))
|
|
|
|
|