https://git.spwbk.site/swatson/clwars/raw/master/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)))))

You are viewing proxied material from chate.io. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.