blob: acae661d4e402f4605bb09809848d19f35d2decd (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
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))))
|
