class.scm 1.91 KB
Newer Older
1 2 3
(define-module (class)
  :use-module (oop goops)
  :use-module (util)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
4
  :export (vector-length v3 make-player make-ray))
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32

(define-class <v3> ()
  (x #:accessor x #:init-keyword #:x)
  (y #:accessor y #:init-keyword #:y)
  (z #:accessor z #:init-keyword #:z))
(export x y z)

(define* (v3 #:optional (x 0) (y 0) (z 0))
  (make <v3> #:x x #:y y #:z z))

(define-method (+ (v <v3>) (u <v3>))
  (v3 (+ (x v) (x u))
      (+ (y v) (y u))
      (+ (z v) (z u))))

(define-method (* (a <number>) (v <v3>))
  (v3 (* a (x v))
      (* a (y v))
      (* a (z v))))

(define (vector-length v)
  (sqrt (+ (* (x v) (x v))
           (* (y v) (y v))
           (* (z v) (z v)))))

(define-class <player> ()
  (pos #:accessor p #:init-form (v3 1 1))
  (angle #:accessor a #:init-value 0)
33
  (feild-of-view #:accessor fov #:init-value (/ tau 8)))
34 35 36 37
(export p a fov)

(define (make-player x y a)
   (make <player> #:x x #:y y #:a a))
Hugo Hörnquist's avatar
Hugo Hörnquist committed
38 39 40


(define-class <ray> ()
41
  (angle #:accessor a #:init-keyword #:a)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
42 43 44
  (length #:accessor length #:init-keyword #:length #:init-value #f)
  (vec #:accessor vec #:init-keyword #:v)
  (pos-on-wall #:accessor pos-on-wall)
45
  (local-wall-segment #:accessor local-wall-segment)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
46
  (hit-coord #:accessor hit #:init-keyword #:hit)
47
  (wall-direction #:accessor wall-direction)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
48 49
  )

50
(export a length vec pos-on-wall hit local-wall-segment wall-direction)
Hugo Hörnquist's avatar
Hugo Hörnquist committed
51 52 53 54 55 56

(define-method (initialize (self <ray>) args)
  (next-method)
  (unless (length self)
    (set! (length self) (vector-length (vec self))))

57 58 59 60 61 62 63 64 65 66 67 68 69
  (set! (wall-direction self) (if (> 0.1 (x (vec self))) 'x 'y)

        (pos-on-wall self)
        (case (wall-direction self)
          ((x) (- (y (vec self)) (floor (y (vec self)))))
          ((y) (- (x (vec self)) (floor (x (vec self))))))

        (local-wall-segment self)
        (case (wall-direction self)
          ((x) (floor (x (vec self))))
          ((y) (floor (y (vec self))))))

  )
Hugo Hörnquist's avatar
Hugo Hörnquist committed
70 71 72

(define (make-ray . args)
  (apply make <ray> args))