clwars/game.lisp

(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))))


(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 ()
  (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))