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

(use-modules (srfi srfi-1)

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

             (util)
             (map)
             (class)
             (draw)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
19 20
             )

21
(define brick-texture #f)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
22 23 24 25 26

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

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

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
31 32
(define keys-down (make-parameter '()))

Hugo Hörnquist's avatar
Hugo Hörnquist committed
33 34
(define current-font (make-parameter #f))

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
37 38
(define (update dt)

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
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
  (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))))
      (keys-down (cons (keyboard-event-scancode ev)
                       (keys-down)))]
     [(keyboard-up-event? ev)
      (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)
                   ))
               #f (keys-down))))

    (unless cached-rays
79
      (set! cached-rays (ray-trace player (1+ ray-count))))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
80
    ret)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
81 82 83

  )

Hugo Hörnquist's avatar
Hugo Hörnquist committed
84 85 86 87 88 89 90 91 92 93 94 95 96 97
(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)))
                     (eq? 'wall (array-ref game-map iy ix)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
98 99 100
                 (make-ray #:a a
                           #:v (v3 dx dy)
                           #:hit (v3 ix iy))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
101 102 103
                 (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
104

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
107
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
108 109 110 111 112 113 114 115 116 117 118 119
  (set-draw-color #xFF #xFF #xFF)
  (clear)

  (set-draw-color 0 0 #xFF)

  (fill-rects
   (filter-map
    (lambda (pt)
      (if (eq? 'wall (array-ref game-map (y pt) (x pt)))
          (make-rect* (x pt) (y pt)
                      1 1)
          #f))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
120
    (map (lambda (p) (apply v3 p))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
         (cross-product (iota board-width) (iota board-height)))))

  (set-draw-color 0 0 0)

  (for-each (lambda (i) (draw-line
                    0 i
                    board-width i))
            (iota board-height))

  (for-each (lambda (i) (draw-line
                    i 0
                    i board-height))
            (iota board-width))


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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
137 138 139
  (set-draw-color #xFF 0 0)

  (fill-rect
Hugo Hörnquist's avatar
Hugo Hörnquist committed
140 141
   (- (x (p player)) 0.1)
   (- (y (p player)) 0.1)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
142 143
   0.2 0.2)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
144
  (let ((pp (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
145 146
   (for-each (lambda (ray)
               (let ((v (+ pp (vec ray))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
147 148
                 (draw-line (x pp) (y pp)
                            (x v)  (y v))))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
149 150
             cached-rays
             ))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
151 152 153 154

  (set-draw-color 0 #xFF 0)

  (draw-line
Hugo Hörnquist's avatar
Hugo Hörnquist committed
155 156 157
   (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
158

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
160 161
  ;; (present)
  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
162

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

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

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

173
  (for-each (lambda (i r r+)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196
              (let* ((l (length r))
                     (segment-height (- 480 (* 70 l))))
                (set-draw-color 0
                                (int (min #xFF (- #x100 (* #x100 (/ l 7)))))
                                (int (min #xFF (- #x100 (* #x100 (/ l 7))))))
                (render-copy
                 (current-renderer)
                 brick-texture
                 #:dstrect (list (int (* i (/ 640 ray-count)))
                                 (int (/ (- 480 segment-height) 2))
                                 (int (1+ (/ 640 ray-count)))
                                 (int segment-height))
                 #:srcrect (list (inexact->exact (round (* 56 (pos-on-wall r)))) 0
                                 (inexact->exact (round (* 56 (pos-on-wall r+)))) 56)

                 )
                #;
                (render-fill-rect
                (current-renderer)
                (make-rect (int (* i (/ 640 ray-count)))
                (int (/ (- 480 segment-height) 2))
                (int (1+ (/ 640 ray-count)))
                (int segment-height)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
197
            (iota ray-count)
198 199 200
            cached-rays
            (cdr cached-rays)
            )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
201 202 203

  )

Hugo Hörnquist's avatar
Hugo Hörnquist committed
204 205
(define texture #f)

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

    (let ((texture (make-texture rend 'rgba8888 'target
                                   (* 8 (current-tile-size))
                                   (* 5 (current-tile-size)))))
      (set-render-target! rend texture)
      (set-draw-color #xFF #xFF #xFF)
      (draw-map)
      (set-render-target! rend #f)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
218

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

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
222 223 224 225 226
      ;; minimap
      (render-copy rend texture
                   #:dstrect (list 0 0
                                   (* 2 (current-tile-size))
                                   (* 2 (current-tile-size))))
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
  (set! brick-texture (surface->texture rend (load-image (string-append (dirname (current-filename)) "/purplebrick.png"))))
252

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
254
  (let loop ((counter 0))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
255
    ;; (usleep (int (/ 1000000 (* 60 60))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
256 257
    ;; (sigaction SIGINT (lambda (sig) (set! looping #f)))

Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
258
    (if (= counter 1)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
259
        (begin (draw window rend) (loop 0))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
260 261 262 263 264 265 266 267 268
        (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
269 270

(sdl-init)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
271 272
(ttf-init)

273
(current-font (load-font "/usr/share/fonts/truetype/gentium/Gentium-R.ttf" 12))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
274 275

(format #t "Loaded font ~a~%" (current-font))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
276 277 278 279 280 281 282

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
283
(ttf-quit)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
284
(sdl-quit)