summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/font.scm4
-rw-r--r--2d/keyboard.scm10
-rw-r--r--2d/mouse.scm6
-rw-r--r--2d/rect.scm34
-rw-r--r--2d/shader.scm12
-rw-r--r--2d/sprite.scm20
-rw-r--r--2d/texture.scm20
-rw-r--r--2d/transform.scm26
-rw-r--r--2d/vector.scm157
-rw-r--r--2d/vector2.scm112
-rw-r--r--2d/window.scm10
11 files changed, 232 insertions, 179 deletions
diff --git a/2d/font.scm b/2d/font.scm
index 3f4674f..909f351 100644
--- a/2d/font.scm
+++ b/2d/font.scm
@@ -34,7 +34,7 @@
#:use-module (2d shader)
#:use-module (2d signal)
#:use-module (2d texture)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:use-module (2d window)
#:use-module (2d wrappers gl)
#:export (enable-fonts
@@ -141,7 +141,7 @@ the given position. Optional arguments are COLOR with a default of
white and ANCHOR with a default of 'top-left."
(let* ((texture (render-text font text))
(vertices (and texture (make-label-vertices texture)))
- (anchor (if texture (anchor-texture texture anchor) null-vector2)))
+ (anchor (if texture (anchor-texture texture anchor) #(0 0))))
(%make-label font text position anchor color texture vertices)))
(define (draw-label label)
diff --git a/2d/keyboard.scm b/2d/keyboard.scm
index d46fb76..97bc20a 100644
--- a/2d/keyboard.scm
+++ b/2d/keyboard.scm
@@ -25,7 +25,7 @@
#:use-module ((sdl sdl) #:prefix SDL:)
#:use-module (2d event)
#:use-module (2d signal)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:export (key-press-hook
key-release-hook
key-last-down
@@ -75,10 +75,10 @@ KEY is pressed or #f otherwise."
(define (key-directions up down left right)
(signal-map (lambda (up? down? left? right?)
- (vector2 (+ (if left? -1 0)
- (if right? 1 0))
- (+ (if up? -1 0)
- (if down? 1 0))))
+ (vector (+ (if left? -1 0)
+ (if right? 1 0))
+ (+ (if up? -1 0)
+ (if down? 1 0))))
(key-down? up)
(key-down? down)
(key-down? left)
diff --git a/2d/mouse.scm b/2d/mouse.scm
index 0942d9a..388b139 100644
--- a/2d/mouse.scm
+++ b/2d/mouse.scm
@@ -25,7 +25,7 @@
#:use-module ((sdl sdl) #:prefix SDL:)
#:use-module (2d event)
#:use-module (2d signal)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:export (mouse-move-hook
mouse-press-hook
mouse-click-hook
@@ -47,9 +47,9 @@
(define-signal mouse-position
(hook->signal mouse-move-hook
- null-vector2
+ #(0 0)
(lambda (x y)
- (vector2 x y))))
+ (vector x y))))
(define-signal mouse-x (signal-map vx mouse-position))
(define-signal mouse-y (signal-map vy mouse-position))
diff --git a/2d/rect.scm b/2d/rect.scm
index e3584d3..3a74ae2 100644
--- a/2d/rect.scm
+++ b/2d/rect.scm
@@ -24,7 +24,7 @@
(define-module (2d rect)
#:use-module (srfi srfi-9)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:export (<rect>
make-rect
null-rect
@@ -92,23 +92,23 @@
(+ (rect-y rect) (rect-height rect)))
(define (rect-position rect)
- "Return the top-left corner of RECT as a vector2."
- (vector2 (rect-x rect)
- (rect-y rect)))
+ "Return the top-left corner of RECT as a vector."
+ (vector (rect-x rect)
+ (rect-y rect)))
(define rect-top-left rect-position)
(define (rect-top-right rect)
- (vector2 (rect-right rect)
- (rect-top rect)))
+ (vector (rect-right rect)
+ (rect-top rect)))
(define (rect-bottom-left rect)
- (vector2 (rect-left rect)
- (rect-bottom rect)))
+ (vector (rect-left rect)
+ (rect-bottom rect)))
(define (rect-bottom-right rect)
- (vector2 (rect-right rect)
- (rect-bottom rect)))
+ (vector (rect-right rect)
+ (rect-bottom rect)))
(define (rect-center-x rect)
(+ (rect-x rect) (rect-half-width rect)))
@@ -117,8 +117,8 @@
(+ (rect-y rect) (rect-half-height rect)))
(define (rect-center rect)
- (vector2 (rect-center-x rect)
- (rect-center-y rect)))
+ (vector (rect-center-x rect)
+ (rect-center-y rect)))
(define (rect-half-width rect)
(/ (rect-width rect) 2))
@@ -127,9 +127,9 @@
(/ (rect-height rect) 2))
(define (rect-size rect)
- "Return the size of RECT as a vector2."
- (vector2 (rect-width rect)
- (rect-height rect)))
+ "Return the size of RECT as a vector."
+ (vector (rect-width rect)
+ (rect-height rect)))
(define (%rect-move rect x y)
"Move RECT by the offset X, Y."
@@ -141,7 +141,7 @@
(define rect-move
(case-lambda
"Create a new rectangle by moving RECT by the given
-offset. rect-move accepts a vector2 or x and y coordinates as separate
+offset. rect-move accepts a vector or x and y coordinates as separate
arguments."
((rect v)
(%rect-move rect (vx v) (vy v)))
@@ -159,7 +159,7 @@ its current center."
(define rect-inflate
(case-lambda
"Create a new rectangle by growing RECT by the given amount
-without changing the center point. rect-inflate accepts a vector2 or x
+without changing the center point. rect-inflate accepts a vector or x
and y coordinates as separate arguments."
((rect v)
(%rect-inflate rect (vx v) (vy v)))
diff --git a/2d/shader.scm b/2d/shader.scm
index 4fffcb3..56a4e03 100644
--- a/2d/shader.scm
+++ b/2d/shader.scm
@@ -26,7 +26,7 @@
#:use-module (gl low-level)
#:use-module (2d helpers)
#:use-module (2d transform)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:use-module (2d color)
#:use-module (2d wrappers gl)
#:export (make-shader
@@ -249,7 +249,7 @@ location."
(cons (make-uniform-setter predicate setter)
%uniform-setters)))
-;; Built-in uniform setters for booleans, numbers, vector2s, and
+;; Built-in uniform setters for booleans, numbers, vectors, and
;; colors.
(register-uniform-setter! boolean?
(lambda (location b)
@@ -263,6 +263,14 @@ location."
(lambda (location v)
(glUniform2f location (vx v) (vy v))))
+(register-uniform-setter! vector3?
+ (lambda (location v)
+ (glUniform3f location (vx v) (vy v) (vz v))))
+
+(register-uniform-setter! vector4?
+ (lambda (location v)
+ (glUniform4f location (vx v) (vy v) (vz v) (vw v))))
+
(register-uniform-setter! transform?
(lambda (location t)
(let ((pointer
diff --git a/2d/sprite.scm b/2d/sprite.scm
index 39bc746..a672d58 100644
--- a/2d/sprite.scm
+++ b/2d/sprite.scm
@@ -38,7 +38,7 @@
#:use-module (2d shader)
#:use-module (2d signal)
#:use-module (2d texture)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:use-module (2d window)
#:use-module (2d wrappers gl)
#:export (enable-sprites
@@ -101,17 +101,17 @@
(texture-t2 texture))))
(define* (make-sprite drawable #:optional #:key
- (position (vector2 0 0)) (scale (vector2 1 1))
+ (position #(0 0)) (scale #(1 1))
(rotation 0) (color white) (anchor 'center))
"Create a new sprite object. DRAWABLE is either a texture or
animation object. All keyword arguments are optional. POSITION is a
-vector2 object with a default of (0, 0). SCALE is a vector2 object
-that describes how much DRAWABLE should be strected on the x and y
-axes, with a default of 1x scale. ROTATION is an angle in degrees
-with a default of 0. COLOR is a color object with a default of white.
-ANCHOR is either a vector2 that represents the center point of the
-sprite, or 'center which will place the anchor at the center of
-DRAWABLE. Sprites are centered by default."
+vector with a default of (0, 0). SCALE is a vector that describes how
+much DRAWABLE should be strected on the x and y axes, with a default
+of 1x scale. ROTATION is an angle in degrees with a default of 0.
+COLOR is a color object with a default of white. ANCHOR is either a
+vector that represents the center point of the sprite, or 'center
+which will place the anchor at the center of DRAWABLE. Sprites are
+centered by default."
(let* ((vertices (make-packed-array texture-vertex 4))
(animator (if (animation? drawable)
(make-animator drawable)
@@ -123,7 +123,7 @@ DRAWABLE. Sprites are centered by default."
sprite))
(define* (load-sprite filename #:optional #:key
- (position (vector2 0 0)) (scale (vector2 1 1))
+ (position #(0 0)) (scale #(1 1))
(rotation 0) (color white) (anchor 'center))
"Load a sprite from the file at FILENAME. See make-sprite for
optional keyword arguments."
diff --git a/2d/texture.scm b/2d/texture.scm
index 8dcbf95..bd7bea6 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -28,7 +28,7 @@
#:use-module (gl contrib packed-struct)
#:use-module (2d color)
#:use-module (2d helpers)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:use-module (2d wrappers gl)
#:use-module (2d wrappers freeimage)
#:export (make-texture
@@ -156,7 +156,7 @@ that will be rendered, in pixels."
texture))
(define (anchor-texture texture anchor)
- "Return a vector2 of the coordinates for the center point of a
+ "Return a vector of the coordinates for the center point of a
texture."
(let ((w (texture-width texture))
(h (texture-height texture)))
@@ -164,20 +164,20 @@ texture."
((vector2? anchor)
anchor)
((eq? anchor 'center)
- (vector2 (/ w 2)
- (/ h 2)))
+ (vector (/ w 2)
+ (/ h 2)))
((eq? anchor 'top-left)
- null-vector2)
+ #(0 0))
((eq? anchor 'top-right)
- (vector2 w 0))
+ (vector w 0))
((eq? anchor 'bottom-left)
- (vector2 0 h))
+ (vector 0 h))
((eq? anchor 'bottom-right)
- (vector2 w h))
+ (vector w h))
((eq? anchor 'top-center)
- (vector2 (/ w 2) 0))
+ (vector (/ w 2) 0))
((eq? anchor 'bottom-center)
- (vector2 (/ w 2) h))
+ (vector (/ w 2) h))
(else
(error "Invalid anchor type!" anchor)))))
diff --git a/2d/transform.scm b/2d/transform.scm
index 4edd080..8efd8be 100644
--- a/2d/transform.scm
+++ b/2d/transform.scm
@@ -26,7 +26,7 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-42)
#:use-module (2d math)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:export (make-transform
make-transform*
null-transform
@@ -77,8 +77,8 @@ column-major format."
(array-set! matrix dd 3 3)
(%make-transform matrix)))
-(define* (make-transform* #:optional #:key (translate null-vector2)
- (scale (vector2 1 1)) (rotate 0))
+(define* (make-transform* #:optional #:key (translate #(0 0))
+ (scale #(1 1)) (rotate 0))
"Return a new transform that is the result of the composition of the
given TRANSLATE, SCALE, and ROTATE values. Both TRANSLATE and SCALE
are vector2 values, while ROTATE is a number."
@@ -105,21 +105,21 @@ are vector2 values, while ROTATE is a number."
(%make-transform m2)))
(define (transform-vector2 transform v)
- "Apply TRANSFORM to the vector2 V."
+ "Apply TRANSFORM to the 2D vector V."
(let ((m (transform-matrix transform))
(x (vx v))
(y (vy v)))
- (vector2 (+ (* x (array-ref m 0 0))
- (* y (array-ref m 0 1))
- (array-ref m 0 3))
- (+ (* x (array-ref m 1 0))
- (* y (array-ref m 1 1))
- (array-ref m 1 3)))))
+ (vector (+ (* x (array-ref m 0 0))
+ (* y (array-ref m 0 1))
+ (array-ref m 0 3))
+ (+ (* x (array-ref m 1 0))
+ (* y (array-ref m 1 1))
+ (array-ref m 1 3)))))
(define (transform-position transform)
"Extract 2D vector from TRANSFORM."
(let ((m (transform-matrix transform)))
- (vector2 (array-ref m 0 3) (array-ref m 1 3))))
+ (vector (array-ref m 0 3) (array-ref m 1 3))))
(define (transform+ . transforms)
"Return the sum of all given transformation matrices. Return
@@ -152,14 +152,14 @@ identity-transform if called without any arguments."
(define (transform-translate v)
"Return a new transform that translates the x and y axes by the
-vector2 V."
+vector V."
(make-transform 1 0 0 0
0 1 0 0
0 0 1 0
(vx v) (vy v) 0 1))
(define (transform-scale v)
- "Return a new transform that scales the X and Y axes by the vector2
+ "Return a new transform that scales the X and Y axes by the vector
V."
(make-transform (vx v) 0 0 0
0 (vy v) 0 0
diff --git a/2d/vector.scm b/2d/vector.scm
new file mode 100644
index 0000000..302f62b
--- /dev/null
+++ b/2d/vector.scm
@@ -0,0 +1,157 @@
+;;; guile-2d
+;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Vector math.
+;;
+;;; Code:
+
+(define-module (2d vector)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-43)
+ #:export (vector2? vector3? vector4?
+ vector-length= v=
+ vx vy vz vw
+ polar-vector
+ v+ v- v* vdot vcross
+ magnitude normalize))
+
+(define (vector-dimensionality? v d)
+ (and (vector? v) (= (vector-length v) d)))
+
+(define (vector2? v)
+ "Return #t if V is a 2D vector, #f otherwise."
+ (vector-dimensionality? v 2))
+
+(define (vector3? v)
+ "Return #t if V is a 3D vector, #f otherwise."
+ (vector-dimensionality? v 3))
+
+(define (vector4? v)
+ "Return #t if V is a 4D vector, #f otherwise."
+ (vector-dimensionality? v 4))
+
+(define (vector-length= v1 v2)
+ "Return #t if V1 and V2 are of the same dimensionality, #f
+otherwise."
+ (= (vector-length v1)
+ (vector-length v2)))
+
+(define (v= . vectors)
+ "Return #t if all arguments are equivalent vectors, #f otherwise."
+ (apply vector= = vectors))
+
+(define (vx v)
+ "Return the first component of the vector V."
+ (vector-ref v 0))
+
+(define (vy v)
+ "Return the second component of the vector V."
+ (vector-ref v 1))
+
+(define (vz v)
+ "Return the third component of the vector V."
+ (vector-ref v 2))
+
+(define (vw v)
+ "Return the fourth component of the vector V."
+ (vector-ref v 3))
+
+(define (polar-vector r theta)
+ "Create a 2D cartesian vector from the polar coordinates (R,
+THETA)."
+ (vector (* r (cos theta))
+ (* r (sin theta))))
+
+(define (dimension-error v1 v2)
+ (error "Vector dimensionality mismatch: " v1 v2))
+
+(define* (vreduce op vectors #:optional (reduce reduce))
+ (reduce (lambda args
+ (match args
+ (((? number? k) (? number? l))
+ (op k l))
+ (((? number? k) (? vector? v))
+ (vector-map (lambda (i n) (op k n)) v))
+ (((? vector? v) (? number? k))
+ (vector-map (lambda (i n) (op n k)) v))
+ (((? vector? v1) (? vector? v2))
+ (if (vector-length= v1 v2)
+ (vector-map (lambda (i a b)
+ (op a b))
+ v1 v2)
+ (dimension-error v1 v2)))))
+ 0 vectors))
+
+(define (v+ . vectors)
+ "Return the sum of all vectors. All vectors must be of the same
+dimensionality. Scalar values can be used to add to all components of
+the resulting vector."
+ (vreduce + vectors))
+
+(define v-
+ (case-lambda
+ "Return the difference of all vectors. All vectors must be of the
+same dimensionality. Scalar values can be used to subtract from all
+components of the resulting vector."
+ ((v) (v- 0 v))
+ ((v . rest)
+ (vreduce - (cons v rest) reduce-right))))
+
+(define (v* . vectors)
+ "Return the product of all VECTORS. All vectors must be of the same
+dimensionality. Scalar values can be used to multiply all components
+of the resulting vector."
+ (vreduce * vectors))
+
+(define (vdot v1 v2)
+ "Return the dot product of the vectors V1 and V2. V1 and V2 must be
+of the same dimensionality."
+ (if (vector-length= v1 v2)
+ (vector-fold (lambda (i memo a b)
+ (+ memo (* a b)))
+ 0 v1 v2)
+ (dimension-error v1 v2)))
+
+(define (vcross v1 v2)
+ "Return the cross product of the vectors V1 and V2. V1 and V2 must
+both be 3D vectors."
+ (match (list v1 v2)
+ ((#(x1 y1 z1) #(x2 y2 z2))
+ (vector (- (* y1 z2) (* z1 y2))
+ (- (* z1 x2) (* x1 z2))
+ (- (* x1 y2) (* y1 x2))))
+ (_ (error "Expected 3D vectors: " v1 v2))))
+
+(define (magnitude v)
+ "Return the magnitude of the vector V."
+ (sqrt
+ (vector-fold (lambda (i memo n)
+ (+ memo (expt n 2)))
+ 0 v)))
+
+(define (normalize v)
+ "Normalize the vector V."
+ (let ((m (magnitude v)))
+ (if (zero? m)
+ 0
+ (vector-map (lambda (i n)
+ (/ n m))
+ v))))
diff --git a/2d/vector2.scm b/2d/vector2.scm
deleted file mode 100644
index bc425a1..0000000
--- a/2d/vector2.scm
+++ /dev/null
@@ -1,112 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program is free software: you can redistribute it and/or
-;;; modify it under the terms of the GNU General Public License as
-;;; published by the Free Software Foundation, either version 3 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; 2D vector math operations.
-;;
-;;; Code:
-
-(define-module (2d vector2)
- #:use-module (ice-9 match)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-9)
- #:export (<vector2>
- vector2
- vector2?
- vx
- vy
- null-vector2
- identity-vector2
- vector2-polar
- v+
- v*
- vmag
- vnorm
- vdot
- vcross))
-
-(define-record-type <vector2>
- (vector2 x y)
- vector2?
- (x vx)
- (y vy))
-
-(define null-vector2 (vector2 0 0))
-(define identity-vector2 (vector2 1 1))
-
-(define (vector2-polar r theta)
- "Convert the polar coordinates (R, THETA) into a cartesian vector."
- (vector2 (* r (cos theta))
- (* r (sin theta))))
-
-(define (v= v1 v2)
- "Return #t if V1 and V2 are equivalent, #f otherwise."
- (and (= (vx v1) (vx v2))
- (= (vy v1) (vy v2))))
-
-(define (v+ . vectors)
- "Return the sum of all VECTORS."
- (define (add-vectors x y vectors)
- (cond ((null? vectors)
- (vector2 x y))
- (else
- (add-vectors (+ x (vx (car vectors)))
- (+ y (vy (car vectors)))
- (cdr vectors)))))
- (add-vectors 0 0 vectors))
-
-(define (v* . vectors)
- "Return the product of all VECTORS. Alternatively, a single vector
-and a scalar can be specified to perform scalar multiplication."
- (define (multiply-vectors x y vectors)
- (cond ((null? vectors)
- (vector2 x y))
- (else
- (multiply-vectors (* x (vx (car vectors)))
- (* y (vy (car vectors)))
- (cdr vectors)))))
- (match vectors
- ((($ <vector2> x y) (? number? k))
- (vector2 (* x k) (* y k)))
- (_ (multiply-vectors 1 1 vectors))))
-
-(define (vmag v)
- "Return the magnitude of the vector V."
- (sqrt (+ (expt (vx v) 2)
- (expt (vy v) 2))))
-
-(define (vnorm v)
- "Normalize the vector V."
- (let ((m (vmag v)))
- (if (zero? m)
- null-vector2
- (vector2 (/ (vx v) m)
- (/ (vy v) m)))))
-
-(define (vdot v1 v2)
- "Return the dot product of the vectors V1 and V2."
- (+ (* (vx v1) (vx v2))
- (* (vy v1) (vy v2))))
-
-(define (vcross v1 v2)
- "Return the cross product of the vectors V1 and V2. Technically, the
-cross product of a 2D vector is not defined. This function instead
-returns the Z coordinate of the cross product as if the vectors were
-in 3D space."
- (- (* (vx v1) (vy v2))
- (* (vy v1) (vx v2))))
diff --git a/2d/window.scm b/2d/window.scm
index 9b01e13..fe971c3 100644
--- a/2d/window.scm
+++ b/2d/window.scm
@@ -29,7 +29,7 @@
#:use-module (2d event)
#:use-module (2d signal)
#:use-module (2d transform)
- #:use-module (2d vector2)
+ #:use-module (2d vector)
#:export (make-window
window?
window-title
@@ -54,7 +54,7 @@
(define* (make-window #:optional #:key
(title "Guile-2D Window")
- (resolution (vector2 640 480))
+ (resolution #(640 480))
(fullscreen? #f))
(%make-window title resolution fullscreen?))
@@ -69,9 +69,9 @@
(define-signal window-size
(hook->signal window-resize-hook
- null-vector2
+ #(0 0)
(lambda (width height)
- (vector2 width height))))
+ #(width height))))
(define-signal window-width (signal-map vx window-size))
(define-signal window-height (signal-map vy window-size))
@@ -94,7 +94,7 @@
(let ((flags (if (window-fullscreen? window) '(opengl fullscreen) 'opengl))
(width (vx (window-resolution window)))
(height (vy (window-resolution window))))
- (signal-set! window-size (vector2 width height))
+ (signal-set! window-size (vector width height))
;; Initialize everything
(SDL:enable-unicode #t)
(SDL:init 'everything)