61 lines
2.1 KiB
Scheme
61 lines
2.1 KiB
Scheme
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
(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)))))
|