From 98dc87a054c1108bd5f4bb093024d962ce0c8ce2 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 4 Jan 2017 22:16:26 -0500 Subject: First commit! --- .dir-locals.el | 13 + .gitignore | 13 + Makefile.am | 64 +++++ README | 47 ++++ bootstrap | 3 + chickadee.scm | 185 ++++++++++++++ chickadee/color.scm | 182 +++++++++++++ chickadee/config.scm.in | 36 +++ chickadee/input/controller.scm | 87 +++++++ chickadee/math.scm | 26 ++ chickadee/math/matrix.scm | 315 +++++++++++++++++++++++ chickadee/math/vector.scm | 201 +++++++++++++++ chickadee/render.scm | 135 ++++++++++ chickadee/render/blend.scm | 73 ++++++ chickadee/render/gl.scm | 275 ++++++++++++++++++++ chickadee/render/gpu.scm | 64 +++++ chickadee/render/shader.scm | 346 +++++++++++++++++++++++++ chickadee/render/shapes.scm | 205 +++++++++++++++ chickadee/render/sprite.scm | 282 +++++++++++++++++++++ chickadee/render/texture.scm | 191 ++++++++++++++ chickadee/render/vertex-buffer.scm | 261 +++++++++++++++++++ chickadee/window.scm | 89 +++++++ configure.ac | 26 ++ doc/chickadee.texi | 104 ++++++++ doc/fdl.texi | 505 +++++++++++++++++++++++++++++++++++++ guix.scm | 139 ++++++++++ pre-inst-env.in | 32 +++ 27 files changed, 3899 insertions(+) create mode 100644 .dir-locals.el create mode 100644 .gitignore create mode 100644 Makefile.am create mode 100644 README create mode 100755 bootstrap create mode 100644 chickadee.scm create mode 100644 chickadee/color.scm create mode 100644 chickadee/config.scm.in create mode 100644 chickadee/input/controller.scm create mode 100644 chickadee/math.scm create mode 100644 chickadee/math/matrix.scm create mode 100644 chickadee/math/vector.scm create mode 100644 chickadee/render.scm create mode 100644 chickadee/render/blend.scm create mode 100644 chickadee/render/gl.scm create mode 100644 chickadee/render/gpu.scm create mode 100644 chickadee/render/shader.scm create mode 100644 chickadee/render/shapes.scm create mode 100644 chickadee/render/sprite.scm create mode 100644 chickadee/render/texture.scm create mode 100644 chickadee/render/vertex-buffer.scm create mode 100644 chickadee/window.scm create mode 100644 configure.ac create mode 100644 doc/chickadee.texi create mode 100644 doc/fdl.texi create mode 100644 guix.scm create mode 100644 pre-inst-env.in diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..86a4575 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,13 @@ +((scheme-mode + . + ((eval . (put 'with-blend-mode 'scheme-indent-function 1)) + (eval . (put 'with-depth-test 'scheme-indent-function 1)) + (eval . (put 'with-texture 'scheme-indent-function 1)) + (eval . (put 'with-shader 'scheme-indent-function 1)) + (eval . (put 'with-vertex-array 'scheme-indent-function 1)) + (eval . (put 'with-projection 'scheme-indent-function 1)) + (eval . (put 'with-framebuffer 'scheme-indent-function 1)) + (eval . (put 'with-viewport 'scheme-indent-function 1)) + (eval . (put 'with-mapped-vertex-buffer 'scheme-indent-function 1)) + (eval . (put 'uniform-let 'scheme-indent-function 1)) + (eval . (put 'call-with-surface 'scheme-indent-function 1))))) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..245393f --- /dev/null +++ b/.gitignore @@ -0,0 +1,13 @@ +*.go + +/configure +/config.status +/config.log +/Makefile +/Makefile.in +/aclocal.m4 +/pre-inst-env +/chickadee/config.scm +/doc/chickadee.info +/autom4te.cache +/build-aux diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..780a085 --- /dev/null +++ b/Makefile.am @@ -0,0 +1,64 @@ +## Chickadee Game Toolkit +## Copyright © 2016 David Thompson +## +## 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 +## . + +GOBJECTS = $(SOURCES:%.scm=%.go) + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_go_DATA = $(GOBJECTS) + +# Make sure source files are installed first, so that the mtime of +# installed compiled files is greater than that of installed source +# files. See +# +# for details. +guile_install_go_files = install-nobase_goDATA +$(guile_install_go_files): install-nobase_modDATA + +CLEANFILES = $(GOBJECTS) +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go +.scm.go: + $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<" + +moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) +godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/ccache + +SOURCES = \ + chickadee/config.scm \ + chickadee/input/controller.scm \ + chickadee/math.scm \ + chickadee/math/vector.scm \ + chickadee/math/matrix.scm \ + chickadee/color.scm \ + chickadee/render/gl.scm \ + chickadee/render/gpu.scm \ + chickadee/render/blend.scm \ + chickadee/render/texture.scm \ + chickadee/render/shader.scm \ + chickadee/render/vertex-buffer.scm \ + chickadee/render/shapes.scm \ + chickadee/render/sprite.scm \ + chickadee/render.scm \ + chickadee/window.scm \ + chickadee.scm + +info_TEXINFOS = doc/chickadee.texi + +chickadee_TEXINFOS = \ + doc/fdl.texi \ + doc/chickadee.texi diff --git a/README b/README new file mode 100644 index 0000000..daa87c3 --- /dev/null +++ b/README @@ -0,0 +1,47 @@ +-*- org -*- + +#+TITLE The Chickadee Game Development Toolkit + +* About + + Chickadee is a game development toolkit for Guile Scheme. + + #+BEGIN_SRC scheme + (use-modules (chickadee)) + + (define sprite #f) + + (define (load) + (set! sprite (load-image "chickadee.png"))) + + (define (render alpha) + (draw-sprite sprite (vector2 320 240))) + + (run-game #:load load #:render render) + #+END_SRC + +* Features + + Chickadee supports the following features: + + - 2D/3D rendering engine via OpenGL + - Efficient sprite rendering + - Signed distance field font rendering + - Particles + - Simple geometric shapes + - GLSL shaders + - Keyboard/mouse/joystick input + - Sound effects and music + - 2D/3D/4D vector math library + - Axis-aligned bounding box library + - Fixed timestep game loop + +* Dependencies + + - Guile >= 2.1.4 + - Guile-OpenGL >= 0.1.0 + - Guile-SDL2 >= 0.2.0 + +* License + + GNU GPL version 3 or later diff --git a/bootstrap b/bootstrap new file mode 100755 index 0000000..e756b42 --- /dev/null +++ b/bootstrap @@ -0,0 +1,3 @@ +#! /bin/sh + +autoreconf -vif diff --git a/chickadee.scm b/chickadee.scm new file mode 100644 index 0000000..e3d128a --- /dev/null +++ b/chickadee.scm @@ -0,0 +1,185 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee) + #:use-module (gl) + #:use-module (sdl2) + #:use-module (sdl2 events) + #:use-module (sdl2 input text) + #:use-module (chickadee window) + #:use-module (chickadee render gl) + #:export (load-hook + update-hook + before-draw-hook + draw-hook + after-draw-hook + quit-hook + key-press-hook + key-release-hook + text-input-hook + mouse-press-hook + mouse-release-hook + mouse-move-hook + controller-add-hook + controller-remove-hook + controller-press-hook + controller-release-hook + controller-move-hook + run-game + abort-game + time)) + +(define load-hook (make-hook 0)) +(define update-hook (make-hook 1)) +(define before-draw-hook (make-hook 0)) +(define after-draw-hook (make-hook 0)) +(define draw-hook (make-hook 1)) +(define quit-hook (make-hook 0)) +(define key-press-hook (make-hook 4)) +(define key-release-hook (make-hook 3)) +(define text-input-hook (make-hook 1)) +(define mouse-press-hook (make-hook 4)) +(define mouse-release-hook (make-hook 3)) +(define mouse-move-hook (make-hook 5)) +(define controller-add-hook (make-hook 1)) +(define controller-remove-hook (make-hook 1)) +(define controller-press-hook (make-hook 2)) +(define controller-release-hook (make-hook 2)) +(define controller-move-hook (make-hook 3)) + +(define open-controller (@@ (chickadee input controller) open-controller)) +(define close-controller (@@ (chickadee input controller) close-controller)) +(define lookup-controller (@@ (chickadee input controller) lookup-controller)) + +(define game-loop-prompt-tag (make-prompt-tag 'game-loop)) + +(define* (run-game #:key + (window-title "Chickadee!") + (window-width 640) + (window-height 480) + window-fullscreen? + (update-hz 60)) + (sdl-init) + (start-text-input) + (let ((window (open-window #:title window-title + #:width window-width + #:height window-height + #:fullscreen? window-fullscreen?))) + (define (process-event event) + (cond + ((quit-event? event) + (run-hook quit-hook)) + ((keyboard-down-event? event) + (run-hook key-press-hook + (keyboard-event-key event) + (keyboard-event-scancode event) + (keyboard-event-modifiers event) + (keyboard-event-repeat event))) + ((keyboard-up-event? event) + (run-hook key-release-hook + (keyboard-event-key event) + (keyboard-event-scancode event) + (keyboard-event-modifiers event))) + ((text-input-event? event) + (run-hook text-input-hook (text-input-event-text event))) + ((mouse-button-down-event? event) + (run-hook mouse-press-hook + (mouse-button-event-button event) + (mouse-button-event-clicks event) + (mouse-button-event-x event) + (mouse-button-event-y event))) + ((mouse-button-up-event? event) + (run-hook mouse-release-hook + (mouse-button-event-button event) + (mouse-button-event-x event) + (mouse-button-event-y event))) + ((mouse-motion-event? event) + (run-hook mouse-move-hook + (mouse-motion-event-x event) + (mouse-motion-event-y event) + (mouse-motion-event-x-rel event) + (mouse-motion-event-y-rel event) + (mouse-motion-event-buttons event))) + ((and (controller-device-event? event) + (eq? (controller-device-event-action event) 'added)) + (run-hook controller-add-hook + (open-controller (controller-device-event-which event)))) + ((and (controller-device-event? event) + (eq? (controller-device-event-action event) 'removed)) + (let ((controller (lookup-controller + (controller-device-event-which event)))) + (run-hook controller-remove-hook controller) + (close-controller controller))) + ((controller-button-down-event? event) + (run-hook controller-press-hook + (lookup-controller + (controller-button-event-which event)) + (controller-button-event-button event))) + ((controller-button-up-event? event) + (run-hook controller-release-hook + (lookup-controller + (controller-button-event-which event)) + (controller-button-event-button event))) + ((controller-axis-event? event) + (run-hook controller-move-hook + (lookup-controller + (controller-axis-event-which event)) + (controller-axis-event-axis event) + (/ (controller-axis-event-value event) 32768.0))))) + (with-window window + (let ((update-interval (round (/ 1000 update-hz)))) + (call-with-prompt game-loop-prompt-tag + (lambda () + ;; Catch SIGINT and kill the loop. + (sigaction SIGINT + (lambda (signum) + (abort-game))) + (run-hook load-hook) + (let loop ((previous-time (sdl-ticks)) + (lag 0)) + (let* ((current-time (sdl-ticks)) + (delta (- current-time previous-time))) + (let update-loop ((lag (+ lag delta))) + (if (>= lag update-interval) + (begin + ;; Process all pending events. + (let loop ((event (poll-event))) + (when event + (process-event event) + (loop (poll-event)))) + ;; Advance the simulation. + (run-hook update-hook update-interval) + (update-loop (- lag update-interval))) + (begin + ;; Render a frame. + (run-hook before-draw-hook) + (gl-clear-color 0.267 0.141 0.204 1.0) + (gl-clear (logior (attrib-mask color-buffer) + (attrib-mask depth-buffer) + (attrib-mask stencil-buffer))) + (run-hook draw-hook (/ lag update-interval)) + (swap-buffers window) + (run-hook after-draw-hook) + (loop current-time lag))))))) + (lambda (cont callback) + #f)))))) + +(define (abort-game) + (abort-to-prompt game-loop-prompt-tag #f)) + +(define (time) + (sdl-ticks)) diff --git a/chickadee/color.scm b/chickadee/color.scm new file mode 100644 index 0000000..e40deb4 --- /dev/null +++ b/chickadee/color.scm @@ -0,0 +1,182 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +;;; Commentary: +;; +;; Colors! +;; +;;; Code: + +(define-module (chickadee color) + #:use-module (ice-9 match) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-1) + #:use-module (chickadee math) + #:export ( + make-color + color? + color-r color-g color-b color-a + rgba rgb transparency + color* color+ color- color-inverse color-lerp + + white black red green blue yellow magenta cyan transparent + tango-light-butter tango-butter tango-dark-butter + tango-light-orange tango-orange tango-dark-orange + tango-light-chocolate tango-chocolate tango-dark-chocolate + tango-light-chameleon tango-chameleon tango-dark-chameleon + tango-light-sky-blue tango-sky-blue tango-dark-sky-blue + tango-light-plum tango-plum tango-dark-plum + tango-light-scarlet-red tango-scarlet-red tango-dark-scarlet-red + tango-aluminium-1 tango-aluminium-2 tango-aluminium-3 + tango-aluminium-4 tango-aluminium-5 tango-aluminium-6)) + +(define-record-type + (%make-color r g b a) + color? + (r color-r) + (g color-g) + (b color-b) + (a color-a)) + +(define (make-color r g b a) + "Return a newly allocated color with the given RGBA channel values. +Each channel is clamped to the range [0, 1]." + (%make-color (clamp 0 1 r) + (clamp 0 1 g) + (clamp 0 1 b) + (clamp 0 1 a))) + +(define (color-component color-code offset) + "Return the value of an 8-bit color channel in the range [0,1] for +the integer COLOR-CODE, given an OFFSET in bits." + (let ((mask (ash #xff offset))) + (/ (ash (logand mask color-code) + (- offset)) + 255.0))) + +(define (rgba color-code) + "Translate an RGBA format string COLOR-CODE into a color object. +For example: #xffffffff will return a color with RGBA values 1, 1, 1, +1." + (%make-color (color-component color-code 24) + (color-component color-code 16) + (color-component color-code 8) + (color-component color-code 0))) + +(define (rgb color-code) + "Translate an RGB format string COLOR-CODE into a color object. +For example: #xffffff will return a color with RGBA values 1, 1, 1, +1." + (%make-color (color-component color-code 16) + (color-component color-code 8) + (color-component color-code 0) + 1.0)) + +(define (transparency alpha) + "Create a new color that is white with a transparency value of +ALPHA. ALPHA is clamped to the range [0, 1]." + (make-color 1 1 1 alpha)) + +;; (define-method (* (a <>) (b <>)) +;; (make-color (* (color-r a) (color-r b)) +;; (* (color-g a) (color-g b)) +;; (* (color-b a) (color-b b)) +;; (* (color-a a) (color-a b)))) + +(define color* + (match-lambda* + ((($ r1 g1 b1 a1) ($ r2 g2 b2 a2)) + (make-color (* r1 r2) + (* g1 g2) + (* b1 b2) + (* a1 a2))) + ((($ r g b a) (? number? k)) + (make-color (* r k) + (* g k) + (* b k) + (* a k))))) + +(define color+ + (match-lambda* + ((($ r1 g1 b1 a1) ($ r2 g2 b2 a2)) + (make-color (+ r1 r2) + (+ g1 g2) + (+ b1 b2) + (+ a1 a2))))) + +(define color- + (match-lambda* + ((($ r1 g1 b1 a1) ($ r2 g2 b2 a2)) + (make-color (- r1 r2) + (- g1 g2) + (- b1 b2) + (- a1 a2))))) + +(define color-inverse + (match-lambda + (($ r g b a) + (make-color (- 1 r) + (- 1 g) + (- 1 b) + a)))) ; Do not alter alpha channel. + +;;(define color-lerp (make-lerp color+ color*)) + +;;; +;;; Pre-defined Colors +;;; + +;; Basic +(define white (rgb #xffffff)) +(define black (rgb #x000000)) +(define red (rgb #xff0000)) +(define green (rgb #x00ff00)) +(define blue (rgb #x0000ff)) +(define yellow (rgb #xffff00)) +(define magenta (rgb #xff00ff)) +(define cyan (rgb #x00ffff)) +(define transparent (make-color 0 0 0 0)) + +;; Tango color pallete +;; http://tango.freedesktop.org +(define tango-light-butter (rgb #xfce94f)) +(define tango-butter (rgb #xedd400)) +(define tango-dark-butter (rgb #xc4a000)) +(define tango-light-orange (rgb #xfcaf3e)) +(define tango-orange (rgb #xf57900)) +(define tango-dark-orange (rgb #xce5c00)) +(define tango-light-chocolate (rgb #xe9b96e)) +(define tango-chocolate (rgb #xc17d11)) +(define tango-dark-chocolate (rgb #x8f5902)) +(define tango-light-chameleon (rgb #x8ae234)) +(define tango-chameleon (rgb #x73d216)) +(define tango-dark-chameleon (rgb #x4e9a06)) +(define tango-light-sky-blue (rgb #x729fcf)) +(define tango-sky-blue (rgb #x3465a4)) +(define tango-dark-sky-blue (rgb #x204a87)) +(define tango-light-plum (rgb #xad7fa8)) +(define tango-plum (rgb #x75507b)) +(define tango-dark-plum (rgb #x5c3566)) +(define tango-light-scarlet-red (rgb #xef2929)) +(define tango-scarlet-red (rgb #xcc0000)) +(define tango-dark-scarlet-red (rgb #xa40000)) +(define tango-aluminium-1 (rgb #xeeeeec)) +(define tango-aluminium-2 (rgb #xd3d7cf)) +(define tango-aluminium-3 (rgb #xbabdb6)) +(define tango-aluminium-4 (rgb #x888a85)) +(define tango-aluminium-5 (rgb #x555753)) +(define tango-aluminium-6 (rgb #x2e3436)) diff --git a/chickadee/config.scm.in b/chickadee/config.scm.in new file mode 100644 index 0000000..86aaeb5 --- /dev/null +++ b/chickadee/config.scm.in @@ -0,0 +1,36 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; Chickadee is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU Lesser 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 Lesser General +;;; Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this program. If not, see +;;; . + +;;; Commentary: +;; +;; Build time configuration. +;; +;;; Code: + +(define-module (chickadee config) + #:export (%datadir + %sly-version + scope-datadir)) + +(define %datadir + (or (getenv "SLY_DATADIR") "@chickadee_datadir@/chickadee")) + +(define %chickadee-version "@PACKAGE_VERSION@") + +(define (scope-datadir file) + "Append the Chickadee data directory to FILE." + (string-append %datadir file)) diff --git a/chickadee/input/controller.scm b/chickadee/input/controller.scm new file mode 100644 index 0000000..e78623e --- /dev/null +++ b/chickadee/input/controller.scm @@ -0,0 +1,87 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee input controller) + #:use-module (srfi srfi-9) + #:use-module (sdl2) + #:use-module ((sdl2 input game-controller) #:prefix sdl2:) + #:use-module ((sdl2 input joystick) #:prefix sdl2:) + #:export (controller? + controller-name + controller-power-level + controller-button-pressed? + controller-axis)) + +(define-record-type + (wrap-controller sdl-controller) + controller? + (sdl-controller unwrap-controller)) + +(define %controllers (make-hash-table)) + +(define (open-controller index) + (let* ((sdl-controller (sdl2:open-game-controller index)) + (controller (wrap-controller sdl-controller))) + ;; Register controller in global hash table for future lookup. + (hash-set! %controllers + (sdl2:joystick-instance-id + (sdl2:game-controller-joystick sdl-controller)) + controller) + controller)) + +(define (close-controller controller) + (hash-remove! %controllers + (sdl2:joystick-instance-id + (sdl2:game-controller-joystick + (unwrap-controller controller)))) + (sdl2:close-game-controller (unwrap-controller controller))) + +(define (lookup-controller instance-id) + (hash-ref %controllers instance-id)) + +(define (controller-name controller) + "Return the human readable model name of CONTROLLER." + (sdl2:game-controller-name (unwrap-controller controller))) + +(define (controller-power-level controller) + "Return the symbolic power level for CONTROLLER. + +Possible return values are: +- unknown +- empty +- low +- medium +- full +- wired" + (sdl2:joystick-power-level + (sdl2:game-controller-joystick + (unwrap-controller controller)))) + +(define (controller-connected? controller) + "Return #t if CONTROLLER is currently in use." + (sdl2:game-controller-attached? (unwrap-controller controller))) + +(define (controller-button-pressed? controller button) + "Return #t if BUTTON is currently being pressed on CONTROLLER." + (sdl2:game-controller-button-pressed? (unwrap-controller controller) button)) + +(define (controller-axis controller axis) + "Return a floating point value in the range [-1, 1] corresponding to +how much AXIS is being pushed on CONTROLLER. 0 is returned if AXIS is +not being pushed at all." + (/ (sdl2:game-controller-axis (unwrap-controller controller) axis) + 32768.0)) diff --git a/chickadee/math.scm b/chickadee/math.scm new file mode 100644 index 0000000..753f70d --- /dev/null +++ b/chickadee/math.scm @@ -0,0 +1,26 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee math) + #:export (clamp)) + +(define (clamp min max x) + "Restrict X to the range defined by MIN and MAX. Assumes that MIN is +actually less than MAX." + (cond ((< x min) min) + ((> x max) max) + (else x))) diff --git a/chickadee/math/matrix.scm b/chickadee/math/matrix.scm new file mode 100644 index 0000000..be307ab --- /dev/null +++ b/chickadee/math/matrix.scm @@ -0,0 +1,315 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee math matrix) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-4) + #:use-module (system foreign) + #:use-module (chickadee math vector) + #:export (make-matrix4 + make-null-matrix4 + matrix4? + matrix4-mult! + matrix4* + matrix4-identity! + make-identity-matrix4 + orthographic-projection + matrix4-translate! + matrix4-translate + matrix4-scale! + matrix4-scale + matrix4-rotate-z! + matrix4-rotate-z + transform)) + +;; 4x4 matrix +(define-record-type + (%make-matrix4 bv ptr) + matrix4? + (bv matrix4-bv) + (ptr matrix4-ptr)) + +(define-inlinable (matrix-set! matrix row column x) + (f32vector-set! matrix (+ (* row 4) column) x)) + +(define-inlinable (matrix-ref matrix row column) + (f32vector-ref matrix (+ (* row 4) column))) + +(define (init-matrix4 matrix + aa ab ac ad + ba bb bc bd + ca cb cc cd + da db dc dd) + (let ((bv (matrix4-bv matrix))) + (matrix-set! bv 0 0 aa) + (matrix-set! bv 0 1 ab) + (matrix-set! bv 0 2 ac) + (matrix-set! bv 0 3 ad) + (matrix-set! bv 1 0 ba) + (matrix-set! bv 1 1 bb) + (matrix-set! bv 1 2 bc) + (matrix-set! bv 1 3 bd) + (matrix-set! bv 2 0 ca) + (matrix-set! bv 2 1 cb) + (matrix-set! bv 2 2 cc) + (matrix-set! bv 2 3 cd) + (matrix-set! bv 3 0 da) + (matrix-set! bv 3 1 db) + (matrix-set! bv 3 2 dc) + (matrix-set! bv 3 3 dd))) + +(define (make-null-matrix4) + (let ((bv (make-f32vector 16))) + (%make-matrix4 bv (bytevector->pointer bv)))) + +(define (make-matrix4 aa ab ac ad + ba bb bc bd + ca cb cc cd + da db dc dd) + "Return a new 4x4 matrix initialized with the given 16 values in +column-major format." + (let ((matrix (make-null-matrix4))) + (init-matrix4 matrix + aa ab ac ad + ba bb bc bd + ca cb cc cd + da db dc dd) + matrix)) + +(define (matrix4-mult! dest a b) + "Multiply matrices A and B, storing the result in DEST." + (let ((m1 (matrix4-bv a)) + (m2 (matrix4-bv b)) + (m3 (matrix4-bv dest))) + (let ((m1-0-0 (matrix-ref m1 0 0)) + (m1-0-1 (matrix-ref m1 0 1)) + (m1-0-2 (matrix-ref m1 0 2)) + (m1-0-3 (matrix-ref m1 0 3)) + (m1-1-0 (matrix-ref m1 1 0)) + (m1-1-1 (matrix-ref m1 1 1)) + (m1-1-2 (matrix-ref m1 1 2)) + (m1-1-3 (matrix-ref m1 1 3)) + (m1-2-0 (matrix-ref m1 2 0)) + (m1-2-1 (matrix-ref m1 2 1)) + (m1-2-2 (matrix-ref m1 2 2)) + (m1-2-3 (matrix-ref m1 2 3)) + (m1-3-0 (matrix-ref m1 3 0)) + (m1-3-1 (matrix-ref m1 3 1)) + (m1-3-2 (matrix-ref m1 3 2)) + (m1-3-3 (matrix-ref m1 3 3)) + (m2-0-0 (matrix-ref m2 0 0)) + (m2-0-1 (matrix-ref m2 0 1)) + (m2-0-2 (matrix-ref m2 0 2)) + (m2-0-3 (matrix-ref m2 0 3)) + (m2-1-0 (matrix-ref m2 1 0)) + (m2-1-1 (matrix-ref m2 1 1)) + (m2-1-2 (matrix-ref m2 1 2)) + (m2-1-3 (matrix-ref m2 1 3)) + (m2-2-0 (matrix-ref m2 2 0)) + (m2-2-1 (matrix-ref m2 2 1)) + (m2-2-2 (matrix-ref m2 2 2)) + (m2-2-3 (matrix-ref m2 2 3)) + (m2-3-0 (matrix-ref m2 3 0)) + (m2-3-1 (matrix-ref m2 3 1)) + (m2-3-2 (matrix-ref m2 3 2)) + (m2-3-3 (matrix-ref m2 3 3))) + (matrix-set! m3 0 0 + (+ (* m1-0-0 m2-0-0) + (* m1-0-1 m2-1-0) + (* m1-0-2 m2-2-0) + (* m1-0-3 m2-3-0))) + (matrix-set! m3 0 1 + (+ (* m1-0-0 m2-0-1) + (* m1-0-1 m2-1-1) + (* m1-0-2 m2-2-1) + (* m1-0-3 m2-3-1))) + (matrix-set! m3 0 2 + (+ (* m1-0-0 m2-0-2) + (* m1-0-1 m2-1-2) + (* m1-0-2 m2-2-2) + (* m1-0-3 m2-3-2))) + (matrix-set! m3 0 3 + (+ (* m1-0-0 m2-0-3) + (* m1-0-1 m2-1-3) + (* m1-0-2 m2-2-3) + (* m1-0-3 m2-3-3))) + (matrix-set! m3 1 0 + (+ (* m1-1-0 m2-0-0) + (* m1-1-1 m2-1-0) + (* m1-1-2 m2-2-0) + (* m1-1-3 m2-3-0))) + (matrix-set! m3 1 1 + (+ (* m1-1-0 m2-0-1) + (* m1-1-1 m2-1-1) + (* m1-1-2 m2-2-1) + (* m1-1-3 m2-3-1))) + (matrix-set! m3 1 2 + (+ (* m1-1-0 m2-0-2) + (* m1-1-1 m2-1-2) + (* m1-1-2 m2-2-2) + (* m1-1-3 m2-3-2))) + (matrix-set! m3 1 3 + (+ (* m1-1-0 m2-0-3) + (* m1-1-1 m2-1-3) + (* m1-1-2 m2-2-3) + (* m1-1-3 m2-3-3))) + (matrix-set! m3 2 0 + (+ (* m1-2-0 m2-0-0) + (* m1-2-1 m2-1-0) + (* m1-2-2 m2-2-0) + (* m1-2-3 m2-3-0))) + (matrix-set! m3 2 1 + (+ (* m1-2-0 m2-0-1) + (* m1-2-1 m2-1-1) + (* m1-2-2 m2-2-1) + (* m1-2-3 m2-3-1))) + (matrix-set! m3 2 2 + (+ (* m1-2-0 m2-0-2) + (* m1-2-1 m2-1-2) + (* m1-2-2 m2-2-2) + (* m1-2-3 m2-3-2))) + (matrix-set! m3 2 3 + (+ (* m1-2-0 m2-0-3) + (* m1-2-1 m2-1-3) + (* m1-2-2 m2-2-3) + (* m1-2-3 m2-3-3))) + (matrix-set! m3 3 0 + (+ (* m1-3-0 m2-0-0) + (* m1-3-1 m2-1-0) + (* m1-3-2 m2-2-0) + (* m1-3-3 m2-3-0))) + (matrix-set! m3 3 1 + (+ (* m1-3-0 m2-0-1) + (* m1-3-1 m2-1-1) + (* m1-3-2 m2-2-1) + (* m1-3-3 m2-3-1))) + (matrix-set! m3 3 2 + (+ (* m1-3-0 m2-0-2) + (* m1-3-1 m2-1-2) + (* m1-3-2 m2-2-2) + (* m1-3-3 m2-3-2))) + (matrix-set! m3 3 3 + (+ (* m1-3-0 m2-0-3) + (* m1-3-1 m2-1-3) + (* m1-3-2 m2-2-3) + (* m1-3-3 m2-3-3)))))) + +(define (matrix4-copy matrix) + (let ((bv (bytevector-copy (matrix4-bv matrix)))) + (%make-matrix4 bv (bytevector->pointer bv)))) + +(define (matrix4* . matrices) + "Return the product of MATRICES." + (match matrices + (() (make-identity-matrix4)) + ((a b) + (let ((result (make-identity-matrix4))) + (matrix4-mult! result a b) + result)) + ((first . rest) + (let loop ((temp (make-identity-matrix4)) + (prev (matrix4-copy first)) + (matrices rest)) + (match matrices + (() prev) + ((current . rest) + (matrix4-mult! temp prev current) + (loop prev temp rest))))))) + +(define (matrix4-identity! matrix) + (init-matrix4 matrix + 1.0 0.0 0.0 0.0 + 0.0 1.0 0.0 0.0 + 0.0 0.0 1.0 0.0 + 0.0 0.0 0.0 1.0)) + +(define (make-identity-matrix4) + (let ((matrix (make-null-matrix4))) + (matrix4-identity! matrix) + matrix)) + +(define (orthographic-projection left right top bottom near far) + "Return a new transform that represents an orthographic projection +for the vertical clipping plane LEFT and RIGHT, the horizontal +clipping plane TOP and BOTTOM, and the depth clipping plane NEAR and +FAR." + (make-matrix4 (/ 2 (- right left)) 0 0 0 + 0 (/ 2 (- top bottom)) 0 0 + 0 0 (/ 2 (- far near)) 0 + (- (/ (+ right left) (- right left))) + (- (/ (+ top bottom) (- top bottom))) + (- (/ (+ far near) (- far near))) + 1)) + +(define (matrix4-translate! matrix v) + (cond + ((vector2? v) + (init-matrix4 matrix + 1 0 0 0 + 0 1 0 0 + 0 0 1 0 + (vx v) (vy v) 0 1)) + ((vector3? v) + (init-matrix4 matrix + 1 0 0 0 + 0 1 0 0 + 0 0 1 0 + (vx v) (vy v) (vz v) 1)) + (else + (error "invalid translation vector" v)))) + +(define (matrix4-translate v) + (let ((matrix (make-null-matrix4))) + (matrix4-translate! matrix v) + matrix)) + +(define (matrix4-scale! matrix s) + (init-matrix4 matrix + s 0.0 0.0 0.0 + 0.0 s 0.0 0.0 + 0.0 0.0 s 0.0 + 0.0 0.0 0.0 1.0)) + +(define (matrix4-scale s) + (let ((matrix (make-null-matrix4))) + (matrix4-scale! matrix s) + matrix)) + +(define (matrix4-rotate-z! matrix angle) + (init-matrix4 matrix + (cos angle) (- (sin angle)) 0.0 0.0 + (sin angle) (cos angle) 0.0 0.0 + 0.0 0.0 1.0 0.0 + 0.0 0.0 0.0 1.0)) + +(define (matrix4-rotate-z angle) + "Return a new matrix that rotates the Z axis by ANGLE radians." + (let ((matrix (make-null-matrix4))) + (matrix4-rotate-z! matrix angle) + matrix)) + +(define (transform matrix x y) + (let ((bv (matrix4-bv matrix))) + (values (+ (* x (matrix-ref bv 0 0)) + (* y (matrix-ref bv 1 0)) + (matrix-ref bv 3 0)) + (+ (* x (matrix-ref bv 0 1)) + (* y (matrix-ref bv 1 1)) + (matrix-ref bv 3 1))))) diff --git a/chickadee/math/vector.scm b/chickadee/math/vector.scm new file mode 100644 index 0000000..66a21fd --- /dev/null +++ b/chickadee/math/vector.scm @@ -0,0 +1,201 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee math vector) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:export ( + + + vector2 vector3 vector4 + vector2? vector3? vector4? + polar2 + vx vy vz vw + + vadd! vmul! + vx-in-range? vy-in-range? + + vmap v+ v- v* vdot vcross + magnitude normalize + anchor-vector) + #:replace (magnitude)) + +(define-inlinable (square x) + (* x x)) + +(define-record-type + (vector2 x y) + vector2? + (x vector2-x) + (y vector2-y)) + +(define-record-type + (vector3 x y z) + vector3? + (x vector3-x) + (y vector3-y) + (z vector3-z)) + +(define-record-type + (vector4 x y z w) + vector4? + (x vector4-x) + (y vector4-y) + (z vector4-z) + (w vector4-w)) + +(define vx + (match-lambda + ((or ($ x _) + ($ x _ _) + ($ x _ _ _)) + x))) + +(define vy + (match-lambda + ((or ($ _ y) + ($ _ y _) + ($ _ y _ _)) + y))) + +(define vz + (match-lambda + ((or ($ _ _ z) + ($ _ _ z _)) + z))) + +(define vw vector4-w) + +(define (polar2 r theta) + "Create a new 2D vector from the polar coordinate (R, THETA) where R +is the radius and THETA is the angle." + (vector2 (* r (cos theta)) + (* r (sin theta)))) + +(define (vmap proc v) + "Return a new vector that is the result of applying PROC to each +element of the 2D/3D/4D vector V." + (match v + (($ x y) + (vector2 (proc x) (proc y))) + (($ x y z) + (vector3 (proc x) (proc y) (proc z))) + (($ x y z w) + (vector4 (proc x) (proc y) (proc z) (proc w))))) + +(define-syntax-rule (vector-lambda proc) + (match-lambda* + ((($ x1 y1) ($ x2 y2)) + (vector2 (proc x1 x2) (proc y1 y2))) + ((($ x y) (? number? k)) + (vector2 (proc x k) (proc y k))) + (((? number? k) ($ x y)) + (vector2 (proc k x) (proc k y))) + ((($ x1 y1 z1) ($ x2 y2 z2)) + (vector3 (proc x1 x2) (proc y1 y2) (proc z1 z2))) + ((($ x y z) (? number? k)) + (vector3 (proc x k) (proc y k) (proc z k))) + (((? number? k) ($ x y z)) + (vector3 (proc k x) (proc k y) (proc k z))) + ((($ x1 y1 z1 w1) ($ x2 y2 z2 w2)) + (vector4 (proc x1 x2) (proc y1 y2) (proc z1 z2) (proc w1 w2))) + ((($ x y z w) (? number? k)) + (vector4 (proc x k) (proc y k) (proc z k) (proc w k))) + (((? number? k) ($ x y z w)) + (vector4 (proc k x) (proc k y) (proc k z) (proc k w))))) + +(define (v+ . vectors) + (reduce (vector-lambda +) 0 vectors)) + +(define v- + (match-lambda* + ((v) (v- 0 v)) + ((v v* ...) + (fold-right (let ((- (vector-lambda -))) + (lambda (prev v) + (- v prev))) + v v*)))) + +(define (v* . vectors) + (reduce (vector-lambda *) 1 vectors)) + +(define vdot + (match-lambda* + ((($ x1 y1) ($ x2 y2)) + (+ (* x1 x2) (* y1 y2))) + ((($ x1 y1 z1) ($ x2 y2 z2)) + (+ (* x1 x2) (* y1 y2) (* z1 z2))) + ((($ x1 y1 z1 w1) ($ x2 y2 z2 w2)) + (+ (* x1 x2) (* y1 y2) (* z1 z2) (* w1 w2))))) + +(define vcross + (match-lambda* + ((($ x1 y1 z1) ($ x2 y2 z2)) + (vector3 (- (* y1 z2) (* z1 y2)) + (- (* z1 x2) (* x1 z2)) + (- (* x1 y2) (* y1 x2)))))) + +(define (magnitude v) + "Return the magnitude of the vector V." + (sqrt + (match v + (($ x y) + (+ (square x) (square y))) + (($ x y z) + (+ (square x) (square y) (square z))) + (($ x y z w) + (+ (square x) (square y) (square z) (square w)))))) + +(define (normalize v) + "Return the normalized form of the vector V." + (let ((m (magnitude v))) + (if (zero? m) + v + (match v + (($ x y) + (vector2 (/ x m) (/ y m))) + (($ x y z) + (vector3 (/ x m) (/ y m) (/ z m))) + (($ x y z w) + (vector4 (/ x m) (/ y m) (/ z m) (/ w m))))))) + +(define (anchor-vector width height anchor) + "Create an anchor point vector from the description ANCHOR within +the rectangular defined by WIDTH and HEIGHT. Valid values for ANCHOR +are: 'center', 'top-left', 'top-right', 'bottom-left', 'bottom-right', +'top-center', 'bottom-center', or any 2D vector. When ANCHOR is a 2D +vector, the return value is simply the same vector." + (match anchor + ((? vector2? anchor) + anchor) + ('center + (vector2 (/ width 2) + (/ height 2))) + ('top-left + (vector2 0 height)) + ('top-right + (vector2 width height)) + ('bottom-left + (vector2 0 0)) + ('bottom-right + (vector2 width 0)) + ('top-center + (vector2 (/ width 2) height)) + ('bottom-center + (vector2 (/ width 2) 0)) + (_ (error "Invalid anchor type: " anchor)))) diff --git a/chickadee/render.scm b/chickadee/render.scm new file mode 100644 index 0000000..d55c76e --- /dev/null +++ b/chickadee/render.scm @@ -0,0 +1,135 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +;;; Commentary: +;; +;; High-level rendering API. +;; +;;; Code: + +(define-module (chickadee render) + #:use-module (srfi srfi-88) + #:use-module (chickadee math matrix) + #:use-module (chickadee render gpu) + #:use-module (chickadee render blend) + #:use-module (chickadee render shader) + #:use-module (chickadee render texture) + #:use-module (chickadee render vertex-buffer) + #:export (current-blend-mode + current-depth-test + current-texture + current-projection + with-blend-mode + with-depth-test + with-texture + with-projection + gpu-apply + gpu-apply*)) + +(define *current-blend-mode* 'replace) +(define *current-depth-test* #f) +(define *current-texture* null-texture) +(define *current-projection* (make-identity-matrix4)) + +(define (current-blend-mode) + *current-blend-mode*) + +(define (current-depth-test) + *current-depth-test*) + +(define (current-texture) + *current-texture*) + +(define (current-projection) + *current-projection*) + +(define-syntax-rule (with (name value) body ...) + (let ((prev name)) + (dynamic-wind + (lambda () (set! name value)) + (lambda () body ...) + (lambda () (set! name prev))))) + +(define-syntax-rule (with-blend-mode blend-mode body ...) + (with (*current-blend-mode* blend-mode) body ...)) + +(define-syntax-rule (with-depth-test depth-test body ...) + (with (*current-depth-test* depth-test) body ...)) + +(define-syntax-rule (with-texture texture body ...) + (with (*current-texture* texture) body ...)) + +(define-syntax-rule (with-shader shader body ...) + (with (*current-shader* shader) + (initialize-uniforms) + body ...)) + +(define-syntax-rule (with-vertex-array vertex-array body ...) + (with (*current-vertex-array* vertex-array) body ...)) + +(define-syntax-rule (with-projection matrix body ...) + (with (*current-projection* matrix) body ...)) + +;; (define (initialize-uniforms) +;; (hash-for-each (lambda (name uniform) +;; (unless (hash-get-handle *current-uniforms* name) +;; (hash-set! *current-uniforms* name +;; (uniform-default-value uniform)))) +;; (shader-uniforms *current-shader*))) + +;; (define-syntax uniform-let +;; (syntax-rules () +;; ((_ () body ...) (begin body ...)) +;; ((_ ((name value) . rest) body ...) +;; (let ((uniform (shader-uniform (current-shader) name)) +;; (prev (hash-ref *current-uniforms* name))) +;; (if uniform +;; (dynamic-wind +;; (lambda () +;; (hash-set! *current-uniforms* name value)) +;; (lambda () +;; (uniform-let rest body ...)) +;; (lambda () +;; (hash-set! *current-uniforms* name prev))) +;; (error "no such uniform: " name)))))) + +;; (define (uniform-ref name) +;; (uniform-value (shader-uniform (current-shader) name))) + +(define-syntax uniform-apply + (lambda (x) + (syntax-case x () + ((_ shader ()) (datum->syntax x #t)) + ((_ shader (name value . rest)) + (with-syntax ((sname (datum->syntax x (keyword->string + (syntax->datum #'name))))) + #'(begin + (set-uniform-value! (shader-uniform shader sname) value) + (uniform-apply shader rest))))))) + +(define-syntax-rule (gpu-apply* shader vertex-array count . uniforms) + (begin + (gpu-state-set! *blend-mode-state* (current-blend-mode)) + (gpu-state-set! *depth-test-state* (current-depth-test)) + (gpu-state-set! *texture-state* (current-texture)) + (gpu-state-set! *shader-state* shader) + (gpu-state-set! *vertex-array-state* vertex-array) + (uniform-apply shader uniforms) + (render-vertices count))) + +(define-syntax-rule (gpu-apply shader vertex-array uniforms ...) + (gpu-apply* shader vertex-array #f uniforms ...)) diff --git a/chickadee/render/blend.scm b/chickadee/render/blend.scm new file mode 100644 index 0000000..2e8ebb0 --- /dev/null +++ b/chickadee/render/blend.scm @@ -0,0 +1,73 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee render blend) + #:use-module (ice-9 match) + #:use-module (gl) + #:use-module (chickadee render gl) + #:use-module (chickadee render gpu) + #:export (*blend-mode-state* + *depth-test-state*)) + +(define (apply-blend-mode blend-mode) + (if blend-mode + (begin + (gl-enable (enable-cap blend)) + (match blend-mode + ('alpha + (gl-blend-equation (blend-equation-mode-ext func-add-ext)) + (gl-blend-func (blending-factor-src src-alpha) + (blending-factor-dest one-minus-src-alpha))) + ('multiply + (gl-blend-equation (blend-equation-mode-ext func-add-ext)) + (gl-blend-func (blending-factor-src dst-color) + (blending-factor-dest zero))) + ('subtract + (gl-blend-equation + (blend-equation-mode-ext func-reverse-subtract-ext)) + (gl-blend-func (blending-factor-src one) + (blending-factor-dest zero))) + ('add + (gl-blend-equation (blend-equation-mode-ext func-add-ext)) + (gl-blend-func (blending-factor-src one) + (blending-factor-dest zero))) + ('lighten + (gl-blend-equation (blend-equation-mode-ext max-ext)) + (gl-blend-func (blending-factor-src one) + (blending-factor-dest zero))) + ('darken + (gl-blend-equation (blend-equation-mode-ext min-ext)) + (gl-blend-func (blending-factor-src one) + (blending-factor-dest zero))) + ('screen + (gl-blend-equation (blend-equation-mode-ext func-add-ext)) + (gl-blend-func (blending-factor-src one) + (blending-factor-dest one-minus-src-color))) + ('replace + (gl-blend-equation (blend-equation-mode-ext func-add-ext)) + (gl-blend-func (blending-factor-src one) + (blending-factor-dest zero))))) + (gl-disable (enable-cap blend)))) + +(define *blend-mode-state* (make-gpu-state apply-blend-mode 'replace)) + +(define (apply-depth-test depth-test?) + (if depth-test? + (gl-enable (enable-cap depth-test)) + (gl-disable (enable-cap depth-test)))) + +(define *depth-test-state* (make-gpu-state apply-depth-test #f)) diff --git a/chickadee/render/gl.scm b/chickadee/render/gl.scm new file mode 100644 index 0000000..bc93d13 --- /dev/null +++ b/chickadee/render/gl.scm @@ -0,0 +1,275 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +;;; Commentary: +;; +;; Custom wrappers over low level OpenGL commands that aren't part of +;; guile-opengl. +;; +;;; Code: + +(define-module (chickadee render gl) + #:use-module (srfi srfi-4) + #:use-module ((system foreign) #:select (bytevector->pointer)) + #:use-module (gl) + #:use-module ((gl low-level) #:renamer (symbol-prefix-proc '%)) + #:use-module (gl enums) + #:use-module (gl runtime) + #:use-module (gl types)) + +(re-export (%glClearColor . gl-clear-color) + (%glScissor . gl-scissor) + (%glBlendFunc . gl-blend-func) + (%glBlendEquation . gl-blend-equation)) + +;;; +;;; 3.8.1 Texture Image Specification +;;; + +(re-export (%glTexImage3D . gl-texture-image-3d) + (%glTexImage2D . gl-texture-image-2d) + (%glTexImage1D . gl-texture-image-1d)) + +;;; +;;; 3.8.2 Alternate Texture Image Specification Commands +;;; + +(re-export (%glCopyTexImage2D . gl-copy-texture-image-2d) + (%glCopyTexImage1D . gl-copy-texture-image-1d) + (%glCopyTexSubImage3D . gl-copy-texture-sub-image-3d) + (%glCopyTexSubImage2D . gl-copy-texture-sub-image-2d) + (%glCopyTexSubImage1D . gl-copy-texture-sub-image-1d) + (%glTexSubImage3D . gl-texture-sub-image-3d) + (%glTexSubImage2D . gl-texture-sub-image-2d) + (%glTexSubImage1D . gl-texture-sub-image-1d)) + +;;; +;;; 3.8.3 Compressed Texture Images +;;; + +(re-export (%glCompressedTexImage1D . gl-compressed-texture-image-1d) + (%glCompressedTexImage2D . gl-compressed-texture-image-2d) + (%glCompressedTexImage3D . gl-compressed-texture-image-3d) + (%glCompressedTexSubImage1D . gl-compressed-texture-sub-image-1d) + (%glCompressedTexSubImage2D . gl-compressed-texture-sub-image-2d) + (%glCompressedTexSubImage3D . gl-compressed-texture-sub-image-3d)) + +;;; +;;; 3.8.4 Texture Parameters +;;; + +(re-export (%glTexParameteri . gl-texture-parameter) + (%glBindTexture . gl-bind-texture)) + +;;; +;;; Instancing extension +;;; + +(define-gl-procedure (glDrawArraysInstanced (mode GLenum) + (first GLint) + (count GLsizei) + (primcount GLsizei) + -> GLboolean) + "Draw multiple instances of a set of arrays.") + +(define-gl-procedure (glVertexAttribDivisor (index GLuint) + (divisor GLuint) + -> void) + "Modify the rate at which generic vertex attributes advance during +instanced rendering.") + +(export glDrawArraysInstanced + glVertexAttribDivisor) + +;;; +;;; VBOs +;;; + +(re-export (%glGenBuffers . gl-gen-buffers) + (%glDeleteBuffers . gl-delete-buffers) + (%glBufferData . gl-buffer-data) + (%glMapBuffer . gl-map-buffer) + (%glUnmapBuffer . gl-unmap-buffer)) + +;;; +;;; VAOs +;;; + +(define-gl-procedure (glGenVertexArrays (n GLsizei) + (arrays GLuint-*) + -> void) + "Generate N vertex arrays.") + +(define-gl-procedure (glDeleteVertexArrays (n GLsizei) + (arrays GLuint-*) + -> void) + "Delete vertex array objects.") + +(define-gl-procedure (glBindVertexArray (array GLuint) + -> void) + "Bind vertex array object ARRAY.") + +(define-gl-procedure (glEnableVertexAttribArray (index GLuint) + -> void) + "Enable or disable a generic vertex attribute array.") + +(define-gl-procedure (glVertexAttribPointer (index GLuint) + (size GLint) + (type GLenum) + (normalized GLboolean) + (stride GLsizei) + (pointer GLvoid-*) + -> void) + "Define an array of generic vertex attribute data.") + +(define-gl-procedure (glDrawElements (mode GLenum) + (count GLsizei) + (type GLenum) + (indices GLvoid-*) + -> void) + "Render primitives from array data.") + +(export (glGenVertexArrays . gl-gen-vertex-arrays) + (glDeleteVertexArrays . gl-delete-vertex-arrays) + (glBindVertexArray . gl-bind-vertex-array) + (glEnableVertexAttribArray . gl-enable-vertex-attrib-array) + (glVertexAttribPointer . gl-vertex-attrib-pointer) + (glDrawElements . gl-draw-elements)) + +(define-syntax-rule (with-gl-client-state state body ...) + (begin + (gl-enable-client-state state) + body ... + (gl-disable-client-state state))) + +(export with-gl-client-state) + +;;; +;;; Framebuffers +;;; + +(define-gl-procedure (glGenFramebuffers (n GLsizei) + (ids GLuint-*) + -> void) + "Generate framebuffer object names.") + +(define-gl-procedure (glDeleteFramebuffers (n GLsizei) + (framebuffers GLuint-*) + -> void) + "Delete framebuffer objects.") + +(define-gl-procedure (glBindFramebuffer (target GLenum) + (framebuffer GLuint) + -> void) + "Bind a framebuffer to a framebuffer target.") + +(define-gl-procedure (glFramebufferTexture2D (target GLenum) + (attachment GLenum) + (textarget GLenum) + (texture GLuint) + (level GLint) + -> void) + "Attach a level of a texture object as a logical buffer to the +currently bound framebuffer object.") + +(define-gl-procedure (glCheckFramebufferStatus (target GLenum) + -> GLenum) + "Return the framebuffer completeness status of a framebuffer +object.") + +(define-gl-procedure (glGenRenderbuffers (n GLsizei) + (ids GLuint-*) + -> void) + "Generate renderbuffer object names.") + +(define-gl-procedure (glDeleteRenderbuffers (n GLsizei) + (renderbuffers GLuint-*) + -> void) + "Delete renderbuffer objects.") + +(define-gl-procedure (glBindRenderbuffer (target GLenum) + (renderbuffer GLuint) + -> void) + "Bind a named renderbuffer object.") + +(define-gl-procedure (glRenderbufferStorage (target GLenum) + (internalformat GLenum) + (width GLsizei) + (height GLsizei) + -> void) + "Create and initialize a renderbuffer object's data store.") + +(define-gl-procedure (glFramebufferRenderbuffer (target GLenum) + (attachment GLenum) + (renderbuffertarget GLenum) + (renderbuffer GLuint) + -> void) + "Attach a renderbuffer object to a framebuffer object.") + +(export glGenFramebuffers + glDeleteFramebuffers + glBindFramebuffer + glFramebufferTexture2D + glCheckFramebufferStatus + glGenRenderbuffers + glDeleteRenderbuffers + glBindRenderbuffer + glRenderbufferStorage + glFramebufferRenderbuffer) + + +;;; +;;; Shaders +;;; + +(define-gl-procedure (glUniform1ui (location GLint) + (v0 GLuint) + -> void) + "Specify the value of a uniform variable for the current program object") + +(export (glUniform1ui . gl-uniform1ui)) + +(re-export (%glUseProgram . gl-use-program) + (%glDeleteProgram . gl-delete-program) + (%glDetachShader . gl-detach-shader) + (%glLinkProgram . gl-link-program) + (%glBindAttribLocation . gl-bind-attrib-location) + (%glAttachShader . gl-attach-shader) + (%glGetAttribLocation . gl-get-attrib-location) + (%glGetUniformLocation . gl-get-uniform-location) + (%glCreateProgram . gl-create-program) + (%glGetProgramInfoLog . gl-get-program-info-log) + (%glGetProgramiv . gl-get-programiv) + (%glDeleteProgram . gl-delete-program) + (%glDeleteShader . gl-delete-shader) + (%glGetShaderiv . gl-get-shaderiv) + (%glGetShaderInfoLog . gl-get-shader-info-log) + (%glCompileShader . gl-compile-shader) + (%glShaderSource . gl-shader-source) + (%glCreateShader . gl-create-shader) + (%glGetActiveUniform . gl-get-active-uniform) + (%glGetActiveAttrib . gl-get-active-attrib) + (%glUniform1i . gl-uniform1i) + (%glUniform2i . gl-uniform2i) + (%glUniform3i . gl-uniform3i) + (%glUniform4i . gl-uniform4i) + (%glUniform1f . gl-uniform1f) + (%glUniform2f . gl-uniform2f) + (%glUniform3f . gl-uniform3f) + (%glUniform4f . gl-uniform4f) + (%glUniformMatrix4fv . gl-uniform-matrix4fv) + (%glUniform4f . gl-uniform4f)) diff --git a/chickadee/render/gpu.scm b/chickadee/render/gpu.scm new file mode 100644 index 0000000..dde8a69 --- /dev/null +++ b/chickadee/render/gpu.scm @@ -0,0 +1,64 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee render gpu) + #:use-module (oop goops) + #:use-module (srfi srfi-9) + #:export (make-gpu-state + gpu-state-ref + gpu-state-set! + + gpu-finalize + gpu-guard + gpu-reap!)) + + +;;; +;;; GPU state +;;; + +(define-record-type + (make-gpu-state bind value) + gpu-state? + (bind gpu-state-bind) + (value gpu-state-ref %gpu-state-set!)) + +(define (gpu-state-set! state new-value) + (unless (eq? new-value (gpu-state-ref state)) + ((gpu-state-bind state) new-value) + (%gpu-state-set! state new-value))) + +;;; +;;; GPU finalizers +;;; + +(define-generic gpu-finalize) + +(define *gpu-guardian* (make-guardian)) + +(define (gpu-guard obj) + "Protect OBJ for the garbage collector until OBJ has been deleted +from the GPU's memory." + (*gpu-guardian* obj) + obj) + +(define (gpu-reap!) + "Delete all GPU objects that are no longer being referenced." + (let loop ((obj (*gpu-guardian*))) + (when obj + (gpu-finalize obj) + (loop (*gpu-guardian*))))) diff --git a/chickadee/render/shader.scm b/chickadee/render/shader.scm new file mode 100644 index 0000000..5e8afc9 --- /dev/null +++ b/chickadee/render/shader.scm @@ -0,0 +1,346 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee render shader) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-4) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (gl) + #:use-module (chickadee color) + #:use-module (chickadee math matrix) + #:use-module (chickadee math vector) + #:use-module (chickadee render gl) + #:use-module (chickadee render gpu) + #:use-module (chickadee render texture) + #:export (make-shader + shader? + null-shader + load-shader + strings->shader + shader-uniform + shader-uniforms + uniform? + uniform-name + uniform-value + uniform-default-value + set-uniform-value! + *shader-state*)) + +(define-record-type + (%make-shader id attributes uniforms) + shader? + (id shader-id) + (attributes shader-attributes) + (uniforms shader-uniforms)) + +(define-record-type + (make-uniform name location type value setter) + uniform? + (name uniform-name) + (location uniform-location) + (type uniform-type) + (value uniform-value %set-uniform-value!) + (setter uniform-setter)) + +(define-record-type + (make-attribute name location type) + attribute? + (name attribute-name) + (location attribute-location) + (type attribute-type)) + +(define null-shader (%make-shader 0 (make-hash-table) (make-hash-table))) + +(define <> (class-of null-shader)) + +(define-method (gpu-finalize (shader <>)) + (gl-delete-program (shader-id shader))) + +(define (apply-shader shader) + (gl-use-program (shader-id shader))) + +(define *shader-state* (make-gpu-state apply-shader null-shader)) + +(define (shader-compiled? id) + (let ((status (make-u32vector 1))) + (gl-get-shaderiv id (version-2-0 compile-status) + (bytevector->pointer status)) + (= (u32vector-ref status 0) 1))) + +(define (shader-linked? id) + (let ((status (make-u32vector 1))) + (gl-get-programiv id (version-2-0 link-status) + (bytevector->pointer status)) + (= (u32vector-ref status 0) 1))) + +(define (info-log length-proc log-proc id) + (let ((log-length-bv (make-u32vector 1))) + (length-proc id (version-2-0 info-log-length) + (bytevector->pointer log-length-bv)) + (u32vector-ref log-length-bv 0) + ;; Add one byte to account for the null string terminator. + (let* ((log-length (u32vector-ref log-length-bv 0)) + (log (make-u8vector (1+ log-length)))) + (log-proc id log-length %null-pointer (bytevector->pointer log)) + (utf8->string log)))) + +(define (compilation-error id) + (info-log gl-get-shaderiv gl-get-shader-info-log id)) + +(define (linking-error id) + (info-log gl-get-programiv gl-get-program-info-log id)) + +(define (uniform-count id) + (let ((bv (make-u32vector 1))) + (gl-get-programiv id + (arb-shader-objects active-uniforms) + (bytevector->pointer bv)) + (u32vector-ref bv 0))) + +(define (utf8->string* bv length) + (let ((bv* (make-bytevector length))) + (bytevector-copy! bv 0 bv* 0 length) + (utf8->string bv*))) + +(define (set-boolean-uniform! location bool) + (gl-uniform1i location (if bool 1 0))) + +(define (set-integer-uniform! location n) + (gl-uniform1i location n)) + +(define (set-unsigned-integer-uniform! location n) + (gl-uniform1ui location n)) + +(define (set-float-uniform! location n) + (gl-uniform1f location n)) + +(define (set-float-vector2-uniform! location v) + (gl-uniform2f location (vx v) (vy v))) + +(define (set-float-vector3-uniform! location v) + (gl-uniform3f location (vx v) (vy v) (vz v))) + +(define (set-float-vector4-uniform! location v) + (if (color? v) + (gl-uniform4f location + (color-r v) + (color-g v) + (color-b v) + (color-a v)) + (gl-uniform4f location (vx v) (vy v) (vz v) (vw v)))) + +(define (set-integer-vector2-uniform! location v) + (gl-uniform2i location (vx v) (vy v))) + +(define (set-integer-vector3-uniform! location v) + (gl-uniform3i location (vx v) (vy v) (vz v))) + +(define (set-integer-vector4-uniform! location v) + (gl-uniform4i location (vx v) (vy v) (vz v) (vw v))) + +(define (set-float-matrix4-uniform! location m) + (gl-uniform-matrix4fv location 1 #f + ((@@ (chickadee math matrix) matrix4-ptr) m))) + +(define (set-sampler-2d-uniform! location texture-unit) + (gl-uniform1i location texture-unit)) + +(define (gl-type->symbol type) + (cond + ((= type (version-2-0 bool)) 'bool) + ((= type (data-type int)) 'int) + ((= type (data-type unsigned-int)) 'unsigned-int) + ((= type (data-type float)) 'float) + ((= type (version-2-0 float-vec2)) 'float-vec2) + ((= type (version-2-0 float-vec3)) 'float-vec3) + ((= type (version-2-0 float-vec4)) 'float-vec4) + ((= type (version-2-0 int-vec2)) 'int-vec2) + ((= type (version-2-0 int-vec3)) 'int-vec3) + ((= type (version-2-0 int-vec4)) 'int-vec4) + ((= type (version-2-0 float-mat4)) 'mat4) + ((= type (version-2-0 sampler-2d)) 'sampler-2d) + (else + (error "unsupported OpenGL type" type)))) + +(define %default-mat4 (make-identity-matrix4)) + +(define (default-uniform-value type) + (match type + ('bool #f) + ('int 0) + ('unsigned-int 0) + ('float 0.0) + ('float-vec2 (vector2 0.0 0.0)) + ('float-vec3 (vector3 0.0 0.0 0.0)) + ('float-vec4 (vector4 0.0 0.0 0.0 0.0)) + ('int-vec2 (vector2 0 0)) + ('int-vec3 (vector3 0 0 0)) + ('int-vec4 (vector4 0 0 0 0)) + ('sampler-2d 0) + ('mat4 %default-mat4))) + +(define (uniform-setter-for-type type) + ;; TODO: Handle more data types, notably matrices. + (match type + ('bool set-boolean-uniform!) + ('int set-integer-uniform!) + ('unsigned-int set-unsigned-integer-uniform!) + ('float set-float-uniform!) + ('float-vec2 set-float-vector2-uniform!) + ('float-vec3 set-float-vector3-uniform!) + ('float-vec4 set-float-vector4-uniform!) + ('int-vec2 set-integer-vector2-uniform!) + ('int-vec3 set-integer-vector3-uniform!) + ('int-vec4 set-integer-vector4-uniform!) + ('mat4 set-float-matrix4-uniform!) + ('sampler-2d set-sampler-2d-uniform!))) + +(define (extract-uniforms id) + (let ((total (uniform-count id)) + (table (make-hash-table))) + (let loop ((i 0)) + (unless (= i total) + (let ((length-bv (make-u32vector 1)) + (size-bv (make-u32vector 1)) + (type-bv (make-u32vector 1)) + (name-bv (make-bytevector 255))) + (gl-get-active-uniform id i + (bytevector-length name-bv) + (bytevector->pointer length-bv) + (bytevector->pointer size-bv) + (bytevector->pointer type-bv) + (bytevector->pointer name-bv)) + (let* ((length (u32vector-ref length-bv 0)) + (name (utf8->string* name-bv length)) + (location (gl-get-uniform-location id name)) + (size (u32vector-ref size-bv 0)) + (type (gl-type->symbol (u32vector-ref type-bv 0))) + (default (default-uniform-value type)) + (setter (uniform-setter-for-type type))) + ;; TODO: Handle uniform arrays. + (unless (= size 1) + (error "unsupported uniform size" name size)) + + (unless (eq? type 'sampler-2d) + (hash-set! table + name + (make-uniform name location type default setter))))) + (loop (1+ i)))) + table)) + +(define (attribute-count id) + (let ((bv (make-u32vector 1))) + (gl-get-programiv id + (arb-shader-objects active-attributes) + (bytevector->pointer bv)) + (u32vector-ref bv 0))) + +(define (extract-attributes id) + (let ((total (attribute-count id)) + (table (make-hash-table))) + (let loop ((i 0)) + (unless (= i total) + (let ((length-bv (make-u32vector 1)) + (size-bv (make-u32vector 1)) + (type-bv (make-u32vector 1)) + (name-bv (make-bytevector 255))) + (gl-get-active-attrib id i + (bytevector-length name-bv) + (bytevector->pointer length-bv) + (bytevector->pointer size-bv) + (bytevector->pointer type-bv) + (bytevector->pointer name-bv)) + (let* ((length (u32vector-ref length-bv 0)) + (name (utf8->string* name-bv length)) + (size (u32vector-ref size-bv 0)) + (type (gl-type->symbol (u32vector-ref type-bv 0))) + (location (gl-get-attrib-location id name))) + (unless (= size 1) + (error "unsupported attribute size" name size)) + + (hash-set! table name (make-attribute name location type)))) + (loop (1+ i)))) + table)) + +(define (make-shader vertex-port fragment-port) + (define (make-shader-stage type port) + (let ((id (gl-create-shader type)) + (source (get-bytevector-all port))) + (gl-shader-source id 1 + (bytevector->pointer + (u64vector + (pointer-address (bytevector->pointer source)))) + (bytevector->pointer + (u32vector (bytevector-length source)))) + (gl-compile-shader id) + (unless (shader-compiled? id) + (let ((error-log (compilation-error id))) + (gl-delete-shader id) ; clean up GPU resource. + (error "failed to compile shader" error-log))) + id)) + + (let ((vertex-id (make-shader-stage (version-2-0 vertex-shader) + vertex-port)) + (fragment-id (make-shader-stage (version-2-0 fragment-shader) + fragment-port)) + (id (gl-create-program))) + (gl-attach-shader id vertex-id) + (gl-attach-shader id fragment-id) + (gl-link-program id) + (unless (shader-linked? id) + (let ((error-log (linking-error id))) + (gl-delete-program id) + (error "failed to link shader" error-log))) + (gl-delete-shader vertex-id) + (gl-delete-shader fragment-id) + (gpu-guard (%make-shader id (extract-attributes id) (extract-uniforms id))))) + +(define (load-shader vertex-source-file fragment-source-file) + (call-with-input-file vertex-source-file + (lambda (vertex-port) + (call-with-input-file fragment-source-file + (lambda (fragment-port) + (make-shader vertex-port fragment-port)))))) + +(define (strings->shader vertex-source fragment-source) + (call-with-input-string vertex-source + (lambda (vertex-port) + (call-with-input-string fragment-source + (lambda (fragment-port) + (make-shader vertex-port fragment-port)))))) + +(define (shader-uniform shader name) + (let ((uniform (hash-ref (shader-uniforms shader) name))) + (or uniform (error "no such uniform" name)))) + +(define (set-uniform-value! uniform x) + "Change the value of UNIFORM to X. This procedure assumes that the +shader where UNIFORM is defined is currently bound in the OpenGL +context. The behavior of this procedure under any other circumstance +is undefined." + ((uniform-setter uniform) (uniform-location uniform) x) + (%set-uniform-value! uniform x)) + +(define (uniform-default-value uniform) + (default-uniform-value (uniform-type uniform))) diff --git a/chickadee/render/shapes.scm b/chickadee/render/shapes.scm new file mode 100644 index 0000000..52e2613 --- /dev/null +++ b/chickadee/render/shapes.scm @@ -0,0 +1,205 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +;;; Commentary +;; +;; Polylines as described in +;; http://jcgt.org/published/0002/02/08/paper.pdf +;; +;;; Code: + +(define-module (chickadee render shapes) + #:use-module (ice-9 match) + #:use-module (srfi srfi-4) + #:use-module (chickadee math matrix) + #:use-module (chickadee math vector) + #:use-module (chickadee render) + #:use-module (chickadee color) + #:use-module (chickadee render shader) + #:use-module (chickadee render vertex-buffer) + #:export (draw-line + draw-rectangle-outline)) + +(define draw-line + (let* ((vertex-buffer + (delay (make-streaming-vertex-buffer 'vec2 4))) + (texcoord-buffer + (delay (make-streaming-vertex-buffer 'vec2 4))) + (index-buffer + (delay (make-vertex-buffer 'index 'static (u32vector 0 3 2 0 2 1)))) + (vertex-array + (delay (make-vertex-array (force index-buffer) + (force vertex-buffer) + (force texcoord-buffer)))) + (default-shader + (delay + (strings->shader + " +#version 330 + +in vec2 position; +in vec2 tex; +out vec2 frag_tex; +uniform mat4 projection; + +void main(void) { + frag_tex = tex; + gl_Position = projection * vec4(position.xy, 0.0, 1.0); +} +" + " +#version 330 + +in vec2 frag_tex; +uniform vec4 color; +uniform float r; +uniform float w; +uniform float t; +uniform float l; +uniform int cap; +float infinity = 1.0 / 0.0; + +void main (void) { + float hw = w / 2.0; + float u = frag_tex.x; + float v = frag_tex.y; + float dx; + float dy; + float d; + + if (u < 0 || u > l) { + if (u < 0) { + dx = abs(u); + } else { + dx = u - l; + } + dy = abs(v); + + switch (cap) { + // none + case 0: + d = infinity; + break; + // butt + case 1: + d = max(dx + w / 2 - 2 * r, dy); + break; + // square + case 2: + d = max(dx, dy); + break; + // round + case 3: + d = sqrt(dx * dx + dy * dy); + break; + // triangle out + case 4: + d = dx + dy; + break; + // triangle in + case 5: + d = max(dy, w / 2 - r + dx - dy); + break; + } + } else { + d = abs(v); + } + + if (d <= hw) { + gl_FragColor = color; + } else { + gl_FragColor = vec4(color.rgb, color.a * (1.0 - ((d - hw) / r))); + } +} +")))) + (lambda* (x1 y1 x2 y2 #:key + (thickness 1.0) + (feather 1.0) + (cap 'round) + (color white) + (shader (force default-shader))) + (let* ((dx (- x2 x1)) + (dy (- y2 y1)) + (length (sqrt (+ (expt dx 2) (expt dy 2)))) + (padding (/ (ceiling (+ thickness (* feather 2.5))) 2.0)) + (nx (/ dx length)) + (ny (/ dy length)) + (xpad (* nx padding)) + (ypad (* ny padding)) + ;; start left + (vx1 (+ (- x1 xpad) ypad)) + (vy1 (+ (- y1 ypad) (- xpad))) + (s1 (- padding)) + (t1 padding) + ;; start right + (vx2 (+ (- x1 xpad) (- ypad))) + (vy2 (+ (- y1 ypad) xpad)) + (s2 (- padding)) + (t2 (- padding)) + ;; end left + (vx3 (+ x2 xpad (- ypad))) + (vy3 (+ y2 ypad xpad)) + (s3 (+ length padding)) + (t3 (- padding)) + ;; end right + (vx4 (+ (+ x2 xpad) ypad)) + (vy4 (+ (+ y2 ypad) (- xpad))) + (s4 (+ length padding)) + (t4 padding)) + (with-mapped-vertex-buffer (force vertex-buffer) + (let ((bv (vertex-buffer-data (force vertex-buffer)))) + (f32vector-set! bv 0 vx1) + (f32vector-set! bv 1 vy1) + (f32vector-set! bv 2 vx2) + (f32vector-set! bv 3 vy2) + (f32vector-set! bv 4 vx3) + (f32vector-set! bv 5 vy3) + (f32vector-set! bv 6 vx4) + (f32vector-set! bv 7 vy4))) + (with-mapped-vertex-buffer (force texcoord-buffer) + (let ((bv (vertex-buffer-data (force texcoord-buffer)))) + (f32vector-set! bv 0 s1) + (f32vector-set! bv 1 t1) + (f32vector-set! bv 2 s2) + (f32vector-set! bv 3 t2) + (f32vector-set! bv 4 s3) + (f32vector-set! bv 5 t3) + (f32vector-set! bv 6 s4) + (f32vector-set! bv 7 t4))) + (with-blend-mode 'alpha + (gpu-apply shader (force vertex-array) + #:projection (current-projection) + #:color color + #:w thickness + #:r feather + #:l length + #:cap (match cap + ('none 0) + ('butt 1) + ('square 2) + ('round 3) + ('triangle-out 4) + ('triangle-in 5)))))))) + +;; TODO: Use an outline polygon instead of rendering a bunch of lines. +(define* (draw-rectangle-outline left bottom right top #:key + (thickness 1.0) + (color white)) + (draw-line left bottom right bottom #:thickness thickness #:color color) + (draw-line right bottom right top #:thickness thickness #:color color) + (draw-line right top left top #:thickness thickness #:color color) + (draw-line left top left bottom #:thickness thickness #:color color)) diff --git a/chickadee/render/sprite.scm b/chickadee/render/sprite.scm new file mode 100644 index 0000000..b23130a --- /dev/null +++ b/chickadee/render/sprite.scm @@ -0,0 +1,282 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee render sprite) + #:use-module (srfi srfi-4) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) + #:use-module (chickadee math matrix) + #:use-module (chickadee math vector) + #:use-module (chickadee render) + #:use-module (chickadee render shader) + #:use-module (chickadee render texture) + #:use-module (chickadee render vertex-buffer) + #:export (draw-sprite + with-batched-sprites)) + +(define default-shader + (delay + (strings->shader + " +#version 330 + +in vec2 position; +in vec2 tex; +out vec2 frag_tex; +uniform mat4 mvp; + +void main(void) { + frag_tex = tex; + gl_Position = mvp * vec4(position.xy, 0.0, 1.0); +} +" + " +#version 330 + +in vec2 frag_tex; +uniform sampler2D color_texture; + +void main (void) { + gl_FragColor = texture2D(color_texture, frag_tex); +} +"))) + +(define draw-sprite-unbatched + (let* ((vertex-buffer + (delay (make-streaming-vertex-buffer 'vec2 4))) + (texcoord-buffer + (delay (make-streaming-vertex-buffer 'vec2 4))) + (index-buffer + (delay (make-vertex-buffer 'index 'static (u32vector 0 3 2 0 2 1)))) + (vertex-array + (delay (make-vertex-array (force index-buffer) + (force vertex-buffer) + (force texcoord-buffer)))) + (tmp-matrix (make-null-matrix4)) + (mvp (make-null-matrix4))) + (lambda (texture position center width height + scale rotation blend-mode shader + s1 t1 s2 t2) + (with-mapped-vertex-buffer (force vertex-buffer) + (let* ((x1 (- (vx center))) + (y1 (- (vy center))) + (x2 (+ x1 width)) + (y2 (+ y1 height)) + (bv (vertex-buffer-data (force vertex-buffer)))) + (f32vector-set! bv 0 x1) + (f32vector-set! bv 1 y1) + (f32vector-set! bv 2 x2) + (f32vector-set! bv 3 y1) + (f32vector-set! bv 4 x2) + (f32vector-set! bv 5 y2) + (f32vector-set! bv 6 x1) + (f32vector-set! bv 7 y2))) + (with-mapped-vertex-buffer (force texcoord-buffer) + (let ((bv (vertex-buffer-data (force texcoord-buffer)))) + (f32vector-set! bv 0 s1) + (f32vector-set! bv 1 t1) + (f32vector-set! bv 2 s2) + (f32vector-set! bv 3 t1) + (f32vector-set! bv 4 s2) + (f32vector-set! bv 5 t2) + (f32vector-set! bv 6 s1) + (f32vector-set! bv 7 t2))) + (matrix4-identity! mvp) + (when rotation + (matrix4-rotate-z! tmp-matrix rotation) + (matrix4-mult! mvp mvp tmp-matrix)) + (when scale + (matrix4-scale! tmp-matrix scale) + (matrix4-mult! mvp mvp tmp-matrix)) + (matrix4-translate! tmp-matrix position) + (matrix4-mult! mvp mvp tmp-matrix) + (matrix4-mult! mvp mvp (current-projection)) + (with-blend-mode blend-mode + (with-texture texture + (gpu-apply shader (force vertex-array) #:mvp mvp)))))) + + +;;; +;;; Sprite Batch +;;; + +(define-record-type + (%make-sprite-batch texture blend-mode shader size capacity index-buffer + position-buffer texture-buffer vertex-array) + sprite-batch? + (texture sprite-batch-texture set-sprite-batch-texture!) + (blend-mode sprite-batch-blend-mode set-sprite-batch-blend-mode!) + (shader sprite-batch-shader set-sprite-batch-shader!) + (size sprite-batch-size set-sprite-batch-size!) + (capacity sprite-batch-capacity) + (index-buffer sprite-batch-index-buffer) + (position-buffer sprite-batch-position-buffer) + (texture-buffer sprite-batch-texture-buffer) + (vertex-array sprite-batch-vertex-array)) + +(define (make-sprite-batch capacity) + "Make a sprite batch that can hold CAPACITY sprites." + (let* ((index (make-streaming-vertex-buffer 'index (* capacity 6))) + (pos (make-streaming-vertex-buffer 'vec2 (* capacity 4))) + (tex (make-streaming-vertex-buffer 'vec2 (* capacity 4))) + (va (make-vertex-array index pos tex))) + (%make-sprite-batch #f #f #f 0 capacity index pos tex va))) + +(define (sprite-batch-full? batch) + (= (sprite-batch-capacity batch) (sprite-batch-size batch))) + +(define (double-sprite-batch-size! batch) + #f) + +(define (sprite-batch-reset! batch) + "Reset BATCH to size 0." + (set-sprite-batch-texture! batch #f) + (set-sprite-batch-blend-mode! batch #f) + (set-sprite-batch-shader! batch #f) + (set-sprite-batch-size! batch 0)) + +(define (sprite-batch-begin! batch) + (map-vertex-buffer! (sprite-batch-index-buffer batch)) + (map-vertex-buffer! (sprite-batch-position-buffer batch)) + (map-vertex-buffer! (sprite-batch-texture-buffer batch))) + +(define (sprite-batch-flush! batch) + "Render the contents of BATCH and clear the cache." + (unless (zero? (sprite-batch-size batch)) + (with-blend-mode (sprite-batch-blend-mode batch) + (with-texture (sprite-batch-texture batch) + (unmap-vertex-buffer! (sprite-batch-index-buffer batch)) + (unmap-vertex-buffer! (sprite-batch-position-buffer batch)) + (unmap-vertex-buffer! (sprite-batch-texture-buffer batch)) + (gpu-apply* (sprite-batch-shader batch) + (sprite-batch-vertex-array batch) + (* (sprite-batch-size batch) 6) + #:mvp (current-projection)) + (sprite-batch-reset! batch))))) + +(define sprite-batch-add! + (let ((tmp-matrix (make-null-matrix4)) + (matrix (make-null-matrix4))) + (lambda (batch texture position center width height + scale rotation blend-mode shader s1 t1 s2 t2) + ;; Expand the buffers when necessary. + (when (sprite-batch-full? batch) + (double-sprite-batch-size! batch)) + ;; Flush the batch if any GL state needs changing. + (unless (and (eq? (sprite-batch-texture batch) texture) + (eq? (sprite-batch-blend-mode batch) blend-mode) + (eq? (sprite-batch-shader batch) shader)) + (sprite-batch-flush! batch) + (sprite-batch-begin! batch) + (set-sprite-batch-texture! batch texture) + (set-sprite-batch-blend-mode! batch blend-mode) + (set-sprite-batch-shader! batch shader)) + (let ((size (sprite-batch-size batch))) + (let* ((index-offset (* size 6)) + (index-vertex-offset (* size 4)) + (vertex-offset (* size 8)) ;; 4 vertices, 2 floats per vertex + (texture-offset (* size 8)) + (indices (vertex-buffer-data (sprite-batch-index-buffer batch))) + (vertices (vertex-buffer-data (sprite-batch-position-buffer batch))) + (texcoords (vertex-buffer-data (sprite-batch-texture-buffer batch))) + (local-x1 (- (vx center))) + (local-y1 (- (vy center))) + (local-x2 (+ local-x1 width)) + (local-y2 (+ local-y1 height))) + (matrix4-identity! matrix) + (when rotation + (matrix4-rotate-z! tmp-matrix rotation) + (matrix4-mult! matrix matrix tmp-matrix)) + (when scale + (matrix4-scale! tmp-matrix scale) + (matrix4-mult! matrix matrix tmp-matrix)) + (matrix4-translate! tmp-matrix position) + (matrix4-mult! matrix matrix tmp-matrix) + (let-values (((world-x1 world-y1) + (transform matrix local-x1 local-y1)) + ((world-x2 world-y2) + (transform matrix local-x2 local-y2))) + ;; Add indices. + (u32vector-set! indices index-offset index-vertex-offset) + (u32vector-set! indices (+ index-offset 1) (+ index-vertex-offset 3)) + (u32vector-set! indices (+ index-offset 2) (+ index-vertex-offset 2)) + (u32vector-set! indices (+ index-offset 3) index-vertex-offset) + (u32vector-set! indices (+ index-offset 4) (+ index-vertex-offset 2)) + (u32vector-set! indices (+ index-offset 5) (+ index-vertex-offset 1)) + ;; Add vertices. + ;; Bottom-left + (f32vector-set! vertices vertex-offset world-x1) + (f32vector-set! vertices (+ vertex-offset 1) world-y1) + ;; Bottom-right + (f32vector-set! vertices (+ vertex-offset 2) world-x2) + (f32vector-set! vertices (+ vertex-offset 3) world-y1) + ;; Top-right + (f32vector-set! vertices (+ vertex-offset 4) world-x2) + (f32vector-set! vertices (+ vertex-offset 5) world-y2) + ;; Top-left + (f32vector-set! vertices (+ vertex-offset 6) world-x1) + (f32vector-set! vertices (+ vertex-offset 7) world-y2) + ;; Add texture coordinates. + ;; Bottom-left + (f32vector-set! texcoords texture-offset s1) + (f32vector-set! texcoords (+ texture-offset 1) t1) + ;; Bottom-right + (f32vector-set! texcoords (+ texture-offset 2) s2) + (f32vector-set! texcoords (+ texture-offset 3) t1) + ;; Top-right + (f32vector-set! texcoords (+ texture-offset 4) s2) + (f32vector-set! texcoords (+ texture-offset 5) t2) + ;; Top-left + (f32vector-set! texcoords (+ texture-offset 6) s1) + (f32vector-set! texcoords (+ texture-offset 7) t2) + (set-sprite-batch-size! batch (1+ size)))))))) + +(define *batch?* #f) +(define %batch (delay (make-sprite-batch 256))) + +(define (draw-sprite-batched texture position center width height + scale rotation blend-mode shader + s1 t1 s2 t2) + (sprite-batch-add! (force %batch) texture position center width height + scale rotation blend-mode shader + s1 t1 s2 t2)) + +(define-syntax-rule (with-batched-sprites body ...) + (dynamic-wind + (lambda () + (set! *batch?* #t)) + (lambda () + (sprite-batch-reset! (force %batch)) + body ... + (sprite-batch-flush! (force %batch))) + (lambda () + (set! *batch?* #f)))) + +(define* (draw-sprite texture position #:key + (center (vector2 0 0)) + (width (texture-width texture)) + (height (texture-height texture)) + scale rotation (blend-mode 'alpha) + (s1 0.0) (t1 0.0) (s2 1.0) (t2 1.0) + (shader (force default-shader))) + (if *batch?* + (draw-sprite-batched texture position center width height + scale rotation blend-mode shader + s1 t1 s2 t2 ) + (draw-sprite-unbatched texture position center width height + scale rotation blend-mode shader + s1 t1 s2 t2))) diff --git a/chickadee/render/texture.scm b/chickadee/render/texture.scm new file mode 100644 index 0000000..ef55dca --- /dev/null +++ b/chickadee/render/texture.scm @@ -0,0 +1,191 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee render texture) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (gl) + #:use-module ((gl enums) + #:select (texture-min-filter texture-mag-filter) + #:prefix gl:) + #:use-module ((sdl2 image) #:prefix sdl-image:) + #:use-module (sdl2 surface) + #:use-module (oop goops) + #:use-module (chickadee render gl) + #:use-module (chickadee render gpu) + #:export (make-texture + load-image + texture? + texture-null? + texture-id + texture-parent + texture-width + texture-height + texture-min-filter + texture-mag-filter + texture-wrap-s + texture-wrap-t + null-texture + *texture-state*)) + +;;; +;;; Textures +;;; + +;; The object is a simple wrapper around an OpenGL texture +;; id. +(define-record-type + (%make-texture id width height min-filter mag-filter wrap-s wrap-t) + texture? + (id texture-id) + (width texture-width) + (height texture-height) + (min-filter texture-min-filter) + (mag-filter texture-mag-filter) + (wrap-s texture-wrap-s) + (wrap-t texture-wrap-t)) + +(set-record-type-printer! + (lambda (texture port) + (format port + "#" + (texture-width texture) + (texture-height texture) + (texture-min-filter texture) + (texture-mag-filter texture) + (texture-wrap-s texture) + (texture-wrap-t texture)))) + +(define null-texture (%make-texture 0 0 0 'linear 'linear 'repeat 'repeat)) + +(define <> (class-of null-texture)) + +(define (texture-null? texture) + "Return #t if TEXTURE is the null texture." + (eq? texture null-texture)) + +(define (free-texture texture) + (gl-delete-texture (texture-id texture))) + +(define-method (gpu-finalize (texture <>)) + (free-texture texture)) + +(define (apply-texture texture) + (gl-enable (enable-cap texture-2d)) + (gl-bind-texture (texture-target texture-2d) + (texture-id texture))) + +(define *texture-state* (make-gpu-state apply-texture null-texture)) + +(define* (make-texture pixels width height #:key + (min-filter 'linear) + (mag-filter 'linear) + (wrap-s 'repeat) + (wrap-t 'repeat) + (format 'rgba)) + "Translate the bytevector PIXELS into an OpenGL texture with +dimensions WIDTHxHEIGHT where each pixel is in 32-bit RGBA format. +The generated texture uses MIN-FILTER for downscaling and MAG-FILTER +for upscaling. WRAP-S and WRAP-T are symbols that control how texture +access is handled for texture coordinates outside the [0, 1] range. +Allowed symbols are: repeat (the default), clamp, clamp-to-border, +clamp-to-edge. FORMAT specifies the pixel format. Currently only +32-bit RGBA format is supported." + (define (gl-wrap mode) + (match mode + ('repeat (texture-wrap-mode repeat)) + ('clamp (texture-wrap-mode clamp)) + ('clamp-to-border (texture-wrap-mode clamp-to-border-sgis)) + ('clamp-to-edge (texture-wrap-mode clamp-to-edge-sgis)))) + + (let ((texture (gpu-guard + (%make-texture (gl-generate-texture) width height + min-filter mag-filter wrap-s wrap-t)))) + (gpu-state-set! *texture-state* texture) + (gl-texture-parameter (texture-target texture-2d) + (texture-parameter-name texture-min-filter) + (match min-filter + ('nearest (gl:texture-min-filter nearest)) + ('linear (gl:texture-min-filter linear)))) + (gl-texture-parameter (texture-target texture-2d) + (texture-parameter-name texture-mag-filter) + (match mag-filter + ('nearest (gl:texture-mag-filter nearest)) + ('linear (gl:texture-mag-filter linear)))) + (gl-texture-parameter (texture-target texture-2d) + (texture-parameter-name texture-wrap-s) + (gl-wrap wrap-s)) + (gl-texture-parameter (texture-target texture-2d) + (texture-parameter-name texture-wrap-t) + (gl-wrap wrap-t)) + (gl-texture-image-2d (texture-target texture-2d) + 0 (pixel-format rgba) width height 0 + (match format + ('rgba (pixel-format rgba))) + (color-pointer-type unsigned-byte) + pixels) + texture)) + +(define (flip-pixels-vertically pixels width height) + "Create a new bytevector that reverses the rows in PIXELS, a WIDTH x +HEIGHT, 32 bit color bytevector." + (let ((buffer (make-u8vector (bytevector-length pixels))) + (row-width (* width 4))) ; assuming 32 bit color + (let loop ((y 0)) + (when (< y height) + (let* ((y* (- height y 1)) + (source-start (* y row-width)) + (target-start (* y* row-width))) + (bytevector-copy! pixels source-start buffer target-start row-width) + (loop (1+ y))))) + buffer)) + +(define (surface->texture surface min-filter mag-filter wrap-s wrap-t) + "Convert SURFACE, an SDL2 surface object, into a texture that uses +the given MIN-FILTER and MAG-FILTER." + ;; Convert to 32 bit RGBA color. + (call-with-surface (convert-surface-format surface 'abgr8888) + (lambda (surface) + (let* ((width (surface-width surface)) + (height (surface-height surface)) + ;; OpenGL textures use the bottom-left corner as the + ;; origin, whereas SDL uses the top-left, so the rows + ;; of pixels must be reversed before creating a + ;; texture from them. + (pixels (flip-pixels-vertically (surface-pixels surface) + width height))) + (make-texture pixels width height + #:min-filter min-filter + #:mag-filter mag-filter + #:wrap-s wrap-s + #:wrap-t wrap-t))))) + +(define* (load-image file #:optional #:key + (min-filter 'nearest) + (mag-filter 'nearest) + (wrap-s 'repeat) + (wrap-t 'repeat)) + "Load a texture from an image in FILE. MIN-FILTER and MAG-FILTER +describe the method that should be used for minification and +magnification. Valid values are 'nearest and 'linear. By default, +'nearest is used." + (call-with-surface (sdl-image:load-image file) + (lambda (surface) + (surface->texture surface min-filter mag-filter wrap-s wrap-t)))) diff --git a/chickadee/render/vertex-buffer.scm b/chickadee/render/vertex-buffer.scm new file mode 100644 index 0000000..5286a44 --- /dev/null +++ b/chickadee/render/vertex-buffer.scm @@ -0,0 +1,261 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +;;; Commentary: +;; +;; Vertex buffers and vertex arrays. +;; +;;; Code: + +(define-module (chickadee render vertex-buffer) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-4) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (gl) + #:use-module (system foreign) + #:use-module (chickadee render gl) + #:use-module (chickadee render gpu) + #:export (make-vertex-buffer + make-streaming-vertex-buffer + vertex-buffer? + index-buffer? + vertex-buffer-type + vertex-buffer-usage + vertex-buffer-data + null-vertex-buffer + map-vertex-buffer! + unmap-vertex-buffer! + with-mapped-vertex-buffer + *vertex-buffer-state* + + make-vertex-array + vertex-array? + vertex-array-index-buffer + vertex-array-attribute-buffers + null-vertex-array + *vertex-array-state* + + render-vertices)) + +;;; +;;; Vertex Buffers +;;; + +(define-record-type + (%make-vertex-buffer id type usage data) + vertex-buffer? + (id vertex-buffer-id) + (type vertex-buffer-type) + (usage vertex-buffer-usage) + (data vertex-buffer-data set-vertex-buffer-data!)) + +(set-record-type-printer! + (lambda (vb port) + (format port + "#" + (vertex-buffer-type vb) + (vertex-buffer-usage vb)))) + +(define (index-buffer? vb) + "Return #t if VB is of type 'index'." + (eq? (vertex-buffer-type vb) 'index)) + +(define null-vertex-buffer (%make-vertex-buffer 0 #f 'static #f)) + +(define <> (class-of null-vertex-buffer)) + +(define (free-vertex-buffer vb) + (gl-delete-buffers 1 (u32vector (vertex-buffer-id vb)))) + +(define-method (gpu-finalize (vb <>)) + (free-vertex-buffer vb)) + +(define (vertex-buffer-length vb) + (bytevector-length (vertex-buffer-data vb))) + +(define (type-size type) + (match type + ((or 'float 'index) 1) + ('vec2 2) + ('vec3 3) + ('vec4 4))) + +(define (vertex-buffer-attribute-size vb) + (type-size (vertex-buffer-type vb))) + +(define (apply-vertex-buffer vb) + (gl-bind-buffer (vertex-buffer-target-gl vb) + (vertex-buffer-id vb))) + +(define *vertex-buffer-state* + (make-gpu-state apply-vertex-buffer null-vertex-buffer)) + +(define (vertex-buffer-target-gl vb) + (if (index-buffer? vb) + (arb-vertex-buffer-object element-array-buffer-arb) + (arb-vertex-buffer-object array-buffer-arb))) + +(define (vertex-buffer-usage-gl vb) + (match (vertex-buffer-usage vb) + ('static (arb-vertex-buffer-object static-draw-arb)) + ('stream (arb-vertex-buffer-object stream-draw-arb)))) + +(define (generate-vertex-buffer-gl) + (let ((bv (u32vector 1))) + (gl-gen-buffers 1 (bytevector->pointer bv)) + (u32vector-ref bv 0))) + +(define (make-vertex-buffer type usage bv) + "Upload BV, a bytevector of TYPE elements, to the GPU as a vertex +buffer. + +USAGE provides a hint to the GPU as to how the vertex buffer will be +used: + +- static: The vertex buffer will not be updated after creation. +- stream: The vertex buffer will be dynamically updated frequently." + ;; Weird bugs will occur when creating a new vertex buffer while a + ;; vertex array is bound. + (gpu-state-set! *vertex-array-state* null-vertex-array) + (let ((vb (gpu-guard + (%make-vertex-buffer (generate-vertex-buffer-gl) + type + usage + bv)))) + (gpu-state-set! *vertex-buffer-state* vb) + (gl-buffer-data (vertex-buffer-target-gl vb) + (bytevector-length bv) + (bytevector->pointer bv) + (vertex-buffer-usage-gl vb)) + (gpu-state-set! *vertex-buffer-state* null-vertex-buffer) + vb)) + +(define (make-streaming-vertex-buffer type length) + "Return a new vertex buffer of LENGTH elements suitable for +streaming data to the GPU every frame. TYPE is a symbol specifying +the element type, either 'float', 'index', 'vec2', 'vec3', or 'vec4'." + (make-vertex-buffer type 'stream + ;; TODO: Don't assume all numbers are 32-bit. + (make-bytevector (* (type-size type) length 4)))) + +(define (map-vertex-buffer! vb) + "Map the memory space for VB from the GPU to the CPU, allowing the +vertex buffer to be updated with new vertex data. The +'unmap-vertex-buffer!' procedure must be called to submit the new +vertex buffer data back to the GPU." + (let ((target (vertex-buffer-target-gl vb)) + (length (vertex-buffer-length vb)) + (usage (vertex-buffer-usage-gl vb))) + (gpu-state-set! *vertex-buffer-state* vb) + ;; Orphan the buffer to avoid implicit synchronization. + ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification + (gl-buffer-data target length %null-pointer usage) + (let ((ptr (gl-map-buffer target (version-1-5 read-write)))) + (set-vertex-buffer-data! vb (pointer->bytevector ptr length))))) + +(define (unmap-vertex-buffer! vb) + "Return the mapped vertex buffer data for VB to the GPU." + (gpu-state-set! *vertex-buffer-state* vb) + (gl-unmap-buffer (vertex-buffer-target-gl vb))) + +(define-syntax-rule (with-mapped-vertex-buffer vb body ...) + (dynamic-wind + (lambda () + (map-vertex-buffer! vb)) + (lambda () body ...) + (lambda () + (unmap-vertex-buffer! vb)))) + + +;;; +;;; Vertex Arrays +;;; + +(define-record-type + (%make-vertex-array id index-buffer attribute-buffers) + vertex-array? + (id vertex-array-id) + (index-buffer vertex-array-index-buffer) + (attribute-buffers vertex-array-attribute-buffers)) + +(set-record-type-printer! + (lambda (va port) + (format port + "#" + (vertex-array-index-buffer va) + (vertex-array-attribute-buffers va)))) + +(define null-vertex-array (%make-vertex-array 0 #f '())) + +(define <> (class-of null-vertex-array)) + +(define (generate-vertex-array) + (let ((bv (u32vector 1))) + (gl-gen-vertex-arrays 1 (bytevector->pointer bv)) + (u32vector-ref bv 0))) + +(define (free-vertex-array va) + (gl-delete-vertex-arrays 1 (u32vector (vertex-array-id va)))) + +(define-method (gpu-finalize (va <>)) + (free-vertex-array va)) + +(define (apply-vertex-array va) + (gl-bind-vertex-array (vertex-array-id va))) + +(define *vertex-array-state* + (make-gpu-state apply-vertex-array null-vertex-array)) + +(define (make-vertex-array index-buffer . attribute-buffers) + (let ((va (gpu-guard + (%make-vertex-array (generate-vertex-array) + index-buffer + attribute-buffers)))) + (gpu-state-set! *vertex-array-state* va) + ;; Configure all attribute buffers starting from attribute + ;; location 0. + (let loop ((attrs attribute-buffers) + (index 0)) + (match attrs + (() #f) + ((attr . rest) + (gl-enable-vertex-attrib-array index) + (gpu-state-set! *vertex-buffer-state* attr) + (gl-vertex-attrib-pointer index + (vertex-buffer-attribute-size attr) + (data-type float) + #f + 0 + %null-pointer) + (loop rest (1+ index))))) + (gpu-state-set! *vertex-buffer-state* index-buffer) + (gpu-state-set! *vertex-array-state* null-vertex-array) + va)) + +(define* (render-vertices #:optional count) + (gl-draw-elements (begin-mode triangles) + (or count + (u32vector-length + (vertex-buffer-data + (vertex-array-index-buffer + (gpu-state-ref *vertex-array-state*))))) + (data-type unsigned-int) + %null-pointer)) diff --git a/chickadee/window.scm b/chickadee/window.scm new file mode 100644 index 0000000..0ca94e4 --- /dev/null +++ b/chickadee/window.scm @@ -0,0 +1,89 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +(define-module (chickadee window) + #:use-module (ice-9 match) + #:use-module (srfi srfi-9) + #:use-module ((sdl2) #:prefix sdl2:) + #:use-module ((sdl2 events) #:prefix sdl2:) + #:use-module ((sdl2 video) #:prefix sdl2:) + #:export (open-window + close-window + window? + window-title + window-width + window-height + window-fullscreen? + with-window + swap-buffers)) + +(define-record-type + (make-window sdl-window gl-context) + window? + (sdl-window unwrap-window) + (gl-context window-gl-context)) + +(define* (open-window #:key + (title "Chickadee") + (width 640) + (height 480) + fullscreen?) + (sdl2:set-gl-attribute! 'context-major-version 3) + (sdl2:set-gl-attribute! 'context-minor-version 3) + (sdl2:set-gl-attribute! 'double-buffer 1) + (sdl2:set-gl-attribute! 'depth-size 24) + (sdl2:set-gl-attribute! 'red-size 8) + (sdl2:set-gl-attribute! 'green-size 8) + (sdl2:set-gl-attribute! 'blue-size 8) + (sdl2:set-gl-attribute! 'alpha-size 8) + (sdl2:set-gl-attribute! 'stencil-size 8) + (sdl2:set-gl-attribute! 'retained-backing 0) + (sdl2:set-gl-attribute! 'framebuffer-srgb-capable 1) + (let* ((sdl-window (sdl2:make-window #:opengl? #t + #:title title + #:size (list width height) + #:fullscreen? fullscreen?)) + (gl-context (sdl2:make-gl-context sdl-window)) + (window (make-window sdl-window gl-context))) + (sdl2:set-gl-swap-interval! 'vsync) + window)) + +(define (close-window! window) + "Close WINDOW." + (sdl2:delete-gl-context! (window-gl-context window)) + (sdl2:close-window! (unwrap-window window))) + +(define (window-title window) + "Return the title of WINDOW." + (sdl2:window-title (unwrap-window window))) + +(define (set-window-title! window title) + "Set TITLE for WINDOW." + (sdl2:set-window-title! (unwrap-window window) title)) + +(define (set-window-size! window width height) + (sdl2:set-window-size! (unwrap-window window) (list width height))) + +(define-syntax-rule (with-window window body ...) + (dynamic-wind + (const #t) + (lambda () body ...) + (lambda () + (close-window! window)))) + +(define (swap-buffers window) + (sdl2:swap-gl-window (unwrap-window window))) diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..d3ced53 --- /dev/null +++ b/configure.ac @@ -0,0 +1,26 @@ +dnl -*- Autoconf -*- + +AC_INIT(chickadee, 0.1.0) +AC_CONFIG_SRCDIR(chickadee) +AC_CONFIG_AUX_DIR([build-aux]) +AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign]) +AM_SILENT_RULES([yes]) + +AC_PATH_PROG([GUILE], [guile]) +AC_CONFIG_FILES([Makefile]) +AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) +AC_CONFIG_FILES([chickadee/config.scm]) + +# Prepare a version of $datadir that does not contain references to +# shell variables. +chickadee_prefix="`eval echo $prefix | sed -e"s|NONE|/usr/local|g"`" +chickadee_datadir="`eval eval echo $datadir | sed -e "s|NONE|$chickadee_prefix|g"`" +AC_SUBST([chickadee_datadir]) + +GUILE_PKG([2.2 2.0]) +GUILE_PROGS + +GUILE_MODULE_REQUIRED([gl]) +GUILE_MODULE_REQUIRED([sdl2]) + +AC_OUTPUT diff --git a/doc/chickadee.texi b/doc/chickadee.texi new file mode 100644 index 0000000..7e9362f --- /dev/null +++ b/doc/chickadee.texi @@ -0,0 +1,104 @@ +\input texinfo @c -*-texinfo-*- +@c %**start of header +@setfilename chickadee.info +@settitle The Chickadee Game Toolkit +@c %**end of header +@copying +Copyright @copyright{} 2016 David Thompson @email{davet@@gnu.org} + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 +or any later version published by the Free Software Foundation; +with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. +A copy of the license is included in the section entitled ``GNU +Free Documentation License''. + +A copy of the license is also available from the Free Software +Foundation Web site at @url{http://www.gnu.org/licenses/fdl.html}. + +@end quotation + +The document was typeset with +@uref{http://www.texinfo.org/, GNU Texinfo}. + +@end copying + +@titlepage +@title Chickadee 0.1 +@subtitle Using the Chickadee game toolkit +@author David Thompson +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@c Output the table of the contents at the beginning. +@contents + +@ifnottex +@node Top +@top Chickadee + +@insertcopying +@end ifnottex + +@c Generate the nodes for this menu with `C-c C-u C-m'. +@menu +* Installation:: Installing Chickadee. + +* Copying This Manual:: The GNU Free Documentation License and you! +* Index:: +@end menu + +@c Update all node entries with `C-c C-u C-n'. +@c Insert new nodes with `C-c C-c n'. + +@node Installation +@chapter Installation + +Chickadee is available for download from its website at +@url{dthompson.us/projects/chickadee.html}. This section describes +the software requirements of Chickadee, as well as how to install it. + +The build procedure for Chickadee is the same as for GNU software packages, +and is not covered here. Please see the files @file{README.org} and +@file{INSTALL.org} for additional details. + +@menu +* Requirements:: Software needed to build and run Chickadee. +@end menu + +@node Requirements +@section Requirements + +Chickadee depends on the following packages: + +@itemize +@item @url{https://gnu.org/software/guile, GNU Guile}, version 2.0.11 or later; +@item @url{https://gnu.org/software/guile-opengl, GNU guile-opengl}, version 0.1 or later. +@item @url{https://dthompson.us/pages/software/guile-sdl2.html, guile-sdl2}, version 0.2.0 or later; +@end itemize + +@node Copying This Manual +@appendix Copying This Manual + +@menu +* GNU Free Documentation License:: License for copying this manual. +@end menu + +@c Get fdl.texi from http://www.gnu.org/licenses/fdl.html +@node GNU Free Documentation License +@section GNU Free Documentation License +@include fdl.texi + +@node Index +@unnumbered Index + +@syncodeindex tp fn +@syncodeindex vr fn +@printindex fn + +@bye + +@c chickadee.texi ends here diff --git a/doc/fdl.texi b/doc/fdl.texi new file mode 100644 index 0000000..9c3bbe5 --- /dev/null +++ b/doc/fdl.texi @@ -0,0 +1,505 @@ +@c The GNU Free Documentation License. +@center Version 1.3, 3 November 2008 + +@c This file is intended to be included within another document, +@c hence no sectioning command or @node. + +@display +Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. +@uref{http://fsf.org/} + +Everyone is permitted to copy and distribute verbatim copies +of this license document, but changing it is not allowed. +@end display + +@enumerate 0 +@item +PREAMBLE + +The purpose of this License is to make a manual, textbook, or other +functional and useful document @dfn{free} in the sense of freedom: to +assure everyone the effective freedom to copy and redistribute it, +with or without modifying it, either commercially or noncommercially. +Secondarily, this License preserves for the author and publisher a way +to get credit for their work, while not being considered responsible +for modifications made by others. + +This License is a kind of ``copyleft'', which means that derivative +works of the document must themselves be free in the same sense. It +complements the GNU General Public License, which is a copyleft +license designed for free software. + +We have designed this License in order to use it for manuals for free +software, because free software needs free documentation: a free +program should come with manuals providing the same freedoms that the +software does. But this License is not limited to software manuals; +it can be used for any textual work, regardless of subject matter or +whether it is published as a printed book. We recommend this License +principally for works whose purpose is instruction or reference. + +@item +APPLICABILITY AND DEFINITIONS + +This License applies to any manual or other work, in any medium, that +contains a notice placed by the copyright holder saying it can be +distributed under the terms of this License. Such a notice grants a +world-wide, royalty-free license, unlimited in duration, to use that +work under the conditions stated herein. The ``Document'', below, +refers to any such manual or work. Any member of the public is a +licensee, and is addressed as ``you''. You accept the license if you +copy, modify or distribute the work in a way requiring permission +under copyright law. + +A ``Modified Version'' of the Document means any work containing the +Document or a portion of it, either copied verbatim, or with +modifications and/or translated into another language. + +A ``Secondary Section'' is a named appendix or a front-matter section +of the Document that deals exclusively with the relationship of the +publishers or authors of the Document to the Document's overall +subject (or to related matters) and contains nothing that could fall +directly within that overall subject. (Thus, if the Document is in +part a textbook of mathematics, a Secondary Section may not explain +any mathematics.) The relationship could be a matter of historical +connection with the subject or with related matters, or of legal, +commercial, philosophical, ethical or political position regarding +them. + +The ``Invariant Sections'' are certain Secondary Sections whose titles +are designated, as being those of Invariant Sections, in the notice +that says that the Document is released under this License. If a +section does not fit the above definition of Secondary then it is not +allowed to be designated as Invariant. The Document may contain zero +Invariant Sections. If the Document does not identify any Invariant +Sections then there are none. + +The ``Cover Texts'' are certain short passages of text that are listed, +as Front-Cover Texts or Back-Cover Texts, in the notice that says that +the Document is released under this License. A Front-Cover Text may +be at most 5 words, and a Back-Cover Text may be at most 25 words. + +A ``Transparent'' copy of the Document means a machine-readable copy, +represented in a format whose specification is available to the +general public, that is suitable for revising the document +straightforwardly with generic text editors or (for images composed of +pixels) generic paint programs or (for drawings) some widely available +drawing editor, and that is suitable for input to text formatters or +for automatic translation to a variety of formats suitable for input +to text formatters. A copy made in an otherwise Transparent file +format whose markup, or absence of markup, has been arranged to thwart +or discourage subsequent modification by readers is not Transparent. +An image format is not Transparent if used for any substantial amount +of text. A copy that is not ``Transparent'' is called ``Opaque''. + +Examples of suitable formats for Transparent copies include plain +ASCII without markup, Texinfo input format, La@TeX{} input +format, SGML or XML using a publicly available +DTD, and standard-conforming simple HTML, +PostScript or PDF designed for human modification. Examples +of transparent image formats include PNG, XCF and +JPG@. Opaque formats include proprietary formats that can be +read and edited only by proprietary word processors, SGML or +XML for which the DTD and/or processing tools are +not generally available, and the machine-generated HTML, +PostScript or PDF produced by some word processors for +output purposes only. + +The ``Title Page'' means, for a printed book, the title page itself, +plus such following pages as are needed to hold, legibly, the material +this License requires to appear in the title page. For works in +formats which do not have any title page as such, ``Title Page'' means +the text near the most prominent appearance of the work's title, +preceding the beginning of the body of the text. + +The ``publisher'' means any person or entity that distributes copies +of the Document to the public. + +A section ``Entitled XYZ'' means a named subunit of the Document whose +title either is precisely XYZ or contains XYZ in parentheses following +text that translates XYZ in another language. (Here XYZ stands for a +specific section name mentioned below, such as ``Acknowledgements'', +``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title'' +of such a section when you modify the Document means that it remains a +section ``Entitled XYZ'' according to this definition. + +The Document may include Warranty Disclaimers next to the notice which +states that this License applies to the Document. These Warranty +Disclaimers are considered to be included by reference in this +License, but only as regards disclaiming warranties: any other +implication that these Warranty Disclaimers may have is void and has +no effect on the meaning of this License. + +@item +VERBATIM COPYING + +You may copy and distribute the Document in any medium, either +commercially or noncommercially, provided that this License, the +copyright notices, and the license notice saying this License applies +to the Document are reproduced in all copies, and that you add no other +conditions whatsoever to those of this License. You may not use +technical measures to obstruct or control the reading or further +copying of the copies you make or distribute. However, you may accept +compensation in exchange for copies. If you distribute a large enough +number of copies you must also follow the conditions in section 3. + +You may also lend copies, under the same conditions stated above, and +you may publicly display copies. + +@item +COPYING IN QUANTITY + +If you publish printed copies (or copies in media that commonly have +printed covers) of the Document, numbering more than 100, and the +Document's license notice requires Cover Texts, you must enclose the +copies in covers that carry, clearly and legibly, all these Cover +Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on +the back cover. Both covers must also clearly and legibly identify +you as the publisher of these copies. The front cover must present +the full title with all words of the title equally prominent and +visible. You may add other material on the covers in addition. +Copying with changes limited to the covers, as long as they preserve +the title of the Document and satisfy these conditions, can be treated +as verbatim copying in other respects. + +If the required texts for either cover are too voluminous to fit +legibly, you should put the first ones listed (as many as fit +reasonably) on the actual cover, and continue the rest onto adjacent +pages. + +If you publish or distribute Opaque copies of the Document numbering +more than 100, you must either include a machine-readable Transparent +copy along with each Opaque copy, or state in or with each Opaque copy +a computer-network location from which the general network-using +public has access to download using public-standard network protocols +a complete Transparent copy of the Document, free of added material. +If you use the latter option, you must take reasonably prudent steps, +when you begin distribution of Opaque copies in quantity, to ensure +that this Transparent copy will remain thus accessible at the stated +location until at least one year after the last time you distribute an +Opaque copy (directly or through your agents or retailers) of that +edition to the public. + +It is requested, but not required, that you contact the authors of the +Document well before redistributing any large number of copies, to give +them a chance to provide you with an updated version of the Document. + +@item +MODIFICATIONS + +You may copy and distribute a Modified Version of the Document under +the conditions of sections 2 and 3 above, provided that you release +the Modified Version under precisely this License, with the Modified +Version filling the role of the Document, thus licensing distribution +and modification of the Modified Version to whoever possesses a copy +of it. In addition, you must do these things in the Modified Version: + +@enumerate A +@item +Use in the Title Page (and on the covers, if any) a title distinct +from that of the Document, and from those of previous versions +(which should, if there were any, be listed in the History section +of the Document). You may use the same title as a previous version +if the original publisher of that version gives permission. + +@item +List on the Title Page, as authors, one or more persons or entities +responsible for authorship of the modifications in the Modified +Version, together with at least five of the principal authors of the +Document (all of its principal authors, if it has fewer than five), +unless they release you from this requirement. + +@item +State on the Title page the name of the publisher of the +Modified Version, as the publisher. + +@item +Preserve all the copyright notices of the Document. + +@item +Add an appropriate copyright notice for your modifications +adjacent to the other copyright notices. + +@item +Include, immediately after the copyright notices, a license notice +giving the public permission to use the Modified Version under the +terms of this License, in the form shown in the Addendum below. + +@item +Preserve in that license notice the full lists of Invariant Sections +and required Cover Texts given in the Document's license notice. + +@item +Include an unaltered copy of this License. + +@item +Preserve the section Entitled ``History'', Preserve its Title, and add +to it an item stating at least the title, year, new authors, and +publisher of the Modified Version as given on the Title Page. If +there is no section Entitled ``History'' in the Document, create one +stating the title, year, authors, and publisher of the Document as +given on its Title Page, then add an item describing the Modified +Version as stated in the previous sentence. + +@item +Preserve the network location, if any, given in the Document for +public access to a Transparent copy of the Document, and likewise +the network locations given in the Document for previous versions +it was based on. These may be placed in the ``History'' section. +You may omit a network location for a work that was published at +least four years before the Document itself, or if the original +publisher of the version it refers to gives permission. + +@item +For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve +the Title of the section, and preserve in the section all the +substance and tone of each of the contributor acknowledgements and/or +dedications given therein. + +@item +Preserve all the Invariant Sections of the Document, +unaltered in their text and in their titles. Section numbers +or the equivalent are not considered part of the section titles. + +@item +Delete any section Entitled ``Endorsements''. Such a section +may not be included in the Modified Version. + +@item +Do not retitle any existing section to be Entitled ``Endorsements'' or +to conflict in title with any Invariant Section. + +@item +Preserve any Warranty Disclaimers. +@end enumerate + +If the Modified Version includes new front-matter sections or +appendices that qualify as Secondary Sections and contain no material +copied from the Document, you may at your option designate some or all +of these sections as invariant. To do this, add their titles to the +list of Invariant Sections in the Modified Version's license notice. +These titles must be distinct from any other section titles. + +You may add a section Entitled ``Endorsements'', provided it contains +nothing but endorsements of your Modified Version by various +parties---for example, statements of peer review or that the text has +been approved by an organization as the authoritative definition of a +standard. + +You may add a passage of up to five words as a Front-Cover Text, and a +passage of up to 25 words as a Back-Cover Text, to the end of the list +of Cover Texts in the Modified Version. Only one passage of +Front-Cover Text and one of Back-Cover Text may be added by (or +through arrangements made by) any one entity. If the Document already +includes a cover text for the same cover, previously added by you or +by arrangement made by the same entity you are acting on behalf of, +you may not add another; but you may replace the old one, on explicit +permission from the previous publisher that added the old one. + +The author(s) and publisher(s) of the Document do not by this License +give permission to use their names for publicity for or to assert or +imply endorsement of any Modified Version. + +@item +COMBINING DOCUMENTS + +You may combine the Document with other documents released under this +License, under the terms defined in section 4 above for modified +versions, provided that you include in the combination all of the +Invariant Sections of all of the original documents, unmodified, and +list them all as Invariant Sections of your combined work in its +license notice, and that you preserve all their Warranty Disclaimers. + +The combined work need only contain one copy of this License, and +multiple identical Invariant Sections may be replaced with a single +copy. If there are multiple Invariant Sections with the same name but +different contents, make the title of each such section unique by +adding at the end of it, in parentheses, the name of the original +author or publisher of that section if known, or else a unique number. +Make the same adjustment to the section titles in the list of +Invariant Sections in the license notice of the combined work. + +In the combination, you must combine any sections Entitled ``History'' +in the various original documents, forming one section Entitled +``History''; likewise combine any sections Entitled ``Acknowledgements'', +and any sections Entitled ``Dedications''. You must delete all +sections Entitled ``Endorsements.'' + +@item +COLLECTIONS OF DOCUMENTS + +You may make a collection consisting of the Document and other documents +released under this License, and replace the individual copies of this +License in the various documents with a single copy that is included in +the collection, provided that you follow the rules of this License for +verbatim copying of each of the documents in all other respects. + +You may extract a single document from such a collection, and distribute +it individually under this License, provided you insert a copy of this +License into the extracted document, and follow this License in all +other respects regarding verbatim copying of that document. + +@item +AGGREGATION WITH INDEPENDENT WORKS + +A compilation of the Document or its derivatives with other separate +and independent documents or works, in or on a volume of a storage or +distribution medium, is called an ``aggregate'' if the copyright +resulting from the compilation is not used to limit the legal rights +of the compilation's users beyond what the individual works permit. +When the Document is included in an aggregate, this License does not +apply to the other works in the aggregate which are not themselves +derivative works of the Document. + +If the Cover Text requirement of section 3 is applicable to these +copies of the Document, then if the Document is less than one half of +the entire aggregate, the Document's Cover Texts may be placed on +covers that bracket the Document within the aggregate, or the +electronic equivalent of covers if the Document is in electronic form. +Otherwise they must appear on printed covers that bracket the whole +aggregate. + +@item +TRANSLATION + +Translation is considered a kind of modification, so you may +distribute translations of the Document under the terms of section 4. +Replacing Invariant Sections with translations requires special +permission from their copyright holders, but you may include +translations of some or all Invariant Sections in addition to the +original versions of these Invariant Sections. You may include a +translation of this License, and all the license notices in the +Document, and any Warranty Disclaimers, provided that you also include +the original English version of this License and the original versions +of those notices and disclaimers. In case of a disagreement between +the translation and the original version of this License or a notice +or disclaimer, the original version will prevail. + +If a section in the Document is Entitled ``Acknowledgements'', +``Dedications'', or ``History'', the requirement (section 4) to Preserve +its Title (section 1) will typically require changing the actual +title. + +@item +TERMINATION + +You may not copy, modify, sublicense, or distribute the Document +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense, or distribute it is void, and +will automatically terminate your rights under this License. + +However, if you cease all violation of this License, then your license +from a particular copyright holder is reinstated (a) provisionally, +unless and until the copyright holder explicitly and finally +terminates your license, and (b) permanently, if the copyright holder +fails to notify you of the violation by some reasonable means prior to +60 days after the cessation. + +Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + +Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, receipt of a copy of some or all of the same material does +not give you any rights to use it. + +@item +FUTURE REVISIONS OF THIS LICENSE + +The Free Software Foundation may publish new, revised versions +of the GNU Free Documentation License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. See +@uref{http://www.gnu.org/copyleft/}. + +Each version of the License is given a distinguishing version number. +If the Document specifies that a particular numbered version of this +License ``or any later version'' applies to it, you have the option of +following the terms and conditions either of that specified version or +of any later version that has been published (not as a draft) by the +Free Software Foundation. If the Document does not specify a version +number of this License, you may choose any version ever published (not +as a draft) by the Free Software Foundation. If the Document +specifies that a proxy can decide which future versions of this +License can be used, that proxy's public statement of acceptance of a +version permanently authorizes you to choose that version for the +Document. + +@item +RELICENSING + +``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any +World Wide Web server that publishes copyrightable works and also +provides prominent facilities for anybody to edit those works. A +public wiki that anybody can edit is an example of such a server. A +``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the +site means any set of copyrightable works thus published on the MMC +site. + +``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0 +license published by Creative Commons Corporation, a not-for-profit +corporation with a principal place of business in San Francisco, +California, as well as future copyleft versions of that license +published by that same organization. + +``Incorporate'' means to publish or republish a Document, in whole or +in part, as part of another Document. + +An MMC is ``eligible for relicensing'' if it is licensed under this +License, and if all works that were first published under this License +somewhere other than this MMC, and subsequently incorporated in whole +or in part into the MMC, (1) had no cover texts or invariant sections, +and (2) were thus incorporated prior to November 1, 2008. + +The operator of an MMC Site may republish an MMC contained in the site +under CC-BY-SA on the same site at any time before August 1, 2009, +provided the MMC is eligible for relicensing. + +@end enumerate + +@page +@heading ADDENDUM: How to use this License for your documents + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and +license notices just after the title page: + +@smallexample +@group + Copyright (C) @var{year} @var{your name}. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. +@end group +@end smallexample + +If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, +replace the ``with@dots{}Texts.''@: line with this: + +@smallexample +@group + with the Invariant Sections being @var{list their titles}, with + the Front-Cover Texts being @var{list}, and with the Back-Cover Texts + being @var{list}. +@end group +@end smallexample + +If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + +If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of +free software license, such as the GNU General Public License, +to permit their use in free software. + +@c Local Variables: +@c ispell-local-pdict: "ispell-dict" +@c End: diff --git a/guix.scm b/guix.scm new file mode 100644 index 0000000..5653a36 --- /dev/null +++ b/guix.scm @@ -0,0 +1,139 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2016 David Thompson +;;; +;;; 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 +;;; . + +;;; Commentary: +;; +;; Development environment for GNU Guix. +;; +;; To setup the development environment, run the following: +;; +;; guix environment -l guix.scm +;; ./bootstrap && ./configure; +;; +;; To build the development snapshot, run: +;; +;; guix build -f guix.scm +;; +;; To install the development snapshot, run: +;; +;; guix install -f guix.scm +;; +;;; Code: + +(use-modules (ice-9 match) + (srfi srfi-1) + (guix packages) + (guix licenses) + (guix git-download) + (guix build-system gnu) + (gnu packages) + (gnu packages autotools) + (gnu packages pkg-config) + (gnu packages texinfo) + (gnu packages guile) + (gnu packages gl) + (gnu packages sdl) + (gnu packages maths) + (gnu packages image)) + +(define (package-with-guile p guile) + (package + (inherit p) + (inputs + (map (match-lambda + (("guile" _) + `("guile" ,guile)) + (input input)) + (package-inputs p))))) + +(define (package-with-guile-next p) + (package-with-guile p guile-next)) + +(define guile-sdl2 + (let ((commit "9ec24e3f997e40ebde5e8b0057e0324e21fd93a4")) + (package + (name "guile-sdl2") + (version (string-append "0.1.2-1." (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "git://dthompson.us/guile-sdl2.git") + (commit commit))) + (file-name (string-append name "-" version "-checkout")) + (sha256 + (base32 + "1aczhrg5s83242hlj6i258axf8cr8a2pvp1kdfk55cr4gf1ajf5x")))) + (build-system gnu-build-system) + (arguments + '(#:configure-flags + (list (string-append "--with-libsdl2-prefix=" + (assoc-ref %build-inputs "sdl2")) + (string-append "--with-libsdl2-image-prefix=" + (assoc-ref %build-inputs "sdl2-image")) + (string-append "--with-libsdl2-ttf-prefix=" + (assoc-ref %build-inputs "sdl2-ttf")) + (string-append "--with-libsdl2-mixer-prefix=" + (assoc-ref %build-inputs "sdl2-mixer"))) + #:make-flags '("GUILE_AUTO_COMPILE=0") + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ (zero? (system* "sh" "bootstrap")))) + (add-after 'configure 'patch-makefile + (lambda _ + ;; Install compiled Guile files in the expected place. + (substitute* '("Makefile") + (("^godir = .*$") + "godir = $(moddir)\n"))))))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo))) + (inputs + `(("guile" ,guile-next) + ("sdl2" ,sdl2) + ("sdl2-image" ,sdl2-image) + ("sdl2-mixer" ,sdl2-mixer) + ("sdl2-ttf" ,sdl2-ttf))) + (synopsis "Guile bindings for SDL2") + (description "Guile-sdl2 provides pure Guile Scheme bindings to the +SDL2 C shared library via the foreign function interface.") + (home-page "https://git.dthompson.us/guile-sdl2.git") + (license lgpl3+)))) + +(package + (name "chickadee") + (version "0.1") + (source #f) + (build-system gnu-build-system) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo))) + (inputs + `(("guile" ,guile-next))) + (propagated-inputs + `(("guile-opengl" ,(package-with-guile-next guile-opengl)) + ("guile-sdl2" ,(package-with-guile-next guile-sdl2)))) + (synopsis "Game development toolkit for Guile Scheme") + (description "Chickadee is a game development toolkit for Guile +Scheme. It contains all of the basic components needed to develop +2D/3D video games.") + (home-page "https://dthompson.us/projects/chickadee.html") + (license gpl3+)) diff --git a/pre-inst-env.in b/pre-inst-env.in new file mode 100644 index 0000000..d06155f --- /dev/null +++ b/pre-inst-env.in @@ -0,0 +1,32 @@ +#!/bin/sh + +# Chickadee Game Toolkit +# Copyright © 2016 David Thompson +# +# 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 Chickadee. If not, see . + +abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" +abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" + +GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" +GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" +export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH + +PATH="$abs_top_builddir/scripts:$PATH" +export PATH + +CHICKADEE_DATADIR="$abs_top_builddir/assets" +export CHICKADEE_DATADIR + +exec "$@" -- cgit v1.2.3