summaryrefslogtreecommitdiffstats
path: root/src/main.lisp
blob: 8baf3558ed23b81b3abc59ece5622e842bf605cb (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
(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))
  ;; :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 ()
					 (2/3 zone-price)
					 (1/3 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-zone-price (game:commodities-panel g) stream))
	 (defmethod display-panel ((frame superapp) stream)
	   (format-stats (game:player-stats g) stream))
	 
	 ;; Panel command
	 (define-superapp-command (com-panel :name t) ()
	   (format-zone-price (game:commodities-panel g) t))

	 ;; 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)))
				 (format out "~a~%" (cur-zone frame))
				 (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)))))