(use-modules (chickadee) (chickadee math vector) (chickadee math rect) (chickadee math grid) (chickadee render font) (chickadee render sprite) (chickadee render texture) (chickadee render tiled) (chickadee render color) (chickadee render shapes) (oop goops)) (define-class () (pos #:init-keyword #:pos #:getter get-pos #:setter set-pos!) (size #:init-keyword #:size #:getter get-size) (falling #:init-value #t #:getter is-falling? #:setter set-falling!) (draw-offset #:init-keyword #:draw-offset #:getter get-draw-offset) (y-vel #:init-value 0.0 #:getter get-y-vel #:setter set-y-vel!) (face-direction #:init-keyword #:face-dir #:setter set-face-direction! #:getter get-face-direction) (animation-step #:init-value 0 #:getter get-animation-step #:setter set-animation-step!) (sprite #:init-keyword #:sprite #:getter get-sprite)) (define (draw-animal animal) (define (face-row dir) (if (> 0 dir) 4 12)) (draw-sprite (texture-atlas-ref (get-sprite animal) (+ (face-row (get-face-direction animal)) (truncate (/ (get-animation-step animal) 4)))) (vec2- (get-screen-pos animal) (get-draw-offset animal)))) ;; -------------- Initial game state -------------- (define llama #f) (define sheep #f) (define tile-map #f) (define view-pos #v(0.0 0.0)) (define grid (make-grid 64)) (define show-hitboxes #f) (define (load) (set! llama (make #:pos #v(200.0 200.0) #:size #v(128.0 128.0) #:draw-offset #v(17 12) #:face-dir 1 #:sprite (split-texture (load-image "llama_walk.png") 80 80 #:spacing 48 #:margin 24))) (grid-add grid 'llama 203.0 200.0 44.0 58.0) (set! sheep (make #:pos #v(400.0 115.0) #:size #v(128.0 128.0) #:draw-offset #v(18 12) #:face-dir 1 #:sprite (split-texture (load-image "sheep_walk.png") 80 80 #:spacing 48 #:margin 24))) (grid-add grid 'sheep 400.0 115.0 45.0 45.0) (set! tile-map (load-tile-map "llama.tmx")) ;; Add objects from map to grid (define (add-to-grid obj) (let ((shape (map-object-shape obj))) (grid-add grid (map-object-id obj) (rect-x shape) (- (rect-y shape) (rect-height shape)) (rect-width shape) (rect-height shape)))) (let ((objects (object-layer-objects (vector-ref (tile-map-layers tile-map) 1)))) (for-each (lambda (obj) (add-to-grid obj)) objects))) ;; ------------------------------------------------ (define (draw alpha) (draw-tile-map tile-map #:position (vec2* view-pos -1.0)) (draw-animal llama) (draw-animal sheep) (when show-hitboxes (let ((col (make-color 0.0 0.0 0.7 0.8))) (for-each-item (lambda (item rect) (draw-filled-rect (rect-move-by-vec2 rect (vec2* view-pos -1)) col)) grid)))) (define (get-screen-pos animal) (vec2- (get-pos animal) view-pos)) (define (rect-xy rect) #v((rect-x rect) (rect-y rect))) (define (get-screen-rect animal) (let ((screen-pos (get-screen-pos animal))) (make-rect (vec2-x screen-pos) (vec2-y screen-pos) (vec2-x (get-size animal)) (vec2-y (get-size animal))))) (define (overshoot small-rect big-rect) (let ((moved-small-rect (rect-clamp small-rect big-rect))) (vec2- (rect-xy small-rect) (rect-xy moved-small-rect)))) (define (vertical-overlap a b) (or (> (rect-right b) (rect-left a) (rect-left b)) (> (rect-right b) (rect-right a) (rect-left b)))) (define (rect-above a b) (>= (rect-bottom a) (rect-top b))) (define (update tstep) (let ((x-vel 0.0)) (when (and (key-pressed? 'space) (not (is-falling? llama))) (set-y-vel! llama 8.0) (set-falling! llama #t)) (when (key-pressed? 'right) (set-face-direction! llama 1) (set! x-vel 4.0) (set-animation-step! llama (floor-remainder (+ (get-animation-step llama) -1) 16)) (set-falling! llama #t)) (when (key-pressed? 'left) (set-face-direction! llama -1) (set! x-vel -4.0) (set-animation-step! llama (floor-remainder (- (get-animation-step llama) 1) 16)) (set-falling! llama #t)) (vec2-add! (get-pos llama) #v(x-vel 0.0)) (grid-move grid 'llama (get-pos llama) (lambda (a b) (if (eq? a 'llama) (lambda (item item-rect other other-rect goal) (slide item item-rect other other-rect goal)) #f)))) ;; Gravity (when (is-falling? llama) (vec2-add! (get-pos llama) #v(0.0 (get-y-vel llama))) (set-y-vel! llama (- (get-y-vel llama) 0.4)) (grid-move grid 'llama (get-pos llama) (lambda (a b) (if (eq? a 'llama) (lambda (item item-rect other other-rect goal) (when (vertical-overlap item-rect other-rect) (set-y-vel! llama 0.0) (when (rect-above item-rect other-rect) (set-falling! llama #f))) (slide item item-rect other other-rect goal)) #f)))) ;; Ensure llama is near centre of screen (let ((fovea (make-rect 150.0 100.0 450.0 350.0)) (llama-rect (get-screen-rect llama))) (unless (rect-within? llama-rect fovea) (vec2-add! view-pos (overshoot llama-rect fovea))))) (define (key-press key scancode modifier repeat?) (case key ((q) (abort-game)) ((f1) (set! show-hitboxes (not show-hitboxes))))) (run-game #:window-title "Hey Llama!" #:load load #:draw draw #:key-press key-press #:update-hz 60 #:update update)