diff options
| -rw-r--r-- | src/gui.lisp | 178 | ||||
| -rw-r--r-- | src/main.lisp | 137 | ||||
| -rw-r--r-- | transacc.asd | 3 |
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")) |