diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | chickadee/pixbuf.scm | 183 |
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)))))) |