Merge branch 'master' of toniatuh:transaccHEADmaster

3 files changed, 182 insertions, 136 deletions

diff --git a/src/gui.lisp b/src/gui.lisp
new file mode 100644
index 0000000..acae661
--- /dev/null
+++ b/src/gui.lisp
@@ -0,0 +1,178 @@
+(in-package :cl-user)
+(defpackage transacc-gui
+  (:use :cl)
+  (:export :gengui
+		   :rungui))
+
+(in-package :transacc-gui)
+
+(clim:define-application-frame superapp ()
+  ((cur-zone :initarg :start-zone
+			 :accessor cur-zone)
+   (cur-panel :initform '(stats)
+			  :accessor cur-panel))
+  ;; :panes section describes different parts of the
+  ;; application-frame. This application has only one pane.
+  (:panes
+   (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
+		  :display-time :command-loop
+		  :scroll-bar nil
+		  :display-function 'display-panel)
+   (int :interactor))
+
+  ;; :layouts section describes how the panes are layed out.
+  ;; This application has one layout named "default" which has a single pane.
+  (:layouts
+   (default (clim:vertically ()
+							 (1/8 title)
+							 (4/8 (clim:horizontally ()
+													 (1/2 zone-price)
+													 (1/2 panel)))
+							 (3/8 int)))))
+
+(clim:define-application-frame superapp ()
+  ((cur-zone :initarg :start-zone
+			 :accessor cur-zone)
+   (cur-panel :initform '(stats)
+			  :accessor cur-panel))
+  ;; :panes section describes different parts of the
+  ;; application-frame. This application has only one pane.
+  (:panes
+   (title :title-pane
+		  :display-time t
+		  :display-function 'display-title)
+   (zone-price :application
+			   :display-time t
+			   :scroll-bar nil
+			   :display-function 'display-zone-price)
+   (panel :application
+		  :display-time t
+		  :scroll-bar nil
+		  :display-function 'display-panel)
+   (int :interactor))
+
+  ;; :layouts section describes how the panes are layed out.
+  ;; This application has one layout named "default" which has a single pane.
+  (:layouts
+   (default (clim:vertically ()
+			  (1/8 title)
+			  (4/8 (clim:horizontally ()
+					 (1/2 zone-price)
+					 (1/2 panel)))
+			  (3/8 int)))))
+
+(defmethod frame-standard-output ((frame superapp))
+  (clim:get-frame-pane frame 'int))
+
+(defun redisplay (panel)
+  (clim:with-application-frame (frame)
+	(setf (clim:pane-needs-redisplay
+		   (clim:get-frame-pane frame panel))
+		  t)))
+
+(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 gengui (g)
+	 (defmethod display-title ((frame superapp) stream)
+	   (clim:draw-text* stream
+						(format nil "Joze~%~a" (zone:name (game:get-cur-zone g)))
+						300 2
+						:align-x :center
+						:align-y :top))
+	 (defmethod display-zone-price ((frame superapp) stream)
+	   (format stream "Prices for ~a~%" (zone:name (game:get-cur-zone g)))
+	   (format-zone-price
+		(game:commodities-panel g (game:get-cur-zone g)) stream))
+	 (defmethod display-panel ((frame superapp) stream)
+	   (case (car (cur-panel frame))
+		 ('stats (format-stats (game:player-stats g) stream))
+		 ('prices (progn
+					(format stream "Prices for ~a~%" (cdr (cur-panel frame)))
+					(format-zone-price
+					 (game:commodities-panel g
+											 (game:get-zone g
+															(cdr (cur-panel frame))))
+					 stream)))))
+
+	 ;; Prices command -> changes the panel to prices for zone
+	 (define-superapp-command (com-prices :name t) ((zone 'string))
+	   (clim:with-application-frame (frame)
+		 (if (game:get-zone g zone)
+			 (progn 
+			   (setf (cur-panel frame) (cons 'prices zone))
+			   (redisplay 'panel))
+			 (format (frame-standard-output frame)
+					 "Zone ~A does not exist~%"
+					 zone))))
+	 ;; Stats command -> changes the panel to player stats
+	 (define-superapp-command (com-stats :name t) ()
+	   (clim:with-application-frame (frame)
+		 (setf (cur-panel frame) '(stats))
+		 (redisplay 'panel)))
+
+	 ;; Buy command
+	 (define-superapp-command (com-buy :name t)
+		 ((item 'string) (quantity 'integer))
+	   (clim:with-application-frame (frame)
+		 (let ((out (frame-standard-output frame)))
+		   (if (game:buy-item g item quantity)
+			   (progn
+				 (when (eq 'stats (car (cur-panel frame)))
+				   (redisplay 'panel))
+				 (redisplay 'zone-price)
+				 (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))
+	   (clim:with-application-frame (frame)
+		 (let ((out (frame-standard-output frame))
+			   (sold (game:sell-item g item quantity)))
+		   (if sold
+			   (progn
+				 (when (eq 'stats (car (cur-panel frame)))
+				   (redisplay 'panel))
+				 (redisplay 'zone-price)
+				 (format out "Sold ~a ~a~%" sold item))
+			   (format out "Could not sell any ~a" item)))))
+
+	 ;; Goto command
+	 (define-superapp-command (com-goto :name t)
+		 ((dest 'string))
+	   (clim:with-application-frame (frame)
+		 (let ((out (frame-standard-output frame)))
+		   (if (game:change-zone g dest)
+			   (progn
+				 (setf (cur-zone frame) (zone:name (game:get-cur-zone g)))
+				 (redisplay 'title)
+				 (redisplay 'zone-price)
+				 (format out "Arrived in ~a" (zone:name (game:get-cur-zone g))))
+			   (format out "Zone ~a does not exist!" dest))))))
+
+(defun rungui (g &optional (width 600) (height 400))
+  (clim:run-frame-top-level
+   (clim:make-application-frame 'superapp
+								:height 400
+								:width 600
+								:start-zone (game:get-cur-zone g))))
diff --git a/src/main.lisp b/src/main.lisp
index 0153da4..479d826 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -5,59 +5,6 @@
 
 (in-package :transacc)
 
-(clim:define-application-frame superapp ()
-  ((cur-zone :initarg :start-zone
-			 :accessor cur-zone)
-   (cur-panel :initform '(stats)
-			  :accessor cur-panel))
-  ;; :panes section describes different parts of the
-  ;; application-frame. This application has only one pane.
-  (:panes
-   (title :title-pane
-		  :display-time t
-		  :display-function 'display-title)
-   (zone-price :application
-			   :display-time t
-			   :scroll-bar nil
-			   :display-function 'display-zone-price)
-   (panel :application
-		  :display-time t
-		  :scroll-bar nil
-		  :display-function 'display-panel)
-   (int :interactor))
-
-  ;; :layouts section describes how the panes are layed out.
-  ;; This application has one layout named "default" which has a single pane.
-  (:layouts
-   (default (clim:vertically ()
-			  (1/8 title)
-			  (4/8 (clim:horizontally ()
-					 (1/2 zone-price)
-					 (1/2 panel)))
-			  (3/8 int)))))
-
-(defmethod frame-standard-output ((frame superapp))
-  (clim:get-frame-pane frame 'int))
-
-(defun redisplay (panel)
-  (clim:with-application-frame (frame)
-	(setf (clim:pane-needs-redisplay
-		   (clim:get-frame-pane frame panel))
-		  t)))
-(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" 50)
@@ -68,85 +15,5 @@
 		 (z2 (zone:new-zone "Manhattan" c2))
 		 (g (game:new-game p z2 (list z z2))))
 
-	 (defmethod display-title ((frame superapp) stream)
-	   (clim:draw-text* stream
-						(format nil "Joze~%~a" (zone:name (game:get-cur-zone g)))
-						300 2
-						:align-x :center
-						:align-y :top))
-	 (defmethod display-zone-price ((frame superapp) stream)
-	   (format stream "Prices for ~a~%" (zone:name (game:get-cur-zone g)))
-	   (format-zone-price
-		(game:commodities-panel g (game:get-cur-zone g)) stream))
-	 (defmethod display-panel ((frame superapp) stream)
-	   (case (car (cur-panel frame))
-		 ('stats (format-stats (game:player-stats g) stream))
-		 ('prices (progn
-					(format stream "Prices for ~a~%" (cdr (cur-panel frame)))
-					(format-zone-price
-					 (game:commodities-panel g
-											 (game:get-zone g
-															(cdr (cur-panel frame))))
-					 stream)))))
-
-	 ;; Prices command -> changes the panel to prices for zone
-	 (define-superapp-command (com-prices :name t) ((zone 'string))
-	   (clim:with-application-frame (frame)
-		 (if (game:get-zone g zone)
-			 (progn 
-			   (setf (cur-panel frame) (cons 'prices zone))
-			   (redisplay 'panel))
-			 (format (frame-standard-output frame)
-					 "Zone ~A does not exist~%"
-					 zone))))
-	 ;; Stats command -> changes the panel to player stats
-	 (define-superapp-command (com-stats :name t) ()
-	   (clim:with-application-frame (frame)
-		 (setf (cur-panel frame) '(stats))
-		 (redisplay 'panel)))
-
-	 ;; Buy command
-	 (define-superapp-command (com-buy :name t)
-		 ((item 'string) (quantity 'integer))
-	   (clim:with-application-frame (frame)
-		 (let ((out (frame-standard-output frame)))
-		   (if (game:buy-item g item quantity)
-			   (progn
-				 (when (eq 'stats (car (cur-panel frame)))
-				   (redisplay 'panel))
-				 (redisplay 'zone-price)
-				 (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))
-	   (clim:with-application-frame (frame)
-		 (let ((out (frame-standard-output frame))
-			   (sold (game:sell-item g item quantity)))
-		   (if sold
-			   (progn
-				 (when (eq 'stats (car (cur-panel frame)))
-				   (redisplay 'panel))
-				 (redisplay 'zone-price)
-				 (format out "Sold ~a ~a~%" sold item))
-			   (format out "Could not sell any ~a" item)))))
-
-	 ;; Goto command
-	 (define-superapp-command (com-goto :name t)
-		 ((dest 'string))
-	   (clim:with-application-frame (frame)
-		 (let ((out (frame-standard-output frame)))
-		   (if (game:change-zone g dest)
-			   (progn
-				 (setf (cur-zone frame) (zone:name (game:get-cur-zone g)))
-				 (redisplay 'title)
-				 (redisplay 'zone-price)
-				 (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
-								   :height 400
-								   :width 600
-								   :start-zone (game:get-cur-zone g)))))
+	 (transacc-gui:gengui g)
+	 (transacc-gui:rungui g)))
diff --git a/transacc.asd b/transacc.asd
index e9cbf45..4795910 100644
--- a/transacc.asd
+++ b/transacc.asd
@@ -6,7 +6,8 @@
   :depends-on ("mcclim")
   :components ((:module "src"
 				:components
-				((:file "main" :depends-on ("game"))
+				((:file "main" :depends-on ("gui"))
+				 (:file "gui" :depends-on ("game"))
 				 (:file "game" :depends-on ("zone" "player"))
 				 (:file "player" :depends-on ("commodities" "inventory"))
 				 (:file "zone" :depends-on ("commodities"))