main.scm 16.4 KB
Newer Older
1 2 3 4
#!/usr/bin/guile \
-e main -s
!#

Hugo Hörnquist's avatar
Hugo Hörnquist committed
5
(add-to-load-path "/usr/local/share/guile/site/2.2/")
6
(add-to-load-path (dirname (current-filename)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
7

8 9 10
(define (media str)
  (string-append (dirname (current-filename)) str))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
11 12 13
(use-modules (srfi srfi-1)

             (sdl2)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
14
             (sdl2 ttf)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
15
             (sdl2 video)
16
             (sdl2 image)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
17 18 19 20
             (sdl2 rect)
             (sdl2 render)
             (sdl2 surface)
             (sdl2 events)
21

22
             (rnrs base)
23 24 25 26

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

27 28 29 30
             (util)
             (map)
             (class)
             (draw)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
31 32
             )

33 34 35 36 37 38
(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
39 40

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
42
(define ray-count 64)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
43

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

46 47 48 49
(define game-map (call-with-input-file "simple.map" (compose parse-map read-map)))

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

52 53
(define update
  (let ((keys-down '()))
54
    (lambda (dt)                             ; dt in ms
55

56 57
      (let ((ev (poll-event)))
        (cond #; [(keyboard-event-repeat? ev) #f] ;; TODO implement in bindings
58 59 60 61

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

62
         [(keyboard-up-event? ev)
63
          (set! keys-down (delv (keyboard-event-scancode ev) keys-down))]
64

65
         [(quit-event? ev) (raise SIGINT)]))
66

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

81
           ((p) (set! (a player) = (+ (* dt 4e-3)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
82 83
            (when (< tau (a player))
              (set! (a player) 0))
84
            (wake))
85 86
           ))
       keys-down))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
87

Hugo Hörnquist's avatar
Hugo Hörnquist committed
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
;; (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)))
;;                      (memv (array-ref game-map iy ix)
;;                            '(wall window)))
;;                  (make-ray #:a a
;;                            #:v (v3 dx dy)
;;                            #:type (if (not (and (<= 0 nx board-width)
;;                                                 (<= 0 ny board-height)))
;;                                       #f (array-ref game-map iy ix))
;;                            #:hitf (v3 nx ny)
;;                            #:hit (v3 ix iy))
;;                  (loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a)))))))))
;;      (iota ray-count (- (a player) (/ (fov player) 2))
;;            (/ (fov player) ray-count)))))


(define (pow x y)
  (let ((xd (abs (decimals x)))
        (yd (abs (decimals y))))
    (min (max xd yd)
         (max (- 1 xd) (- 1 yd)))))

(define (decimals x)
  (- x (truncate x)))

(define (cot a)
  (/ (tan a)))

(define sgn signum)

129 130
(define (x-from-edge x a)
  "distance-from-y-wall"
131
  (mod (* (sgn (cos a))
132 133 134
          (decimals x))
       1))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
135 136 137
;; distance from x wall, horizontal wall, wall paralell with the x axis
;; returns how far you would have to travel in direction a before you
;; hit a wall.
138 139
(define (y-from-edge y a)
  "distance-from-x-wall"
140
  (mod (* (sgn (sin a))
141 142 143 144 145 146 147
          (decimals y))
       1))

(define distance-from-x-wall y-from-edge)
(define distance-from-y-wall x-from-edge)


Hugo Hörnquist's avatar
Hugo Hörnquist committed
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
(define (move-horizontally-from-middle x y a callback)
  (let* ((dx (* 1.01 (sgn (cos a))
                (mod (* x -1 (sgn (cos a)))
                     1)))
         (pdy (* dx (tan a))))
    (if (= (truncate y) (truncate (+ y pdy)))
        (callback (+ x dx)
                  (+ y pdy))

        (let ((dy (* 1.01 (sgn (sin a))
                     (mod (* y -1 (sgn (sin a)))
                          1))))
          (callback (+ x (* dy (cot a)))
                    (+ y dy))))))

(define (move-vertically-from-middle x y a callback)
  (let* ((dy (* 1.01 (sgn (sin a))
                (mod (* y -1 (sgn (sin a)))
                     1)))
         (pdx (* dy (cot a))))
    (if (= (truncate x) (truncate (+ x pdx)))
        (callback (+ x pdx)
                  (+ y dy))

        (let ((dx (* 1.01 (sgn (cos a))
                     (mod (* x -1 (sgn (cos a)))
                          1))))
          (callback (+ x (* dx (tan a)))
                    (+ y dy))))))

178 179
;; (loop (+ x (* 0.01 (cos a)))
;;       (+ y (* 0.01 (sin a))))
180

