summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am1
-rw-r--r--chickadee/pixbuf.scm183
2 files changed, 184 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am
index 55f626e..848741f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -65,6 +65,7 @@ SOURCES = \
chickadee/audio/vorbis.scm \
chickadee/audio/wav.scm \
chickadee/audio.scm \
+ chickadee/pixbuf.scm \
chickadee/image/jpeg.scm \
chickadee/image/png.scm \
chickadee/graphics/gl.scm \
diff --git a/chickadee/pixbuf.scm b/chickadee/pixbuf.scm
new file mode 100644
index 0000000..09db6ee
--- /dev/null
+++ b/chickadee/pixbuf.scm
@@ -0,0 +1,183 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2023 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Chickadee 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.
+;;;
+;;; Chickadee 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:
+;;
+;; CPU-side pixel data buffers.
+;;
+;;; Code:
+
+(define-module (chickadee pixbuf)
+ #:use-module (chickadee graphics color)
+ #:use-module (chickadee utils)
+ #:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:export (make-pixbuf
+ bytevector->pixbuf
+ pixbuf?
+ pixbuf-alpha?
+ pixbuf-pixels
+ pixbuf-width
+ pixbuf-height
+ pixbuf-format
+ pixbuf-bit-depth
+ pixbuf-copy-raw!
+ pixbuf-flip-vertically!
+ pixbuf-color-key!))
+
+(define (pixbuf-error message irritants)
+ (error 'pixbuff-error message irritants))
+
+;; A pixbuf is raw pixel data stored in memory that can be saved to
+;; disk or loaded into a GPU texture.
+(define-record-type <pixbuf>
+ (%make-pixbuf pixels width height format bit-depth)
+ pixbuf?
+ (pixels pixbuf-pixels)
+ (width pixbuf-width)
+ (height pixbuf-height)
+ (format pixbuf-format)
+ (bit-depth pixbuf-bit-depth))
+
+(define (print-pixbuf pixbuf port)
+ (format port "#<pixbuf width: ~a height: ~a format: ~a bit-depth: ~a>"
+ (pixbuf-width pixbuf)
+ (pixbuf-height pixbuf)
+ (pixbuf-format pixbuf)
+ (pixbuf-bit-depth pixbuf)))
+
+(set-record-type-printer! <pixbuf> print-pixbuf)
+
+(define (channel-count format)
+ (case format
+ ((rgba) 4)))
+
+(define (byte-depth bit-depth)
+ (/ bit-depth 8))
+
+(define (buffer-length width height format bit-depth)
+ (* width height
+ (byte-depth bit-depth)
+ (channel-count format)))
+
+(define* (make-pixbuf width height #:key (format 'rgba) (bit-depth 8))
+ "Return a new pixbuf object of WIDTH x HEIGHT pixels using color
+channel FORMAT and BIT-DEPTH bits per channel. Initially, all color
+channel values are 0. Currently, the only supported format is 'rgba'
+and the only supported bit depth is 8."
+ (unless (= bit-depth 8)
+ (pixbuf-error "unsupported bit depth" (list bit-depth)))
+ (unless (eq? format 'rgba)
+ (pixbuf-error "unsupported format" (list format)))
+ (let* ((n (buffer-length width height format bit-depth))
+ (buffer (make-bytevector n 0)))
+ (%make-pixbuf buffer width height format bit-depth)))
+
+(define* (bytevector->pixbuf bv width height #:key (format 'rgba) (bit-depth 8))
+ (let ((pixbuf (make-pixbuf width height
+ #:format format
+ #:bit-depth bit-depth)))
+ (pixbuf-copy-raw! pixbuf bv)
+ pixbuf))
+
+(define (pixbuf-alpha? pixbuf)
+ "Return #t if PIXBUF has an alpha channel."
+ (case (pixbuf-format pixbuf)
+ ((rgba) #t)
+ (else #f)))
+
+(define (pixbuf-byte-depth pixbuf)
+ (byte-depth (pixbuf-bit-depth pixbuf)))
+
+(define (pixbuf-red-channel-index pixbuf)
+ (case (pixbuf-format pixbuf)
+ ((rgba) 0)))
+
+(define (pixbuf-green-channel-index pixbuf)
+ (case (pixbuf-format pixbuf)
+ ((rgba) 1)))
+
+(define (pixbuf-blue-channel-index pixbuf)
+ (case (pixbuf-format pixbuf)
+ ((rgba) 2)))
+
+(define (pixbuf-alpha-channel-index pixbuf)
+ (case (pixbuf-format pixbuf)
+ ((rgba) 3)))
+
+(define (pixbuf-channel-count pixbuf)
+ "Return the number of channels per pixel in PIXBUF."
+ (channel-count (pixbuf-format pixbuf)))
+
+(define (pixbuf-copy-raw! pixbuf bv)
+ "Copy the contents of the bytevector BV into PIXBUF. BV must be
+exactly the same size as the underlying buffer of PIXBUF."
+ (let* ((pixels (pixbuf-pixels pixbuf))
+ (n (bytevector-length pixels)))
+ (if (= (bytevector-length bv) n)
+ (bytevector-copy! bv 0 pixels 0 n)
+ (pixbuf-error "improperly sized bytevector" (list bv)))))
+
+(define (pixbuf-flip-vertically! pixbuf)
+ "Flip the pixel data in PIXBUF upside-down."
+ (let* ((w (pixbuf-width pixbuf))
+ (h (pixbuf-height pixbuf))
+ (n (pixbuf-channel-count pixbuf))
+ (d (pixbuf-byte-depth pixbuf))
+ (row-length (* w n d))
+ (temp-row (make-bytevector row-length 0))
+ (pixels (pixbuf-pixels pixbuf)))
+ (for-range ((y (floor (/ h 2))))
+ (let* ((y* (- h y 1))
+ (source-start (* y row-length))
+ (target-start (* y* row-length)))
+ ;; Copy the target row into the temp row.
+ (bytevector-copy! pixels target-start temp-row 0 row-length)
+ ;; Overwrite the target row with the source row.
+ (bytevector-copy! pixels source-start pixels target-start row-length)
+ ;; Overwrite the source row with the temp row.
+ (bytevector-copy! temp-row 0 pixels source-start row-length)))))
+
+(define (pixbuf-color-key! pixbuf color)
+ "Overwrite the alpha channel for pixels in PIXBUF that match COLOR
+with full transparency."
+ (when (pixbuf-alpha? pixbuf)
+ (let* ((w (pixbuf-width pixbuf))
+ (h (pixbuf-height pixbuf))
+ (n (pixbuf-channel-count pixbuf))
+ (d (pixbuf-byte-depth pixbuf))
+ (ri (pixbuf-red-channel-index pixbuf))
+ (gi (pixbuf-green-channel-index pixbuf))
+ (bi (pixbuf-blue-channel-index pixbuf))
+ (ai (pixbuf-alpha-channel-index pixbuf))
+ (high (- (expt 256 d) 1))
+ (r (inexact->exact (* (color-r color) high)))
+ (g (inexact->exact (* (color-g color) high)))
+ (b (inexact->exact (* (color-b color) high)))
+ (pixels (pixbuf-pixels pixbuf)))
+ (define (channel-ref i offset)
+ (bytevector-uint-ref pixels (+ i offset) (native-endianness) d))
+ (define (channel-set! i offset x)
+ (bytevector-uint-set! pixels (+ i offset) x (native-endianness) d))
+ (for-range ((i (bytevector-length pixels) 0 (* n d)))
+ ;; Zero the alpha channel of pixels that match the transparent
+ ;; color key.
+ (when (and (= r (channel-ref i ri))
+ (= g (channel-ref i gi))
+ (= b (channel-ref i bi)))
+ (channel-set! i ai 0))))))