main.scm 8.33 KB
Newer Older
Hugo Hörnquist's avatar
Hugo Hörnquist committed
1
(add-to-load-path "/usr/local/share/guile/site/2.2/")
2
(add-to-load-path (dirname (current-filename)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
3
4
5
6

(use-modules (srfi srfi-1)

             (sdl2)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
7
             (sdl2 ttf)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
8
             (sdl2 video)
9
             (sdl2 image)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
10
11
12
13
             (sdl2 rect)
             (sdl2 render)
             (sdl2 surface)
             (sdl2 events)
14
15
16
17
18

             (util)
             (map)
             (class)
             (draw)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
19
20
             )

21
(define brick-texture #f)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
22
23
24
25
26

(define (get-t)
  (define t (gettimeofday))
  (+ (cdr t) (* 1000000 (car t))))

27
(define player (make-player 1 1 0))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
28

Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
29
(define ray-count 64)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
30

Hugo Hörnquist's avatar
Hugo Hörnquist committed
31
32
(define keys-down (make-parameter '()))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
33
34
(define current-font (make-parameter #f))

Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
35
36
(define cached-rays #f)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
37
38
(define (update dt)

Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
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
  (let ((ev (poll-event)))
    (cond #; [(keyboard-event-repeat? ev) #f] ;; TODO implement in bindings
     [(and (keyboard-down-event? ev)
           (not (memv (keyboard-event-scancode ev)
                   (keys-down))))
      (keys-down (cons (keyboard-event-scancode ev)
                       (keys-down)))]
     [(keyboard-up-event? ev)
      (keys-down (delv (keyboard-event-scancode ev)
                       (keys-down)))]))


  (let ((ret
         (fold (lambda (key ret)
                 (case key
                   ((x q) 'game-end)
                   ((w) (set! (p player) = (+ (* dt 0.000003
                                                 (v3 (cos (a player))
                                                     (sin (a player)))))
                              cached-rays #f)
                    ret)
                   ((s) (set! (p player) = (+ (* dt 0.000003 -1
                                                 (v3 (cos (a player))
                                                     (sin (a player)))))
                              cached-rays #f) ret)
                   ;; ((a) (set! (p player) = (+ (* dt 0.000003 -1
                   ;;                               (v3 (sin (a player))
                   ;;                                   (cos (a player)))))) ret)
                   ;; ((d) (set! (p player) = (+ (* dt 0.000003
                   ;;                               (v3 (sin (a player))
                   ;;                                   (cos (a player)))))) ret)
                   ((j) (set! (a player) = (- (* dt 0.000003))
                              cached-rays #f) ret)
                   ((p) (set! (a player) = (+ (* dt 0.000003))
                              cached-rays #f) ret)
                   (else ret)
                   ))
               #f (keys-down))))

    (unless cached-rays
79
      (set! cached-rays (ray-trace player (1+ ray-count))))
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
80
    ret)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
81
82
83

  )

Hugo Hörnquist's avatar
Hugo Hörnquist committed
84
85
86
87
88
89
90
91
92
93
94
95
96
97
(define (ray-trace player ray-count)
  (let ((x (x (p player)))
        (y (y (p player))))
    (map
     (lambda (a)
       (let loop ((dx 0)
                  (dy 0))
         (let ((nx (+ x dx))
               (ny (+ y dy)))
           (let ((ix (int nx))
                 (iy (int ny)))
             (if (or (not (and (<= 0 nx board-width)
                               (<= 0 ny board-height)))
                     (eq? 'wall (array-ref game-map iy ix)))
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
98
                 (cons
99
100
                  (min (- dx (floor dx))
                       (- dy (floor dy)))
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
101
                  (v3 dx dy))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
102
103
104
                 (loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a)))))))))
     (iota ray-count (- (a player) (/ (fov player) 2))
           (/ (fov player) ray-count)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
105

Hugo Hörnquist's avatar
Hugo Hörnquist committed
106
(define fps-time (get-t))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
107

Hugo Hörnquist's avatar
Hugo Hörnquist committed
108
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
109
110
111
112
113
114
115
116
117
118
119
120
  (set-draw-color #xFF #xFF #xFF)
  (clear)

  (set-draw-color 0 0 #xFF)

  (fill-rects
   (filter-map
    (lambda (pt)
      (if (eq? 'wall (array-ref game-map (y pt) (x pt)))
          (make-rect* (x pt) (y pt)
                      1 1)
          #f))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
121
    (map (lambda (p) (apply v3 p))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
         (cross-product (iota board-width) (iota board-height)))))

  (set-draw-color 0 0 0)

  (for-each (lambda (i) (draw-line
                    0 i
                    board-width i))
            (iota board-height))

  (for-each (lambda (i) (draw-line
                    i 0
                    i board-height))
            (iota board-width))


Hugo Hörnquist's avatar
Hugo Hörnquist committed
137

Hugo Hörnquist's avatar
Hugo Hörnquist committed
138
139
140
  (set-draw-color #xFF 0 0)

  (fill-rect
Hugo Hörnquist's avatar
Hugo Hörnquist committed
141
142
   (- (x (p player)) 0.1)
   (- (y (p player)) 0.1)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
143
144
   0.2 0.2)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
145
146
  (let ((pp (p player)))
   (for-each (lambda (p)
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
147
               (let ((v (+ pp (cdr p))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
148
149
                 (draw-line (x pp) (y pp)
                            (x v)  (y v))))
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
150
151
             cached-rays
             ))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
152
153
154
155

  (set-draw-color 0 #xFF 0)

  (draw-line
Hugo Hörnquist's avatar
Hugo Hörnquist committed
156
157
158
   (x (p player)) (y (p player))
   (+ (cos (a player)) (x (p player)))
   (+ (sin (a player)) (y (p player))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
159

Hugo Hörnquist's avatar
Hugo Hörnquist committed
160

Hugo Hörnquist's avatar
Hugo Hörnquist committed
161
162
  ;; (present)
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
163

Hugo Hörnquist's avatar
Hugo Hörnquist committed
164
(define (draw-first-person-perspective)
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
165
  (set-draw-color #xBB #xBB #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
166
167
168
169
170
171
172
173
  (clear)

  (set-draw-color #x33 #x33 #x33)
  (render-fill-rect (current-renderer)
                    (make-rect 0 240 640 240))

  (set-draw-color 0 #xEE #xEE)

174
175
176
  (for-each (lambda (i r r+)
              (let ((pos-on-wall (car r))
                    (ray (cdr r)))
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
177
178
179
180
181
                (let* ((l (vector-length ray))
                       (segment-height (- 480 (* 70 l))))
                  (set-draw-color 0
                                  (int (min #xFF (- #x100 (* #x100 (/ l 7)))))
                                  (int (min #xFF (- #x100 (* #x100 (/ l 7))))))
182
183
184
185
186
187
188
189
190
191
192
193
                  (render-copy
                   (current-renderer)
                   brick-texture
                   #:dstrect (list (int (* i (/ 640 ray-count)))
                                   (int (/ (- 480 segment-height) 2))
                                   (int (1+ (/ 640 ray-count)))
                                   (int segment-height))
                   #:srcrect (list (inexact->exact (round (* 56 (car r+)))) 0
                                   (inexact->exact (round (* 56 (car r)))) 56)

                   )
                  #;
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
194
195
196
197
198
199
                  (render-fill-rect
                   (current-renderer)
                   (make-rect (int (* i (/ 640 ray-count)))
                              (int (/ (- 480 segment-height) 2))
                              (int (1+ (/ 640 ray-count)))
                              (int segment-height))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
200
            (iota ray-count)
201
202
203
            cached-rays
            (cdr cached-rays)
            )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
204
205
206

  )

Hugo Hörnquist's avatar
Hugo Hörnquist committed
207
208
(define texture #f)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
209
210
211
212
213
214
215
216
217
218
219
220
(define (draw window rend)
  (parameterize ((current-renderer rend))
    (set-draw-color #xFF #xFF #xFF)
    (clear)

    (let ((texture (make-texture rend 'rgba8888 'target
                                   (* 8 (current-tile-size))
                                   (* 5 (current-tile-size)))))
      (set-render-target! rend texture)
      (set-draw-color #xFF #xFF #xFF)
      (draw-map)
      (set-render-target! rend #f)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
221

Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
222
      ;; Camera
Hugo Hörnquist's avatar
Hugo Hörnquist committed
223
224
      (draw-first-person-perspective)

Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
225
226
227
228
229
      ;; minimap
      (render-copy rend texture
                   #:dstrect (list 0 0
                                   (* 2 (current-tile-size))
                                   (* 2 (current-tile-size))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
230

Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
231
      (delete-texture! texture))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
232

Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
233
    ;; FPS counter
Hugo Hörnquist's avatar
Hugo Hörnquist committed
234
    (let ((nt (get-t)))
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
235
236
237
238
239
240
      (let ((surf (render-font-solid
                   (current-font)
                   (format #f "FPS: ~,2f" (/ 1000000 (- nt fps-time)))
                   (make-color 0 0 0 #xFF))))
        (render-copy (current-renderer)
                     (surface->texture (current-renderer) surf)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
241
242
243
244
245
246
                     #:dstrect (list 1 1
                                     (surface-width surf)
                                     (surface-height surf))))

      (set! fps-time nt))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
247
    (present)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
248

Hugo Hörnquist's avatar
Hugo Hörnquist committed
249
    ))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
250
251

(define (main-loop window)
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
252
  (define rend (make-renderer window '(accelerated #; vsync texture)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
253
  (define last-t (get-t))
254
255
  (set! brick-texture (surface->texture rend (load-image "./purplebrick.png")))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
256

Hugo Hörnquist's avatar
Hugo Hörnquist committed
257
  (let loop ((counter 0))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
258
    ;; (usleep (int (/ 1000000 (* 60 60))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
259
260
    ;; (sigaction SIGINT (lambda (sig) (set! looping #f)))

Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
261
    (if (= counter 1)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
262
        (begin (draw window rend) (loop 0))
Hugo Hörnquist's avatar
huh?    
Hugo Hörnquist committed
263
264
265
266
267
268
269
270
271
        (let ((dt (let ((t (get-t)))
                    (let ((dt (- t last-t)))
                      (set! last-t t)
                      dt))))
          (if (update dt)
              'return
              (begin
                (usleep (int (/ (- 1000000 dt) 100)))
                (loop (1+ counter))))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
272
273

(sdl-init)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
274
275
276
277
278
(ttf-init)

(current-font (load-font "/usr/share/fonts/OTF/FiraMono-Regular.otf" 12))

(format #t "Loaded font ~a~%" (current-font))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
279
280
281
282
283
284
285

(call-with-window
    (make-window
     #:title "Wolf 3D"
     #:size '(640 480))
  main-loop)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
286
(ttf-quit)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
287
(sdl-quit)