-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmain.scm
289 lines (265 loc) · 13.1 KB
/
main.scm
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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
;;; main.scm
;;; Laaja harjoitustyö: Labyrintti ja 3d-visualisointi
;;; Paul Wagner
;;;
;;; Lyhyt selostus ohjelman toiminnasta löytyy readme.text -tiedostosta.
;; Yhteensopivuuskorjauksia mzscheme v200:aa varten
(load "xdraw-mzscheme-r200.scm")
(define true #t)
(define false #f)
(load "scheme-extensions.scm")
(load "math.scm")
(load "lights.scm")
(load "locator.scm")
; Näppäinsidonnat
(define key-bindings
'(("a" step-left sticky)
("d" step-right sticky)
("w" step-forward sticky)
("s" step-backward sticky)
("q" turn-left sticky)
("e" turn-right sticky)
("i" toggle-true-inertia non-sticky)
("1" throw-torch-1 non-sticky)
("2" throw-torch-2 non-sticky)
("3" throw-torch-3 non-sticky)
("4" throw-torch-4 non-sticky)
("l" toggle-solve-route non-sticky)
("p" update-backgrounds non-sticky)
("v" switch-player-light non-sticky)
("space" switch-viewmode non-sticky)
("Escape" exit non-sticky)))
; Kuva
(define zoom-factor 1.0) ; Ei toimi, älä muuta! ; 2.0 -> fov = 60'
(define max-fps 30) ; (12fps on turvallinen) ettei x puuroudu seinää tuijottaessa..
(define initial-viewmode '2d) ; '3d / '2d
;(define initial-window-size-string "1024x576+0+0")
(define initial-window-size-string "1280x720+0+0")
;(define initial-window-size-string "1920x1080+0+0")
;(define initial-window-size-string "1260x708+0+140") ; Niksulan O2 -koneissa about keskellä näyttöä.
; Tätä suuremmilla ikkunoilla kuvan päivitykseen
; alkaa kasautua viivettä, ellei fps <= 12.
;(define initial-window-size-string "1270x987+0+0") ; Niksula O2 -koneissa about fullscreen,
; edellyttää että fps <= 12! (muuten xdraw puuroutuu..)
; Soihdut
(define torch-1-light-color (vector 0.1 0.8 0.1))
(define torch-2-light-color (vector 0.8 0.1 0.1))
(define torch-3-light-color (vector 0.1 0.8 0.8))
(define torch-4-light-color (vector -0.15 -0.15 -0.15))
(define torch-throw-speed 0.12)
(define torch-vertical-velocity 0.1)
(define torch-light-affection-distance 5)
(define dynamic-lights-effective-distance-factor 18.0)
(define torch-light-switching-steps 3)
(define torch-kinetic-attributes
(make-kinetic-attributes 0.99 ; move-deceleration-factor
0.001 ; -delta
0.8 ; bounce-deceleration-factor
0.0 ; -delta
0.0 ; gravity-acceleration-delta
+inf.0)) ; max-acceleration-delta
; Värit ja valot
(define color-cycle-steps 42) ; Tätä pienennetään yli 10x10 -labyrinteissä
(define color-max-intensity 1.0)
(define color-mode 'normal) ; Kysytään käyttäjältä mainissa ja muutetaan
(define color-quantization-levels 256) ; Asetetaan mainissa uudelleen väritilan valinnasta riippuen
(define bg-color (vector 0.0 0.0 0.0))
(define wall-color (vector 1.0 1.0 1.0))
(define floor-color (vector 0.0 0.1 0.6))
;(define player-color (vector 0.0 0.4 1.0))
(define player-color (vector 1 1 1))
(define player-light-color (vector 0.5 0.5 0.4))
(define player-light-effective-distance-factor 3.0)
(define player-light-switching-steps 5)
(define player-light-changing-speed-curve-exp 1)
(define cell-ambient-lightning-when-no-solve-route
(vector (mul 0.3 (vector 0.2 0.2 0.2)) ; lattia
(mul 0.3 (vector 0.15 0.15 0.15)) ; itäseinä
(mul 0.3 (vector 0.05 0.05 0.05)) ; pohjois-
(mul 0.3 (vector 0.1 0.1 0.1)) ; länsi-
(mul 0.3 (vector 0.2 0.2 0.2)))) ; etelä-
(define cell-ambient-lightning-when-solve-route-marked
(vector-map (lambda (light)
(mul 0.75 light))
cell-ambient-lightning-when-no-solve-route))
(define lights-flicker-amount 0.2)
(define reflected-light-magnitude-factor 0)
(define light-ambient-diffusion 0.33)
(define lights-switching-steps 10)
(define exit-light (vector 0.0 1.0 0.2))
(define exit-light-altitude 0.5)
(define exit-light-affection-distance 5)
(define solve-route-light (vector 0.0 0.6 0.2))
(define solve-route-lights-altitude 0.4)
(define solve-route-lights-affection-distance 3)
(define solve-route-lights-effective-distance-factor 3.0)
(define visit-marker-lights-affection-distance 1)
(define visit-marker-lights-initial-altitude 0.2)
(define visit-marker-lights-switching-steps 1)
(define first-visit-marker-light-color (vector 0 0.05 0))
(define second-visit-marker-light-color (vector 0 0 0.05))
; Siirtymät
;(define h-transition-view-distance 8)
(define h-transition-view-distance 7) ; ei ala heti tahmata soihtuja heitellessä
; Liikkuminen
(define walking-altitude 0.3)
(define move-acceleration-delta 0.02)
(define turn-acceleration-delta 0.025)
(define move-deceleration-factor 0.8) ; turn deceleration factor, actually
(define bounce-vertical-acceleration-delta 0.2)
(define initial-true-inertia? false)
(define player-normal-kinetic-attributes
(make-kinetic-attributes 0.9 ; move-deceleration-factor
0.001 ; -delta
0.95 ; bounce-deceleration-factor
0.0 ; -delta
0.0 ; gravity-acceleration-delta
+inf.0)) ; max-acceleration-delta
(define player-true-inertia-kinetic-attributes
(make-kinetic-attributes 0.99 ;player-true-inertia-deceleration-factor
0.0 ;player-true-inertia-deceleration-delta
0.8 ;player-true-inertia-bounce-deceleration-factor
0.01 ; -delta
0.0 ;gravity-acceleration-delta
move-acceleration-delta)) ; max-acceleration-delta
; Yleistä
(define wall-thickness/2 0.25)
(define gravity-acceleration-delta 0.01) ; globaali painovoima, kinetic-attributes
; -painovoimakiihtyvyys ei ole käytössä
(define floor-altitude 0.3)
(define projection-vanishing-plane-guard-distance-factor 0.1)
;-----------------------------------------------------
(define global-brightness-factor 1)
(define true-inertia? initial-true-inertia?)
(define 2d<->3d-transition-average-step-length false) ; Lasketaan kun labyrintin koko on tiedossa
(define solved? false)
(define bg-color-string (color->color-string bg-color))
(define wall-color-string (color->color-string wall-color))
(define floor-color-string (color->color-string floor-color))
(define player-color-string (color->color-string player-color))
(load "ticker.scm")
(load "enws-dirs.scm")
(load "maze.scm")
(load "camera.scm")
(load "player.scm")
(load "3d-vis.scm")
(load "user-interface.scm")
(define visit-marker-light-kinetic-attributes
(make-kinetic-attributes 0 0 0 0 0 0))
(define (display-startup-message!)
; Näppäinkomennot:
(display "Voimassa olevat näppäinsidonnat:") (newline)
(for-each (lambda (binding)
(display (string-append " "
(car binding)
" = "
(symbol->string (cadr binding))))
(newline))
key-bindings)
(newline)
; Loppuläpät:
(display "Hieman infoa ohjelman käytöstä:") (newline)
(display " Ratkaisureitin näyttö/piilotus ja ikkunan koon muuttaminen aiheuttavat") (newline)
(display " 2d-moodiin mentäessä / 2d-moodissa oltaessa taustojen uudelleenlaskennan,") (newline)
(display " mikä voi kestää kohtalaisen kauan!") (newline)
(newline)
(display " Mikäli 2d-moodi alkaa tahmata pahasti, kannattaa taustat päivittää") (newline)
(display " uudelleen. (update-backgrounds -nappi)") (newline)
(newline)
(display " Kaikki ylimääräiset ohjelmat kannattaa sulkea taustalta pois, muuten xdraw") (newline)
(display " saattaa alkaa itkemään värien loppumisesta. Jos värit silti loppuvat (seinät") (newline)
(display " alkavat välähtelemään mustana), auttaa main.scm -tiedostosta löytyvän") (newline)
(display " color-quantization-levels -vakion arvon pienentäminen.") (newline)
(newline)
(display "(Yli 30x30 -labyrinttien taustojen piirto kestää aika tolkuttoman kauan, en suosittele..)") (newline))
(define (main)
(let ((maze-width 0)
(maze-height 0)
(maze (new-maze))
(ticker (new-ticker)))
; Kerrotaan käyttäjälle sitä sun tätä
(display-startup-message!)
; Kysytään värimoodi
; ( 'normal / 'blue-gray / 'cyan-gray / 'green-blue-gray / 'grayscale )
(display "Väritilan valinta:") (newline)
(display " a) normal (täydet värit)") (newline)
(display " b) cyan-gray (vanhoja koneita varten: vähän värejä, sopii soihtujen heittelyyn)") (newline)
(display " c) green-blue-gray (vanhoja koneita varten: enemmän värejä, karkea porrastus)") (newline)
(display " Anna haluamasi väritilan kirjain: ")
(set! color-mode
(let ((input (read)))
(case input
((a) 'normal)
((b) 'cyan-gray)
((c) 'green-blue-gray)
(else (error "Virheellinen valinta!")))))
;; Värien kvantisointia ei ilmeisesti tarvita enää uudemmilla X-toteutuksilla.
;; (set! color-quantization-levels
;; (case color-mode
;; ((normal) 10)
;; ((green-blue-gray) 14) ; 16
;; ((blue-gray) 26) ; 24 on suht turvallinen
;; ((cyan-gray) 26) ; 24 on suht turvallinen
;; ((grayscale) 32)))
; Kysytään labyrintin mitat
(display "Anna labyrintin leveys: ")
(let ((input (read)))
(if (not (integer? input))
(error "Virheellinen syöte: " input)
(set! maze-width (inexact->exact input))))
(display "Anna labyrintin korkeus: ")
(let ((input (read)))
(if (not (integer? input))
(error "Virheellinen syöte: " input)
(set! maze-height (inexact->exact input))))
; Tarkistetaan mittojen järkevyys ja käynnistetään systeemi
(if (or (< maze-width 2)
(< maze-height 2))
(error "Labyrintin leveyden ja korkeuden tulee olla >= 2!")
(begin
; Mitat ok, initialisoidaan olioita
(set! 2d<->3d-transition-average-step-length
(max (/ (expt (* maze-width maze-height)
1)
10000)
0.3))
;; Tätä tuskin tarvitaan enää uudemmilla X-toteutuksilla.
;; (if (> (* maze-width maze-height) 100)
;; (set! color-cycle-steps
;; (max (inexact->exact (round (* color-cycle-steps
;; (/ (expt 100 0.25)
;; (expt (* maze-width maze-height)
;; 0.25)))))
;; 6)))
((maze 'generate!) maze-width maze-height)
(let* ((player (new-player (new-locator (maze 'vis-interface)
ticker
(vector 0 0 0) ; location
(vector 0 0 0) ; velocity
(if initial-true-inertia?
player-true-inertia-kinetic-attributes
player-normal-kinetic-attributes))
(maze 'vis-interface)
ticker))
(camera (new-camera player
(maze 'vis-interface)
ticker)))
(let ((start-loc-x.y (((maze 'maze-map) 'get-loc) 'start)))
; Siirretään pelaaja alkupisteeseen
(((player 'locator) 'set-loc!) (vector (+ (car start-loc-x.y) 0.5)
(+ (cdr start-loc-x.y) 0.5)
walking-altitude))
; Käännetään katsomaan sellaiseen suuntaan jossa ei ole seinää edessä
((player 'set-dir!) (cadr (assq false
(map (lambda (enws-dir&rad-dir)
(list (((maze 'maze-map) 'wall-at-to?) (car start-loc-x.y)
(cdr start-loc-x.y)
(car enws-dir&rad-dir))
(cadr enws-dir&rad-dir)))
(list (list 'e 0)
(list 'n pi/2)
(list 'w pi)
(list 's 3/2pi)))))))
; Ja homma käyntiin
(user-interface (maze 'vis-interface) player camera ticker))))))
(define run main)