summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix.scm39
-rw-r--r--starling/gui.scm7
-rw-r--r--starling/node-2d.scm10
-rw-r--r--starling/ring-buffer.scm39
-rw-r--r--starling/scene.scm36
5 files changed, 77 insertions, 54 deletions
diff --git a/guix.scm b/guix.scm
index 22614eb..7df938b 100644
--- a/guix.scm
+++ b/guix.scm
@@ -37,6 +37,7 @@
(srfi srfi-1)
(guix build-system gnu)
(guix download)
+ (guix gexp)
(guix git-download)
((guix licenses) #:prefix license:)
(guix packages)
@@ -57,12 +58,17 @@
(define target-guile
(package
- (inherit guile-3.0-latest)
- (source (origin
- (inherit (package-source guile-3.0-latest))
- (patches (list "0001-goops-Preserve-all-slot-options-in-redefinable-class.patch"))))
- (arguments
- `(#:tests? #f ,@(package-arguments guile-3.0-latest)))))
+ (inherit guile-3.0-latest)
+ (version "3.0.6")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/guile/guile-"
+ version ".tar.xz"))
+ (sha256
+ (base32
+ "0a2xhjy6y5p15qvc59pdnzi20fm1jwqa772pwxb16wkx0z187gg2"))))
+ (arguments
+ `(#:tests? #f ,@(package-arguments guile-3.0-latest)))))
(define guile3.0-opengl
(package
@@ -97,7 +103,7 @@
(invoke "autoreconf" "-vfi")))))))))
(define guile-sdl2
- (let ((commit "90578fd69c2eeebc3956d5fcc47d7f771270b5c4"))
+ (let ((commit "2ecdf1e97f415a5818c4dcd7a2ddff6dc7ecdd0f"))
(package
(name "guile-sdl2")
(version (string-append "0.5.0-1." (string-take commit 7)))
@@ -108,7 +114,7 @@
(commit commit)))
(sha256
(base32
- "1dk4k1p0b80i6yfyhpfygagb3xmk7njd2v82xnd0nn0b962p7p78"))))
+ "0dzg321xr72x2xx49p93bdb44g6bx1hq8y39aqfzzh3qmdhyvhw5"))))
(build-system gnu-build-system)
(arguments
'(#:make-flags '("GUILE_AUTO_COMPILE=0")
@@ -133,7 +139,7 @@ SDL2 C shared library via the foreign function interface.")
(license license:lgpl3+))))
(define chickadee
- (let ((commit "d4d82c8f2259f368085ce4cb31a3de1751199edd"))
+ (let ((commit "3b4787975ec6684878db2b21dc33dcfdc748d51e"))
(package
(name "chickadee")
(version (string-append "0.5.0-1." (string-take commit 7)))
@@ -144,7 +150,7 @@ SDL2 C shared library via the foreign function interface.")
(commit commit)))
(sha256
(base32
- "1flral9nsxqydsmvw1lprrhkvn4xdkjv1lx4imr0i9lhdx1nbzq5"))))
+ "1hlkmk903n3wg7ca9rf6fpdf4qj7gdvxdvj1vhczv4yqg6b6bjq6"))))
(build-system gnu-build-system)
(arguments
'(#:make-flags '("GUILE_AUTO_COMPILE=0")
@@ -174,11 +180,22 @@ Scheme. It contains all of the basic components needed to develop
(home-page "https://dthompson.us/projects/chickadee.html")
(license license:gpl3+))))
+(define %source-dir (dirname (current-filename)))
+
(package
(name "starling")
(version "0.1")
- (source #f)
+ (source (local-file %source-dir
+ #:recursive? #t
+ #:select? (git-predicate %source-dir)))
(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
`(("autoconf" ,autoconf)
("automake" ,automake)
diff --git a/starling/gui.scm b/starling/gui.scm
index f00c329..3a93f36 100644
--- a/starling/gui.scm
+++ b/starling/gui.scm
@@ -41,6 +41,7 @@
current-theme
<widget>
apply-theme
+ enabled?
focused?
hover?
left-pressed?
@@ -126,6 +127,7 @@
(define current-theme (make-parameter #f))
(define-class <widget> (<node-2d>)
+ (enabled? #:accessor enabled? #:init-value #t #:watch? #t)
(focused? #:accessor focused? #:init-value #f #:watch? #t)
(hover? #:accessor hover? #:init-value #f #:watch? #t)
(left-pressed? #:accessor left-pressed? #:init-value #f #:watch? #t)
@@ -300,7 +302,10 @@
(keyboard-focus #:accessor keyboard-focus #:init-value #f))
(define-method (pick-widget (scene <gui-scene>) p)
- (pick scene p (lambda (node) (is-a? node <widget>))))
+ (pick scene p (lambda (node)
+ (and (visible? node)
+ (is-a? node <widget>)
+ (enabled? node)))))
(define-method (on-mouse-move (scene <gui-scene>) x y x-rel y-rel buttons)
(let ((focused (mouse-focus scene))
diff --git a/starling/node-2d.scm b/starling/node-2d.scm
index 9fdc578..71f43bf 100644
--- a/starling/node-2d.scm
+++ b/starling/node-2d.scm
@@ -524,8 +524,8 @@
(follow-bezier-path node path duration #t))
(define-method (pick (node <node-2d>) p pred)
- (let ((bb (bounding-box node)))
- (and (pred node)
+ (and (pred node)
+ (let ((bb (bounding-box node)))
(let loop ((kids (reverse (children node))))
(match kids
(()
@@ -797,7 +797,8 @@
(text #:accessor text #:init-form "" #:init-keyword #:text #:watch? #t)
(align #:accessor align #:init-value 'left #:init-keyword #:align #:watch? #t)
(vertical-align #:accessor vertical-align #:init-value 'bottom
- #:init-keyword #:vertical-align #:watch? #t))
+ #:init-keyword #:vertical-align #:watch? #t)
+ (color #:accessor color #:init-keyword #:color #:init-value white))
(define-method (realign (label <label>))
(set! (origin-x label)
@@ -839,7 +840,8 @@
(next-method))))
(define-method (render (label <label>) alpha)
- (draw-text* (font label) (text label) (world-matrix label)))
+ (draw-text* (font label) (text label) (world-matrix label)
+ #:color (color label)))
;;;
diff --git a/starling/ring-buffer.scm b/starling/ring-buffer.scm
index 2b67f78..e4f18d7 100644
--- a/starling/ring-buffer.scm
+++ b/starling/ring-buffer.scm
@@ -5,7 +5,8 @@
ring-buffer-length
ring-buffer-put!
ring-buffer-get!
- ring-buffer-ref))
+ ring-buffer-ref
+ ring-buffer-clear!))
(define-record-type <ring-buffer>
(%make-ring-buffer vector length head tail)
@@ -52,30 +53,12 @@
(vector-ref v (modulo (+ (ring-buffer-head ring) i)
(vector-length v))))))
-;; (define (test)
-;; (define (do-test ring)
-;; (ring-buffer-put! ring 'h)
-;; (pk ring)
-;; (ring-buffer-put! ring 'e)
-;; (pk ring)
-;; (ring-buffer-put! ring 'l)
-;; (pk ring)
-;; (ring-buffer-put! ring 'l)
-;; (pk ring)
-;; (ring-buffer-put! ring 'o)
-;; (pk ring)
-;; (ring-buffer-put! ring 'w)
-;; (pk ring)
-;; (ring-buffer-put! ring 'o)
-;; (pk ring)
-;; (ring-buffer-put! ring 'r)
-;; (pk ring)
-;; (ring-buffer-put! ring 'l)
-;; (pk ring)
-;; (ring-buffer-put! ring 'd)
-;; (pk ring)
-;; (pk (ring-buffer-get! ring) (ring-buffer-get! ring) (ring-buffer-get! ring) (ring-buffer-get! ring))
-;; (pk ring))
-;; (let ((ring (make-ring-buffer 4)))
-;; (do-test ring)
-;; (do-test ring)))
+(define (ring-buffer-clear! ring)
+ (let ((v (ring-buffer-vector ring)))
+ (set-ring-buffer-head! ring 0)
+ (set-ring-buffer-tail! ring 0)
+ (set-ring-buffer-length! ring 0)
+ (let loop ((i 0))
+ (when (< i (vector-length v))
+ (vector-set! v i #f)
+ (loop (+ i 1))))))
diff --git a/starling/scene.scm b/starling/scene.scm
index 7412727..8757ad8 100644
--- a/starling/scene.scm
+++ b/starling/scene.scm
@@ -55,21 +55,33 @@
(define-class <scene> (<node>)
(background-music-source #:getter background-music-source
- #:init-form (make-source #:loop? #t))
+ #:init-thunk make-source)
(background-music #:accessor background-music #:init-form #f
- #:init-keyword #:music)
+ #:init-keyword #:music #:asset? #t #:watch? #t)
(background-music-volume #:accessor background-music-volume #:init-form 1.0
- #:init-keyword #:music-volume)
+ #:init-keyword #:music-volume #:watch? #t)
(background-music-loop? #:accessor background-music-loop? #:init-form #t
- #:init-keyword #:music-loop?))
+ #:init-keyword #:music-loop? #:watch? #t))
+
+(define-method (refresh-background-music (scene <scene>))
+ (let ((source (background-music-source scene)))
+ (set-source-volume! source (background-music-volume scene))
+ (set-source-loop! source (background-music-loop? scene))
+ (when (audio? (background-music scene))
+ (set-source-audio! source (background-music scene))
+ (if (active? scene)
+ (source-play source)
+ (source-stop source)))))
+
+(define-method (on-change (scene <scene>) slot-name old new)
+ (case slot-name
+ ((background-music background-music-volume background-music-loop?)
+ (refresh-background-music scene))
+ (else
+ (next-method))))
(define-method (on-enter (scene <scene>))
- (when (audio? (background-music scene))
- (set-source-volume! (background-music-source scene)
- (background-music-volume scene))
- (set-source-audio! (background-music-source scene)
- (background-music scene))
- (source-play (background-music-source scene))))
+ (refresh-background-music scene))
(define-method (on-exit (scene <scene>))
(source-stop (background-music-source scene)))
@@ -158,6 +170,10 @@
(()
(error "no scene to pop!" mux))))
+(define-method (on-detach (mux <scene-mux>) (scene <scene>))
+ (when (eq? scene (current-scene mux))
+ (error "current scene improperly detached. use push/pop/replace-scene instead.")))
+
(define-method (on-scenes-empty (mux <scene-mux>))
#t)