48 lines
1.5 KiB
Scheme
48 lines
1.5 KiB
Scheme
|
(define-module (game tileset)
|
||
|
|
#:use-module (dom canvas)
|
||
|
|
#:use-module (dom image)
|
||
|
|
#:use-module (ice-9 match)
|
||
|
|
#:use-module (math rect)
|
||
|
|
#:use-module (srfi srfi-9)
|
||
|
|
#:export (make-tileset
|
||
|
|
tileset?
|
||
|
|
tileset-image
|
||
|
|
tileset-tile-width
|
||
|
|
tileset-tile-height
|
||
|
|
draw-tile))
|
||
|
|
|
||
|
|
(define-record-type <tileset>
|
||
|
|
(%make-tileset image tile-width tile-height tiles)
|
||
|
|
tileset?
|
||
|
|
(image tileset-image)
|
||
|
|
(tile-width tileset-tile-width)
|
||
|
|
(tile-height tileset-tile-height)
|
||
|
|
(tiles tileset-tiles))
|
||
|
|
|
||
|
|
(define (make-tileset image width height tile-width tile-height)
|
||
|
|
(let* ((w (quotient width tile-width))
|
||
|
|
(h (quotient height tile-height))
|
||
|
|
(tiles (make-vector (* w h))))
|
||
|
|
(let y-loop ((y 0))
|
||
|
|
(when (< y h)
|
||
|
|
(let x-loop ((x 0))
|
||
|
|
(when (< x w)
|
||
|
|
(vector-set! tiles (+ (* y w) x)
|
||
|
|
(make-rect (* x tile-width)
|
||
|
|
(* y tile-height)
|
||
|
|
tile-width
|
||
|
|
tile-height))
|
||
|
|
(x-loop (1+ x))))
|
||
|
|
(y-loop (1+ y))))
|
||
|
|
(%make-tileset image tile-width tile-height tiles)))
|
||
|
|
|
||
|
|
(define (draw-tile context tileset idx x y)
|
||
|
|
(match tileset
|
||
|
|
(($ <tileset> image _ _ tiles)
|
||
|
|
(let* ((tile (vector-ref tiles idx))
|
||
|
|
(sx (rect-x tile))
|
||
|
|
(sy (rect-y tile))
|
||
|
|
(w (rect-width tile))
|
||
|
|
(h (rect-height tile)))
|
||
|
|
(draw-image context image sx sy w h x y w h)))))
|