main.scm 7.88 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
(define rays (make-atomic-box '()))
Hugo Hörnquist's avatar
huh?  
Hugo Hörnquist committed
46

47 48
(define update
  (let ((keys-down '()))
49 50
    (lambda (dt)                             ; dt in μs

51 52
      (let ((ev (poll-event)))
        (cond #; [(keyboard-event-repeat? ev) #f] ;; TODO implement in bindings
53 54 55 56

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

57
         [(keyboard-up-event? ev)
58
          (set! keys-down (delv (keyboard-event-scancode ev) keys-down))]
59

60
         [(quit-event? ev) (raise SIGINT)]))
61

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
78
(define (ray-trace player ray-count)
79
  (let ((p (p player)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
80 81
    (map
     (lambda (a)
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
       (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
97 98
     (iota ray-count (- (a player) (/ (fov player) 2))
           (/ (fov player) ray-count)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
99

Hugo Hörnquist's avatar
Hugo Hörnquist committed
100
(define (draw-map)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
101
  (set-draw-color #xFF #xFF #xFF)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
102 103
  (clear)

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


118 119 120 121 122 123 124 125 126
  ;; 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
127

Hugo Hörnquist's avatar
Hugo Hörnquist committed
128
(define (draw-first-person-perspective)
129
  (set-draw-color #xBB #xBB #xFF)       ; light blue
Hugo Hörnquist's avatar
Hugo Hörnquist committed
130 131
  (clear)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
132
  ;; floor
Hugo Hörnquist's avatar
Hugo Hörnquist committed
133 134 135 136
  (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
137 138 139

  (let ((rays (atomic-box-ref rays)))
   (unless (null? rays)
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
     (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
162
               (iota ray-count)
163
               rays
Hugo Hörnquist's avatar
Hugo Hörnquist committed
164
               )))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
165 166 167

  )

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

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

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

179 180


Hugo Hörnquist's avatar
Hugo Hörnquist committed
181 182 183 184 185
(define (with-render-target target thunk)
  (dynamic-wind (lambda () (set-render-target! (current-renderer) target))
                thunk
                (lambda () (set-render-target! (current-renderer) #f))))

186 187 188 189 190 191 192 193 194 195 196 197
(define (make-fps-counter)
  (let ((last-time (get-t)))
    (lambda ()
      (let ((new-time (get-t)))
        (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
198

199 200 201 202 203
        ;; 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
204

205 206
          ;; Camera
          (draw-first-person-perspective)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
207

208 209 210
          (render-copy rend texture
                       #:dstrect (list 0 (- 480 100)
                                       100 100))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
211

212
          (delete-texture! texture))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
213

214 215
        ;; Text overlay
        (parameterize ((color (make-color 0 0 0 #xFF)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
216

217 218
          ;; FPS counter
          (render-text (format #f "FPS: ~,2f" (/ 1000000 (fps-counter))) #:line 0)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
219

220 221 222 223
          (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
224

225
        (present)))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
226 227

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
231 232 233 234 235
  (begin-thread
   (while
       #t (let ((rays-next (ray-trace player (1+ ray-count))))
            (atomic-box-set! rays rays-next)
            (wait))))
236

237
  ;; load textures
Hugo Hörnquist's avatar
Hugo Hörnquist committed
238 239 240 241 242
  (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
243

244 245
  (let ((counter 0))
    (while #t
246
           (sigaction SIGINT (lambda (sig) (break)))
247 248 249

           (if (= counter 1)
               (begin (draw window rend) (set! counter 0))
250
               (let ((dt (fps-counter)))
251
                 (update dt)
252
                 (usleep (int (/ (- 1000000 dt) 360)))
253
                 (set! counter = (+ 1)))))))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
254 255

(sdl-init)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
256 257
(ttf-init)

Hugo Hörnquist's avatar
Hugo Hörnquist committed
258 259 260
(define current-font
  (make-parameter
   (load-font (media "/font.otf") 20)))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
261

262 263 264 265
;; (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
266 267 268 269 270 271 272

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

Hugo Hörnquist's avatar
Hugo Hörnquist committed
273
(ttf-quit)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
274
(sdl-quit)