economy.lisp 4.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110
  1. ;;; TRADING ;;;
  2. (defparameter *trade-opt-lookup* (list (cons '1 (lambda ()
  3. (buy-menu (player-ship-obj *sector*) (market *sector*))))
  4. (cons '2 (lambda ()
  5. (sell-menu (player-ship-obj *sector*) (market *sector*))))
  6. (cons '3 'top-level-game-menu)))
  7. (defvar *trade-menu-options-display* "
  8. Actions:
  9. 1 | Buy | b
  10. 2 | Sell | s
  11. 3 | Return to top level | r
  12. ")
  13. (defun buy-transaction (resource quantity player-ship-obj market-obj)
  14. "Do they actual purchase transaction, not intended to be called interactively"
  15. (let* ((available-player-funds (credits player-ship-obj))
  16. (inventory-obj (inventory player-ship-obj))
  17. (price (slot-value market-obj (read-from-string (concatenate 'string "price-of-" resource))))
  18. (total-cost (* quantity price)))
  19. (if (> total-cost available-player-funds)
  20. (progn
  21. (format T "Not enough credits to buy ~A ~A at ~A credits~%" quantity resource price)
  22. (format T "~%PLAYER CREDITS: ~A~%" (credits player-ship-obj))
  23. (return-from buy-transaction NIL))
  24. (progn
  25. (let ((resource-sym (read-from-string resource))
  26. (minus-funds (lambda (amount)
  27. (let ((remainder (- available-player-funds amount)))
  28. (setf (credits player-ship-obj) remainder)))))
  29. (setf (slot-value inventory-obj resource-sym) (+ quantity (slot-value inventory-obj resource-sym)))
  30. (funcall minus-funds total-cost)
  31. (format T "Successfully purchased ~A ~A~%" quantity resource))))))
  32. (defun buy-menu (player-ship-obj market-obj)
  33. (let ((item-to-buy (prompt-read "Enter a resource to buy: "))
  34. (quantity (parse-integer (prompt-read "Enter a quantity to buy: "))))
  35. (if (member item-to-buy '("gruel" "ammo" "petrofuel" "archeotech" "spice") :test #'string=)
  36. (progn
  37. (buy-transaction item-to-buy quantity player-ship-obj market-obj)))))
  38. (defun sell-transaction (resource quantity player-ship-obj market-obj)
  39. "Do the sale transaction, not intended to be called interactively"
  40. (let* ((resource-sym (read-from-string resource))
  41. (available-player-funds (credits player-ship-obj))
  42. (inventory (inventory player-ship-obj))
  43. (available-player-resource (slot-value inventory resource-sym))
  44. (price (slot-value market-obj (read-from-string (concatenate 'string "price-of-" resource))))
  45. (total-profit (* quantity price)))
  46. (if (> quantity available-player-resource)
  47. (progn
  48. (format T "Not enough ~A to sell ~A. You have ~A~%" resource quantity available-player-resource)
  49. (return-from sell-transaction NIL))
  50. (progn
  51. (let ((remove-resource (lambda (amount)
  52. (let ((new-credits (+ available-player-funds total-profit)))
  53. (setf (credits player-ship-obj) new-credits))
  54. (- available-player-resource amount)))) ; This is pretty convoluted
  55. ;;; remove-resource lambda is a pretty bad idea?
  56. ;;; it is used to set the new credits amount and then return the amount needed to
  57. ;;; be removed from the resource in the player inventory. I did it this way
  58. ;;; to keep the logic concise, but it smells bad and is probably stupid
  59. (setf (slot-value inventory resource-sym) (funcall remove-resource quantity))
  60. ;; (archeotech (progn
  61. ;; (setf (player-inventory-archeotech inventory) (funcall remove-resource quantity))))))
  62. (format T "Successfully sold ~A ~A~%" quantity resource))))))
  63. (defun sell-menu (player-ship-obj market-obj)
  64. (let ((item-to-sell (prompt-read "Enter a resource to sell: "))
  65. (quantity (parse-integer (prompt-read "Enter a quantity to sell: "))))
  66. (if (member item-to-sell '("gruel" "ammo" "petrofuel" "archeotech" "spice") :test #'string=)
  67. (progn
  68. (sell-transaction item-to-sell quantity player-ship-obj market-obj)))))
  69. (defun display-prices (market-obj player-credits)
  70. (let ((market-list (loop for resource in (return-slots market-obj)
  71. collect (list resource (slot-value market-obj resource)))))
  72. (format T "~%PLAYER CREDITS: ~A~%" player-credits)
  73. (format T "~%MARKET PRICES~%")
  74. (format-table T market-list :column-label '("Resource" "Cost"))))
  75. (defun trade-menu (sector)
  76. (display-prices (market sector) (credits (player-ship-obj sector)))
  77. (display-inventory (player-ship-obj sector))
  78. (format t *trade-menu-options-display*)
  79. (let ((option (prompt-read "Enter an option: ")))
  80. (format t "~%")
  81. (handle-opt (read-from-string option) *trade-opt-lookup*))
  82. (trade-menu sector))
  83. ;;; END TRADING ;;;
  84. ;;; MARKET ;;;
  85. ;;; Use this parameter when randomizing market prices. Used to lookup how
  86. ;;; 'random' prices should really be."
  87. (defparameter *market-price-bounds*
  88. (list (cons 'price-of-petrofuel '(10 41))
  89. (cons 'price-of-ammo '(5 31))
  90. (cons 'price-of-archeotech '(750 2001))
  91. (cons 'price-of-spice '(5 101))
  92. (cons 'price-of-gruel '(1 16))))
  93. ;; This could be simplfied with (map #')
  94. (defun randomize-market-prices (market)
  95. (let ((get-random-val (lambda (resource-arg)
  96. (+ (cadr resource-arg)
  97. (random (caddr resource-arg))))))
  98. (loop for resource in *market-price-bounds*
  99. do (setf (slot-value market (car resource)) (funcall get-random-val resource)))))