diff options
| -rw-r--r-- | examples/grid.scm | 94 |
1 files changed, 63 insertions, 31 deletions
diff --git a/examples/grid.scm b/examples/grid.scm index 58ada10..51a4a37 100644 --- a/examples/grid.scm +++ b/examples/grid.scm @@ -5,16 +5,50 @@ (chickadee graphics) (chickadee graphics color) (chickadee graphics font) - (chickadee graphics shapes) + (chickadee graphics path) (chickadee graphics sprite)) (define grid (make-grid)) -(define item-color (make-color 0.7 0.0 0.0 0.5)) -(define cell-color (make-color 0.0 0.7 0.0 0.2)) +(define item-color (make-color 0.7 0.0 0.0 0.7)) +(define cell-color (make-color 0.0 0.7 0.0 0.4)) (define player-color (make-color 0.0 0.0 0.7 0.8)) -(define player-pos #v(32.0 32.0)) +(define player-pos (vec2 32.0 32.0)) (define player-speed 2) -(define player-velocity #v(0.0 0.0)) +(define player-velocity (vec2 0.0 0.0)) +(define null-vec2 (vec2 0.0 0.0)) +(define last-cell-count -1) +(define cell-painter + (with-style ((fill-color cell-color)) + (fill (square null-vec2 (grid-cell-size grid))))) +(define cell-canvas (make-empty-canvas)) +(define item-canvas (make-empty-canvas)) + +(define (make-cell-painter) + (let ((size (grid-cell-size grid))) + (apply superimpose + (grid-cell-fold (lambda (cell x y memo) + (cons (translate (vec2 (* x size) (* y size)) + cell-painter) + memo)) + '() + grid)))) + +(define (make-item-painter item rect) + (with-style ((fill-color (if (eq? item 'player) + player-color + item-color))) + (fill + (rectangle (vec2 (rect-x rect) + (rect-y rect)) + (rect-width rect) + (rect-height rect))))) + +(define (compose-item-painters) + (apply superimpose + (grid-item-fold (lambda (item rect memo) + (cons (make-item-painter item rect) memo)) + '() + grid))) (define (load) (grid-add grid 'wall-left 0 0 32 480) @@ -25,7 +59,8 @@ (grid-add grid 'box-2 300 300 50 100) (grid-add grid 'box-3 350 150 200 75) (grid-add grid 'box-4 150 140 130 75) - (grid-add grid 'player (vec2-x player-pos) (vec2-y player-pos) 32 32)) + (grid-add grid 'player (vec2-x player-pos) (vec2-y player-pos) 32 32) + (set-canvas-painter! item-canvas (compose-item-painters))) (define (update dt) (set-vec2-x! player-velocity 0.0) @@ -38,17 +73,23 @@ (set-vec2-x! player-velocity player-speed)) (when (key-pressed? 'left) (set-vec2-x! player-velocity (- player-speed))) - (vec2-add! player-pos player-velocity) - (grid-move grid 'player player-pos - (lambda (a b) - (if (eq? a 'player) - slide - #f)))) + (unless (vec2= player-velocity null-vec2) + (vec2-add! player-pos player-velocity) + (grid-move grid 'player player-pos + (lambda (a b) + (if (eq? a 'player) + slide + #f))) + (set-canvas-painter! item-canvas (compose-item-painters))) + (let ((cell-count (grid-cell-count grid))) + (unless (= cell-count last-cell-count) + (set! last-cell-count cell-count) + (set-canvas-painter! cell-canvas (make-cell-painter))))) (define %cell-rect (make-rect 0.0 0.0 (grid-cell-size grid) (grid-cell-size grid))) (define %cell-count-pos - #v(0.0 0.0)) + (vec2 0.0 0.0)) (define number->string* (let ((cache (make-hash-table))) @@ -60,23 +101,14 @@ s)))))) (define (draw alpha) - (with-blend-mode 'alpha - (let ((size (grid-cell-size grid))) - (for-each-cell (lambda (cell x y) - (set-rect-x! %cell-rect (* x size)) - (set-rect-y! %cell-rect (* y size)) - (draw-filled-rect %cell-rect cell-color)) - grid) - (for-each-cell (lambda (cell x y) - (set-vec2-x! %cell-count-pos (+ (* x size) (/ size 2))) - (set-vec2-y! %cell-count-pos (+ (* y size) (/ size 2))) - (draw-text (number->string* (cell-count cell)) - %cell-count-pos)) - grid)) - (for-each-item (lambda (item rect) - (if (eq? item 'player) - (draw-filled-rect rect player-color) - (draw-filled-rect rect item-color))) - grid))) + (draw-canvas cell-canvas) + (let ((size (grid-cell-size grid))) + (for-each-cell (lambda (cell x y) + (set-vec2-x! %cell-count-pos (+ (* x size) (/ size 2))) + (set-vec2-y! %cell-count-pos (+ (* y size) (/ size 2))) + (draw-text (number->string* (cell-count cell)) + %cell-count-pos)) + grid)) + (draw-canvas item-canvas)) (run-game #:load load #:draw draw #:update update) |