diff --git a/game.js b/game.js
index 49f2da6..47780a6 100644
--- a/game.js
+++ b/game.js
@@ -67,6 +67,7 @@ window.addEventListener("load", async () => {
getContext: (elem, type) => elem.getContext(type),
setGlobalAlpha: (ctx, alpha) => ctx.globalAlpha = alpha,
setFillColor: (ctx, color) => ctx.fillStyle = color,
+ setStrokeColor: (ctx, color) => ctx.strokeStyle = color,
setFont: (ctx, font) => ctx.font = font,
setTextAlign: (ctx, align) => ctx.textAlign = align,
clearRect: (ctx, x, y, w, h) => ctx.clearRect(x, y, w, h),
diff --git a/game.scm b/game.scm
index 1fbaba7..493aa18 100644
--- a/game.scm
+++ b/game.scm
@@ -61,7 +61,8 @@
(local-storage)
(math)
(math rect)
- (math vector))
+ (math vector)
+ (scheme base))
(define game-width 320.0)
(define game-height 240.0)
@@ -105,7 +106,20 @@
(define audio:bg-music (load-music "cirkoban"))
;; Game state
-(define *state* #f)
+(define *state* '(initial))
+
+(define (push-game-state! state)
+ (set! *state* (cons state *state*)))
+(define (pop-game-state!)
+ (when (pair? *state*)
+ (set! *state* (cdr *state*))))
+(define (replace-game-state! state)
+ (match *state*
+ ((_ . rest)
+ (set! *state* (cons state rest)))))
+(define (current-game-state)
+ (match *state*
+ ((state . _) state)))
(define *actormap* (make-whactormap))
(define (call-with-goblins thunk)
@@ -132,6 +146,8 @@
load-catboss-2
load-catboss-3))
(define *level-idx* #f)
+;; Last level for restoring after visiting credits via the menu
+(define *level-last* #f)
(define *gems* #f)
(define *level* #f)
;; Latest representation of all actors in level
@@ -201,8 +217,8 @@
(define (collected-gem? idx)
(memq idx *gems*))
-(define (load-level! idx)
- (set! *state* 'play)
+(define (set-level! idx)
+ (replace-game-state! 'play)
(set! *actormap* (make-whactormap))
(clear-snapshots!)
(with-goblins
@@ -210,7 +226,7 @@
(update-objects!)))
(define (load-credits!)
- (set! *state* 'win)
+ (replace-game-state! 'credits)
(set! *actormap* (make-whactormap))
(set-vec2-y! *credits-scroll* 0.0)
(clear-snapshots!)
@@ -218,8 +234,7 @@
(set! *level* (load-credits #f))
(update-objects!)))
-(define (next-level!)
- (let ((idx (+ *level-idx* 1)))
+(define (load-level! idx)
;; TODO: Maybe show a little achievement popup when all gems
;; are collected?
(when (with-goblins ($ (level-actor *level*) 'gem-collected?))
@@ -228,17 +243,17 @@
(begin
(run-script
(lambda ()
- (set! *state* 'interstitial)
+ (replace-game-state! 'interstitial)
(yield
(lambda (k)
(show-effect! (make-fade-out+in-effect 1.0 k))))
(set! *level-idx* idx)
(save-game!)
- (load-level! idx))))
+ (set-level! idx))))
(begin
(run-script
(lambda ()
- (set! *state* 'interstitial)
+ (replace-game-state! 'interstitial)
(yield
(lambda (k)
(show-effect! (make-fade-out+in-effect 2.0 k))))
@@ -248,7 +263,10 @@
;; text from showing up when resetting the game, set
;; level idx to non-zero during the credits.
(set! *level-idx* -1)
- (load-credits!)))))))
+ (load-credits!))))))
+
+(define (next-level!)
+ (load-level! (+ *level-idx* 1)))
;; Auto-save/load to local storage.
(define (save-game!)
@@ -266,18 +284,127 @@
((idx gems)
(set! *level-idx* idx)
(set! *gems* gems)
- (load-level! *level-idx*)
+ (set-level! *level-idx*)
(media-play audio:bg-music)))))
+;; Menu types
+
+(define-record-type <menu>
+ (make-menu name items)
+ menu?
+ (name menu-name)
+ (items menu-items))
+
+;; Menu state
+
+(define-record-type <menu-state>
+ (make-menu-state current index page history)
+ menu-state?
+ (current menu-state-current set-menu-state-current!)
+ (index menu-state-index set-menu-state-index!)
+ (page menu-state-page set-menu-state-page!)
+ (history menu-state-history set-menu-state-history!))
+
+(define (menu-action:submenu menu)
+ (lambda ()
+ (push-menu-history!)
+ (set-menu! menu)
+ (set-menu-index! -1)))
+
+(define (menu-action:load-level level)
+ (lambda ()
+ (hide-menu!)
+ (load-level! level)))
+
+(define (menu-action:credits)
+ (hide-menu!)
+ (set! *level-last* *level-idx*)
+ (load-level! (vector-length levels)))
+
+;; Menu constants
+(define center (vec2 (* 10.0 tile-width) (* 7.0 tile-height)))
+(define menu:max-items 10)
+(define menu:level-select
+ (let ((items (make-vector (vector-length levels))))
+ (do ((i 0 (1+ i)))
+ ((= i (vector-length levels)))
+ (vector-set! items i (cons (string-append "Level " (number->string i))
+ (menu-action:load-level i))))
+ (make-menu "Select Level" items)))
+(define menu:main
+ (make-menu "Menu" (vector (cons "Select Level"
+ (menu-action:submenu menu:level-select))
+ (cons "Credits" menu-action:credits))))
+
+;; -1 for the index means 'Back' will be indicated first
+(define *menu* (make-menu-state menu:main -1 0 '()))
+
+(define (current-menu)
+ (menu-state-current *menu*))
+(define (current-menu-index)
+ (menu-state-index *menu*))
+(define (current-menu-page)
+ (menu-state-page *menu*))
+(define (current-menu-history)
+ (menu-state-history *menu*))
+(define (set-menu! menu)
+ (set-menu-state-current! *menu* menu))
+(define (set-menu-index! index)
+ (set-menu-state-index! *menu* index))
+(define (set-menu-page! page)
+ (set-menu-state-page! *menu* page))
+(define (set-menu-history! history)
+ (set-menu-state-history! *menu* history))
+
+;; Menu commands
+(define* (show-menu! #:optional (menu menu:main))
+ (push-game-state! 'menu)
+ (set-menu! menu)
+ (set-menu-index! -1)
+ (set-menu-page! 0)
+ (set-menu-history! '()))
+
+(define (hide-menu!)
+ (pop-game-state!))
+
+(define (menu-up!)
+ (set-menu-index! (max -1 (1- (current-menu-index))))
+ (when (and (> (current-menu-page) 0)
+ (= (current-menu-index) (- (* (current-menu-page) menu:max-items) (current-menu-page) 1)))
+ (set-menu-page! (1- (current-menu-page)))))
+
+(define (menu-down!)
+ (set-menu-index! (min (1- (vector-length (menu-items (current-menu)))) (1+ (current-menu-index))))
+ (when (= (current-menu-index) (- (* (1+ (current-menu-page)) menu:max-items) (current-menu-page)))
+ (set-menu-page! (1+ (current-menu-page)))))
+
+(define (push-menu-history!)
+ (set-menu-history! (cons (cons (current-menu)
+ (current-menu-index))
+ (current-menu-history))))
+
+(define (pop-menu-history!)
+ (match (current-menu-history)
+ (() (hide-menu!))
+ (((prev . index) . rest)
+ (set-menu! prev)
+ (set-menu-index! index)
+ (set-menu-history! rest))))
+
+(define (menu-select!)
+ (if (= (current-menu-index) -1) ;; back button pressed
+ (pop-menu-history!)
+ ((cdr (vector-ref (menu-items (current-menu)) (current-menu-index))))))
+
(define (reset-game!)
(run-script
(lambda ()
- (set! *state* 'interstitial)
+ (replace-game-state! 'interstitial)
(yield
(lambda (k)
(show-effect! (make-fade-out+in-effect 2.0 k))))
(set! *level-idx* 0)
- (load-level! 0))))
+ (set-level! 0))))
(define (emit-pickup-particles x y)
(run-script
@@ -607,6 +734,94 @@
(id (level-tile-id tile)))
(draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
+
+(define (draw-menu)
+ ;; Height (in tiles) will be 1 for the menu title + the y padding
+ ;; + 1 for the back button if on the first page or ellipses otherwise
+ ;; + num menu items + 1 for ellipses if num items is too big
+ ;; + the y padding again
+ (let* ((padding-y 1)
+ (text-offset-y (* 0.75 tile-height))
+ (width 8.0)
+ (num-items (vector-length (menu-items (current-menu))))
+ (height (+ 2 ;; Menu title + back/ellipses
+ (* 2 padding-y) ;; Padding
+ (if (> num-items menu:max-items)
+ (1+ menu:max-items) ;; bottom ellipses
+ num-items)))
+ (y-start (- (vec2-y center) (* tile-height
+ (floor (/ height 2)))))
+ (x-start (- (vec2-x center) (* tile-width
+ (floor (/ width 2))))))
+
+ ;; Draw menu background
+ (let ((w (* tile-width width))
+ (h (* tile-height height)))
+ (set-fill-color! context "#000")
+ (fill-rect context x-start y-start w h)
+ (set-stroke-color! context "blue")
+ (stroke-rect context x-start y-start w h))
+
+ ;; Draw menu text
+ (set-font! context "normal 16px monogram")
+ (set-fill-color! context "#fff")
+ (let* (;; The first menu item is at index 0. The 'Back' or ellipses are
+ ;; directly above the first menu item at index -1. The menu title
+ ;; is above the 'Back' button and separated by the padding-y
+ (r-start (- -2 padding-y))
+ ;; end of text
+ (r-end (- (+ r-start height) padding-y))
+ ;; r will not take into account which page you are on
+ (r-page-offset (- (* (current-menu-page) menu:max-items) (current-menu-page)))
+ (x-gutter (+ tile-width x-start))
+ (x-text (+ tile-width x-gutter)))
+ (do ((r r-start (1+ r)) (y y-start (+ tile-height y)))
+ ((or (>= r r-end) (>= (+ r r-page-offset) num-items)))
+ (let ((y-text (+ y text-offset-y))
+ (r-page (+ r r-page-offset)))
+ ;; Draw menu title
+ (when (= r r-start)
+ (set-text-align! context "center")
+ (fill-text context (menu-name (current-menu))
+ (vec2-x center) y-text))
+ (set-text-align! context "left")
+ ;; indicator
+ (when (= (+ r r-page-offset) (current-menu-index))
+ (fill-text context "▸" x-gutter y-text))
+ ;; Menu items
+ (when (>= r -1)
+ (fill-text
+ context
+ (cond
+ ((= r-page -1) "Back")
+ ((or (= r -1) (and (= r (1- r-end))
+ (< r-page (1- num-items))))
+ "...")
+ (else
+ (car (vector-ref (menu-items (current-menu))
+ r-page))))
+ x-text y-text)))))))
+
+(define (draw-controls)
+ (let ((cx1 (/ game-width 4.0))
+ (cx2 (* game-width 0.75))
+ (baseline (/ game-height 2.0)))
+ (set-fill-color! context "#ffffff")
+ (set-text-align! context "center")
+ (set-font! context "normal 16px monogram")
+ (fill-text context "keyboard:"
+ cx1 (- baseline 32.0))
+ (fill-text context "arrows -> move"
+ cx1 (- baseline 16.0))
+ (fill-text context "Z -> undo"
+ cx1 baseline)
+ (fill-text context "touchscreen:"
+ cx2 (- baseline 32.0))
+ (fill-text context "dpad -> move"
+ cx2 (- baseline 16.0))
+ (fill-text context "A -> undo"
+ cx2 baseline)))
+
(define (draw-level)
(draw-background)
(for-each draw-object *objects*)
@@ -620,7 +835,9 @@
(set-font! context "normal 32px monogram")
(set-fill-color! context "#ffffff")
(set-text-align! context "center")
- (fill-text context "OUCH... x_x" (/ game-width 2.0) (/ game-height 2.0)))))
+ (fill-text context "OUCH... x_x" (/ game-width 2.0) (/ game-height 2.0))))
+ (when (= *level-idx* 0)
+ (draw-controls)))
(define (draw-interstitial)
(draw-level))
@@ -675,7 +892,7 @@
(define credits-line-spacing 16.0)
(define max-credits-scroll
(+ game-height (* (- (vector-length credits) 9) credits-line-spacing)))
-(define (draw-win)
+(define (draw-credits)
(draw-level)
(set-fill-color! context "#ffffff")
(set-text-align! context "center")
@@ -726,30 +943,13 @@
(scale! context *canvas-scale* *canvas-scale*)
(draw-current-effect 'pre)
- (match *state*
+ (match (current-game-state)
((or 'play 'interstitial)
+ (draw-level))
+ ('menu
(draw-level)
- ;; Display input mappings on the title screen/first level.
- (when (= *level-idx* 0)
- (let ((cx1 (/ game-width 4.0))
- (cx2 (* game-width 0.75))
- (baseline (/ game-height 2.0)))
- (set-fill-color! context "#ffffff")
- (set-text-align! context "center")
- (set-font! context "normal 16px monogram")
- (fill-text context "keyboard:"
- cx1 (- baseline 32.0))
- (fill-text context "arrows -> move"
- cx1 (- baseline 16.0))
- (fill-text context "Z -> undo"
- cx1 baseline)
- (fill-text context "touchscreen:"
- cx2 (- baseline 32.0))
- (fill-text context "dpad -> move"
- cx2 (- baseline 16.0))
- (fill-text context "A -> undo"
- cx2 baseline))))
- ('win (draw-win)))
+ (draw-menu))
+ ('credits (draw-credits)))
(draw-current-effect 'post)
(request-animation-frame draw-callback)))
(define draw-callback (procedure->external draw))
@@ -761,6 +961,7 @@
(define key:up "ArrowUp")
(define key:confirm "Enter")
(define key:undo "KeyZ")
+(define key:menu "Space")
(define (on-key-down event)
(let ((key (keyboard-event-code event)))
@@ -776,7 +977,9 @@
((string=? key key:undo)
(on-input-down 'undo))
((string=? key key:confirm)
- (on-input-down 'confirm)))))
+ (on-input-down 'confirm))
+ ((string=? key key:menu)
+ (on-input-down 'menu)))))
(define *gamepad* #f)
(define *button:left* #f)
@@ -837,7 +1040,7 @@
(on-input-down 'undo))))))))
(define (on-input-down input)
- (match *state*
+ (match (current-game-state)
('play
(match input
('left (move-player 'left))
@@ -849,9 +1052,23 @@
(with-goblins (update-objects!)))
;; REMOVE BEFORE RELEASE!!!!
;; ('confirm (next-level!))
- ))
+ ('menu (show-menu!))
+ (_ #f)))
+ ('menu
+ (match input
+ ('up (menu-up!))
+ ('down (menu-down!))
+ ('confirm (menu-select!))
+ ('menu (hide-menu!))
+ (_ #f)))
;; Pressing any bound input resets the game.
- ('win (reset-game!))))
+ ;; If traveling to the credits via the menu, go back to '*level-last*'
+ ('credits
+ (cond
+ (*level-last*
+ (load-level! *level-last*)
+ (set! *level-last* #f))
+ (else (reset-game!))))))
;; Canvas and event loop setup
(define canvas (get-element-by-id "canvas"))
diff --git a/modules/dom/canvas.scm b/modules/dom/canvas.scm
index 08bdf07..a75fc09 100644
--- a/modules/dom/canvas.scm
+++ b/modules/dom/canvas.scm
@@ -25,10 +25,12 @@
#:export (get-context
set-global-alpha!
set-fill-color!
+ set-stroke-color!
set-font!
set-text-align!
clear-rect
fill-rect
+ stroke-rect
fill-text
draw-image
restore!
@@ -51,6 +53,9 @@
(define-foreign set-fill-color!
"canvas" "setFillColor"
(ref extern) (ref string) -> none)
+(define-foreign set-stroke-color!
+ "canvas" "setStrokeColor"
+ (ref extern) (ref string) -> none)
(define-foreign set-font!
"canvas" "setFont"
(ref extern) (ref string) -> none)