main.scm 8.16 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))))

41
(define player (make-player 1 1 0))
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 current-font (make-parameter #f))

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

49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
(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)
                                keys-down))]))


64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
      (for-each
       (lambda (key)
         (case key
           ((x q) (raise SIGINT))
           ((w) (set! (p player) = (+ (* dt 0.000003
                                         (v3 (cos (a player))
                                             (sin (a player))))))
            (wake)
            )
           ((s) (set! (p player) = (+ (* dt 0.000003 -1
                                         (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)
           ((j) (set! (a player) = (- (* dt 0.000003)))
            (wake)
            )
           ((p) (set! (a player) = (+ (* dt 0.000003)))
            (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 170 171 172 173 174 175
  (clear)

  (set-draw-color #x33 #x33 #x33)
  (render-fill-rect (current-renderer)
                    (make-rect 0 240 640 240))

  (set-draw-color 0 #xEE #xEE)

176
  (for-each (lambda (i r r+)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
              (when (hashq-ref texture-map (type r))
               (let* ((l (length r))
                      (segment-height (- 480 (* 70 l))))
                 (render-copy
                  (current-renderer)
                  (hashq-ref texture-map (type r))
                  #: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)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
192
            (iota ray-count)
193 194
            (atomic-box-ref rays)
            (cdr (atomic-box-ref rays))
195
            )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
196 197 198

  )

Hugo Hörnquist's avatar
Hugo Hörnquist committed
199 200
(define texture #f)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
201
(define (draw window rend)
202 203


Hugo Hörnquist's avatar
Hugo Hörnquist committed
204 205 206 207 208
  (parameterize ((current-renderer rend))
    (set-draw-color #xFF #xFF #xFF)
    (clear)

    (let ((texture (make-texture rend 'rgba8888 'target
209 210
                                   (* board-width  (current-tile-size))
                                   (* board-height (current-tile-size)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
211 212 213
      (set-render-target! rend texture)
      (draw-map)
      (set-render-target! rend #f)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
214

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
215
      ;; Camera
Hugo Hörnquist's avatar
Hugo Hörnquist committed
216 217
      (draw-first-person-perspective)

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
218 219
      ;; minimap
      (render-copy rend texture
220 221
                   #:dstrect (list 0 (- 480 100)
                                   100 100))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
222

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

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
225
    ;; FPS counter
Hugo Hörnquist's avatar
Hugo Hörnquist committed
226
    (let ((nt (get-t)))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
227 228 229 230 231 232
      (let ((surf (render-font-solid
                   (current-font)
                   (format #f "FPS: ~,2f" (/ 1000000 (- nt fps-time)))
                   (make-color 0 0 0 #xFF))))
        (render-copy (current-renderer)
                     (surface->texture (current-renderer) surf)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
233 234 235 236 237 238
                     #:dstrect (list 1 1
                                     (surface-width surf)
                                     (surface-height surf))))

      (set! fps-time nt))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
239
    (present)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
240

Hugo Hörnquist's avatar
Hugo Hörnquist committed
241
    ))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
242 243

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

247 248 249 250 251 252 253
  (call-with-new-thread
   (lambda ()
     (while
      #t (let ((rays-next (ray-trace player (1+ ray-count))))
           (atomic-box-set! rays rays-next)
           (wait)))))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
254 255 256 257 258
  (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
259

260 261 262 263 264 265 266 267 268 269 270 271 272 273
  (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
274 275

(sdl-init)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
276 277
(ttf-init)

278
(current-font (load-font (media "/font.otf") 12))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
279 280

(format #t "Loaded font ~a~%" (current-font))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
281 282 283 284 285 286 287

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
288
(ttf-quit)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
289
(sdl-quit)