main.scm 8.35 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

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
24 25

(define texture-map (make-hash-table))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
26 27 28 29 30

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

31
(define player (make-player 1 1 0))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
32

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
33
(define ray-count 64)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
34 35 36

(define current-font (make-parameter #f))

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
37 38
(define cached-rays #f)

39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
(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))]))


      (let ((ret
             (fold (lambda (key ret)
                     (case key
                       ((x q) 'game-end)
                       ((w) (set! (p player) = (+ (* dt 0.000003
                                                     (v3 (cos (a player))
                                                         (sin (a player)))))
                                  cached-rays #f)
                        ret)
                       ((s) (set! (p player) = (+ (* dt 0.000003 -1
                                                     (v3 (cos (a player))
                                                         (sin (a player)))))
                                  cached-rays #f) ret)
                       ;; ((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))
                                  cached-rays #f) ret)
                       ((p) (set! (a player) = (+ (* dt 0.000003))
                                  cached-rays #f) ret)
                       (else ret)
                       ))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
79
                   #f keys-down)))
80 81 82 83

        (unless cached-rays
          (set! cached-rays (ray-trace player (1+ ray-count))))
        ret)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
84 85 86

  )

Hugo Hörnquist's avatar
Hugo Hörnquist committed
87 88 89 90 91 92 93 94 95 96 97 98 99
(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
100 101
                     (memv (array-ref game-map iy ix)
                           '(wall window)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
102 103
                 (make-ray #:a a
                           #:v (v3 dx dy)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
104 105 106 107
                           #: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
108
                           #:hit (v3 ix iy))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
109 110 111
                 (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
112

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
115
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
116
  (set-draw-color #xFF #xFF #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
117 118 119 120
  (clear)

  (set-draw-color 0 0 #xFF)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
121 122 123 124 125 126 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))
       (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
132

133
  ;; (set-draw-color 0 0 0)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
134

135 136 137 138
  ;; (for-each (lambda (i) (draw-line
  ;;                   0 i
  ;;                   board-width i))
  ;;           (iota board-height))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
139

140 141 142 143
  ;; (for-each (lambda (i) (draw-line
  ;;                   i 0
  ;;                   i board-height))
  ;;           (iota board-width))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
144 145


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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
147 148 149
  (set-draw-color #xFF 0 0)

  (fill-rect
Hugo Hörnquist's avatar
Hugo Hörnquist committed
150 151
   (- (x (p player)) 0.1)
   (- (y (p player)) 0.1)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
152 153
   0.2 0.2)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
154
  (let ((pp (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
155 156
   (for-each (lambda (ray)
               (let ((v (+ pp (vec ray))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
157 158
                 (draw-line (x pp) (y pp)
                            (x v)  (y v))))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
159 160
             cached-rays
             ))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
161 162 163 164

  (set-draw-color 0 #xFF 0)

  (draw-line
Hugo Hörnquist's avatar
Hugo Hörnquist committed
165 166 167
   (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
168

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
170 171
  ;; (present)
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
172

Hugo Hörnquist's avatar
Hugo Hörnquist committed
173
(define (draw-first-person-perspective)
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
174
  (set-draw-color #xBB #xBB #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
175 176 177 178 179 180 181 182
  (clear)

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

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

183
  (for-each (lambda (i r r+)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
              (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
199
            (iota ray-count)
200 201 202
            cached-rays
            (cdr cached-rays)
            )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
203 204 205

  )

Hugo Hörnquist's avatar
Hugo Hörnquist committed
206 207
(define texture #f)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
208 209 210 211 212 213
(define (draw window rend)
  (parameterize ((current-renderer rend))
    (set-draw-color #xFF #xFF #xFF)
    (clear)

    (let ((texture (make-texture rend 'rgba8888 'target
214 215
                                   (* board-width  (current-tile-size))
                                   (* board-height (current-tile-size)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
216 217 218
      (set-render-target! rend texture)
      (draw-map)
      (set-render-target! rend #f)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
219

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
220
      ;; Camera
Hugo Hörnquist's avatar
Hugo Hörnquist committed
221 222
      (draw-first-person-perspective)

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
223 224
      ;; minimap
      (render-copy rend texture
225 226
                   #:dstrect (list 0 (- 480 100)
                                   100 100))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
227

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

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
230
    ;; FPS counter
Hugo Hörnquist's avatar
Hugo Hörnquist committed
231
    (let ((nt (get-t)))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
232 233 234 235 236 237
      (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
238 239 240 241 242 243
                     #:dstrect (list 1 1
                                     (surface-width surf)
                                     (surface-height surf))))

      (set! fps-time nt))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
244
    (present)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
245

Hugo Hörnquist's avatar
Hugo Hörnquist committed
246
    ))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
247 248

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

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
258
  (let loop ((counter 0))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
259
    ;; (usleep (int (/ 1000000 (* 60 60))))
260
    (sigaction SIGINT (lambda (sig) (set! looping #f)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
261

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
262
    (if (= counter 1)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
263
        (begin (draw window rend) (loop 0))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
264 265 266 267 268 269 270 271 272
        (let ((dt (let ((t (get-t)))
                    (let ((dt (- t last-t)))
                      (set! last-t t)
                      dt))))
          (if (update dt)
              'return
              (begin
                (usleep (int (/ (- 1000000 dt) 100)))
                (loop (1+ counter))))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
273 274

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

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

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

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

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