summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/texture.scm19
-rw-r--r--2d/tileset.scm87
2 files changed, 88 insertions, 18 deletions
diff --git a/2d/texture.scm b/2d/texture.scm
index 8df5e51..66d158b 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -24,7 +24,6 @@
(define-module (2d texture)
#:use-module (srfi srfi-9)
- #:use-module (srfi srfi-42)
#:use-module (figl gl)
#:use-module (2d wrappers gl)
#:use-module (2d wrappers freeimage)
@@ -42,8 +41,7 @@
texture-s2
texture-t2
surface->texture
- draw-texture
- split-texture))
+ draw-texture))
;;;
;;; Textures
@@ -176,18 +174,3 @@
(gl-vertex x2 y2)
(gl-texture-coordinates s2 t1)
(gl-vertex x2 y)))))
-
-(define* (split-texture texture width height #:optional #:key
- (margin 0) (spacing 0))
- "Splits a texture into a vector of texture regions of width x height
-size."
- (define (build-tile tx ty)
- (let* ((x (+ (* tx (+ width spacing)) margin))
- (y (+ (* ty (+ height spacing)) margin)))
- (make-texture-region texture x y width height)))
-
- (let* ((tw (texture-width texture))
- (th (texture-height texture))
- (rows (/ (- tw margin) (+ width spacing)))
- (columns (/ (- tw margin) (+ height spacing))))
- (vector-ec (: y rows) (: x columns) (build-tile x y))))
diff --git a/2d/tileset.scm b/2d/tileset.scm
new file mode 100644
index 0000000..e07336b
--- /dev/null
+++ b/2d/tileset.scm
@@ -0,0 +1,87 @@
+;;; guile-2d
+;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Guile-2d is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; Guile-2d 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
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Tilesets encapsulate a group of uniformly sized texture regions
+;; that come from a single texture.
+;;
+;;; Code:
+
+(define-module (2d tileset)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-42)
+ #:use-module (2d texture)
+ #:export (<tileset>
+ make-tileset
+ load-tileset
+ tileset?
+ tileset-tiles
+ tileset-width
+ tileset-height
+ tileset-margin
+ tileset-spacing
+ tileset-ref))
+
+(define-record-type <tileset>
+ (%make-tileset tiles width height margin spacing)
+ tileset?
+ (tiles tileset-tiles)
+ (width tileset-width)
+ (height tileset-height)
+ (margin tileset-margin)
+ (spacing tileset-spacing))
+
+(define (split-texture texture width height margin spacing)
+ "Splits a texture into a vector of texture regions of width x height
+size."
+ (define (build-tile tx ty)
+ (let* ((x (+ (* tx (+ width spacing)) margin))
+ (y (+ (* ty (+ height spacing)) margin)))
+ (make-texture-region texture x y width height)))
+
+ (let* ((tw (texture-width texture))
+ (th (texture-height texture))
+ (rows (/ (- tw margin) (+ width spacing)))
+ (columns (/ (- tw margin) (+ height spacing))))
+ (vector-ec (: y rows) (: x columns) (build-tile x y))))
+
+(define* (make-tileset texture width height
+ #:optional #:key (margin 0) (spacing 0))
+ "Returns a new tileset that is built by splitting the given texture
+into tiles."
+ (let ((tiles (split-texture texture
+ width
+ height
+ margin
+ spacing)))
+ (%make-tileset tiles width height margin spacing)))
+
+(define* (load-tileset filename width height
+ #:optional #:key (margin 0) (spacing 0))
+ "Returns a new tileset that is built by loading the given texture
+file and splitting the texture into tiles."
+ (let* ((tiles (split-texture (load-texture filename)
+ width
+ height
+ margin
+ spacing)))
+ (%make-tileset tiles width height margin spacing)))
+
+(define (tileset-ref tileset i)
+ "Returns the tile at index i."
+ (vector-ref (tileset-tiles tileset) i))