main.scm 8.96 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 37 38 39 40

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

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

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
43
(define ray-count 64)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
44 45


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

48 49 50 51 52 53 54 55 56 57 58 59
(define update
  (let ((keys-down '()))
    (lambda (dt)
      (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)))
          (set! keys-down (cons (keyboard-event-scancode ev)
                                keys-down))]
         [(keyboard-up-event? ev)
          (set! keys-down (delv (keyboard-event-scancode ev)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
60 61
                                keys-down))]
         [(quit-event? ev) (raise SIGINT)]))
62 63


64 65 66 67
      (for-each
       (lambda (key)
         (case key
           ((x q) (raise SIGINT))
68
           ((w) (set! (p player) = (+ (* dt 0.000009
69 70 71 72
                                         (v3 (cos (a player))
                                             (sin (a player))))))
            (wake)
            )
73
           ((s) (set! (p player) = (+ (* dt 0.000006 -1
74 75 76 77 78 79 80 81 82 83
                                         (v3 (cos (a player))
                                             (sin (a player))))))
            (wake)
            )
           ;; ((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)
84
           ((j) (set! (a player) = (- (* dt 0.000004)))
85 86
            (wake)
            )
87
           ((p) (set! (a player) = (+ (* dt 0.000004)))
88 89 90 91
            (wake)
            )
           ))
       keys-down))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
92

Hugo Hörnquist's avatar
Hugo Hörnquist committed
93 94 95 96 97 98 99 100 101 102 103 104 105
(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)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
106 107
                     (memv (array-ref game-map iy ix)
                           '(wall window)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
108 109
                 (make-ray #:a a
                           #:v (v3 dx dy)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
110 111 112 113
                           #:type (if (not (and (<= 0 nx board-width)
                                                (<= 0 ny board-height)))
                                      #f (array-ref game-map iy ix))
                           #:hitf (v3 nx ny)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
114
                           #:hit (v3 ix iy))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
115 116 117
                 (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
118

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
121
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
122
  (set-draw-color #xFF #xFF #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
123 124 125 126
  (clear)

  (set-draw-color 0 0 #xFF)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
127 128 129 130 131
  (for-each
   (lambda (pt)
     (case (array-ref game-map (y pt) (x pt))
       ((wall) (set-draw-color #xBB #xBB #xBB))
       ((window) (set-draw-color #x10 #x10 #xFF))
132
       ((grass) (set-draw-color 0 #xCC 0))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
133 134 135 136 137 138
       (else (set-draw-color #xFF #xFF #xFF)))
     (fill-rect
      (x pt) (y pt)
      1 1))
   (map (lambda (p) (apply v3 p))
        (cross-product (iota board-width) (iota board-height))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
139 140 141 142

  (set-draw-color #xFF 0 0)

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
147
  (let ((pp (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
148 149
   (for-each (lambda (ray)
               (let ((v (+ pp (vec ray))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
150 151
                 (draw-line (x pp) (y pp)
                            (x v)  (y v))))
152
             (atomic-box-ref rays)
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
153
             ))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
154 155 156 157

  (set-draw-color 0 #xFF 0)

  (draw-line
Hugo Hörnquist's avatar
Hugo Hörnquist committed
158 159 160
   (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
161

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
163 164
  ;; (present)
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
165

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
170
  ;; floor
Hugo Hörnquist's avatar
Hugo Hörnquist committed
171 172 173 174
  (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
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201

  (let ((rays (atomic-box-ref rays)))
   (unless (null? rays)
     (for-each (lambda (i r r+)
                 (when (hashq-ref texture-map (type r))
                   (let* ((l (length r))
                          (segment-height (- 480 (* 30 l) 40))
                          (texture (hashq-ref texture-map (type r))))

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

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


                      #:srcrect
                      (list (int (* 16 (pos-on-wall r))) 0
                            1 16)))))
               (iota ray-count)
               rays (cdr rays)
               )))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
202 203 204

  )

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
206 207 208 209 210 211 212 213 214 215

(define color (make-parameter (make-color 0 0 0 #xFF)))
(define* (render-text str #:key (line 0))
  (let ((surf (render-font-solid (current-font) str (color))))
    (render-copy (current-renderer)
                 (surface->texture (current-renderer) surf)
                 #:dstrect (list 1 (+ 1 (* line (+ 3 (font-height (current-font)))))
                                 (surface-width surf)
                                 (surface-height surf)))))

216 217


Hugo Hörnquist's avatar
Hugo Hörnquist committed
218 219 220 221 222 223
(define (with-render-target target thunk)
  (dynamic-wind (lambda () (set-render-target! (current-renderer) target))
                thunk
                (lambda () (set-render-target! (current-renderer) #f))))

(define (draw window rend)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
224 225
  (parameterize ((current-renderer rend))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
226
    ;; minimap
Hugo Hörnquist's avatar
Hugo Hörnquist committed
227
    (let ((texture (make-texture rend 'rgba8888 'target
Hugo Hörnquist's avatar
Hugo Hörnquist committed
228 229 230
                                 (* 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
231

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
232
      ;; Camera
Hugo Hörnquist's avatar
Hugo Hörnquist committed
233 234
      (draw-first-person-perspective)

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
235
      (render-copy rend texture
236 237
                   #:dstrect (list 0 (- 480 100)
                                   100 100))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
238

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
241 242
    ;; Text overlay
    (parameterize ((color (make-color 0 0 0 #xFF)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
243

Hugo Hörnquist's avatar
Hugo Hörnquist committed
244 245 246 247 248
      ;; FPS counter
      (let ((nt (get-t)))
        (render-text (format #f "FPS: ~,2f" (/ 1000000 (- nt fps-time)))
                     #:line 0)
        (set! fps-time nt))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
249

Hugo Hörnquist's avatar
Hugo Hörnquist committed
250 251 252 253 254 255
      (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
256

Hugo Hörnquist's avatar
Hugo Hörnquist committed
257
    (present)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
258 259

(define (main-loop window)
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
260
  (define rend (make-renderer window '(accelerated #; vsync texture)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
261
  (define last-t (get-t))
262

Hugo Hörnquist's avatar
Hugo Hörnquist committed
263 264 265 266 267
  (begin-thread
   (while
       #t (let ((rays-next (ray-trace player (1+ ray-count))))
            (atomic-box-set! rays rays-next)
            (wait))))
268

Hugo Hörnquist's avatar
Hugo Hörnquist committed
269 270 271 272 273
  (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
274

275 276 277 278 279 280 281 282 283 284 285 286 287 288
  (let ((counter 0))
    (while #t
           ;; (usleep (int (/ 1000000 (* 60 60))))
           (sigaction SIGINT (lambda (sig) (break )))

           (if (= counter 1)
               (begin (draw window rend) (set! counter 0))
               (let ((dt (let ((t (get-t)))
                           (let ((dt (- t last-t)))
                             (set! last-t t)
                             dt))))
                 (update dt)
                 (usleep (int (/ (- 1000000 dt) 1000)))
                 (set! counter = (+ 1)))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
289 290

(sdl-init)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
291 292
(ttf-init)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
293 294 295
(define current-font
  (make-parameter
   (load-font (media "/font.otf") 20)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
296

Hugo Hörnquist's avatar
Hugo Hörnquist committed
297 298 299 300
(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
301 302 303 304 305 306 307

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
308
(ttf-quit)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
309
(sdl-quit)