main.scm 10.3 KB
Newer Older
1 2 3 4 5 6 7 8
#!/usr/bin/env bash

# -*- mode: scheme -*-

export GUILE_LOAD_PATH=$HOME/.local/share/guile/site/2.2
export GUILE_LOAD_COMPILED_PATH=$HOME/.local/lib/guile/2.2/site-ccache

exec guile -q -e main -s $0
9 10
!#

Hugo Hörnquist's avatar
Hugo Hörnquist committed
11
;; (add-to-load-path "/usr/local/share/guile/site/2.2/")
12
(add-to-load-path (dirname (current-filename)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
13

14 15 16
(define (media str)
  (string-append (dirname (current-filename)) str))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
17 18 19
(use-modules (srfi srfi-1)

             (sdl2)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
20
             (sdl2 ttf)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
21
             (sdl2 video)
22
             (sdl2 image)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
23 24 25 26
             (sdl2 rect)
             (sdl2 render)
             (sdl2 surface)
             (sdl2 events)
27

28
             (rnrs base)
29 30 31 32

             (ice-9 threads)
             (ice-9 atomic)

33 34 35 36
             (util)
             (map)
             (class)
             (draw)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
37 38
             )

39 40 41 42 43 44
(define-values (wait wake)
  (let ((mutex (make-mutex))
        (condvar (make-condition-variable)))
    (values
     (lambda () (with-mutex mutex (wait-condition-variable condvar mutex)))
     (lambda () (broadcast-condition-variable condvar)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
45 46

(define texture-map (make-hash-table))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
47

Hugo Hörnquist's avatar
Hugo Hörnquist committed
48
(define ray-count 64)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
49

50
(define rays (make-atomic-box '()))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
51

Hugo Hörnquist's avatar
Hugo Hörnquist committed
52
(define game-map (call-with-input-file "b-huset.map" (compose parse-map read-map)))
53 54 55

(define player (make-player (+ 1/2 (car (board-spawn game-map)))
                            (+ 1/2 (cadr (board-spawn game-map)))
56
                            0.1))
57

58 59
(define update
  (let ((keys-down '()))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
60
    (lambda (dt)                             ; dt in ms
61

62 63
      (let ((ev (poll-event)))
        (cond #; [(keyboard-event-repeat? ev) #f] ;; TODO implement in bindings
64 65 66 67

         [(keyboard-down-event? ev)
          (set! keys-down (lset-adjoin eq? keys-down (keyboard-event-scancode ev)))]

68
         [(keyboard-up-event? ev)
69
          (set! keys-down (delv (keyboard-event-scancode ev) keys-down))]
70

71
         [(quit-event? ev) (raise SIGINT)]))
72

73 74 75 76
      (for-each
       (lambda (key)
         (case key
           ((x q) (raise SIGINT))
77
           ((w s) (set! (p player)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
78
                        = (+ (* dt 6e-3 (if (eq? key 'w) 1 -1)
79 80 81
                                (v3 (cos (a player))
                                    (sin (a player))))))
            (wake))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
82
           ((j) (set! (a player) = (- (* dt 4e-3)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
83 84
            (when (> 0 (a player))
              (set! (a player) tau))
85
            (wake))
86

Hugo Hörnquist's avatar
Hugo Hörnquist committed
87
           ((p) (set! (a player) = (+ (* dt 4e-3)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
88 89
            (when (< tau (a player))
              (set! (a player) 0))
90
            (wake))
Gustav Sörnäs's avatar
Gustav Sörnäs committed
91 92 93 94 95 96 97

           ((a d) (set! (p player)
                      = (+ (* dt 3e-3 (if (eq? key 'a) 1 -1)
                            (v3 (sin (a player))
                                (- (cos (a player)))))))
            (wake))
          ))
98
       keys-down))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
99

Hugo Hörnquist's avatar
Hugo Hörnquist committed
100 101 102 103 104 105 106 107 108 109
(define (find-next-wall x y a callback)
  (let ((dx-ampl (mod (* -1 (sgn (cos a)) (decimals x)) 1))
        (dy-ampl (mod (* -1 (sgn (sin a)) (decimals y)) 1)))
    (let* ((dx (* 1.01 dx-ampl (sgn (cos a))))
           (dy (* dx (tan a))))
      (if (<= (abs dy) dy-ampl)
          (callback (+ x dx) (+ y dy))
          (let* ((dy (* 1.01 dy-ampl (sgn (sin a))))
                 (dx (* dy (cot a))))
            (callback (+ x dx) (+ y dy)))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
110

Hugo Hörnquist's avatar
Hugo Hörnquist committed
111
(define (ray-trace player ray-count)
112
  (let ((p (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
113 114
    (let ((px (x p))
          (py (y p)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
115 116 117 118 119 120 121
      (map (lambda (a)
             (let loop ((x px) (y py))
               (cond [(or (not (and (<= 0 x) (< x (board-width game-map))
                                    (<= 0 y) (< y (board-height game-map))))
                          (< 15 (sqrt (+ (expt (- x px) 2)
                                         (expt (- y py) 2)))))
                      ;; outside board
Hugo Hörnquist's avatar
Hugo Hörnquist committed
122 123 124
                      (list (make-ray #:a a #:type #f
                                      #:v (v3 (- x px) (- y py))
                                      #:hitf (v3 x y))) ]
Hugo Hörnquist's avatar
Hugo Hörnquist committed
125 126 127

                     ;; hit wall
                     [(array-ref (board-data game-map) (int y) (int x))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
128 129 130 131 132 133 134 135 136
                      (lambda (tile) (memv tile '(wall)))
                      => (lambda (tile)
                           (list (make-ray #:a a #:type tile
                                           #:v (v3 (- x px) (- y py))
                                           #:hitf (v3 x y))))]

                     ;; hit window
                     [(array-ref (board-data game-map) (int y) (int x))
                      (lambda (tile) (memv tile '(window)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
137
                      => (lambda (tile)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
138 139 140 141
                           (cons (make-ray #:a a #:type tile
                                           #:v (v3 (- x px) (- y py))
                                           #:hitf (v3 x y))
                                 (find-next-wall x y a loop)))]
Hugo Hörnquist's avatar
Hugo Hörnquist committed
142 143

                     ;; follow ray
Hugo Hörnquist's avatar
Hugo Hörnquist committed
144
                     [else (find-next-wall x y a loop)])))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
145 146 147

           (iota ray-count (- (a player) (/ (fov player) 2))
                 (/ (fov player) ray-count)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
148
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
149

Hugo Hörnquist's avatar
Hugo Hörnquist committed
150
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
151
  (set-draw-color #xFF #xFF #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
152 153
  (clear)

154
  ;; draw level
Hugo Hörnquist's avatar
Hugo Hörnquist committed
155 156
  (for-each
   (lambda (pt)
157
     (apply set-draw-color
158
      (case (array-ref (board-data game-map) (y pt) (x pt))
159 160 161 162 163
        ((wall)   '(#xBB #xBB #xBB))
        ((window) '(#x10 #x10 #xFF))
        ((grass)  '(0 #xCC 0))
        (else     '(#xFF #xFF #xFF))))
     (fill-rect (x pt) (y pt) 1 1))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
164
   (map (lambda (p) (apply v3 p))
165
        (cross-product (iota (board-width game-map)) (iota (board-height game-map)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
166

167 168
  ;; draw raycast
  (set-draw-color #xFF 0 0)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
169

Hugo Hörnquist's avatar
Hugo Hörnquist committed
170
  (let ((pp (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
171 172 173 174 175 176 177 178 179
    (for-each
     (lambda (rays)
       (for-each
        (lambda (ray)
          (let ((v (+ pp (vec ray))))
            (draw-line (x pp) (y pp)
                       (x v)  (y v))))
        rays))
     (atomic-box-ref rays)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
180
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
181

Hugo Hörnquist's avatar
Hugo Hörnquist committed
182
(define (draw-first-person-perspective)
183
  (set-draw-color #xBB #xBB #xFF)       ; light blue
Hugo Hörnquist's avatar
Hugo Hörnquist committed
184 185
  (clear)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
186
  ;; floor
Hugo Hörnquist's avatar
Hugo Hörnquist committed
187 188 189 190
  (set-draw-color #x33 #x33 #x33)
  (render-fill-rect (current-renderer)
                    (make-rect 0 240 640 240))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
191
  (let ((rays (atomic-box-ref rays)))
192 193
    (unless (null? rays)
      (for-each
Hugo Hörnquist's avatar
Hugo Hörnquist committed
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
       (lambda (i rays)
         (for-each
          (lambda (r)
            (cond ((hashq-ref texture-map (type r))
                   => (lambda (texture)
                        (let* ((l (length r))
                               (segment-height (int (- 480 (* 30 l) 40))))

                          (let ((c (max 0 (int (- #xFF (* l 20))))))
                            (set-texture-color-mod! texture c c c))

                          (render-copy
                           (current-renderer)
                           texture
                           #:dstrect (list (floor/ (* i 640) ray-count)
                                           (floor/ (- 480 segment-height) 2)
                                           (floor/ 640 ray-count)
                                           segment-height)


                           #:srcrect
                           (list (int (* 16 (pos-on-wall r))) 0
                                 1 16)))))))
          rays))
218 219 220
       (iota ray-count)
       rays
       ))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
221 222


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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
224 225 226

(define color (make-parameter (make-color 0 0 0 #xFF)))
(define* (render-text str #:key (line 0))
227
  (let ((surf (render-font-blended (current-font) str (color))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
228 229
    (render-copy (current-renderer)
                 (surface->texture (current-renderer) surf)
230
                 #:dstrect (list 5 (+ 1 (* line (+ 1 (font-height (current-font)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
231
                                 (surface-width surf)
232 233
                                 (surface-height surf)))
    (delete-surface! surf)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
234

235 236


Hugo Hörnquist's avatar
Hugo Hörnquist committed
237 238 239 240 241
(define (with-render-target target thunk)
  (dynamic-wind (lambda () (set-render-target! (current-renderer) target))
                thunk
                (lambda () (set-render-target! (current-renderer) #f))))

242
(define (make-fps-counter)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
243
  (let ((last-time (sdl-ticks)))
244
    (lambda ()
245 246
      ;; TODO this only ticks when sdl is active, which is NOT when
      ;; the window is unmapped
Hugo Hörnquist's avatar
Hugo Hörnquist committed
247
      (let ((new-time (sdl-ticks)))
248 249 250 251 252 253 254
        (let ((return (- new-time last-time)))
          (set! last-time new-time)
          return)))))

(define draw
  (let ((fps-counter (make-fps-counter)))
    (lambda ( window rend)
255 256
      (parameterize ((current-renderer rend)
                     (current-tile-size (/ 480 (board-height game-map))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
257

258 259
        ;; minimap
        (let ((texture (make-texture rend 'rgba8888 'target
Hugo Hörnquist's avatar
Hugo Hörnquist committed
260
                                     (int (* (board-width game-map)  (current-tile-size)))
261
                                     (* (board-height game-map) (current-tile-size)))))
262
          (with-render-target texture draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
263

264
          ;; Camera
Hugo Hörnquist's avatar
Hugo Hörnquist committed
265
          (draw-first-person-perspective)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
266

267
          (render-copy rend texture
268
                       #:dstrect
Hugo Hörnquist's avatar
Hugo Hörnquist committed
269
                       (let ((map-size 100))
270 271
                         (list 0 (- 480 map-size)
                               map-size map-size)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
272

273
          (delete-texture! texture))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
274

275 276
        ;; Text overlay
        (parameterize ((color (make-color 0 0 0 #xFF)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
277

278
          ;; FPS counter
Hugo Hörnquist's avatar
Hugo Hörnquist committed
279
          (render-text (format #f "FPS: ~,2f" (/ 1000 (1+ (fps-counter)))) #:line 0)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
280

281 282 283 284
          (render-text
           (format #f "x = ~,4f   y = ~,4f   a = ~,4f"
                   (x (p player)) (y (p player)) (a player))
           #:line 1))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
285

286
        (present)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
287 288

(define (main-loop window)
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
289
  (define rend (make-renderer window '(accelerated #; vsync texture)))
290
  (define fps-counter (make-fps-counter))
291

Hugo Hörnquist's avatar
Hugo Hörnquist committed
292 293
  (begin-thread
   (while
294
       #t (let ((rays-next (ray-trace player ray-count)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
295 296
            (atomic-box-set! rays rays-next)
            (wait))))
297

298
  ;; load textures
Hugo Hörnquist's avatar
Hugo Hörnquist committed
299 300 301 302 303
  (for-each
   (lambda (type)
     (hashq-set! texture-map type
                 (surface->texture rend (load-image (media (format #f "/textures/~a.png" type))))))
   '(wall window))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
304

305 306
  (let ((counter 0))
    (while #t
307
           (sigaction SIGINT (lambda (sig) (break)))
308 309 310

           (if (= counter 1)
               (begin (draw window rend) (set! counter 0))
311
               (let ((dt (fps-counter)))
312
                 (update dt)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
313
                 (usleep (max 0 (floor/ (- 1000 dt) 360)))
314
                 (set! counter = (+ 1)))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
315

316 317 318 319 320
(define current-font (make-parameter #f))

(define (main args)
  (sdl-init)
  (ttf-init)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
321

322
  (current-font (load-font (media "/font.otf") 20))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
323

324 325 326 327
  ;; (let ((sock-path "/tmp/guile-socket"))
  ;;   (use-modules (system repl server))
  ;;   (delete-file sock-path)
  ;;   (spawn-server (make-unix-domain-server-socket #:path sock-path)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
328

329 330 331 332 333
  (call-with-window
   (make-window
    #:title "Wolf 3D"
    #:size '(640 480))
   main-loop)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
334

335 336
  (ttf-quit)
  (sdl-quit))