Update game to just have a player
It is not working right now, but at least we are able to draw!
This commit is contained in:
parent
4613bf58f3
commit
9e502b0595
GPG key ID:
A64F41345C7400AF
2 changed files with 217 additions and 232 deletions
159
.dir-locals.el
Normal file
159
.dir-locals.el
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
;; Per-directory local variables for GNU Emacs 23 and later.
|
||||
|
||||
((nil
|
||||
. ((fill-column . 78)
|
||||
(tab-width . 8)
|
||||
(sentence-end-double-space . t)
|
||||
|
||||
(eval . (add-to-list 'completion-ignored-extensions ".go"))
|
||||
|
||||
;; Geiser
|
||||
;; This allows automatically setting the `geiser-guile-load-path'
|
||||
;; variable when using various Guix checkouts (e.g., via git worktrees).
|
||||
(geiser-repl-per-project-p . t)))
|
||||
|
||||
(c-mode . ((c-file-style . "gnu")))
|
||||
(scheme-mode
|
||||
.
|
||||
((indent-tabs-mode . nil)
|
||||
(eval . (put 'eval-when 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-prompt 'scheme-indent-function 1))
|
||||
(eval . (put 'test-assert 'scheme-indent-function 1))
|
||||
(eval . (put 'test-assertm 'scheme-indent-function 1))
|
||||
(eval . (put 'test-equalm 'scheme-indent-function 1))
|
||||
(eval . (put 'test-equal 'scheme-indent-function 1))
|
||||
(eval . (put 'test-eq 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-input-string 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-port 'scheme-indent-function 1))
|
||||
(eval . (put 'guard 'scheme-indent-function 1))
|
||||
(eval . (put 'lambda* 'scheme-indent-function 1))
|
||||
(eval . (put 'substitute* 'scheme-indent-function 1))
|
||||
(eval . (put 'match-record 'scheme-indent-function 3))
|
||||
(eval . (put 'match-record-lambda 'scheme-indent-function 2))
|
||||
|
||||
;; TODO: Contribute these to Emacs' scheme-mode.
|
||||
(eval . (put 'let-keywords 'scheme-indent-function 3))
|
||||
|
||||
;; 'modify-inputs' and its keywords.
|
||||
(eval . (put 'modify-inputs 'scheme-indent-function 1))
|
||||
(eval . (put 'replace 'scheme-indent-function 1))
|
||||
|
||||
;; 'modify-phases' and its keywords.
|
||||
(eval . (put 'modify-phases 'scheme-indent-function 1))
|
||||
(eval . (put 'replace 'scheme-indent-function 1))
|
||||
(eval . (put 'add-before 'scheme-indent-function 2))
|
||||
(eval . (put 'add-after 'scheme-indent-function 2))
|
||||
|
||||
(eval . (put 'modify-services 'scheme-indent-function 1))
|
||||
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
|
||||
(eval . (put 'with-file-lock 'scheme-indent-function 1))
|
||||
(eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1))
|
||||
(eval . (put 'with-profile-lock 'scheme-indent-function 1))
|
||||
(eval . (put 'with-writable-file 'scheme-indent-function 2))
|
||||
|
||||
(eval . (put 'package 'scheme-indent-function 0))
|
||||
(eval . (put 'package/inherit 'scheme-indent-function 1))
|
||||
(eval . (put 'origin 'scheme-indent-function 0))
|
||||
(eval . (put 'build-system 'scheme-indent-function 0))
|
||||
(eval . (put 'bag 'scheme-indent-function 0))
|
||||
(eval . (put 'graft 'scheme-indent-function 0))
|
||||
(eval . (put 'operating-system 'scheme-indent-function 0))
|
||||
(eval . (put 'file-system 'scheme-indent-function 0))
|
||||
(eval . (put 'manifest-entry 'scheme-indent-function 0))
|
||||
(eval . (put 'manifest-pattern 'scheme-indent-function 0))
|
||||
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
|
||||
(eval . (put 'with-store 'scheme-indent-function 1))
|
||||
(eval . (put 'with-external-store 'scheme-indent-function 1))
|
||||
(eval . (put 'with-error-handling 'scheme-indent-function 0))
|
||||
(eval . (put 'with-mutex 'scheme-indent-function 1))
|
||||
(eval . (put 'with-atomic-file-output 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2))
|
||||
(eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
|
||||
(eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-lzip-input-port 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-lzip-output-port 'scheme-indent-function 1))
|
||||
(eval . (put 'signature-case 'scheme-indent-function 1))
|
||||
(eval . (put 'emacs-batch-eval 'scheme-indent-function 0))
|
||||
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
|
||||
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
|
||||
(eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
|
||||
(eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
|
||||
(eval . (put 'with-derivation-substitute 'scheme-indent-function 2))
|
||||
(eval . (put 'with-status-report 'scheme-indent-function 1))
|
||||
(eval . (put 'with-status-verbosity 'scheme-indent-function 1))
|
||||
(eval . (put 'with-build-handler 'scheme-indent-function 1))
|
||||
|
||||
(eval . (put 'mlambda 'scheme-indent-function 1))
|
||||
(eval . (put 'mlambdaq 'scheme-indent-function 1))
|
||||
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
|
||||
(eval . (put 'with-monad 'scheme-indent-function 1))
|
||||
(eval . (put 'mbegin 'scheme-indent-function 1))
|
||||
(eval . (put 'mwhen 'scheme-indent-function 1))
|
||||
(eval . (put 'munless 'scheme-indent-function 1))
|
||||
(eval . (put 'mlet* 'scheme-indent-function 2))
|
||||
(eval . (put 'mlet 'scheme-indent-function 2))
|
||||
(eval . (put 'mparameterize 'scheme-indent-function 2))
|
||||
(eval . (put 'run-with-store 'scheme-indent-function 1))
|
||||
(eval . (put 'run-with-state 'scheme-indent-function 1))
|
||||
(eval . (put 'wrap-program 'scheme-indent-function 1))
|
||||
(eval . (put 'wrap-script 'scheme-indent-function 1))
|
||||
(eval . (put 'with-imported-modules 'scheme-indent-function 1))
|
||||
(eval . (put 'with-extensions 'scheme-indent-function 1))
|
||||
(eval . (put 'with-parameters 'scheme-indent-function 1))
|
||||
(eval . (put 'let-system 'scheme-indent-function 1))
|
||||
(eval . (put 'with-build-variables 'scheme-indent-function 2))
|
||||
|
||||
(eval . (put 'with-database 'scheme-indent-function 2))
|
||||
(eval . (put 'call-with-database 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-transaction 'scheme-indent-function 1))
|
||||
(eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1))
|
||||
|
||||
(eval . (put 'call-with-container 'scheme-indent-function 1))
|
||||
(eval . (put 'container-excursion 'scheme-indent-function 1))
|
||||
(eval . (put 'eventually 'scheme-indent-function 1))
|
||||
|
||||
(eval . (put 'call-with-progress-reporter 'scheme-indent-function 1))
|
||||
(eval . (put 'with-repository 'scheme-indent-function 2))
|
||||
(eval . (put 'with-temporary-git-repository 'scheme-indent-function 2))
|
||||
(eval . (put 'with-environment-variables 'scheme-indent-function 1))
|
||||
(eval . (put 'with-fresh-gnupg-setup 'scheme-indent-function 1))
|
||||
|
||||
(eval . (put 'with-paginated-output-port 'scheme-indent-function 1))
|
||||
|
||||
(eval . (put 'with-shepherd-action 'scheme-indent-function 3))
|
||||
|
||||
(eval . (put 'with-http-server 'scheme-indent-function 1))
|
||||
|
||||
;; This notably allows '(' in Paredit to not insert a space when the
|
||||
;; preceding symbol is one of these.
|
||||
(eval . (modify-syntax-entry ?~ "'"))
|
||||
(eval . (modify-syntax-entry ?$ "'"))
|
||||
(eval . (modify-syntax-entry ?+ "'"))
|
||||
|
||||
;; Emacs 28 changed the behavior of 'lisp-fill-paragraph', which causes the
|
||||
;; first line of package descriptions to extrude past 'fill-column', and
|
||||
;; somehow that is deemed more correct upstream (see:
|
||||
;; https://issues.guix.gnu.org/56197).
|
||||
(eval . (progn
|
||||
(require 'lisp-mode)
|
||||
(defun emacs27-lisp-fill-paragraph (&optional justify)
|
||||
(interactive "P")
|
||||
(or (fill-comment-paragraph justify)
|
||||
(let ((paragraph-start
|
||||
(concat paragraph-start
|
||||
"\\|\\s-*\\([(;\"]\\|\\s-:\\|`(\\|#'(\\)"))
|
||||
(paragraph-separate
|
||||
(concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
|
||||
(fill-column (if (and (integerp emacs-lisp-docstring-fill-column)
|
||||
(derived-mode-p 'emacs-lisp-mode))
|
||||
emacs-lisp-docstring-fill-column
|
||||
fill-column)))
|
||||
(fill-paragraph justify))
|
||||
;; Never return nil.
|
||||
t))
|
||||
(setq-local fill-paragraph-function #'emacs27-lisp-fill-paragraph)))))
|
||||
|
||||
(emacs-lisp-mode . ((indent-tabs-mode . nil)))
|
||||
(texinfo-mode . ((indent-tabs-mode . nil)
|
||||
(fill-column . 72))))
|
||||
290
game.scm
290
game.scm
|
|
@ -36,118 +36,51 @@
|
|||
(math vector))
|
||||
|
||||
;; Data types
|
||||
(define-record-type <brick-type>
|
||||
(make-brick-type image points)
|
||||
brick-type?
|
||||
(image brick-type-image)
|
||||
(points brick-type-points))
|
||||
|
||||
(define-record-type <brick>
|
||||
(make-brick type hitbox)
|
||||
brick?
|
||||
(type brick-type)
|
||||
(hitbox brick-hitbox)
|
||||
(broken? brick-broken? set-brick-broken!))
|
||||
|
||||
(define-record-type <ball>
|
||||
(make-ball velocity hitbox)
|
||||
ball?
|
||||
(velocity ball-velocity)
|
||||
(hitbox ball-hitbox))
|
||||
|
||||
(define-record-type <paddle>
|
||||
(make-paddle velocity hitbox)
|
||||
paddle?
|
||||
(velocity paddle-velocity)
|
||||
(hitbox paddle-hitbox))
|
||||
|
||||
(define-record-type <level>
|
||||
(make-level state bricks ball paddle score move-left? move-right? move-up? move-down?)
|
||||
(make-level state player move-left? move-right? move-up? move-down?)
|
||||
level?
|
||||
(state level-state set-level-state!) ; play, win, lose
|
||||
(bricks level-bricks)
|
||||
(ball level-ball)
|
||||
(paddle level-paddle)
|
||||
(score level-score set-level-score!)
|
||||
(player level-player)
|
||||
(move-left? level-move-left? set-level-move-left!)
|
||||
(move-right? level-move-right? set-level-move-right!)
|
||||
(move-up? level-move-up? set-level-move-up!)
|
||||
(move-down? level-move-down? set-level-move-up!))
|
||||
(move-down? level-move-down? set-level-move-down!))
|
||||
|
||||
(define-record-type <player>
|
||||
(make-player velocity position hitbox weapon-primary)
|
||||
entity?
|
||||
(velocity player-velocity player-velocity-set!)
|
||||
(position player-position player-position-set!)
|
||||
(hitbox player-hitbox player-hitbox-set!)
|
||||
(weapon-primary player-weapon-primary player-weapon-primary-set!))
|
||||
|
||||
;; Assets
|
||||
(define image:paddle (make-image "assets/images/paddle.png"))
|
||||
(define image:ball (make-image "assets/images/ball.png"))
|
||||
(define image:brick-red (make-image "assets/images/brick-red.png"))
|
||||
(define image:brick-green (make-image "assets/images/brick-green.png"))
|
||||
(define image:brick-blue (make-image "assets/images/brick-blue.png"))
|
||||
(define audio:brick (make-audio "assets/sounds/brick.wav"))
|
||||
(define audio:paddle (make-audio "assets/sounds/paddle.wav"))
|
||||
(define image:player (make-image "assets/images/ball.png"))
|
||||
|
||||
;; Game data
|
||||
(define game-width 640.0)
|
||||
(define game-height 480.0)
|
||||
(define brick-width 64.0)
|
||||
(define brick-height 32.0)
|
||||
(define ball-width 22.0)
|
||||
(define ball-height 22.0)
|
||||
(define paddle-width 104.0)
|
||||
(define paddle-height 24.0)
|
||||
(define paddle-speed 6.0)
|
||||
(define brick:red (make-brick-type image:brick-red 10))
|
||||
(define brick:green (make-brick-type image:brick-green 20))
|
||||
(define brick:blue (make-brick-type image:brick-blue 30))
|
||||
(define player-width 22.0)
|
||||
(define player-height 22.0)
|
||||
(define player-speed 6.0)
|
||||
|
||||
(define (make-brick* type x y)
|
||||
(make-brick type (make-rect x y brick-width brick-height)))
|
||||
|
||||
(define (make-brick-grid types)
|
||||
(let* ((h (vector-length types))
|
||||
(w (vector-length (vector-ref types 0)))
|
||||
(offset-x (/ (- game-width (* w brick-width)) 2.0))
|
||||
(offset-y 48.0)
|
||||
(bricks (make-vector (* w h))))
|
||||
(do ((y 0 (+ y 1)))
|
||||
((= y h))
|
||||
(let ((row (vector-ref types y)))
|
||||
(do ((x 0 (+ x 1)))
|
||||
((= x w))
|
||||
(vector-set! bricks (+ (* y w) x)
|
||||
(make-brick* (vector-ref row x)
|
||||
(+ offset-x (* x brick-width))
|
||||
(+ offset-y (* y brick-height)))))))
|
||||
bricks))
|
||||
(define (make-player* x y)
|
||||
(make-player (vec2 0.0 0.0)
|
||||
(vec2 x y)
|
||||
(vec2 player-width player-height)
|
||||
'test-shot))
|
||||
|
||||
(define (make-level-1)
|
||||
(make-level 'play
|
||||
(make-brick-grid
|
||||
(vector
|
||||
(vector brick:red brick:green brick:blue brick:red brick:green brick:blue brick:red brick:green)
|
||||
(vector brick:green brick:blue brick:red brick:green brick:blue brick:red brick:green brick:blue)
|
||||
(vector brick:blue brick:red brick:green brick:blue brick:red brick:green brick:blue brick:red)
|
||||
(vector brick:red brick:green brick:blue brick:red brick:green brick:blue brick:red brick:green)
|
||||
(vector brick:green brick:blue brick:red brick:green brick:blue brick:red brick:green brick:blue)
|
||||
(vector brick:blue brick:red brick:green brick:blue brick:red brick:green brick:blue brick:red)))
|
||||
(make-ball (vec2 1.0 3.0)
|
||||
(make-rect (/ game-width 2.0) (/ game-height 2.0)
|
||||
ball-width ball-height))
|
||||
(make-paddle (vec2 0.0 0.0)
|
||||
(make-rect (- (/ game-width 2.0)
|
||||
(/ paddle-width 2.0))
|
||||
(- game-height paddle-height 8.0)
|
||||
paddle-width paddle-height))
|
||||
0 #f #f #f #f))
|
||||
(make-player* 0 0)
|
||||
#f #f #f #f))
|
||||
|
||||
;; Game state
|
||||
(define *level* (make-level-1))
|
||||
|
||||
(define (level-clear? level)
|
||||
(let ((bricks (level-bricks level)))
|
||||
(let loop ((i 0))
|
||||
(if (< i (vector-length bricks))
|
||||
(if (brick-broken? (vector-ref bricks i))
|
||||
(loop (+ i 1))
|
||||
#f)
|
||||
#t))))
|
||||
(#f))
|
||||
|
||||
(define (win! level)
|
||||
(set-level-state! level 'win))
|
||||
|
|
@ -155,101 +88,37 @@
|
|||
(define (lose! level)
|
||||
(set-level-state! level 'lose))
|
||||
|
||||
(define (update-paddle-velocity! level)
|
||||
(let ((speed (* paddle-speed
|
||||
(define (update-play-velocity! level)
|
||||
(let ((speed (* player-speed
|
||||
(+ (if (level-move-left? level) -1.0 0.0)
|
||||
(if (level-move-right? level) 1.0 0.0)
|
||||
(if (level-move-up? level) 0.0 1.0)
|
||||
(if (level-move-down? level) 0.0 -1.0)))))
|
||||
(set-vec2-x! (paddle-velocity (level-paddle level)) speed)))
|
||||
|
||||
(define (speed-up-ball! ball)
|
||||
(let* ((v (ball-velocity ball))
|
||||
(speed (+ (vec2-magnitude v) (* (random) 0.1)))
|
||||
;; Also change its angle slightly. Not the proper Breakout
|
||||
;; behavior but I don't want to write the code for that. :)
|
||||
(dir (+ (atan (vec2-y v) (vec2-x v))
|
||||
(- (* (random) 0.5) 0.25))))
|
||||
(set-vec2-x! v (* (cos dir) speed))
|
||||
(set-vec2-y! v (* (sin dir) speed))))
|
||||
|
||||
(define (reflect-ball! ball x? y?)
|
||||
(let ((v (ball-velocity ball)))
|
||||
(when x? (set-vec2-x! v (- (vec2-x v))))
|
||||
(when y? (set-vec2-y! v (- (vec2-y v))))))
|
||||
|
||||
(define (collide-ball! ball hitbox)
|
||||
(let ((b-hitbox (ball-hitbox ball)))
|
||||
(and (rect-intersects? b-hitbox hitbox)
|
||||
(let ((overlap (rect-clip b-hitbox hitbox)))
|
||||
;; Resolve collision by adjusting the ball's position the
|
||||
;; minimum amount along the X or Y axis.
|
||||
(if (< (rect-width overlap) (rect-height overlap))
|
||||
(begin
|
||||
(reflect-ball! ball #t #f)
|
||||
(if (= (rect-x b-hitbox) (rect-x overlap))
|
||||
(set-rect-x! b-hitbox (+ (rect-x b-hitbox) (rect-width overlap)))
|
||||
(set-rect-x! b-hitbox (- (rect-x b-hitbox) (rect-width overlap)))))
|
||||
(begin
|
||||
(reflect-ball! ball #f #t)
|
||||
(if (= (rect-y b-hitbox) (rect-y overlap))
|
||||
(set-rect-y! b-hitbox (+ (rect-y b-hitbox) (rect-height overlap)))
|
||||
(set-rect-y! b-hitbox (- (rect-y b-hitbox) (rect-height overlap))))))))))
|
||||
(set-vec2-x! (player-velocity (level-player level)) speed)
|
||||
(set-vec2-y! (player-velocity (level-player level)) speed)))
|
||||
|
||||
(define dt (/ 1000.0 60.0)) ; aim for updating at 60Hz
|
||||
(define (update)
|
||||
(match (level-state *level*)
|
||||
('play
|
||||
(let* ((bricks (level-bricks *level*))
|
||||
(ball (level-ball *level*))
|
||||
(b-velocity (ball-velocity ball))
|
||||
(b-hitbox (ball-hitbox ball))
|
||||
(paddle (level-paddle *level*))
|
||||
(p-velocity (paddle-velocity paddle))
|
||||
(p-hitbox (paddle-hitbox paddle))
|
||||
(score (level-score *level*)))
|
||||
;; Move ball and paddle
|
||||
(set-rect-x! b-hitbox (+ (rect-x b-hitbox) (vec2-x b-velocity)))
|
||||
(set-rect-y! b-hitbox (+ (rect-y b-hitbox) (vec2-y b-velocity)))
|
||||
;; We only move the paddle along the x-axis.
|
||||
(set-rect-x! p-hitbox
|
||||
(clamp (+ (rect-x p-hitbox) (vec2-x p-velocity))
|
||||
0.0
|
||||
(- game-width paddle-width)))
|
||||
;; Collide ball against walls, bricks, and paddle.
|
||||
(let* ((player (level-player *level*))
|
||||
(p-velocity (player-velocity player))
|
||||
(p-position (player-position player))
|
||||
(p-hitbox (player-hitbox player)))
|
||||
;; Move player
|
||||
(set-vec2-x! p-position (+ (vec2-x p-position) (vec2-x p-velocity)))
|
||||
(set-vec2-y! p-position (+ (vec2-y p-position) (vec2-y p-velocity)))
|
||||
|
||||
;; Keep player within the bounds of the game
|
||||
(cond
|
||||
((< (rect-x b-hitbox) 0.0) ; left wall
|
||||
(set-rect-x! b-hitbox 0.0)
|
||||
(reflect-ball! ball #t #f))
|
||||
((> (+ (rect-x b-hitbox) (rect-width b-hitbox)) game-width) ; right wall
|
||||
(set-rect-x! b-hitbox (- game-width (rect-width b-hitbox)))
|
||||
(reflect-ball! ball #t #f))
|
||||
((< (rect-y b-hitbox) 0.0) ; top wall
|
||||
(set-rect-y! b-hitbox 0.0)
|
||||
(reflect-ball! ball #f #t))
|
||||
((> (+ (rect-y b-hitbox) (rect-height b-hitbox)) game-height) ; bottom wall
|
||||
(lose! *level*))
|
||||
((collide-ball! ball (paddle-hitbox paddle))
|
||||
(media-play audio:paddle)
|
||||
(speed-up-ball! ball))
|
||||
(else
|
||||
(let loop ((i 0) (hit? #f))
|
||||
(if (< i (vector-length bricks))
|
||||
(let ((brick (vector-ref bricks i)))
|
||||
(if (and (not (brick-broken? brick))
|
||||
(collide-ball! ball (brick-hitbox brick)))
|
||||
(begin
|
||||
(media-play audio:brick)
|
||||
(speed-up-ball! ball)
|
||||
(set-brick-broken! brick #t)
|
||||
(set-level-score! *level*
|
||||
(+ (level-score *level*)
|
||||
(brick-type-points (brick-type brick))))
|
||||
(loop (+ i 1) #t))
|
||||
(loop (+ i 1) hit?)))
|
||||
;; Maybe change to win state if all bricks are broken.
|
||||
(when (and hit? (level-clear? *level*))
|
||||
(win! *level*))))))))
|
||||
((< (vec2-x p-position) 0.0) ; left wall
|
||||
(set-vec2-x! p-position 0.0))
|
||||
((> (vec2-x p-position) game-width) ; right wall
|
||||
(set-vec2-x! p-position game-width)))
|
||||
((< (vec2-y p-position) 0.0) ; top wall
|
||||
(set-vec2-y! p-position 0.0))
|
||||
((> (vec2-y p-position) game-height) ; bottom wall
|
||||
(set-vec2-y! p-position game-height))))
|
||||
(_ #t))
|
||||
(timeout update-callback dt))
|
||||
(define update-callback (procedure->external update))
|
||||
|
|
@ -264,53 +133,18 @@
|
|||
str)))))
|
||||
|
||||
(define (draw prev-time)
|
||||
(let ((bricks (level-bricks *level*))
|
||||
(ball (level-ball *level*))
|
||||
(paddle (level-paddle *level*))
|
||||
(score (level-score *level*)))
|
||||
(let ((player (level-player *level*)))
|
||||
;; Draw background
|
||||
(set-fill-color! context "#140c1c")
|
||||
(fill-rect context 0.0 0.0 game-width game-height)
|
||||
;; Draw bricks
|
||||
(do ((i 0 (+ i 1)))
|
||||
((= i (vector-length bricks)))
|
||||
(let* ((brick (vector-ref bricks i))
|
||||
(type (brick-type brick))
|
||||
(hitbox (brick-hitbox brick)))
|
||||
(unless (brick-broken? brick)
|
||||
(draw-image context (brick-type-image type)
|
||||
0.0 0.0
|
||||
brick-width brick-height
|
||||
(rect-x hitbox) (rect-y hitbox)
|
||||
brick-width brick-height))))
|
||||
;; Draw paddle
|
||||
(let ((w 104.0)
|
||||
(h 24.0)
|
||||
(hitbox (paddle-hitbox paddle)))
|
||||
(draw-image context image:paddle
|
||||
0.0 0.0 w h
|
||||
(rect-x hitbox) (rect-y hitbox) w h))
|
||||
;; Draw ball
|
||||
|
||||
;; Draw player
|
||||
(let ((w 22.0)
|
||||
(h 22.0)
|
||||
(hitbox (ball-hitbox ball)))
|
||||
(draw-image context image:ball
|
||||
(position (player-position player)))
|
||||
(draw-image context image:player
|
||||
0.0 0.0 w h
|
||||
(rect-x hitbox) (rect-y hitbox) w h))
|
||||
;; Print score
|
||||
(set-fill-color! context "#ffffff")
|
||||
(set-font! context "bold 24px monospace")
|
||||
(set-text-align! context "left")
|
||||
(fill-text context "SCORE:" 16.0 36.0)
|
||||
(fill-text context (number->string* score) 108.0 36.0)
|
||||
(match (level-state *level*)
|
||||
('win
|
||||
(set-text-align! context "center")
|
||||
(fill-text context "YAY YOU DID IT!!!" (/ game-width 2.0) (/ game-height 2.0)))
|
||||
('lose
|
||||
(set-text-align! context "center")
|
||||
(fill-text context "OH NO, GAME OVER :(" (/ game-width 2.0) (/ game-height 2.0)))
|
||||
(_ #t)))
|
||||
(vec2-x position) (vec2-y position) w h)))
|
||||
(request-animation-frame draw-callback))
|
||||
(define draw-callback (procedure->external draw))
|
||||
|
||||
|
|
@ -327,17 +161,13 @@
|
|||
('play
|
||||
(cond
|
||||
((string=? key key:left)
|
||||
(set-level-move-left! *level* #t)
|
||||
(update-paddle-velocity! *level*))
|
||||
(set-level-move-left! *level* #t))
|
||||
((string=? key key:right)
|
||||
(set-level-move-right! *level* #t)
|
||||
(update-paddle-velocity! *level*))
|
||||
(set-level-move-right! *level* #t))
|
||||
((string=? key key:up)
|
||||
(set-level-move-up! *level* #t)
|
||||
(update-paddle-velocity! *level*))
|
||||
(set-level-move-up! *level* #t))
|
||||
((string=? key key:down)
|
||||
(set-level-move-down! *level* #t)
|
||||
(update-paddle-velocity! *level*))))
|
||||
(set-level-move-down! *level* #t))))
|
||||
((or 'win 'lose)
|
||||
(when (string=? key key:confirm)
|
||||
(set! *level* (make-level-1)))))))
|
||||
|
|
@ -348,17 +178,13 @@
|
|||
('play
|
||||
(cond
|
||||
((string=? key key:left)
|
||||
(set-level-move-left! *level* #f)
|
||||
(update-paddle-velocity! *level*))
|
||||
(set-level-move-left! *level* #f))
|
||||
((string=? key key:right)
|
||||
(set-level-move-right! *level* #f)
|
||||
(update-paddle-velocity! *level*))
|
||||
(set-level-move-right! *level* #f))
|
||||
((string=? key key:up)
|
||||
(set-level-move-up! *level* #f)
|
||||
(update-paddle-velocity! *level*))
|
||||
(set-level-move-up! *level* #f))
|
||||
((string=? key key:down)
|
||||
(set-level-move-down! *level* #f)
|
||||
(update-paddle-velocity! *level*))))
|
||||
(set-level-move-down! *level* #f))))
|
||||
(_ #t))))
|
||||
|
||||
;; Canvas and event loop setup
|
||||
|
|
|
|||
Loading…
Reference in a new issue