BirDt/imugi
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Vector utility functions

Browse source
This commit is contained in:
BirDt_ 2026-04-02 22:29:35 +08:00
parent 5456f643e3
commit 1453813aee
1 changed files with 88 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

89
engine/components.scm
View file

@ -2,6 +2,7 @@
(import scheme
(chicken base)
(chicken module)
(srfi 1)
(srfi 99))
;; Vector exports
@ -34,6 +35,92 @@
(assert (number? y))
(int:set-vector2-y! vector2 y))
;; Vector utility functions
(define (vector-x component)
(assert (record? component))
((rtd-accessor (record-rtd component) 'x) component))
(define (set-vector-x! component x)
(assert (record? component))
(assert (number? x))
((rtd-mutator (record-rtd component) 'x) component x))
(define (vector-y component)
(assert (record? component))
((rtd-accessor (record-rtd component) 'y) component))
(define (set-vector-y! component y)
(assert (record? component))
(assert (number? y))
((rtd-mutator (record-rtd component) 'y) component y))
;; TODO: make this function accept any number of vectors
(define (vector-+ vec1 vec2)
(assert (and (record? vec1)
(record? vec2)))
(assert (eq? (rtd-name (record-rtd vec1))
(rtd-name (record-rtd vec2))))
(assert (any (lambda (pred) (pred vec1)) '(vector2?)))
(cond
((vector2? vec1)
(make-vector2 (+ (vector-x vec1) (vector-x vec2))
(+ (vector-y vec1) (vector-y vec2))))))
;; TODO: make this function accept any number of vectors
(define (vector-- vec1 vec2)
(assert (and (record? vec1)
(record? vec2)))
(assert (eq? (rtd-name (record-rtd vec1))
(rtd-name (record-rtd vec2))))
(assert (any (lambda (pred) (pred vec1)) '(vector2?)))
(cond
((vector2? vec1)
(make-vector2 (- (vector-x vec1) (vector-x vec2))
(- (vector-y vec1) (vector-y vec2))))))
;; TODO: make this function accept any number of vectors
(define (vector-* vec1 vec2)
(assert (and (record? vec1)
(record? vec2)))
(assert (eq? (rtd-name (record-rtd vec1))
(rtd-name (record-rtd vec2))))
(assert (any (lambda (pred) (pred vec1)) '(vector2?)))
(cond
((vector2? vec1)
(make-vector2 (* (vector-x vec1) (vector-x vec2))
(* (vector-y vec1) (vector-y vec2))))))
;; TODO: make this function accept any number of vectors
(define (vector-/ vec1 vec2)
(assert (and (record? vec1)
(record? vec2)))
(assert (eq? (rtd-name (record-rtd vec1))
(rtd-name (record-rtd vec2))))
(assert (any (lambda (pred) (pred vec1)) '(vector2?)))
(cond
((vector2? vec1)
(make-vector2 (/ (vector-x vec1) (vector-x vec2))
(/ (vector-y vec1) (vector-y vec2))))))
;; Magnitude
(define (vector-magnitude vec)
(assert (any (lambda (pred) (pred vec)) '(vector2?)))
(cond
((vector2? vec)
(sqrt (expt (vector-x vec) 2)
(expt (vector-y vec) 2)))))
;; Normalization
(define (vector-normalize vec)
(assert (any (lambda (pred) (pred vec)) '(vector2?))) ;; TODO: This assertion should be moved out of here
(let ((magnitude (vector-magnitude vec)))
(cond
((vector2? vec)
(make-vector2 (/ (vector-x vec)
magnitude)
(/ (vector-y vec)
magnitude))))))
;; Color exports
(export make-color color-r color-g color-b color-a
set-color-r! set-color-g! set-color-b! set-color-a!)
@ -219,7 +306,7 @@
(define-record-type <visual-2d>
(int:make-visual-2d draw color layer)
visual-2d?
(draw visual-2d-draw int:set-visual-2d-draw!) ;; Typing here: pixel-2d, line-2d, circle-2d, rectangle-2d, triangle-2d etc
(draw visual-2d-draw int:set-visual-2d-draw!) ;; NOTE: Typing here: pixel-2d, line-2d, circle-2d, rectangle-2d, triangle-2d etc
(color visual-2d-color int:set-visual-2d-color!)
(layer visual-2d-layer int:set-visual-2d-layer!))
)