blob: 5713a65a61b39555057d11daac631b89f66a03da (
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
|
(in-package :cl-user)
(defpackage transacc
(:use :cl)
(:export :main))
(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 :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)))))
(defmethod frame-standard-output ((frame superapp))
(clim:get-frame-pane frame 'int))
(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)
(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))))
(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)))))
;; Panel command
(define-superapp-command (com-prices :name t) ((zone 'string))
(clim:with-application-frame (frame)
(if (game:get-zone g zone)
(setf (cur-panel frame) (cons 'prices zone))
(format (frame-standard-output frame)
"Zone ~A does not exist~%"
zone))))
;; Stats command
(define-superapp-command (com-stats :name t) ()
(clim:with-application-frame (frame)
(setf (cur-panel frame) '(stats))))
;; 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)
(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))
(game:sell-item g item quantity))
;; 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)))
(setf (clim:pane-needs-redisplay (clim:get-frame-pane frame 'title)) t)
(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)))))
|
