summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am6
-rw-r--r--configure.ac4
-rwxr-xr-xrun-game2
-rw-r--r--test-subject/assets.scm52
-rw-r--r--test-subject/device.scm42
-rw-r--r--test-subject/game.scm (renamed from game.scm)141
-rw-r--r--test-subject/text-box.scm37
7 files changed, 166 insertions, 118 deletions
diff --git a/Makefile.am b/Makefile.am
index 4f5cd6a..70738c9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -21,7 +21,11 @@ SUFFIXES = .scm .go
moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
-SOURCES = game.scm
+SOURCES = \
+ test-subject/assets.scm \
+ test-subject/text-box.scm \
+ test-subject/device.scm \
+ test-subject/game.scm
EXTRA_DIST += \
COPYING
diff --git a/configure.ac b/configure.ac
index 582cdb7..21e90ac 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,7 +1,7 @@
dnl -*- Autoconf -*-
-AC_INIT(spring-lisp-game-jam-2021, 0.1.0)
-AC_CONFIG_SRCDIR(lisp-game-jam)
+AC_INIT(test-subject, 0.1.0)
+AC_CONFIG_SRCDIR(test-subject)
AC_CONFIG_AUX_DIR([build-aux])
AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign])
AM_SILENT_RULES([yes])
diff --git a/run-game b/run-game
index 0fb9b15..b4d451c 100755
--- a/run-game
+++ b/run-game
@@ -1,3 +1,3 @@
#!/bin/sh
-DEV_MODE=1 ./pre-inst-env guile -c '(use-modules (game)) (launch-game)'
+DEV_MODE=1 ./pre-inst-env guile -c '(use-modules (test-subject game)) (launch-game)'
diff --git a/test-subject/assets.scm b/test-subject/assets.scm
new file mode 100644
index 0000000..76f0d6d
--- /dev/null
+++ b/test-subject/assets.scm
@@ -0,0 +1,52 @@
+(define-module (test-subject assets)
+ #:use-module (chickadee audio)
+ #:use-module (chickadee graphics font)
+ #:use-module (chickadee graphics texture)
+ #:use-module (starling asset)
+ #:export (dialog-box-texture
+ button-press-texture
+ darkness
+ lightness
+ room-background
+ door-lock-texture
+ pin-entry-background
+ door-texture
+ terminal-texture
+ terminal-background
+ control-panel-texture
+ fridge-texture
+ window-texture
+ notebook-texture
+ notebook-background
+ monogram-font
+ monogram-font-big
+ old-fax-font
+ click-sound
+ key-press-sound
+ device-sound
+ gameplay-music
+ credits-music))
+
+(define-asset dialog-box-texture (load-image "assets/images/dialog-box.png"))
+(define-asset button-press-texture (load-image "assets/images/button-press.png"))
+(define-asset darkness (load-image "assets/images/darkness.png"))
+(define-asset lightness (load-image "assets/images/lightness.png"))
+(define-asset room-background (load-image "assets/images/room.png"))
+(define-asset door-lock-texture (load-image "assets/images/door-lock.png"))
+(define-asset pin-entry-background (load-image "assets/images/pin-entry-background.png"))
+(define-asset door-texture (load-image "assets/images/door.png"))
+(define-asset terminal-texture (load-image "assets/images/terminal.png"))
+(define-asset terminal-background (load-image "assets/images/terminal-background.png"))
+(define-asset control-panel-texture (load-image "assets/images/control-panel.png"))
+(define-asset fridge-texture (load-image "assets/images/fridge.png"))
+(define-asset window-texture (load-image "assets/images/window.png"))
+(define-asset notebook-texture (load-image "assets/images/notebook.png"))
+(define-asset notebook-background (load-image "assets/images/notebook-background.png"))
+(define-asset monogram-font (load-font "assets/fonts/monogram_extended.ttf" 12))
+(define-asset monogram-font-big (load-font "assets/fonts/monogram_extended.ttf" 24))
+(define-asset old-fax-font (load-font "assets/fonts/old-fax.ttf" 12))
+(define-asset click-sound (load-audio "assets/sounds/click1.wav"))
+(define-asset key-press-sound (load-audio "assets/sounds/switch6.wav"))
+(define-asset device-sound (load-audio "assets/sounds/switch38.wav"))
+(define-asset gameplay-music (load-audio "assets/sounds/ambientmain_0.ogg" #:mode 'stream))
+(define-asset credits-music (load-audio "assets/sounds/end-theme.mp3" #:mode 'stream))
diff --git a/test-subject/device.scm b/test-subject/device.scm
new file mode 100644
index 0000000..b15f270
--- /dev/null
+++ b/test-subject/device.scm
@@ -0,0 +1,42 @@
+(define-module (test-subject device)
+ #:use-module (chickadee graphics color)
+ #:use-module (chickadee graphics texture)
+ #:use-module (oop goops)
+ #:use-module (starling gui)
+ #:use-module (starling node)
+ #:use-module (starling node-2d)
+ #:export (<device>))
+
+(define %device-hover-tint (rgb #xff7777))
+
+;; An object you can interact with by clicking.
+(define-class <device> (<margin-container>)
+ (texture #:accessor texture #:init-keyword #:texture
+ #:init-value null-texture #:watch? #t))
+
+(define-method (refresh-hover-state (device <device>))
+ ;; A crude way of showing the user something is clickable.
+ (set! (tint (& device sprite))
+ (if (hover? device)
+ %device-hover-tint
+ white)))
+
+(define-method (on-change (device <device>) slot-name old new)
+ (case slot-name
+ ((hover?)
+ (refresh-hover-state device))
+ ((texture)
+ (let ((sprite (& device sprite)))
+ (when sprite
+ (set! (texture sprite) new))))
+ (else
+ (next-method))))
+
+(define-method (apply-theme (device <device>))
+ (next-method)
+ (replace device
+ (make <sprite>
+ #:name 'sprite
+ #:rank 1
+ #:texture (texture device)))
+ (refresh-hover-state device))
diff --git a/game.scm b/test-subject/game.scm
index ef0234c..4a03343 100644
--- a/game.scm
+++ b/test-subject/game.scm
@@ -1,4 +1,4 @@
-(define-module (game)
+(define-module (test-subject game)
#:use-module (chickadee audio)
#:use-module (chickadee graphics color)
#:use-module (chickadee graphics font)
@@ -16,124 +16,18 @@
#:use-module (starling node-2d)
#:use-module (starling ring-buffer)
#:use-module (starling scene)
+ #:use-module (test-subject assets)
+ #:use-module (test-subject device)
+ #:use-module (test-subject text-box)
#:duplicates (merge-generics replace warn-override-core warn last)
#:export (launch-game))
-
-;;;
-;;; Constants
-;;;
-
(define window-width 1280)
(define window-height 720)
(define game-width 640)
(define game-height 360)
(define player-display-name "")
-
-;;;
-;;; Assets
-;;;
-
-(define-asset dialog-box-texture (load-image "assets/images/dialog-box.png"))
-(define-asset button-press-texture (load-image "assets/images/button-press.png"))
-(define-asset darkness (load-image "assets/images/darkness.png"))
-(define-asset lightness (load-image "assets/images/lightness.png"))
-(define-asset room-background (load-image "assets/images/room.png"))
-(define-asset door-lock-texture (load-image "assets/images/door-lock.png"))
-(define-asset pin-entry-background (load-image "assets/images/pin-entry-background.png"))
-(define-asset door-texture (load-image "assets/images/door.png"))
-(define-asset terminal-texture (load-image "assets/images/terminal.png"))
-(define-asset terminal-background (load-image "assets/images/terminal-background.png"))
-(define-asset control-panel-texture (load-image "assets/images/control-panel.png"))
-(define-asset fridge-texture (load-image "assets/images/fridge.png"))
-(define-asset window-texture (load-image "assets/images/window.png"))
-(define-asset notebook-texture (load-image "assets/images/notebook.png"))
-(define-asset notebook-background (load-image "assets/images/notebook-background.png"))
-(define-asset monogram-font (load-font "assets/fonts/monogram_extended.ttf" 12))
-(define-asset monogram-font-big (load-font "assets/fonts/monogram_extended.ttf" 24))
-(define-asset old-fax-font (load-font "assets/fonts/old-fax.ttf" 12))
-(define-asset click-sound (load-audio "assets/sounds/click1.wav"))
-(define-asset key-press-sound (load-audio "assets/sounds/switch6.wav"))
-(define-asset device-sound (load-audio "assets/sounds/switch38.wav"))
-(define-asset background-music (load-audio "assets/sounds/ambientmain_0.ogg" #:mode 'stream))
-(define-asset credits-music (load-audio "assets/sounds/end-theme.mp3" #:mode 'stream))
-
-
-;;;
-;;; Text Box
-;;;
-
-(define-class <text-box> (<widget>)
- (text #:accessor text #:init-keyword #:text #:init-value "" #:watch? #t))
-
-(define-method (on-change (text-box <text-box>) slot-name old new)
- (case slot-name
- ((text)
- (let ((l (& text-box text)))
- (when l
- (set! (text l) new))))
- (else
- (next-method))))
-
-(define-method (apply-theme (text-box <text-box>))
- (next-method)
- (replace text-box
- (make <label>
- #:name 'text
- #:rank 1
- #:font (font text-box)
- #:text (text text-box)
- #:position (vec2 6.0
- (- (height text-box)
- (font-line-height
- (asset-ref
- (font text-box))))))))
-
-
-;;;
-;;; Device
-;;;
-
-(define %device-hover-tint (rgb #xff7777))
-
-;; An object you can interact with by clicking.
-(define-class <device> (<margin-container>)
- (texture #:accessor texture #:init-keyword #:texture
- #:init-value null-texture #:watch? #t))
-
-(define-method (refresh-hover-state (device <device>))
- ;; A crude way of showing the user something is clickable.
- (set! (tint (& device sprite))
- (if (hover? device)
- %device-hover-tint
- white)))
-
-(define-method (on-change (device <device>) slot-name old new)
- (case slot-name
- ((hover?)
- (refresh-hover-state device))
- ((texture)
- (let ((sprite (& device sprite)))
- (when sprite
- (set! (texture sprite) new))))
- (else
- (next-method))))
-
-(define-method (apply-theme (device <device>))
- (next-method)
- (replace device
- (make <sprite>
- #:name 'sprite
- #:rank 1
- #:texture (texture device)))
- (refresh-hover-state device))
-
-
-;;;
-;;; Game
-;;;
-
(define-theme gui-theme
(<widget> (font monogram-font))
(<button> (background dialog-box-texture)
@@ -207,7 +101,7 @@
(c (dialog-container game)))
(attach-to game c)
(set! (text (& c name-margin name)) name)
- (set! (text (& c text-box)) line)
+ (set! (text-box-text (& c text-box)) line)
(match choices
(()
(set! (state game) 'dialog)
@@ -260,6 +154,27 @@
(set! (state game) 'intro)
(attach-to game
(make <sprite>
+ #:name 'intro-lightness
+ #:texture lightness)
+ (make <label>
+ #:name 'intro-splash
+ #:font monogram-font
+ #:color black
+ #:align 'center
+ #:vertical-align 'center
+ #:position (vec2 (/ game-width 2.0) (/ game-height 2.0))))
+ (set! (text (& game intro-splash)) "a nonexistent game studio presents")
+ (sleep 120)
+ (set! (text (& game intro-splash)) "a lisp game jam entry")
+ (sleep 120)
+ (tween 120 white black
+ (lambda (color)
+ (set! (tint (& game intro-lightness)) color))
+ #:interpolate color-lerp)
+ (detach (& game intro-lightness)
+ (& game intro-splash))
+ (attach-to game
+ (make <sprite>
#:name 'intro-darkness
#:texture darkness))
(dialog game player-display-name "> ...")
@@ -410,8 +325,6 @@
(passwordify-maybe input))
'()))))))
(define (help)
- (when (zero? (random 2))
- (log "quit wasting time!! open the door!!"))
(log "available commands:")
(log "exit - leave terminal")
(log "diagnostic N - run level N diagnostic")
@@ -1039,7 +952,7 @@ if you would just open the door.")
#:position (vec2 109.0 40.0)
#:listeners
`((click . ,(run-on-left-click* game open-terminal)))))))
- (set-source-audio! (audio-source game) (asset-ref background-music))
+ (set-source-audio! (audio-source game) (asset-ref gameplay-music))
(source-play (audio-source game))
(fade-in))
diff --git a/test-subject/text-box.scm b/test-subject/text-box.scm
new file mode 100644
index 0000000..e46b396
--- /dev/null
+++ b/test-subject/text-box.scm
@@ -0,0 +1,37 @@
+(define-module (test-subject text-box)
+ #:use-module (chickadee graphics font)
+ #:use-module (chickadee math vector)
+ #:use-module (oop goops)
+ #:use-module (starling asset)
+ #:use-module (starling gui)
+ #:use-module (starling node)
+ #:use-module (starling node-2d)
+ #:duplicates (merge-generics replace warn-override-core warn last)
+ #:export (<text-box>
+ text-box-text))
+
+(define-class <text-box> (<widget>)
+ (text #:accessor text-box-text #:init-keyword #:text #:init-value "" #:watch? #t))
+
+(define-method (on-change (text-box <text-box>) slot-name old new)
+ (case slot-name
+ ((text)
+ (let ((l (& text-box text)))
+ (when l
+ (set! (text l) new))))
+ (else
+ (next-method))))
+
+(define-method (apply-theme (text-box <text-box>))
+ (next-method)
+ (replace text-box
+ (make <label>
+ #:name 'text
+ #:rank 1
+ #:font (font text-box)
+ #:text (text-box-text text-box)
+ #:position (vec2 6.0
+ (- (height text-box)
+ (font-line-height
+ (asset-ref
+ (font text-box))))))))
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-21 11:43:22 +0000