clwars/economy.lisp

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

(defvar *trade-menu-options-display* "
Actions:
1 | Buy | b
2 | Sell | s
3 | 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 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))

(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 ()
  (display-prices)
  (display-inventory)
  (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 ;;;

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

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