blob: 669372b5c37a399534e2aa1606f2834b89a180c1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
;;; 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:
;;
;; 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)
"Split TEXTURE into a vector of texture regions of WIDTH x HEIGHT
size. SPACING refers to the number of pixels separating each
tile. MARGIN refers to the number of pixels on the top and left of
TEXTURE before the first tile begins."
(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))
"Return a new tileset that is built by splitting 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))
"Return a new tileset that is built by loading the texture at
FILENAME 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)
"Return the tile texture of TILESET at index I."
(vector-ref (tileset-tiles tileset) i))
|