Hugo Hörnquist's avatar
Hugo Hörnquist committed
181
(define (ray-trace player ray-count)
182
  (let ((p (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
183 184 185
    (let ((px (x p))
          (py (y p)))
     (map (lambda (a)
186
            ;; (format #t "ray ~,3f τ~%" (/ a tau))
187
            (let loop ((x px) (y py))
188
              ;; (format #t "x = ~,6f  y = ~,6f~%" x y)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
189

190 191
              (cond [(or (not (and (<= 0 x) (< x (board-width game-map))
                                   (<= 0 y) (< y (board-height game-map))))
192 193
                         (< 15 (sqrt (+ (expt (- x px) 2)
                                        (expt (- y py) 2)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
194
                     ;; outside board
195
                     (make-ray #:a a #:type #f
Hugo Hörnquist's avatar
Hugo Hörnquist committed
196 197 198
                               #:v (v3 (- x px) (- y py))
                               #:hitf (v3 x y)) ]

199
                    [(array-ref (board-data game-map) (int y) (int x))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
200 201
                     (lambda (s) (memv s '(wall window)))
                     => (lambda (tile)
202

203
                          ;; (format #t "hit ~a~%" tile)
204

Hugo Hörnquist's avatar
Hugo Hörnquist committed
205
                          ;; hit wall
206
                          (make-ray #:a a #:type tile
Hugo Hörnquist's avatar
Hugo Hörnquist committed
207 208
                                    #:v (v3 (- x px) (- y py))
                                    #:hitf (v3 x y)))]
209 210 211

                    ;; ================= follow ray ===============================

212
                    ;; (hit-x?)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
213
                    #;
214 215 216 217 218
                    [(distance-from-x-wall y a)
                     (lambda (d) (let ((dyw (distance-from-y-wall x a)))
                              (and (< dyw 0.01)
                                   (< dyw d))))
                     => (lambda (d)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
219 220 221 222 223
                          (make-ray #:a a #:type 'wall
                                    #:v (v3 (- x px) (- y py))
                                    #:hitf (v3 x y))

                          #;
224 225 226 227 228 229 230 231 232 233 234 235 236 237
                          (let ((possible-dy (* (sgn (cos a))
                                                (tan a))))
                            (if (> 1 (abs (+ (* d (sgn (cos a)))
                                             possible-dy)))
                                ;; enter x, leave x
                                (loop (+ x (sgn (cos a)))
                                      (+ y possible-dy))

                                ;; else, enter x, leave y
                                (let ((dy (* d (sgn (cos a)))))
                                  (loop (+ x (* dy (tan a)))
                                        (+ y dy))))))]

                    ;; hit wall from top or bottom (hit-y?)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
238
                    #;
239 240 241 242 243
                    [(distance-from-y-wall x a)
                     (lambda (d) (let ((dxw (distance-from-x-wall y a)))
                              (and (< dxw 0.01)
                                   (< dxw d))))
                     => (lambda (d)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
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
                          (make-ray #:a a #:type 'wall
                                    #:v (v3 (- x px) (- y py))
                                    #:hitf (v3 x y))

                          #;

                          ;; dy = 1 = h * sin a
                          ;; dx = h * cos a = 1/sin a * cos a = cos a / sin a = cot a
                          (let ((possible-dx (* (sgn (cos a)) (cot a))))
                            (if (> 1 (abs (+ (* d (sgn (cos a)))
                                             possible-dx)))
                                (loop (+ x possible-dx)
                                      (+ y (sgn (sin a))))

                                ;; h /|
                                ;;  / | dy
                                ;; /__+
                                ;;  dx

                                ;; sin a = dx / h ↔ dx = h * sin a
                                ;; dy = h * cos a = dx * (cos a / sin a)

                                (let ((dx (* d (sgn (sin a)))))
                                  (loop (+ x dx)
                                        (+ y (* dx (cot a)))))))

                          )
272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292


                     #;
                     (let ((b (- a (/ tau 4))))
                       (let ((possible-dx (* (sgn (sin b))
                                             (tan b))))
                         (if (> 1 (abs (+ (* (sgn (cos a))
                                             (mod (* (sgn (cos b))
                                                     (pow x y))
                                                  1))
                                          possible-dx)))
                             (begin
                               (format #t "yy: dx = ~a~%" possible-dx )
                               (loop (+ x possible-dx)
                                     (+ y (sgn (sin b)))))
                             (let ((dx (* (sgn (sin b))
                                          (mod (* (sgn (sin b))
                                                  (pow x y))
                                               1))))
                               (format #t "yyy: a = ~,2f  x = ~,2f  y = ~,2f  dx = ~,2f~%" a x y dx)
                               (loop (+ x dx)
293
                     (+ y (* dx (tan b))))))))
294

295 296 297 298 299
                     ;; h * sin a = 1
                     ;; dx = h * cos a = sin^-1 a * cos a = cot a
                     ]

                    ;; ===== Middle of square =====
300 301

                    ;; moving vertically
Hugo Hörnquist's avatar
Hugo Hörnquist committed
302 303 304 305 306 307 308 309 310
                    [else (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)
                                  (loop (+ x dx) (+ y dy))
                                  (let* ((dy (* 1.01 dy-ampl (sgn (sin a))))
                                         (dx (* dy (cot a))))
                                    (loop (+ x dx) (+ y dy))))))])))
311

Hugo Hörnquist's avatar
Hugo Hörnquist committed
312 313 314
          (iota ray-count (- (a player) (/ (fov player) 2))
                (/ (fov player) ray-count)))))
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
315

Hugo Hörnquist's avatar
Hugo Hörnquist committed
316
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
317
  (set-draw-color #xFF #xFF #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
318 319
  (clear)

320
  ;; draw level
Hugo Hörnquist's avatar
Hugo Hörnquist committed
321 322
  (for-each
   (lambda (pt)
323
     (apply set-draw-color
324
      (case (array-ref (board-data game-map) (y pt) (x pt))
325 326 327 328 329
        ((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
330
   (map (lambda (p) (apply v3 p))
331
        (cross-product (iota (board-width game-map)) (iota (board-height game-map)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
332

333 334
  ;; draw raycast
  (set-draw-color #xFF 0 0)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
335

Hugo Hörnquist's avatar
Hugo Hörnquist committed
336
  (let ((pp (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
337 338
   (for-each (lambda (ray)
               (let ((v (+ pp (vec ray))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
339 340
                 (draw-line (x pp) (y pp)
                            (x v)  (y v))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
341
             (atomic-box-ref rays)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
342
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
343

Hugo Hörnquist's avatar
Hugo Hörnquist committed
344
(define (draw-first-person-perspective)
345
  (set-draw-color #xBB #xBB #xFF)       ; light blue
Hugo Hörnquist's avatar
Hugo Hörnquist committed
346 347
  (clear)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
348
  ;; floor
Hugo Hörnquist's avatar
Hugo Hörnquist committed
349 350 351 352
  (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
353
  (let ((rays (atomic-box-ref rays)))
354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379
    (unless (null? rays)
      (for-each
       (lambda (i 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)))))))
       (iota ray-count)
       rays
       ))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
380 381


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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
383 384 385

(define color (make-parameter (make-color 0 0 0 #xFF)))
(define* (render-text str #:key (line 0))
386
  (let ((surf (render-font-blended (current-font) str (color))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
387 388
    (render-copy (current-renderer)
                 (surface->texture (current-renderer) surf)
389
                 #:dstrect (list 5 (+ 1 (* line (+ 1 (font-height (current-font)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
390
                                 (surface-width surf)
391 392
                                 (surface-height surf)))
    (delete-surface! surf)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
393

394 395


Hugo Hörnquist's avatar
Hugo Hörnquist committed
396 397 398 399 400
(define (with-render-target target thunk)
  (dynamic-wind (lambda () (set-render-target! (current-renderer) target))
                thunk
                (lambda () (set-render-target! (current-renderer) #f))))

401
(define (make-fps-counter)
402
  (let ((last-time (sdl-ticks)))
403
    (lambda ()
404 405
      ;; TODO this only ticks when sdl is active, which is NOT when
      ;; the window is unmapped
406
      (let ((new-time (sdl-ticks)))
407 408 409 410 411 412 413
        (let ((return (- new-time last-time)))
          (set! last-time new-time)
          return)))))

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

417 418
        ;; minimap
        (let ((texture (make-texture rend 'rgba8888 'target
419 420
                                     (* (board-width game-map)  (current-tile-size))
                                     (* (board-height game-map) (current-tile-size)))))
421
          (with-render-target texture draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
422

423
          ;; Camera
424
          ;; (draw-first-person-perspective)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
425

426
          (render-copy rend texture
427
                       #:dstrect
428
                       (let ((map-size 480))
429 430
                         (list 0 (- 480 map-size)
                               map-size map-size)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
431

432
          (delete-texture! texture))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
433

434 435
        ;; Text overlay
        (parameterize ((color (make-color 0 0 0 #xFF)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
436

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

440 441 442 443
          (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
444

445
        (present)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
446 447

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
451 452
  (begin-thread
   (while
453
       #t (let ((rays-next (ray-trace player ray-count)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
454 455
            (atomic-box-set! rays rays-next)
            (wait))))
456

457
  ;; load textures
Hugo Hörnquist's avatar
Hugo Hörnquist committed
458 459 460 461 462
  (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
463

464 465
  (let ((counter 0))
    (while #t
466
           (sigaction SIGINT (lambda (sig) (break)))
467 468 469

           (if (= counter 1)
               (begin (draw window rend) (set! counter 0))
470
               (let ((dt (fps-counter)))
471
                 (update dt)
472
                 (usleep (max 0 (floor/ (- 1000 dt) 360)))
473
                 (set! counter = (+ 1)))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
474

475 476 477 478 479
(define current-font (make-parameter #f))

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

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

483 484 485 486
  ;; (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
487

488 489 490 491 492
  (call-with-window
   (make-window
    #:title "Wolf 3D"
    #:size '(640 480))
   main-loop)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
493

494 495
  (ttf-quit)
  (sdl-quit))