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 + (make-menu name items) + menu? + (name menu-name) + (items menu-items)) + +;; Menu state + +(define-record-type + (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)