main.scm 7.79 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 19 20 21

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

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

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

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
37
(define player (make-player 5 13 -2))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
38

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

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

43 44
(define update
  (let ((keys-down '()))
45
    (lambda (dt)                             ; dt in ms
46

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

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

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

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

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
73
(define (ray-trace player ray-count)
74
  (let ((p (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
75 76
    (map
     (lambda (a)
77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
       (let loop ((dx 0) (dy 0))
         (let ((nx (+ dx (x p)))
               (ny (+ dy (y p))))
           (if (not (and (<= 0 nx board-width)
                         (<= 0 ny board-height)))
               (make-ray #:a a #:v (v3 dx dy)
                         #:hitf (v3 nx ny)
                         #:type #f)
               (let ((tile (array-ref game-map (int ny) (int nx))))
                 (if (memv tile '(wall window))
                     (make-ray #:a a #:v (v3 dx dy)
                               #:type tile
                               #:hitf (v3 nx ny))
                     ;; else continue
                     (loop (+ dx (* 0.1 (cos a))) (+ dy (* 0.1 (sin a))))))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
92 93
     (iota ray-count (- (a player) (/ (fov player) 2))
           (/ (fov player) ray-count)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
94

Hugo Hörnquist's avatar
Hugo Hörnquist committed
95
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
96
  (set-draw-color #xFF #xFF #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
97 98
  (clear)

99
  ;; draw level
Hugo Hörnquist's avatar
Hugo Hörnquist committed
100 101
  (for-each
   (lambda (pt)
102 103 104 105 106 107 108
     (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
109 110
   (map (lambda (p) (apply v3 p))
        (cross-product (iota board-width) (iota board-height))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
111 112


113 114 115 116 117 118 119 120 121
  ;; draw raycast
  (set-draw-color #xFF 0 0)
  (let ((p (p player)))
    (for-each
     (lambda (ray)
       (let ((v (+ p (vec ray))))
         (draw-line (x p) (y p)
                    (x v) (y v))))
     (atomic-box-ref rays))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
122

Hugo Hörnquist's avatar
Hugo Hörnquist committed
123
(define (draw-first-person-perspective)
124
  (set-draw-color #xBB #xBB #xFF)       ; light blue
Hugo Hörnquist's avatar
Hugo Hörnquist committed
125 126
  (clear)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
127
  ;; floor
Hugo Hörnquist's avatar
Hugo Hörnquist committed
128 129 130 131
  (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
132 133 134

  (let ((rays (atomic-box-ref rays)))
   (unless (null? rays)
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
     (for-each (lambda (i r)
                 (let ((hit-tile (hashq-ref texture-map (type r))))
                  (when hit-tile
                    (let* ((l (length r))
                           (segment-height (int (- 480 (* 30 l) 40))))

                      ;; Fade to black when far away
                      (let ((c (max 0 (int (- #xFF (* l 20))))))
                        (set-texture-color-mod! hit-tile c c c))

                      (render-copy
                       (current-renderer)
                       hit-tile
                       #: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))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
157
               (iota ray-count)
158
               rays
Hugo Hörnquist's avatar
Hugo Hörnquist committed
159
               )))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
160 161 162

  )

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
164 165 166

(define color (make-parameter (make-color 0 0 0 #xFF)))
(define* (render-text str #:key (line 0))
167
  (let ((surf (render-font-blended (current-font) str (color))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
168 169
    (render-copy (current-renderer)
                 (surface->texture (current-renderer) surf)
170
                 #:dstrect (list 5 (+ 1 (* line (+ 1 (font-height (current-font)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
171 172 173
                                 (surface-width surf)
                                 (surface-height surf)))))

174 175


Hugo Hörnquist's avatar
Hugo Hörnquist committed
176 177 178 179 180
(define (with-render-target target thunk)
  (dynamic-wind (lambda () (set-render-target! (current-renderer) target))
                thunk
                (lambda () (set-render-target! (current-renderer) #f))))

181
(define (make-fps-counter)
182
  (let ((last-time (sdl-ticks)))
183
    (lambda ()
184
      (let ((new-time (sdl-ticks)))
185 186 187 188 189 190 191 192
        (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
193

194 195 196 197 198
        ;; 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
199

200 201
          ;; Camera
          (draw-first-person-perspective)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
202

203 204 205
          (render-copy rend texture
                       #:dstrect (list 0 (- 480 100)
                                       100 100))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
206

207
          (delete-texture! texture))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
208

209 210
        ;; Text overlay
        (parameterize ((color (make-color 0 0 0 #xFF)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
211

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

215 216 217 218
          (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
219

220
        (present)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
221 222

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
226 227 228 229 230
  (begin-thread
   (while
       #t (let ((rays-next (ray-trace player (1+ ray-count))))
            (atomic-box-set! rays rays-next)
            (wait))))
231

232
  ;; load textures
Hugo Hörnquist's avatar
Hugo Hörnquist committed
233 234 235 236 237
  (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
238

239 240
  (let ((counter 0))
    (while #t
241
           (sigaction SIGINT (lambda (sig) (break)))
242 243 244

           (if (= counter 1)
               (begin (draw window rend) (set! counter 0))
245
               (let ((dt (fps-counter)))
246
                 (update dt)
247
                 (usleep (max 0 (floor/ (- 1000 dt) 360)))
248
                 (set! counter = (+ 1)))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
249 250

(sdl-init)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
251 252
(ttf-init)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
253 254 255
(define current-font
  (make-parameter
   (load-font (media "/font.otf") 20)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
256

257 258 259 260
;; (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
261 262 263 264 265 266 267

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
268
(ttf-quit)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
269
(sdl-quit)