vv
/
gib-gab-gob
1
0
Fork 1
Code Issues Pull Requests Activity

Very much wip, added lots of stuff mostly adapted from comm. garden

This commit is contained in:
Vivianne 2023-07-11 01:56:03 -07:00
parent 79737e6528
commit 8840ca1b1d
4 changed files with 338 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

144
gib-gab-gob/ui/catbird.scm Normal file
View File

@ -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 (<scene> 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> (<node-2d>)
(tile-x #:getter tile-x #:init-keyword #:tile-x)
(tile-y #:getter tile-y #:init-keyword #:tile-y))
(define-class <board-view> (<node-2d>)
(vat #:getter vat #:init-keyword #:vat)
(board #:getter board #:init-keyword #:board)
(tiles #:accessor tiles #:init-value #()))
(define-method (on-boot (board-view <board-view>))
(define tile-container
(make <node-2d>
#:name 'tile-container
#:rank 1))
(define background
(make <canvas>
#: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 <garden-view>) x y)
(vector-ref (vector-ref (tiles garden) y) x))
(define-method (rebuild-tiles (board-view <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 <canvas>
#:name 'background
#:painter painter))
(sprite (make <sprite>
#:name 'sprite
#:texture null-texture))
(tile (make <tile>
#: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 <board-view>) x y)
(define (find-tile node)
(cond
((not node)
#f)
((is-a? node <tile>)
node)
((parent node)
(find-tile (parent node)))
(else #f)))
(find-tile (pick board (vec2 x y) (lambda _ #t))))
(define-class <board-mode> (<major-mode>))
(define-method (make-move (mode <board-mode>) x y)
(define board (& (current-scene) root board))
(define node (board-pick board x y))
(cond
((is-a? node <tile>)
(board-make-move board node))))
(bind-input <board-mode> (mouse-press 'left) make-move)
(define* (launch-game node-thunk)
(run-catbird
(lambda ()
(let ((region (create-full-region #:name 'main))
(scene (make <scene> #:name 'board)))
(replace-scene region scene)
(replace-major-mode scene (make <board-mode>))
(set! (camera region)
(make <camera-2d>
#:width %window-width
#:height %window-height))
(attach-to scene (node-thunk))))
#:title "Gib Gab Gob"
#:width %window-width
#:height %window-height))

38
gib-gab-gob/util/chickadee-vat.scm Normal file
View File

@ -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))

168
guix.scm
View File

@ -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

5
hall.scm
View File

@ -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