Commit 3c59d986 authored by Hugo Hörnquist's avatar Hugo Hörnquist

Solid foundation.

parents
(add-to-load-path "/usr/local/share/guile/site/2.2/")
(use-modules (srfi srfi-1)
(srfi srfi-9)
(ice-9 threads)
(oop goops)
(sdl2)
(sdl2 video)
(sdl2 rect)
(sdl2 render)
(sdl2 surface)
(sdl2 events)
)
(define-public *unspecified* ((@ (guile) if) #f #f))
(define-syntax set!
(syntax-rules (=)
((_) *unspecified*)
((_ field = (op args ...) rest ...)
(begin ((@ (guile) set!) field (op field args ...))
(set! rest ...)))
((_ field proc)
((@ (guile) set!) field proc))
((_ field proc rest ...)
(begin ((@ (guile) set!) field proc) (set! rest ...)))))
(define (parse-map spec)
(let ((arr (make-array #f (length spec) (string-length (car spec)))))
(array-index-map! arr
(lambda (i j)
(case (string-ref (list-ref spec i) j)
((#\space) 'space)
((#\#) 'wall))))
arr))
(define game-map
(parse-map
'("########"
"# #"
"# ### #"
"# # #"
"########")))
(define-values (board-height board-width)
(apply values (array-dimensions game-map)))
(define (cross-product l1 l2)
(concatenate
(map (lambda (a)
(map (lambda (b) (list a b))
l2))
l1)))
(define-class <point> ()
(x #:accessor x
#:init-keyword #:x
#:init-value 0)
(y #:accessor y
#:init-keyword #:y
#:init-value 0))
(define (make-point x y)
(make <point> #:x x #:y y))
(define-class <player> (<point>)
(angle #:accessor a #:init-value 0))
(define (get-t)
(define t (gettimeofday))
(+ (cdr t) (* 1000000 (car t))))
(define current-tile-size (make-parameter 50))
(define current-renderer (make-parameter #f))
(define int (compose inexact->exact floor))
(define (draw-line x1 y1 x2 y2)
(render-draw-line
(current-renderer)
(int (* (current-tile-size) x1)) (int (* (current-tile-size) y1))
(int (* (current-tile-size) x2)) (int (* (current-tile-size) y2))))
(define (fill-rect x y w h)
(render-fill-rect
(current-renderer)
(make-rect (int (* (current-tile-size) x))
(int (* (current-tile-size) y))
(int (* (current-tile-size) w))
(int (* (current-tile-size) h)))))
(define (draw-line x1 y1 x2 y2)
(render-draw-line
(current-renderer)
(int (* x1 (current-tile-size))) (int (* y1 (current-tile-size)))
(int (* x2 (current-tile-size))) (int (* y2 (current-tile-size)))))
(define (make-rect* x y w h)
(make-rect (int (* x (current-tile-size)))
(int (* y (current-tile-size)))
(int (* w (current-tile-size)))
(int (* h (current-tile-size)))))
(define (fill-rects rects)
(render-fill-rects (current-renderer) rects))
(define* (set-draw-color r g b #:optional (a #xFF))
(set-render-draw-color (current-renderer) r g b a))
(define (clear)
(clear-renderer (current-renderer)))
(define (present)
(present-renderer (current-renderer)))
(define player (make <player> #:x 1 #:y 1 #:a 0))
(define keys-down (make-parameter '()))
(define (update dt)
(let ((ev (poll-event)))
(cond #; [(keyboard-event-repeat? ev) #f] ;; TODO implement in bindings
[(keyboard-down-event? ev)
(keys-down (cons (keyboard-event-scancode ev)
(keys-down)))]
[(keyboard-up-event? ev)
(keys-down (delv (keyboard-event-scancode ev)
(keys-down)))]))
(fold (lambda (key ret)
(case key
((x q) 'game-end)
;; Det här börjar vara fånigt...
((w) (set! (y player) = (- (* dt 0.000003))) ret)
((s) (set! (y player) = (+ (* dt 0.000003))) ret)
((a) (set! (x player) = (- (* dt 0.000003))) ret)
((d) (set! (x player) = (+ (* dt 0.000003))) ret)
((j) (set! (a player) = (- (* dt 0.000001))) ret)
((p) (set! (a player) = (+ (* dt 0.000001))) ret)
(else ret)
))
#f (keys-down))
)
(define (draw)
(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))
(map (lambda (p) (apply make-point p))
(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))
(set-draw-color #xFF 0 0)
(fill-rect
(- (x player) 0.25)
(- (y player) 0.25)
0.5 0.5)
(set-draw-color 0 #xFF 0)
(draw-line
(x player) (y player)
(+ (cos (a player)) (x player))
(+ (sin (a player)) (y player)))
(present))
(define (main-loop window)
(define rend (make-renderer window))
(define last-t (get-t))
(parameterize ((current-renderer rend)
(current-tile-size 16))
(let loop ((counter 0))
(usleep (int (/ 1000000 (* 60 60))))
;; (sigaction SIGINT (lambda (sig) (set! looping #f)))
(if (= counter 60)
(begin (draw) (loop 0))
(begin (let ((dt (let ((t (get-t)))
(let ((dt (- t last-t)))
(set! last-t t)
dt))))
(format #t "Δr = ~a~%" dt)
(if (update dt)
'return
(loop (1+ counter)))))))))
(sdl-init)
(call-with-window
(make-window
#:title "Wolf 3D"
#:size '(640 480))
main-loop)
(sdl-quit)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment