Merge branch 'menu' into 'main'
Have menu open and close with Space See merge request spritely/cirkoban!1
This commit is contained in:
commit
25e27df8c1
3 changed files with 265 additions and 42 deletions
1
game.js
1
game.js
|
@ -67,6 +67,7 @@ window.addEventListener("load", async () => {
|
||||||
getContext: (elem, type) => elem.getContext(type),
|
getContext: (elem, type) => elem.getContext(type),
|
||||||
setGlobalAlpha: (ctx, alpha) => ctx.globalAlpha = alpha,
|
setGlobalAlpha: (ctx, alpha) => ctx.globalAlpha = alpha,
|
||||||
setFillColor: (ctx, color) => ctx.fillStyle = color,
|
setFillColor: (ctx, color) => ctx.fillStyle = color,
|
||||||
|
setStrokeColor: (ctx, color) => ctx.strokeStyle = color,
|
||||||
setFont: (ctx, font) => ctx.font = font,
|
setFont: (ctx, font) => ctx.font = font,
|
||||||
setTextAlign: (ctx, align) => ctx.textAlign = align,
|
setTextAlign: (ctx, align) => ctx.textAlign = align,
|
||||||
clearRect: (ctx, x, y, w, h) => ctx.clearRect(x, y, w, h),
|
clearRect: (ctx, x, y, w, h) => ctx.clearRect(x, y, w, h),
|
||||||
|
|
301
game.scm
301
game.scm
|
@ -61,7 +61,8 @@
|
||||||
(local-storage)
|
(local-storage)
|
||||||
(math)
|
(math)
|
||||||
(math rect)
|
(math rect)
|
||||||
(math vector))
|
(math vector)
|
||||||
|
(scheme base))
|
||||||
|
|
||||||
(define game-width 320.0)
|
(define game-width 320.0)
|
||||||
(define game-height 240.0)
|
(define game-height 240.0)
|
||||||
|
@ -105,7 +106,20 @@
|
||||||
(define audio:bg-music (load-music "cirkoban"))
|
(define audio:bg-music (load-music "cirkoban"))
|
||||||
|
|
||||||
;; Game state
|
;; 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 *actormap* (make-whactormap))
|
||||||
(define (call-with-goblins thunk)
|
(define (call-with-goblins thunk)
|
||||||
|
@ -132,6 +146,8 @@
|
||||||
load-catboss-2
|
load-catboss-2
|
||||||
load-catboss-3))
|
load-catboss-3))
|
||||||
(define *level-idx* #f)
|
(define *level-idx* #f)
|
||||||
|
;; Last level for restoring after visiting credits via the menu
|
||||||
|
(define *level-last* #f)
|
||||||
(define *gems* #f)
|
(define *gems* #f)
|
||||||
(define *level* #f)
|
(define *level* #f)
|
||||||
;; Latest representation of all actors in level
|
;; Latest representation of all actors in level
|
||||||
|
@ -201,8 +217,8 @@
|
||||||
(define (collected-gem? idx)
|
(define (collected-gem? idx)
|
||||||
(memq idx *gems*))
|
(memq idx *gems*))
|
||||||
|
|
||||||
(define (load-level! idx)
|
(define (set-level! idx)
|
||||||
(set! *state* 'play)
|
(replace-game-state! 'play)
|
||||||
(set! *actormap* (make-whactormap))
|
(set! *actormap* (make-whactormap))
|
||||||
(clear-snapshots!)
|
(clear-snapshots!)
|
||||||
(with-goblins
|
(with-goblins
|
||||||
|
@ -210,7 +226,7 @@
|
||||||
(update-objects!)))
|
(update-objects!)))
|
||||||
|
|
||||||
(define (load-credits!)
|
(define (load-credits!)
|
||||||
(set! *state* 'win)
|
(replace-game-state! 'credits)
|
||||||
(set! *actormap* (make-whactormap))
|
(set! *actormap* (make-whactormap))
|
||||||
(set-vec2-y! *credits-scroll* 0.0)
|
(set-vec2-y! *credits-scroll* 0.0)
|
||||||
(clear-snapshots!)
|
(clear-snapshots!)
|
||||||
|
@ -218,8 +234,7 @@
|
||||||
(set! *level* (load-credits #f))
|
(set! *level* (load-credits #f))
|
||||||
(update-objects!)))
|
(update-objects!)))
|
||||||
|
|
||||||
(define (next-level!)
|
(define (load-level! idx)
|
||||||
(let ((idx (+ *level-idx* 1)))
|
|
||||||
;; TODO: Maybe show a little achievement popup when all gems
|
;; TODO: Maybe show a little achievement popup when all gems
|
||||||
;; are collected?
|
;; are collected?
|
||||||
(when (with-goblins ($ (level-actor *level*) 'gem-collected?))
|
(when (with-goblins ($ (level-actor *level*) 'gem-collected?))
|
||||||
|
@ -228,17 +243,17 @@
|
||||||
(begin
|
(begin
|
||||||
(run-script
|
(run-script
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set! *state* 'interstitial)
|
(replace-game-state! 'interstitial)
|
||||||
(yield
|
(yield
|
||||||
(lambda (k)
|
(lambda (k)
|
||||||
(show-effect! (make-fade-out+in-effect 1.0 k))))
|
(show-effect! (make-fade-out+in-effect 1.0 k))))
|
||||||
(set! *level-idx* idx)
|
(set! *level-idx* idx)
|
||||||
(save-game!)
|
(save-game!)
|
||||||
(load-level! idx))))
|
(set-level! idx))))
|
||||||
(begin
|
(begin
|
||||||
(run-script
|
(run-script
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set! *state* 'interstitial)
|
(replace-game-state! 'interstitial)
|
||||||
(yield
|
(yield
|
||||||
(lambda (k)
|
(lambda (k)
|
||||||
(show-effect! (make-fade-out+in-effect 2.0 k))))
|
(show-effect! (make-fade-out+in-effect 2.0 k))))
|
||||||
|
@ -248,7 +263,10 @@
|
||||||
;; text from showing up when resetting the game, set
|
;; text from showing up when resetting the game, set
|
||||||
;; level idx to non-zero during the credits.
|
;; level idx to non-zero during the credits.
|
||||||
(set! *level-idx* -1)
|
(set! *level-idx* -1)
|
||||||
(load-credits!)))))))
|
(load-credits!))))))
|
||||||
|
|
||||||
|
(define (next-level!)
|
||||||
|
(load-level! (+ *level-idx* 1)))
|
||||||
|
|
||||||
;; Auto-save/load to local storage.
|
;; Auto-save/load to local storage.
|
||||||
(define (save-game!)
|
(define (save-game!)
|
||||||
|
@ -266,18 +284,127 @@
|
||||||
((idx gems)
|
((idx gems)
|
||||||
(set! *level-idx* idx)
|
(set! *level-idx* idx)
|
||||||
(set! *gems* gems)
|
(set! *gems* gems)
|
||||||
(load-level! *level-idx*)
|
(set-level! *level-idx*)
|
||||||
(media-play audio:bg-music)))))
|
(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!)
|
(define (reset-game!)
|
||||||
(run-script
|
(run-script
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set! *state* 'interstitial)
|
(replace-game-state! 'interstitial)
|
||||||
(yield
|
(yield
|
||||||
(lambda (k)
|
(lambda (k)
|
||||||
(show-effect! (make-fade-out+in-effect 2.0 k))))
|
(show-effect! (make-fade-out+in-effect 2.0 k))))
|
||||||
(set! *level-idx* 0)
|
(set! *level-idx* 0)
|
||||||
(load-level! 0))))
|
(set-level! 0))))
|
||||||
|
|
||||||
(define (emit-pickup-particles x y)
|
(define (emit-pickup-particles x y)
|
||||||
(run-script
|
(run-script
|
||||||
|
@ -607,6 +734,94 @@
|
||||||
(id (level-tile-id tile)))
|
(id (level-tile-id tile)))
|
||||||
(draw-tile context tileset id (vec2-x pos) (vec2-y pos))))))
|
(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)
|
(define (draw-level)
|
||||||
(draw-background)
|
(draw-background)
|
||||||
(for-each draw-object *objects*)
|
(for-each draw-object *objects*)
|
||||||
|
@ -620,7 +835,9 @@
|
||||||
(set-font! context "normal 32px monogram")
|
(set-font! context "normal 32px monogram")
|
||||||
(set-fill-color! context "#ffffff")
|
(set-fill-color! context "#ffffff")
|
||||||
(set-text-align! context "center")
|
(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)
|
(define (draw-interstitial)
|
||||||
(draw-level))
|
(draw-level))
|
||||||
|
@ -675,7 +892,7 @@
|
||||||
(define credits-line-spacing 16.0)
|
(define credits-line-spacing 16.0)
|
||||||
(define max-credits-scroll
|
(define max-credits-scroll
|
||||||
(+ game-height (* (- (vector-length credits) 9) credits-line-spacing)))
|
(+ game-height (* (- (vector-length credits) 9) credits-line-spacing)))
|
||||||
(define (draw-win)
|
(define (draw-credits)
|
||||||
(draw-level)
|
(draw-level)
|
||||||
(set-fill-color! context "#ffffff")
|
(set-fill-color! context "#ffffff")
|
||||||
(set-text-align! context "center")
|
(set-text-align! context "center")
|
||||||
|
@ -726,30 +943,13 @@
|
||||||
(scale! context *canvas-scale* *canvas-scale*)
|
(scale! context *canvas-scale* *canvas-scale*)
|
||||||
(draw-current-effect 'pre)
|
(draw-current-effect 'pre)
|
||||||
|
|
||||||
(match *state*
|
(match (current-game-state)
|
||||||
((or 'play 'interstitial)
|
((or 'play 'interstitial)
|
||||||
|
(draw-level))
|
||||||
|
('menu
|
||||||
(draw-level)
|
(draw-level)
|
||||||
;; Display input mappings on the title screen/first level.
|
(draw-menu))
|
||||||
(when (= *level-idx* 0)
|
('credits (draw-credits)))
|
||||||
(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-current-effect 'post)
|
(draw-current-effect 'post)
|
||||||
(request-animation-frame draw-callback)))
|
(request-animation-frame draw-callback)))
|
||||||
(define draw-callback (procedure->external draw))
|
(define draw-callback (procedure->external draw))
|
||||||
|
@ -761,6 +961,7 @@
|
||||||
(define key:up "ArrowUp")
|
(define key:up "ArrowUp")
|
||||||
(define key:confirm "Enter")
|
(define key:confirm "Enter")
|
||||||
(define key:undo "KeyZ")
|
(define key:undo "KeyZ")
|
||||||
|
(define key:menu "Space")
|
||||||
|
|
||||||
(define (on-key-down event)
|
(define (on-key-down event)
|
||||||
(let ((key (keyboard-event-code event)))
|
(let ((key (keyboard-event-code event)))
|
||||||
|
@ -776,7 +977,9 @@
|
||||||
((string=? key key:undo)
|
((string=? key key:undo)
|
||||||
(on-input-down 'undo))
|
(on-input-down 'undo))
|
||||||
((string=? key key:confirm)
|
((string=? key key:confirm)
|
||||||
(on-input-down 'confirm)))))
|
(on-input-down 'confirm))
|
||||||
|
((string=? key key:menu)
|
||||||
|
(on-input-down 'menu)))))
|
||||||
|
|
||||||
(define *gamepad* #f)
|
(define *gamepad* #f)
|
||||||
(define *button:left* #f)
|
(define *button:left* #f)
|
||||||
|
@ -837,7 +1040,7 @@
|
||||||
(on-input-down 'undo))))))))
|
(on-input-down 'undo))))))))
|
||||||
|
|
||||||
(define (on-input-down input)
|
(define (on-input-down input)
|
||||||
(match *state*
|
(match (current-game-state)
|
||||||
('play
|
('play
|
||||||
(match input
|
(match input
|
||||||
('left (move-player 'left))
|
('left (move-player 'left))
|
||||||
|
@ -849,9 +1052,23 @@
|
||||||
(with-goblins (update-objects!)))
|
(with-goblins (update-objects!)))
|
||||||
;; REMOVE BEFORE RELEASE!!!!
|
;; REMOVE BEFORE RELEASE!!!!
|
||||||
;; ('confirm (next-level!))
|
;; ('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.
|
;; 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
|
;; Canvas and event loop setup
|
||||||
(define canvas (get-element-by-id "canvas"))
|
(define canvas (get-element-by-id "canvas"))
|
||||||
|
|
|
@ -25,10 +25,12 @@
|
||||||
#:export (get-context
|
#:export (get-context
|
||||||
set-global-alpha!
|
set-global-alpha!
|
||||||
set-fill-color!
|
set-fill-color!
|
||||||
|
set-stroke-color!
|
||||||
set-font!
|
set-font!
|
||||||
set-text-align!
|
set-text-align!
|
||||||
clear-rect
|
clear-rect
|
||||||
fill-rect
|
fill-rect
|
||||||
|
stroke-rect
|
||||||
fill-text
|
fill-text
|
||||||
draw-image
|
draw-image
|
||||||
restore!
|
restore!
|
||||||
|
@ -51,6 +53,9 @@
|
||||||
(define-foreign set-fill-color!
|
(define-foreign set-fill-color!
|
||||||
"canvas" "setFillColor"
|
"canvas" "setFillColor"
|
||||||
(ref extern) (ref string) -> none)
|
(ref extern) (ref string) -> none)
|
||||||
|
(define-foreign set-stroke-color!
|
||||||
|
"canvas" "setStrokeColor"
|
||||||
|
(ref extern) (ref string) -> none)
|
||||||
(define-foreign set-font!
|
(define-foreign set-font!
|
||||||
"canvas" "setFont"
|
"canvas" "setFont"
|
||||||
(ref extern) (ref string) -> none)
|
(ref extern) (ref string) -> none)
|
||||||
|
|
Loading…
Add table
Reference in a new issue