From 8840ca1b1dd205ab2f59cb603e54e2475ce0c884 Mon Sep 17 00:00:00 2001 From: Vivianne Langdon Date: Tue, 11 Jul 2023 01:56:03 -0700 Subject: [PATCH] Very much wip, added lots of stuff mostly adapted from comm. garden --- gib-gab-gob/ui/catbird.scm | 144 +++++++++++++++++++++++++ gib-gab-gob/util/chickadee-vat.scm | 38 +++++++ guix.scm | 168 ++++++++++++++++++++++++++--- hall.scm | 5 +- 4 files changed, 338 insertions(+), 17 deletions(-) create mode 100644 gib-gab-gob/ui/catbird.scm create mode 100644 gib-gab-gob/util/chickadee-vat.scm diff --git a/gib-gab-gob/ui/catbird.scm b/gib-gab-gob/ui/catbird.scm new file mode 100644 index 0000000..96e7b68 --- /dev/null +++ b/gib-gab-gob/ui/catbird.scm @@ -0,0 +1,144 @@ +(define-module (gib-gab-gob ui catbird) + #:use-module (catbird) + #:use-module (catbird input-map) + #:use-module (catbird mode) + #:use-module (catbird node) + #:use-module (catbird node-2d) + #:use-module (catbird region) + #:use-module ((catbird scene) + #:select ( current-scene replace-major-mode)) + #:use-module (chickadee) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics texture) + #:use-module (chickadee math vector) + #:use-module (chickadee scripting) + #:use-module (oop goops)) + +(define %window-width 1024) +(define %window-height 768) + +(define %tile-width 64.0) +(define %tile-height 64.0) + +(define-class () + (tile-x #:getter tile-x #:init-keyword #:tile-x) + (tile-y #:getter tile-y #:init-keyword #:tile-y)) + +(define-class () + (vat #:getter vat #:init-keyword #:vat) + (board #:getter board #:init-keyword #:board) + (tiles #:accessor tiles #:init-value #())) + +(define-method (on-boot (board-view )) + (define tile-container + (make + #:name 'tile-container + #:rank 1)) + (define background + (make + #:name 'background + #:painter + (with-style ((fill-color db32-elf-green)) + (fill + rectangle (vec2 0.0 0.0) + %window-width + %window-height)))) + (resize board-view %window-width %window-height) + (attach-to board-view tile-container)) + +(define-method (tile-ref (garden ) x y) + (vector-ref (vector-ref (tiles garden) y) x)) + +(define-method (rebuild-tiles (board-view )) + (let* ((container (& board-view tile-container))) + (for-each-tile + (λ (x y tile) + (detach tile)) + (tiles board-view)) + (set! (tiles garden) + (vector-unfold + (λ (y) + (vector-unfold + (λ (x) + (let* ((painter (with-style + ((fill-color db32-rope) + (stroke-color db32-oiled-cedar)) + (fill-and-stroke + (rectangle (vec2 0.0 0.0) + %tile-width %tile-height)))) + (bg (make + #:name 'background + #:painter painter)) + (sprite (make + #:name 'sprite + #:texture null-texture)) + (tile (make + #:tile-x x + #:tile-y y))) + (set! (width tile) %tile-width) + (set! (height tile) %tile-height) + (attach-to tile bg sprite) + (attach-to container tile) + tile)) + 3)) + 3)) + (for-each-tile + (λ (x y tile) + (if (= y 0) + (set! (position-y tile) + (* %tile-height (- 3 1))) + (place-below (tile-ref board-view x (- y 1)) tile)) + (unless (= x 0) + (place-right (tile-ref board-view (- x 1) y) tile))) + (tiles board-view)) + (set! (width container) (* 3 %tile-width)) + (set! (height container) (* 3 %tile-height)) + (center-in-parent container))) + +(define (for-each-tile proc tiles) + (vector-for-each + (lambda (y row) + (vector-for-each + (lambda (x tile) + (proc x y tile)) + row)) + tiles)) + +(define-method (board-pick (board ) x y) + (define (find-tile node) + (cond + ((not node) + #f) + ((is-a? node ) + node) + ((parent node) + (find-tile (parent node))) + (else #f))) + (find-tile (pick board (vec2 x y) (lambda _ #t)))) + +(define-class ()) + +(define-method (make-move (mode ) x y) + (define board (& (current-scene) root board)) + (define node (board-pick board x y)) + (cond + ((is-a? node ) + (board-make-move board node)))) + +(bind-input (mouse-press 'left) make-move) + +(define* (launch-game node-thunk) + (run-catbird + (lambda () + (let ((region (create-full-region #:name 'main)) + (scene (make #:name 'board))) + (replace-scene region scene) + (replace-major-mode scene (make )) + (set! (camera region) + (make + #:width %window-width + #:height %window-height)) + (attach-to scene (node-thunk)))) + #:title "Gib Gab Gob" + #:width %window-width + #:height %window-height)) diff --git a/gib-gab-gob/util/chickadee-vat.scm b/gib-gab-gob/util/chickadee-vat.scm new file mode 100644 index 0000000..afef6ab --- /dev/null +++ b/gib-gab-gob/util/chickadee-vat.scm @@ -0,0 +1,38 @@ +(define-module (gib-gab-gob util chickadee-vat) + #:use-module (chickadee) + #:use-module (chickadee scripting) + #:use-module (community-garden concurrent-queue) + #:use-module (goblins vat) + #:use-module (ice-9 match) + #:export (make-chickadee-vat)) + +(define* (make-chickadee-vat #:key (name 'chickadee) + (agenda (current-agenda))) + (define vat-script #f) + (define message-queue (make-concurrent-queue)) + (define (start churn) + (define (handle-messages) + (if (concurrent-queue-empty? message-queue) + (begin + (sleep (current-timestep))) + (match (concurrent-dequeue! message-queue) + ((msg return-channel) + (channel-put return-channel (churn msg))) + (msg + (churn msg)))) + (handle-messages)) + (with-agenda agenda + (set! vat-script (script (handle-messages))))) + (define (halt) + (cancel-script vat-script)) + (define (send msg return?) + (if return? + (let ((return-channel (make-channel))) + (concurrent-enqueue! message-queue (list msg return-channel)) + (channel-get return-channel)) + (begin + (concurrent-enqueue! message-queue msg)))) + (make-vat #:name name + #:start start + #:halt halt + #:send send)) diff --git a/guix.scm b/guix.scm index 74d1a9d..1df2f83 100644 --- a/guix.scm +++ b/guix.scm @@ -1,25 +1,161 @@ (use-modules - (guix packages) - ((guix licenses) #:prefix license:) - (guix download) - (guix build-system gnu) - (guix gexp) - (gnu packages) - (gnu packages autotools) - (gnu packages guile) - (gnu packages guile-xyz) - (gnu packages pkg-config) - (gnu packages texinfo) - (srfi srfi-1)) + (srfi srfi-1) + (guix packages) + ((guix licenses) #:prefix license:) + (guix git-download) + (guix build-system gnu) + (guix gexp) + (guix utils) + (gnu packages) + (gnu packages audio) + (gnu packages autotools) + (gnu packages fontutils) + (gnu packages gl) + (gnu packages guile) + (gnu packages guile-xyz) + (gnu packages image) + (gnu packages maths) + (gnu packages mp3) + (gnu packages pkg-config) + (gnu packages readline) + (gnu packages sdl) + (gnu packages texinfo) + (gnu packages xiph)) (define (keep-file? file stat) (not (any (lambda (my-string) (string-contains file my-string)) (list ".git" ".dir-locals.el" "guix.scm")))) +(define target-guile guile-3.0-latest) + +(define guile3.0-opengl + (package + (inherit guile-opengl) + (inputs + (modify-inputs (package-inputs guile-opengl) + (replace "guile" target-guile))) + (native-inputs + (modify-inputs (package-native-inputs guile-opengl) + (append autoconf automake))) + (arguments + (substitute-keyword-arguments (package-arguments guile-opengl) + ((#:phases phases) + `(modify-phases ,phases + (delete 'patch-makefile) + (add-before 'bootstrap 'patch-configure.ac + (lambda _ + ;; The Guile version check doesn't work for the 3.0 + ;; pre-release, so just remove it. + (substitute* "configure.ac" + (("GUILE_PKG\\(\\[2.2 2.0\\]\\)") "")) + (substitute* "Makefile.am" + (("\\$\\(GUILE_EFFECTIVE_VERSION\\)") "3.0") + (("ccache") "site-ccache")) + #t)) + (replace 'bootstrap + (lambda _ + (invoke "autoreconf" "-vfi"))))))))) + +(define guile-sdl2 + (let ((commit "e9a7f5e748719ce5b6ccd08ff91861b578034ea6")) + (package + (name "guile-sdl2") + (version (string-append "0.7.0-1." (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://git.dthompson.us/guile-sdl2.git") + (commit commit))) + (sha256 + (base32 + "0ay7mcar8zs0j5rihwlzi0l46vgg9i93piip4v8a3dzwjx3myr7v")))) + (build-system gnu-build-system) + (arguments + '(#:make-flags '("GUILE_AUTO_COMPILE=0") + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ + (invoke "sh" "bootstrap")))))) + (native-inputs (list autoconf automake pkg-config texinfo)) + (inputs (list target-guile sdl2)) + (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 license:lgpl3+)))) + +(define chickadee + (let ((commit "1759fa0a056f99a61867c393708c210b37af712f")) + (package + (name "chickadee") + (version (string-append "0.10.0." (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://git.dthompson.us/chickadee.git") + (commit commit))) + (sha256 + (base32 + "1vik96bm3qp9hjlhxh4p7cjsdqf1by8i1cd023wvk8dr6anrnfld")))) + (build-system gnu-build-system) + (arguments + '(#:make-flags '("GUILE_AUTO_COMPILE=0") + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ + (invoke "sh" "bootstrap")))))) + (native-inputs (list autoconf automake pkg-config texinfo)) + (inputs (list freetype + libjpeg-turbo + libpng + libvorbis + mpg123 + openal + readline + target-guile)) + (propagated-inputs (list guile3.0-opengl 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 license:gpl3+)))) + +(define catbird + (let ((commit "fa6a85b92f818f1e0139a33ca4110acc97f8d4f2")) + (package + (name "catbird") + (version (string-append "0.1.0-1." (string-take commit 7))) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://git.dthompson.us/catbird.git") + (commit commit))) + (sha256 + (base32 + "0jhsf1idrq433x4l10yfzkmd68k5y1ypsfzqpmh1rv6clczxyszf")))) + (build-system gnu-build-system) + (arguments + '(#:make-flags '("GUILE_AUTO_COMPILE=0") + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ + (invoke "sh" "bootstrap")))))) + (native-inputs (list autoconf automake pkg-config texinfo)) + (inputs (list target-guile)) + (propagated-inputs (list chickadee guile-sdl2)) + (synopsis "Game engine for Scheme programmers") + (description "Catbird is a game engine written in Guile Scheme.") + (home-page "https://dthompson.us/projects/chickadee.html") + (license license:gpl3+)))) + (package (name "gib-gab-gob") - (version "0.1") + (version "0.2") (source (local-file (dirname (current-filename)) #:recursive? #t #:select? keep-file?)) @@ -60,7 +196,7 @@ (string-append (assoc-ref inputs input) path)) - ,''("guile-goblins")))))) + ,''("guile-goblins", "chickadee", "catbird")))))) (out (assoc-ref outputs "out")) (bin (string-append out "/bin/")) (site (uncompiled-dir out ""))) @@ -87,7 +223,9 @@ ("texinfo" ,texinfo))) (inputs `(("guile" ,guile-3.0))) (propagated-inputs - `(("guile-goblins" ,guile-goblins))) + `(("guile-goblins" ,guile-goblins) + ("chickadee" ,chickadee) + ("catbird" ,catbird))) (synopsis "Rock Paper Scissors and Tic Tac Toe in Goblins!") (description diff --git a/hall.scm b/hall.scm index 2418a90..e5dfdb3 100644 --- a/hall.scm +++ b/hall.scm @@ -1,7 +1,7 @@ (hall-description (name "gib-gab-gob") (prefix "") - (version "0.1") + (version "0.2") (author "Vivi Langdon") (copyright (2023)) (synopsis @@ -11,7 +11,8 @@ (home-page "https://solarpunk.moe") (license gpl3+) (dependencies - `(("guile-goblins" (goblins) ,guile-goblins))) + `(("guile-goblins" (goblins) ,guile-goblins) + ("chickadee" (chickadee) ,chickadee))) (skip ()) (files (libraries ((directory