diff options
Diffstat (limited to 'src/gui.lisp')
| -rw-r--r-- | src/gui.lisp | 178 |
1 files changed, 178 insertions, 0 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)))) |