main.scm 11.8 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
(define (media str)
  (string-append (dirname (current-filename)) str))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
7 8 9
(use-modules (srfi srfi-1)

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

18
             (rnrs base)
19 20 21 22

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

23 24 25 26
             (util)
             (map)
             (class)
             (draw)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
27 28
             )

29 30 31 32 33 34
(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
35 36

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

38
(define player (make-player 5 8 pi))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
39

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

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

44 45
(define update
  (let ((keys-down '()))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
46
    (lambda (dt)                             ; dt in ms
47

48 49
      (let ((ev (poll-event)))
        (cond #; [(keyboard-event-repeat? ev) #f] ;; TODO implement in bindings
50 51 52 53

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

54
         [(keyboard-up-event? ev)
55
          (set! keys-down (delv (keyboard-event-scancode ev) keys-down))]
56

57
         [(quit-event? ev) (raise SIGINT)]))
58

59 60 61 62
      (for-each
       (lambda (key)
         (case key
           ((x q) (raise SIGINT))
63
           ((w s) (set! (p player)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
64
                        = (+ (* dt 6e-3 (if (eq? key 'w) 1 -1)
65 66 67
                                (v3 (cos (a player))
                                    (sin (a player))))))
            (wake))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
68
           ((j) (set! (a player) = (- (* dt 4e-3)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
69 70
            (when (> 0 (a player))
              (set! (a player) tau))
71
            (wake))
72

Hugo Hörnquist's avatar
Hugo Hörnquist committed
73
           ((p) (set! (a player) = (+ (* dt 4e-3)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
74 75
            (when (< tau (a player))
              (set! (a player) 0))
76
            (wake))
77 78
           ))
       keys-down))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
79

Hugo Hörnquist's avatar
Hugo Hörnquist committed
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
;; (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)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
121
(define (ray-trace player ray-count)
122
  (let ((p (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
    (let ((px (x p))
          (py (y p)))
     (map (lambda (a)
            (let loop ((x px)
                       (y py))

              (cond [(not (and (<= 0 x board-width)
                               (<= 0 y board-height)))
                     ;; outside board
                     (make-ray #:a a
                               #:v (v3 (- x px) (- y py))
                               #:type #f
                               #:hitf (v3 x y)) ]

                    [(array-ref game-map (int y) (int x))
                     (lambda (s) (memv s '(wall window)))
                     => (lambda (tile)
                          ;; hit wall
                          (make-ray #:a a
                                    #:v (v3 (- x px) (- y py))
                                    #:type tile
                                    #:hitf (v3 x y)))]
                    [else
                     ;; follow ray
147 148 149 150
                     (cond [(< (mod (* (sgn (cos a))
                                       (decimals x))
                                    1)
                               0.01)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
151 152
                            ;; hit wall from left or right

153 154 155
                            (let ((p (mod (* (sgn (sin a))
                                             (pow x y))
                                          1)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
156 157 158 159 160 161 162
                              (cond
                               [(= a 0) (loop (+ x (sgn (cos a))) y)]
                               ;; enter x, leave x
                               [(< 0 (abs (sin a)) (sin (/ tau 8)))
                                (cond [(= p 0)
                                       (loop (+ x (* 0.01 (cos a)))
                                             (+ y (* 0.01 (sin a))))]
163 164 165
                                      [(< (abs (+ (* p       (sgn (sin a)))
                                                  (* (tan a) (sgn (sin a)))))
                                          1)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
166
                                       (loop (+ x (sgn (cos a)))
167 168
                                             (+ y (* (tan a) (sgn (cos a)))))]
                                      [else ; enter x, leave y
Hugo Hörnquist's avatar
Hugo Hörnquist committed
169
                                       (let ((dy (* (sgn (sin a))
170 171
                                                    (mod (* -1 (pow x y) (sgn (sin a)))
                                                         1))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
172 173 174
                                         (loop (+ x (* dy (cot a)))
                                               (+ y dy)))])]

175 176 177 178 179 180
                               [else    ; enter x, leave y
                                (let ((dy (* (sgn (sin a))
                                             (mod (* -1 (pow x y) (sgn (sin a)))
                                                  1))))
                                  (loop (+ x (* dy (cot a)))
                                        (+ y dy)))]))]
Hugo Hörnquist's avatar
Hugo Hörnquist committed
181 182 183 184 185 186 187 188 189 190 191 192 193 194 195

                           [(< (abs (decimals y)) 0.01)
                            ;; hit wall from top or bottom
                            (loop (+ x (* 0.01 (cos a)))
                                  (+ y (* 0.01 (sin a))))]

                           [else
                            ;; Middle of square
                            (loop (+ x (* 0.01 (cos a)))
                                  (+ y (* 0.01 (sin a))))]

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
197
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
198
  (set-draw-color #xFF #xFF #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
199 200
  (clear)

201
  ;; draw level
Hugo Hörnquist's avatar
Hugo Hörnquist committed
202 203
  (for-each
   (lambda (pt)
204 205 206 207 208 209 210
     (apply set-draw-color
      (case (array-ref game-map (y pt) (x pt))
        ((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
211 212
   (map (lambda (p) (apply v3 p))
        (cross-product (iota board-width) (iota board-height))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
213

214 215
  ;; draw raycast
  (set-draw-color #xFF 0 0)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
216

Hugo Hörnquist's avatar
Hugo Hörnquist committed
217
  (let ((pp (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
218 219
   (for-each (lambda (ray)
               (let ((v (+ pp (vec ray))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
220 221
                 (draw-line (x pp) (y pp)
                            (x v)  (y v))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
222
             (atomic-box-ref rays)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
223
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
224

Hugo Hörnquist's avatar
Hugo Hörnquist committed
225
(define (draw-first-person-perspective)
226
  (set-draw-color #xBB #xBB #xFF)       ; light blue
Hugo Hörnquist's avatar
Hugo Hörnquist committed
227 228
  (clear)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
229
  ;; floor
Hugo Hörnquist's avatar
Hugo Hörnquist committed
230 231 232 233
  (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
234
  (let ((rays (atomic-box-ref rays)))
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
    (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
261 262


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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
264 265 266

(define color (make-parameter (make-color 0 0 0 #xFF)))
(define* (render-text str #:key (line 0))
267
  (let ((surf (render-font-blended (current-font) str (color))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
268 269
    (render-copy (current-renderer)
                 (surface->texture (current-renderer) surf)
270
                 #:dstrect (list 5 (+ 1 (* line (+ 1 (font-height (current-font)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
271 272 273
                                 (surface-width surf)
                                 (surface-height surf)))))

274 275


Hugo Hörnquist's avatar
Hugo Hörnquist committed
276 277 278 279 280
(define (with-render-target target thunk)
  (dynamic-wind (lambda () (set-render-target! (current-renderer) target))
                thunk
                (lambda () (set-render-target! (current-renderer) #f))))

281
(define (make-fps-counter)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
282
  (let ((last-time (sdl-ticks)))
283
    (lambda ()
Hugo Hörnquist's avatar
Hugo Hörnquist committed
284
      (let ((new-time (sdl-ticks)))
285 286 287 288 289 290 291 292
        (let ((return (- new-time last-time)))
          (set! last-time new-time)
          return)))))

(define draw
  (let ((fps-counter (make-fps-counter)))
    (lambda ( window rend)
      (parameterize ((current-renderer rend))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
293

294 295 296 297 298
        ;; minimap
        (let ((texture (make-texture rend 'rgba8888 'target
                                     (* board-width  (current-tile-size))
                                     (* board-height (current-tile-size)))))
          (with-render-target texture draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
299

300 301
          ;; Camera
          (draw-first-person-perspective)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
302

303
          (render-copy rend texture
304 305
                       #:dstrect (list 0 (- 480 400)
                                       400 400))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
306

307
          (delete-texture! texture))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
308

309 310
        ;; Text overlay
        (parameterize ((color (make-color 0 0 0 #xFF)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
311

312
          ;; FPS counter
Hugo Hörnquist's avatar
Hugo Hörnquist committed
313
          (render-text (format #f "FPS: ~,2f" (/ 1000 (fps-counter))) #:line 0)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
314

315 316 317 318
          (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
319

320
        (present)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
321 322

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
326 327 328 329 330
  (begin-thread
   (while
       #t (let ((rays-next (ray-trace player (1+ ray-count))))
            (atomic-box-set! rays rays-next)
            (wait))))
331

332
  ;; load textures
Hugo Hörnquist's avatar
Hugo Hörnquist committed
333 334 335 336 337
  (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
338

339 340
  (let ((counter 0))
    (while #t
341
           (sigaction SIGINT (lambda (sig) (break)))
342 343 344

           (if (= counter 1)
               (begin (draw window rend) (set! counter 0))
345
               (let ((dt (fps-counter)))
346
                 (update dt)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
347
                 (usleep (max 0 (floor/ (- 1000 dt) 360)))
348
                 (set! counter = (+ 1)))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
349 350

(sdl-init)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
351 352
(ttf-init)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
353 354 355
(define current-font
  (make-parameter
   (load-font (media "/font.otf") 20)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
356

357 358 359 360
;; (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
361 362 363 364 365 366 367

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
368
(ttf-quit)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
369
(sdl-quit)