diff options
Diffstat (limited to '2d')
| -rw-r--r-- | 2d/font.scm | 4 | ||||
| -rw-r--r-- | 2d/keyboard.scm | 10 | ||||
| -rw-r--r-- | 2d/mouse.scm | 6 | ||||
| -rw-r--r-- | 2d/rect.scm | 34 | ||||
| -rw-r--r-- | 2d/shader.scm | 12 | ||||
| -rw-r--r-- | 2d/sprite.scm | 20 | ||||
| -rw-r--r-- | 2d/texture.scm | 20 | ||||
| -rw-r--r-- | 2d/transform.scm | 26 | ||||
| -rw-r--r-- | 2d/vector.scm | 157 | ||||
| -rw-r--r-- | 2d/vector2.scm | 112 | ||||
| -rw-r--r-- | 2d/window.scm | 10 |
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) |