Move drawing code to it's own module and simplify draw interface
This commit is contained in:
parent
8c48d4ee42
commit
69dd991ab9
4 changed files with 247 additions and 207 deletions
|
|
@ -2,65 +2,12 @@
|
|||
(import scheme
|
||||
(chicken base)
|
||||
(chicken module)
|
||||
(engine core)
|
||||
(engine guards)
|
||||
(engine math)
|
||||
(srfi 1)
|
||||
(srfi 4)
|
||||
(srfi 99))
|
||||
|
||||
;; Color exports
|
||||
(export make-color use-color color-r color-g color-b color-a
|
||||
set-color-r! set-color-g! set-color-b! set-color-a!)
|
||||
|
||||
;; Color type
|
||||
(define-record-type <color>
|
||||
(int:make-color r g b a)
|
||||
color?
|
||||
(r color-r int:set-color-r!)
|
||||
(g color-g int:set-color-g!)
|
||||
(b color-b int:set-color-b!)
|
||||
(a color-a int:set-color-a!))
|
||||
|
||||
;; Get a raylib color vec from a color
|
||||
(define (use-color col)
|
||||
(assert (color? col))
|
||||
(u8vector (floor (* 255 (color-r col)))
|
||||
(floor (* 255 (color-g col)))
|
||||
(floor (* 255 (color-b col)))
|
||||
(floor (* 255 (color-a col)))))
|
||||
|
||||
;; Type safe color constructor
|
||||
(define (make-color r g b a)
|
||||
(assert (and (number? r) (<= 0 r 1)))
|
||||
(assert (and (number? g) (<= 0 g 1)))
|
||||
(assert (and (number? b) (<= 0 b 1)))
|
||||
(assert (and (number? a) (<= 0 a 1)))
|
||||
(int:make-color r g b a))
|
||||
|
||||
;; Type safe color setter
|
||||
(define (set-color-r! color r)
|
||||
(assert (color? color))
|
||||
(assert (and (number? r) (<= 0 r 1)))
|
||||
(int:set-color-r! color r))
|
||||
|
||||
;; Type safe color setter
|
||||
(define (set-color-g! color g)
|
||||
(assert (color? color))
|
||||
(assert (and (number? g) (<= 0 g 1)))
|
||||
(int:set-color-g! color g))
|
||||
|
||||
;; Type safe color setter
|
||||
(define (set-color-b! color b)
|
||||
(assert (color? color))
|
||||
(assert (and (number? b) (<= 0 b 1)))
|
||||
(int:set-color-b! color b))
|
||||
|
||||
;; Type safe color setter
|
||||
(define (set-color-a! color a)
|
||||
(assert (color? color))
|
||||
(assert (and (number? a) (<= 0 a 1)))
|
||||
(int:set-color-a! color a))
|
||||
|
||||
;; Screen transform record and exports
|
||||
(export make-screen-transform screen-transform?)
|
||||
|
||||
|
|
@ -84,7 +31,7 @@
|
|||
(assert (and (symbol? anchor) (member anchor '(top-left top-middle top-right
|
||||
center-left center center-right
|
||||
bottom-left bottom-middle bottom-right))))
|
||||
(assert (and (symbol? parent)))
|
||||
(assert (or (null? parent) (screen-transform? parent)))
|
||||
(int:make-screen-transform position pivot rotation scale anchor parent))
|
||||
|
||||
;; Generic accessors and mutators for position, rotation, scale, anchor, and parent
|
||||
|
|
@ -95,7 +42,10 @@
|
|||
|
||||
(define (position component)
|
||||
(assert (record? component))
|
||||
((rtd-accessor (record-rtd component) 'position) component))
|
||||
(if (null? (parent component))
|
||||
((rtd-accessor (record-rtd component) 'position) component)
|
||||
(v+ ((rtd-accessor (record-rtd component) 'position) component)
|
||||
(position (parent component)))))
|
||||
|
||||
(define (set-position! component position)
|
||||
(assert (record? component))
|
||||
|
|
@ -157,149 +107,4 @@
|
|||
((screen-transform? component)
|
||||
(assert (symbol? anchor))))
|
||||
((rtd-mutator (record-rtd component) 'parent) component parent))
|
||||
|
||||
;; Visuals
|
||||
;; Primitive shape visual types
|
||||
(export pixel-2d? make-pixel-2d
|
||||
pixel-2d-position set-pixel-2d-position!)
|
||||
(define-record-type <pixel-2d>
|
||||
(int:make-pixel-2d position)
|
||||
pixel-2d?
|
||||
(position pixel-2d-position int:set-pixel-2d-position!))
|
||||
|
||||
(define (make-pixel-2d position)
|
||||
(assert (vec2? position))
|
||||
(int:make-pixel-2d position))
|
||||
|
||||
(define set-pixel-2d-position!
|
||||
(guarded-mutator pixel-2d? 'position vec2?))
|
||||
|
||||
(export line-2d? make-line-2d line-2d-start-pos
|
||||
set-line-2d-start-pos! line-2d-end-pos set-line-2d-end-pos!
|
||||
line-2d-thickness set-line-2d-thickness!)
|
||||
(define-record-type <line-2d>
|
||||
(int:make-line-2d start-pos end-pos thickness)
|
||||
line-2d?
|
||||
(start-pos line-2d-start-pos int:set-line-2d-start-pos!)
|
||||
(end-pos line-2d-end-pos int:set-line-2d-end-pos!)
|
||||
(thickness line-2d-thickness int:set-line-2d-thickness!))
|
||||
|
||||
(define (make-line-2d start-pos end-pos thickness)
|
||||
(assert (vec2? start-pos))
|
||||
(assert (vec2? end-pos))
|
||||
(assert ((conjoin integer? positive?) thickness))
|
||||
(int:make-line-2d start-pos end-pos thickness))
|
||||
|
||||
(define set-line-2d-start-pos!
|
||||
(guarded-mutator line-2d? 'start-pos vec2?))
|
||||
(define set-line-2d-end-pos!
|
||||
(guarded-mutator line-2d? 'end-pos vec2?))
|
||||
(define set-line-2d-thickness!
|
||||
(guarded-mutator line-2d? 'start-pos (conjoin integer? positive?)))
|
||||
|
||||
(export circle-2d? make-circle-2d circle-2d-center
|
||||
set-circle-2d-center! circle-2d-radius set-circle-2d-radius!
|
||||
circle-2d-filled? set-circle-2d-filled!)
|
||||
(define-record-type <circle-2d>
|
||||
(int:make-circle-2d center radius filled)
|
||||
circle-2d?
|
||||
(center circle-2d-center int:set-circle-2d-center!)
|
||||
(radius circle-2d-radius int:set-circle-2d-radius!)
|
||||
(filled circle-2d-filled? int:set-circle-2d-filled!))
|
||||
|
||||
(define (make-circle-2d center radius filled)
|
||||
(assert (vec2? center))
|
||||
(assert ((conjoin integer? positive?) radius))
|
||||
(assert (boolean? filled))
|
||||
(int:make-circle-2d center radius filled))
|
||||
|
||||
(define set-circle-2d-center!
|
||||
(guarded-mutator circle-2d? 'center vec2?))
|
||||
(define set-circle-2d-radius!
|
||||
(guarded-mutator circle-2d? 'radius (conjoin integer? positive?)))
|
||||
(define set-circle-2d-filled!
|
||||
(guarded-mutator circle-2d? 'filled boolean?))
|
||||
|
||||
;; TODO: might be nicer to have the origin and width/height inside a rect-2d type or similar
|
||||
(export rectangle-2d? make-rectangle-2d rectangle-2d-origin
|
||||
set-rectangle-2d-origin! rectangle-2d-width set-rectangle-2d-width!
|
||||
rectangle-2d-height set-rectangle-2d-height! rectangle-2d-filled?
|
||||
set-rectangle-2d-filled! rectangle-2d-thickness set-rectangle-2d-thickness!)
|
||||
(define-record-type <rectangle-2d>
|
||||
(int:make-rectangle-2d origin width height filled thickness)
|
||||
rectangle-2d?
|
||||
(origin rectangle-2d-origin int:set-rectangle-2d-origin!)
|
||||
(width rectangle-2d-width int:set-rectangle-2d-width!)
|
||||
(height rectangle-2d-height int:set-rectangle-2d-height!)
|
||||
(filled rectangle-2d-filled? int:set-rectangle-2d-filled!)
|
||||
(thickness rectangle-2d-thickness int:set-rectangle-2d-thickness))
|
||||
|
||||
(define (make-rectangle-2d origin width height filled thickness)
|
||||
(assert (vec2? origin))
|
||||
(assert ((conjoin integer? positive?) width))
|
||||
(assert ((conjoin integer? positive?) height))
|
||||
(assert (boolean? filled))
|
||||
(assert ((conjoin integer? positive?) thickness))
|
||||
(int:make-rectangle-2d origin width height filled thickness))
|
||||
|
||||
(define set-rectangle-2d-origin!
|
||||
(guarded-mutator rectangle-2d? 'origin vec2?))
|
||||
(define set-rectangle-2d-width!
|
||||
(guarded-mutator rectangle-2d? 'width (conjoin integer? positive?)))
|
||||
(define set-rectangle-2d-height!
|
||||
(guarded-mutator rectangle-2d? 'height (conjoin integer? positive?)))
|
||||
(define set-rectangle-2d-filled!
|
||||
(guarded-mutator rectangle-2d? 'filled boolean?))
|
||||
(define set-rectangle-2d-thickness!
|
||||
(guarded-mutator rectangle-2d? 'thickness (conjoin integer? positive?)))
|
||||
|
||||
(export triangle-2d? make-triangle-2d triangle-2d-vertex-1
|
||||
set-triangle-2d-vertex-1! triangle-2d-vertex-2 set-triangle-2d-vertex-2!
|
||||
triangle-2d-vertex-3 set-triangle-2d-vertex-3! triangle-2d-filled? set-triangle-2d-filled!)
|
||||
(define-record-type <triangle-2d>
|
||||
(int:make-triangle-2d vertex-1 vertex-2 vertex-3 filled)
|
||||
triangle-2d?
|
||||
(vertex-1 triangle-2d-vertex-1 int:set-triangle-2d-vertex-1!)
|
||||
(vertex-2 triangle-2d-vertex-2 int:set-triangle-2d-vertex-2!)
|
||||
(vertex-3 triangle-2d-vertex-3 int:set-triangle-2d-vertex-3!)
|
||||
(filled triangle-2d-filled? int:set-triangle-2d-filled!))
|
||||
|
||||
(define (make-triangle-2d vertex-1 vertex-2 vertex-3 filled)
|
||||
(assert (vec2? vertex-1))
|
||||
(assert (vec2? vertex-2))
|
||||
(assert (vec2? vertex-3))
|
||||
(assert (boolean? filled))
|
||||
(int:make-triangle-2d vertex-1 vertex-2 vertex-3 filled))
|
||||
|
||||
(define set-triangle-2d-vertex-1!
|
||||
(guarded-mutator triangle-2d? 'vertex-1 vec2?))
|
||||
(define set-triangle-2d-vertex-2!
|
||||
(guarded-mutator triangle-2d? 'vertex-2 vec2?))
|
||||
(define set-triangle-2d-vertex-3!
|
||||
(guarded-mutator triangle-2d? 'vertex-3 vec2?))
|
||||
(define set-triangle-2d-filled!
|
||||
(guarded-mutator triangle-2d? 'filled boolean?))
|
||||
|
||||
;; Visual component
|
||||
(export visual-2d? make-visual-2d visual-2d-draw set-visual-2d-draw!
|
||||
visual-2d-color set-visual-2d-color! visual-2d-layer set-visual-2d-layer!)
|
||||
(define-record-type <visual-2d>
|
||||
(int:make-visual-2d draw color layer)
|
||||
visual-2d?
|
||||
(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!))
|
||||
|
||||
(define (make-visual-2d draw color layer)
|
||||
(assert ((disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
|
||||
(assert (color? color))
|
||||
(assert (integer? layer))
|
||||
(int:make-visual-2d draw color layer))
|
||||
|
||||
(define set-visual-2d-draw!
|
||||
(guarded-mutator visual-2d? 'draw (disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?)))
|
||||
(define set-visual-2d-color!
|
||||
(guarded-mutator visual-2d? 'color color?))
|
||||
(define set-visual-2d-layer!
|
||||
(guarded-mutator visual-2d? 'layer integer?))
|
||||
)
|
||||
|
|
|
|||
230
engine/drawing.scm
Normal file
230
engine/drawing.scm
Normal file
|
|
@ -0,0 +1,230 @@
|
|||
(module (engine drawing) ()
|
||||
(import scheme
|
||||
(chicken base)
|
||||
(chicken module)
|
||||
raylib
|
||||
(engine guards)
|
||||
(engine math)
|
||||
(srfi 4)
|
||||
(srfi 99))
|
||||
|
||||
;; 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!)
|
||||
|
||||
;; Color type
|
||||
(define-record-type <color>
|
||||
(int:make-color r g b a)
|
||||
color?
|
||||
(r color-r int:set-color-r!)
|
||||
(g color-g int:set-color-g!)
|
||||
(b color-b int:set-color-b!)
|
||||
(a color-a int:set-color-a!))
|
||||
|
||||
;; Get a raylib color vec from a color
|
||||
(define (use-color col)
|
||||
(assert (color? col))
|
||||
(u8vector (floor (* 255 (color-r col)))
|
||||
(floor (* 255 (color-g col)))
|
||||
(floor (* 255 (color-b col)))
|
||||
(floor (* 255 (color-a col)))))
|
||||
|
||||
;; Type safe color constructor
|
||||
(define (make-color r g b a)
|
||||
(assert (and (number? r) (<= 0 r 1)))
|
||||
(assert (and (number? g) (<= 0 g 1)))
|
||||
(assert (and (number? b) (<= 0 b 1)))
|
||||
(assert (and (number? a) (<= 0 a 1)))
|
||||
(int:make-color r g b a))
|
||||
|
||||
;; Type safe color setter
|
||||
(define (set-color-r! color r)
|
||||
(assert (color? color))
|
||||
(assert (and (number? r) (<= 0 r 1)))
|
||||
(int:set-color-r! color r))
|
||||
|
||||
;; Type safe color setter
|
||||
(define (set-color-g! color g)
|
||||
(assert (color? color))
|
||||
(assert (and (number? g) (<= 0 g 1)))
|
||||
(int:set-color-g! color g))
|
||||
|
||||
;; Type safe color setter
|
||||
(define (set-color-b! color b)
|
||||
(assert (color? color))
|
||||
(assert (and (number? b) (<= 0 b 1)))
|
||||
(int:set-color-b! color b))
|
||||
|
||||
;; Type safe color setter
|
||||
(define (set-color-a! color a)
|
||||
(assert (color? color))
|
||||
(assert (and (number? a) (<= 0 a 1)))
|
||||
(int:set-color-a! color a))
|
||||
|
||||
|
||||
;; Visuals
|
||||
;; Primitive shape visual types
|
||||
;; Pixel
|
||||
(export pixel-2d? make-pixel-2d
|
||||
pixel-2d-position set-pixel-2d-position!)
|
||||
(define-record-type <pixel-2d>
|
||||
(int:make-pixel-2d position)
|
||||
pixel-2d?
|
||||
(position pixel-2d-position int:set-pixel-2d-position!))
|
||||
|
||||
(define (make-pixel-2d position)
|
||||
(assert (vec2? position))
|
||||
(int:make-pixel-2d position))
|
||||
|
||||
(define set-pixel-2d-position!
|
||||
(guarded-mutator pixel-2d? 'position vec2?))
|
||||
|
||||
;; Line2D
|
||||
(export line-2d? make-line-2d line-2d-start-pos
|
||||
set-line-2d-start-pos! line-2d-end-pos set-line-2d-end-pos!
|
||||
line-2d-thickness set-line-2d-thickness!)
|
||||
(define-record-type <line-2d>
|
||||
(int:make-line-2d start-pos end-pos thickness)
|
||||
line-2d?
|
||||
(start-pos line-2d-start-pos int:set-line-2d-start-pos!)
|
||||
(end-pos line-2d-end-pos int:set-line-2d-end-pos!)
|
||||
(thickness line-2d-thickness int:set-line-2d-thickness!))
|
||||
|
||||
(define (make-line-2d start-pos end-pos thickness)
|
||||
(assert (vec2? start-pos))
|
||||
(assert (vec2? end-pos))
|
||||
(assert ((conjoin integer? positive?) thickness))
|
||||
(int:make-line-2d start-pos end-pos thickness))
|
||||
|
||||
(define set-line-2d-start-pos!
|
||||
(guarded-mutator line-2d? 'start-pos vec2?))
|
||||
(define set-line-2d-end-pos!
|
||||
(guarded-mutator line-2d? 'end-pos vec2?))
|
||||
(define set-line-2d-thickness!
|
||||
(guarded-mutator line-2d? 'start-pos (conjoin integer? positive?)))
|
||||
|
||||
;; Circle2D
|
||||
(export circle-2d? make-circle-2d circle-2d-center
|
||||
set-circle-2d-center! circle-2d-radius set-circle-2d-radius!
|
||||
circle-2d-filled? set-circle-2d-filled!)
|
||||
(define-record-type <circle-2d>
|
||||
(int:make-circle-2d center radius filled)
|
||||
circle-2d?
|
||||
(center circle-2d-center int:set-circle-2d-center!)
|
||||
(radius circle-2d-radius int:set-circle-2d-radius!)
|
||||
(filled circle-2d-filled? int:set-circle-2d-filled!))
|
||||
|
||||
(define (make-circle-2d center radius filled)
|
||||
(assert (vec2? center))
|
||||
(assert ((conjoin integer? positive?) radius))
|
||||
(assert (boolean? filled))
|
||||
(int:make-circle-2d center radius filled))
|
||||
|
||||
(define set-circle-2d-center!
|
||||
(guarded-mutator circle-2d? 'center vec2?))
|
||||
(define set-circle-2d-radius!
|
||||
(guarded-mutator circle-2d? 'radius (conjoin integer? positive?)))
|
||||
(define set-circle-2d-filled!
|
||||
(guarded-mutator circle-2d? 'filled boolean?))
|
||||
|
||||
;; Rectangle2D
|
||||
;; TODO: might be nicer to have the origin and width/height inside a rect-2d type or similar
|
||||
(export rectangle-2d? make-rectangle-2d rectangle-2d-origin
|
||||
set-rectangle-2d-origin! rectangle-2d-width set-rectangle-2d-width!
|
||||
rectangle-2d-height set-rectangle-2d-height! rectangle-2d-filled?
|
||||
set-rectangle-2d-filled! rectangle-2d-thickness set-rectangle-2d-thickness!)
|
||||
(define-record-type <rectangle-2d>
|
||||
(int:make-rectangle-2d origin width height filled thickness)
|
||||
rectangle-2d?
|
||||
(origin rectangle-2d-origin int:set-rectangle-2d-origin!)
|
||||
(width rectangle-2d-width int:set-rectangle-2d-width!)
|
||||
(height rectangle-2d-height int:set-rectangle-2d-height!)
|
||||
(filled rectangle-2d-filled? int:set-rectangle-2d-filled!)
|
||||
(thickness rectangle-2d-thickness int:set-rectangle-2d-thickness))
|
||||
|
||||
(define (make-rectangle-2d origin width height filled thickness)
|
||||
(assert (vec2? origin))
|
||||
(assert ((conjoin integer? positive?) width))
|
||||
(assert ((conjoin integer? positive?) height))
|
||||
(assert (boolean? filled))
|
||||
(assert ((conjoin integer? positive?) thickness))
|
||||
(int:make-rectangle-2d origin width height filled thickness))
|
||||
|
||||
(define set-rectangle-2d-origin!
|
||||
(guarded-mutator rectangle-2d? 'origin vec2?))
|
||||
(define set-rectangle-2d-width!
|
||||
(guarded-mutator rectangle-2d? 'width (conjoin integer? positive?)))
|
||||
(define set-rectangle-2d-height!
|
||||
(guarded-mutator rectangle-2d? 'height (conjoin integer? positive?)))
|
||||
(define set-rectangle-2d-filled!
|
||||
(guarded-mutator rectangle-2d? 'filled boolean?))
|
||||
(define set-rectangle-2d-thickness!
|
||||
(guarded-mutator rectangle-2d? 'thickness (conjoin integer? positive?)))
|
||||
|
||||
;; Triangle2D
|
||||
(export triangle-2d? make-triangle-2d triangle-2d-vertex-1
|
||||
set-triangle-2d-vertex-1! triangle-2d-vertex-2 set-triangle-2d-vertex-2!
|
||||
triangle-2d-vertex-3 set-triangle-2d-vertex-3! triangle-2d-filled? set-triangle-2d-filled!)
|
||||
(define-record-type <triangle-2d>
|
||||
(int:make-triangle-2d vertex-1 vertex-2 vertex-3 filled)
|
||||
triangle-2d?
|
||||
(vertex-1 triangle-2d-vertex-1 int:set-triangle-2d-vertex-1!)
|
||||
(vertex-2 triangle-2d-vertex-2 int:set-triangle-2d-vertex-2!)
|
||||
(vertex-3 triangle-2d-vertex-3 int:set-triangle-2d-vertex-3!)
|
||||
(filled triangle-2d-filled? int:set-triangle-2d-filled!))
|
||||
|
||||
(define (make-triangle-2d vertex-1 vertex-2 vertex-3 filled)
|
||||
(assert (vec2? vertex-1))
|
||||
(assert (vec2? vertex-2))
|
||||
(assert (vec2? vertex-3))
|
||||
(assert (boolean? filled))
|
||||
(int:make-triangle-2d vertex-1 vertex-2 vertex-3 filled))
|
||||
|
||||
(define set-triangle-2d-vertex-1!
|
||||
(guarded-mutator triangle-2d? 'vertex-1 vec2?))
|
||||
(define set-triangle-2d-vertex-2!
|
||||
(guarded-mutator triangle-2d? 'vertex-2 vec2?))
|
||||
(define set-triangle-2d-vertex-3!
|
||||
(guarded-mutator triangle-2d? 'vertex-3 vec2?))
|
||||
(define set-triangle-2d-filled!
|
||||
(guarded-mutator triangle-2d? 'filled boolean?))
|
||||
|
||||
;; Visual component
|
||||
(export visual-2d? make-visual-2d visual-2d-draw set-visual-2d-draw!
|
||||
visual-2d-color set-visual-2d-color! visual-2d-layer set-visual-2d-layer!)
|
||||
(define-record-type <visual-2d>
|
||||
(int:make-visual-2d draw color layer)
|
||||
visual-2d?
|
||||
(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!))
|
||||
|
||||
(define (make-visual-2d draw color layer)
|
||||
(assert ((disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?) draw))
|
||||
(assert (color? color))
|
||||
(assert (integer? layer))
|
||||
(int:make-visual-2d draw color layer))
|
||||
|
||||
(define set-visual-2d-draw!
|
||||
(guarded-mutator visual-2d? 'draw (disjoin triangle-2d? rectangle-2d? circle-2d? line-2d? pixel-2d?)))
|
||||
(define set-visual-2d-color!
|
||||
(guarded-mutator visual-2d? 'color color?))
|
||||
(define set-visual-2d-layer!
|
||||
(guarded-mutator visual-2d? 'layer integer?))
|
||||
|
||||
;; Drawing functions
|
||||
;; Helper wrappers for raylib functions
|
||||
(export draw-circle-2d)
|
||||
(define (draw-circle-2d pos-vec radius color filled)
|
||||
(assert (vec2? pos-vec))
|
||||
(assert (number? radius))
|
||||
(assert (color? color))
|
||||
(assert (boolean? filled))
|
||||
((if filled
|
||||
draw-circle
|
||||
draw-circle-2d)
|
||||
(number->integer (v-x pos-vec))
|
||||
(number->integer (v-y pos-vec))
|
||||
(number->integer radius)
|
||||
(use-color color)))
|
||||
)
|
||||
|
|
@ -27,6 +27,12 @@
|
|||
(define (approx-= x y)
|
||||
(< (abs (- x y)) (*float-precision*)))
|
||||
|
||||
;; Somewhat reliable fixnum conversion
|
||||
(export number->integer)
|
||||
(define (number->integer number)
|
||||
(assert (number? number))
|
||||
(inexact->exact (round number)))
|
||||
|
||||
;; Vector exports
|
||||
(export vec vec? vec2? v-x
|
||||
set-v-x! v-y set-v-y!)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue