clwars/economy.lisp

;;; TRADING ;;;
(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:
1 | Buy | b
2 | Sell | s
3 | Return to top level | r
")

(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 (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~%" (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 (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 (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 player-ship-obj market-obj)))))

(defun sell-transaction (resource quantity player-ship-obj market-obj)
  "Do the sale transaction, not intended to be called interactively"
  (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 ((remove-resource (lambda (amount)
				   (let ((new-credits (+ available-player-funds total-profit)))
				     (setf (credits player-ship-obj) 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
	    (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 (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 player-ship-obj market-obj)))))

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

;;; 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 '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 (setf (slot-value market (car resource)) (funcall get-random-val resource)))))