Преглед на файлове

Merge branch 'break-into-files' of swatson/clwars into master

Simon Watson преди 1 година
родител
ревизия
741841e6be
променени са 9 файла, в които са добавени 232 реда и са изтрити 194 реда
  1. 4 4
      README.md
  2. 3 0
      ascii-assets.lisp
  3. 0 3
      clwars.lisp
  4. 171 0
      economy.lisp
  5. 12 187
      game.lisp
  6. 6 0
      plumbing.lisp
  7. 8 0
      sector.lisp
  8. 27 0
      ship.lisp
  9. 1 0
      structs.lisp

+ 4 - 4
README.md

@@ -44,9 +44,9 @@ NOTE: This 'game' is just a playground for me to play with Lisp. It is not a ref
 - Money/Economy/Items
   - TODO
     - [X] Basic buy/sell mechanics
-      - [ ] Overhaul buy/sell interface for archeotech specific information
-	- [ ] Random $x*$x ASCII image to represent archeotech
-    - [ ] Variable economy between sectors ('random' prices)
+    - [ ] Overhaul buy/sell interface for archeotech specific information
+    - [ ] Random $x*$x ASCII image to represent archeotech
+    - [X] Variable economy between sectors ('random' prices)
     - [ ] Define how archeotech works (random buffs/characteristics)
       - [ ] Archeotech display menu
   - Notes
@@ -55,7 +55,7 @@ NOTE: This 'game' is just a playground for me to play with Lisp. It is not a ref
     - Can trade archeotech (AT has characteristics that may be desireable to different planetary systems)
 - Crew Systems
   - TODO:
-    - [ ] Crew consumes grew on some regular cadence (per action/jump/etc)
+    - [ ] Crew consumes gruel on some regular cadence (per action/jump/etc)
     - [ ] Crew will consume spice (if available)
       - Spice increases moral but can be destabilizing to sanity
     - [ ] Implementation of crew member buff charateristics

+ 3 - 0
ascii-assets.lisp

@@ -33,3 +33,6 @@
               ▔     ▕▅▅▅▆████▛▔▔▔
                        ╺▛▀▔▔
 ")
+
+;; Used for archeotech art generation
+(defvar *ascii-chars* "█*|")

+ 0 - 3
clwars.lisp

@@ -1,7 +1,4 @@
-(load "~/Repos/clwars/ascii-assets.lisp")
-(load "~/Repos/clwars/structs.lisp")
 (load "~/Repos/clwars/game.lisp")
-(load "~/Repos/clwars/plumbing.lisp")
 
 (defun reload()
   (load "~/Repos/clwars/clwars.lisp"))

+ 171 - 0
economy.lisp

@@ -0,0 +1,171 @@
+;;; 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)))))))

+ 12 - 187
game.lisp

@@ -1,3 +1,11 @@
+(load "~/Repos/clwars/economy.lisp")
+(load "~/Repos/clwars/plumbing.lisp")
+(load "~/Repos/clwars/sector.lisp")
+(load "~/Repos/clwars/ship.lisp")
+(load "~/Repos/clwars/ascii-assets.lisp")
+(load "~/Repos/clwars/structs.lisp")
+
+
 (defvar *player-ship*)
 (defvar *sector*)
 	
@@ -28,6 +36,7 @@
 								    :ammo-cost 3))
 					:credits 1000
 					:crew (make-crew :sanity-val 100
+							 :moral-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
@@ -59,193 +68,12 @@ Actions:
 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
+5 | Leave sector | l
 ")
 
-(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 work
-(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))
-
-(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 ()
-  (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)
+(defparameter *top-level-opt-lookup* (list (cons 'sector-info 'sector-info)
 				 (cons '1 'sector-info)
 				 (cons 'sei 'sector-info)
 				 (cons 'ship-info 'ship-info)
@@ -261,14 +89,11 @@ Actions:
 				 (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*))
+    (handle-opt (read-from-string option) *top-level-opt-lookup*))
   (top-level-game-menu))
 	  

+ 6 - 0
plumbing.lisp

@@ -57,3 +57,9 @@
   (format *query-io* "~a" prompt)
   (force-output *query-io*)
   (read-line *query-io*))
+
+(defun handle-opt (opt lookup-table)
+  "When given a string and a list 'lookup table' call the
+   function associated with the opt used"
+  (let ((handler (cdr (assoc opt lookup-table))))
+    (if handler (funcall handler) (format t "Invalid opt~%~%"))))

+ 8 - 0
sector.lisp

@@ -0,0 +1,8 @@
+(defun sector-info ()
+  (format t "Called sector-info"))
+
+(defun scout ()
+  (format t "Called scout"))
+
+(defun leave ()
+  (format t "Called leave"))

+ 27 - 0
ship.lisp

@@ -0,0 +1,27 @@
+;;; 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 ;;;

+ 1 - 0
structs.lisp

@@ -18,6 +18,7 @@
 
 (defstruct crew
   sanity-val ; Max 100
+  moral-val
   crew-members) ; List of *uniq-crew-mem*
 
 ;;; Unique crew member that can provide an abstract buff