added multipurpose panel (currently only displays player stats)

4 files changed, 67 insertions, 27 deletions

diff --git a/src/game.lisp b/src/game.lisp
index 24f5581..40e201c 100644
--- a/src/game.lisp
+++ b/src/game.lisp
@@ -7,7 +7,8 @@
 		   :get-profit
 		   :get-profit-in-zone
 		   :get-cur-zone
-		   :commodities-panel))
+		   :commodities-panel
+		   :player-stats))
 
 (in-package :game)
 
@@ -75,3 +76,9 @@
 					  :qty quantity
 					  :profit profit)))
 			(zone:get-commodities cur-zone))))
+
+(defmethod player-stats ((g game))
+  (with-slots (player) g
+	(list :cash (player:get-cash player)
+		  :debt (player:get-debt player)
+		  :inv (player:inventory-stats player))))
diff --git a/src/inventory.lisp b/src/inventory.lisp
index 8aa590f..a8b7c59 100644
--- a/src/inventory.lisp
+++ b/src/inventory.lisp
@@ -1,7 +1,7 @@
 (defpackage inventory
   (:use :cl)
   (:export :new-inventory
-		   :filled
+		   :how-filled
 		   :add-item
 		   :remove-item
 		   :find-item))
@@ -21,6 +21,10 @@
   (when (> size 0)
 	(make-instance 'inventory :size size)))
 
+(defmethod how-filled ((inv inventory))
+  (with-slots (size filled) inv
+	(cons filled size)))
+
 (defmethod find-item ((inv inventory) name)
   (with-slots (items) inv
 	(find-if
@@ -36,15 +40,16 @@
 	(setq filled (- filled (cdr item)))))
 
 (defmethod update-item ((inv inventory) item qty old-item)
+  (delete-item inv old-item)
   (with-slots (filled items) inv
-	(delete-item inv old-item)
 	(let ((total-quantity (+ qty (cdr old-item)))
 		  (item-name (commodities:name item))
 		  (item-price (commodities:price item))
 		  (old-qty (cdr old-item))
 		  (old-item-price (commodities:price (car old-item))))
 	  (let ((new-item (commodities:new-commodity item-name
-												 (/ (+ (* qty item-price) (* old-qty old-item-price))
+												 (/ (+ (* qty item-price)
+													   (* old-qty old-item-price))
 													total-quantity))))
 		(push (cons
 			   new-item
diff --git a/src/main.lisp b/src/main.lisp
index 330abe4..8baf355 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -14,8 +14,13 @@
    (title :title-pane
 		  :display-time :command-loop
 		  :display-function 'display-title)
+   (zone-price :application
+			   :display-time :command-loop
+			   :scroll-bar nil
+			   :display-function 'display-zone-price)
    (panel :application
-		  :label-alignment :top
+		  :display-time :command-loop
+		  :scroll-bar nil
 		  :display-function 'display-panel)
    (int :interactor))
 
@@ -24,23 +29,34 @@
   (:layouts
    (default (clim:vertically ()
 			  (1/8 title)
-			  (5/8 panel)
-			  (2/8 int)))))
+			  (4/8 (clim:horizontally ()
+					 (2/3 zone-price)
+					 (1/3 panel)))
+			  (3/8 int)))))
+
+(defmethod frame-standard-output ((frame superapp))
+  (clim:get-frame-pane frame 'int))
 
-(defun format-panel (panel stream)
+(defun format-zone-price (panel stream)
   (loop for it in panel do
 		(format stream "~a :~T ~$$ [~@$$] owned: ~a~%"
 				(getf it :name)
 				(getf it :price)
 				(getf it :profit)
 				(getf it :qty))))
+(defun format-stats (player-stats stream)
+  (format stream "CASH: ~$$~%DEBT: ~$$~%INVENTORY: ~a/~a~%"
+		  (getf player-stats :cash)
+		  (getf player-stats :debt)
+		  (car (getf player-stats :inv))
+		  (cdr (getf player-stats :inv))))
 
 (defun main ()
    (let* ((p (player:init-player "Joze"))
-		 (c (list (commodities:new-commodity "apple" 5)
-				  (commodities:new-commodity "pear" 7)))
-		 (c2 (list (commodities:new-commodity "apple" 6)
-				   (commodities:new-commodity "pear" 2)))
+		 (c (list (commodities:new-commodity "apple" 50)
+				  (commodities:new-commodity "pear" 70)))
+		 (c2 (list (commodities:new-commodity "apple" 60)
+				   (commodities:new-commodity "pear" 20)))
 		 (z (zone:new-zone "Bronx" c))
 		 (z2 (zone:new-zone "Manhattan" c2))
 		 (g (game:new-game p z2 (list z z2))))
@@ -51,16 +67,24 @@
 						300 2
 						:align-x :center
 						:align-y :top))
+	 (defmethod display-zone-price ((frame superapp) stream)
+	   (format-zone-price (game:commodities-panel g) stream))
 	 (defmethod display-panel ((frame superapp) stream)
-	   (format-panel (game:commodities-panel g) stream))
+	   (format-stats (game:player-stats g) stream))
 	 
 	 ;; Panel command
 	 (define-superapp-command (com-panel :name t) ()
-	   (format-panel (game:commodities-panel g) t))
+	   (format-zone-price (game:commodities-panel g) t))
+
 	 ;; Buy command
 	 (define-superapp-command (com-buy :name t)
 		 ((item 'string) (quantity 'integer))
-	   (game:buy-item g item quantity))
+	   (clim:with-application-frame (frame)
+		 (let ((out (frame-standard-output frame)))
+		   (if (game:buy-item g item quantity)
+			   (format out "Bought ~a ~a~%" quantity item)
+			   (format out "Could not buy ~a ~a~%" quantity item)))))
+
 	 ;; Sell command
 	 (define-superapp-command (com-sell :name t)
 		 ((item 'string) (quantity 'integer))
@@ -69,12 +93,13 @@
 	 (define-superapp-command (com-goto :name t)
 		 ((dest 'string))
 	   (clim:with-application-frame (frame)
-		 (if (game:change-zone g dest)
-			 (progn
-			   (setf (cur-zone frame) (zone:name (game:get-cur-zone g)))
-			   (format t "~a~%" (cur-zone frame))
-			   (format t "Arrived in ~a" (zone:name (game:get-cur-zone g))))
-			 (format t "Zone ~a does not exist!" dest))))
+		 (let ((out (frame-standard-output frame)))
+		   (if (game:change-zone g dest)
+			   (progn
+				 (setf (cur-zone frame) (zone:name (game:get-cur-zone g)))
+				 (format out "~a~%" (cur-zone frame))
+				 (format out "Arrived in ~a" (zone:name (game:get-cur-zone g))))
+			   (format out "Zone ~a does not exist!" dest)))))
 
 	 (clim:run-frame-top-level
 	  (clim:make-application-frame 'superapp
diff --git a/src/player.lisp b/src/player.lisp
index b5c8651..c9033ac 100644
--- a/src/player.lisp
+++ b/src/player.lisp
@@ -7,7 +7,8 @@
 		   :repay-debt
 		   :buy-item
 		   :sell-item
-		   :find-item))
+		   :find-item
+		   :inventory-stats))
 
 (in-package :player)
 
@@ -40,11 +41,10 @@
   (with-slots (stock cash) p
 	(let ((cost (* quantity
 				   (commodities:price item))))
-	  (when (>= cash cost)
-		(progn
-		  (inventory:add-item stock item quantity)
-		  (setq cash (- cash cost))
-		  t)))))
+	  (when (and (>= cash cost)
+				 (inventory:add-item stock item quantity))
+		(setq cash (- cash cost))
+		t))))
 
 (defmethod sell-item ((p player) item amount)
   (with-slots (stock cash) p
@@ -67,3 +67,6 @@
 	  (setq cash (- cash amount)
 			debt (- debt amount))
 	  t)))
+
+(defmethod inventory-stats ((p player))
+  (inventory:how-filled (stock p)))