` 63P?p:(VE+@5!ϼvxM`_3z~gQgZ/HEBYaF~s,]']>S}Wup8d%qy)6o;]AsVl33DD43C[U{Ww{{0000  00000000  0000{[UW{000000  00000000  00\ "b""b""""" """ "" 2$ C4 < <2##$ 2D0#L@< "2### 34 L0< C<"" "b"b"!!" "! ""/" " RRUUUUU%R UUU PUUUUUUUUUUPUUUPO  " " " "" "" """N`oOONO """""""""""""""""""""" """""""""""""""""`ff`o`ff """""""""""""" """ """ """"""""""""""""""""""""""""""33333333 """""""""""" "" "" """"""""""""""""""" " "pwPUwPUwPU3s333s333w333wwUwUw7U733w33w73PUpwPUwPU3w333s333s333wwUUw7Uw73733w73 @$"D4"DC3CD"#"4"" @ 303 "0@"3 @C 03D4"@D# @ DD@ 3@32340#0$""0@D"3"BC$ $ "$0@3B333w33w333333PU33PU0PUw3w33?3333U3UU333w33w333333PU33PU0PUw3w33?3333U3UU3@4B4"@0""2 30 #"33@@2DDD0B@D03#CD @D2D#DD#BD0"4B0BDD@D0D303#C#4#"DDC$ "0 @ @ @ @ @ @ @ @ @@@@@@@@@@DEFHJLMOOOOOHPW0 004 4 6 79;<>>????????>>>=====>9: $J$K#\#m#}#}$l$K%%&'(()))))))))))+, -0/P?[U[U[U[U[U[U{Ww{{Ww{{Ww{{Ww{{Ww{{Ww{{{{{{[U[U[U[U[UWWWWW{{{{{{{{{{{[U[U[U[U[U{Ww{{{Ww{w{{Ww{{{{[U[UU[U[UWWWW{{{{{{{{{[U[U[U[U{{Ww{{Ww{{Ww{{Ww{{{{{[U[U[U[U[UWWWWW{{{{{{{{{[U[U[UO[U[U[U{Ww{{Ww{{Ww{{Ww{{Ww{{Ww{{{{{{NO[U[U[U̻[U[UWWW̻WW{{{ko{{{{{kff{{{;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;?;;;;;;;;;;;;;;;;;;;;;;;;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;5;7;;;;;5;7;;;;;;;;;;;;;;;;;;;;;5;7;5;7;;;;;5;7;;;;;5;;;S7;s;;;;;;S7;s;;;;;;;;;;;;;;;;;ݳ;;;;;S7;s;;S7;s;;;;;;S7;s;;;;;;S7;;;s;;;;;;;;s;;;;;;;;;;;;;;;;;;;ݳ;;;;;s;;;;s;;;;;;;;s;;;;;;;;s;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;ݳ;;;;;;;;;;;;;;;;;;;;;;;;;;33+++++%+++++++%++++++++++++++++3Ѳ3!+++++++%+++%+++++++%++++++;;;;;S7;;;;;;;S7;;;;;;;;;;;;;;;;11;;;;;;;S7;;;S7;;;;;;;S7;;;;;;{{{{{{{{{{{[U[U[U[U{Ww{{Ww{{Ww{{Ww{{{{[U[U[UWWW{{{{{{{[U[U[U[U[U[U[U[U{Ww{Ww{ {p{{Ww {w {Ww{{Ww{{Ww{{p {p {{{ [U[U[U[U[U[U[U[UWWWWWWWW{{{{{{{{{{{{{{{{[U[U[U[U[U{Ww{{Ww{{Ww{{Ww{{Ww{{{{{[U[U[U[UWWWW{{{{{{{{{[U[U[U{Ww{{Ww{{Ww{{{{jf;; title: Railroad Wizard ;; author: TofuTheLoafu ;; desc: Complete horizontal or vertical lines to launch spell attacks against your enemies ;; site: website link ;; license: MIT License (change this to your license of choice) ;; version: 0.2 ;; script: scheme (define-macro (define-record-type type-name constructor-spec predicate-name . field-specs) (let* ((ctor-name (car constructor-spec)) (ctor-fields (cdr constructor-spec)) (fields (map car field-specs))) `(begin (define (,ctor-name ,@ctor-fields) (vector ',type-name ,@(map (lambda (f) (if (memq f ctor-fields) f #f)) fields))) (define (,predicate-name obj) (eq? ',type-name (vector-ref obj 0))) ,@(apply append (do ((i 1 (+ i 1)) (specs field-specs (cdr specs)) (acc '() (cons (let* ((spec (car specs)) (getter (cadr spec)) (setter (and (pair? (cddr spec)) (caddr spec)))) (cons `(define (,getter obj) (vector-ref obj ,i)) (if setter (list `(define (,setter obj val) (vector-set! obj ,i val))) '()))) acc))) ((null? specs) (reverse acc))))))) (define-macro (inc! x dx) `(set! ,x (+ ,x ,dx))) (define t 0) (define (make-coroutine thunk) (define resume #f) (define return #f) (define done #f) (define (yield) (call/cc (lambda (k) (set! resume k) (return #f)))) (lambda () (if done 'done (call/cc (lambda (k) (set! return k) (if resume (resume #f) (begin (thunk yield) (set! done #t) (return 'done)))))))) (define *coroutines* '()) (define (spawn! thunk) (set! *coroutines* (cons (make-coroutine thunk) *coroutines*))) (define (pump-coroutines!) (let ((to-run *coroutines*)) (set! *coroutines* '()) (for-each (lambda (c) (unless (eq? (c) 'done) (set! *coroutines* (cons c *coroutines*)))) to-run))) (define (filter predicate lst) (let loop ((lst lst) (result '())) (if (null? lst) (reverse result) (let ((element (car lst))) (if (predicate element) (loop (cdr lst) (cons element result)) (loop (cdr lst) result)))))) (define (all predicate lst) (cond ((null? lst) #t) ((not (predicate (car lst))) #f) (else (all predicate (cdr lst))))) (define (id x) x) (define (remove-duplicates lst) (cond ((null? lst) '()) ((member (car lst) (cdr lst)) (remove-duplicates (cdr lst))) (else (cons (car lst) (remove-duplicates (cdr lst)))))) (define (range n) (do ((i 0 (+ i 1)) (acc '() (cons i acc))) ((= i n) (reverse acc)))) (define (lerp progress start end) (+ start (* progress (- end start)))) (define (ease-out-cubic p) (let ((f (- p 1))) (+ 1 (* f f f)))) (define (ease-in-cubic p) (* p p p)) (define (ease-in-out-cubic p) (if (< p 0.5) (* 4 p p p) (+ 1 (/ (* (- (* 2 p) 2) (- (* (- (* 2 p) 2)) (- (* 2 p) 2)) (- (* 2 p) 2)) 2)))) (define-record-type animation-clip (make-animation-clip frames ticks-per-frame loop?) animation-clip? (frames animation-clip-frames) (ticks-per-frame animation-clip-ticks-per-frame) (loop? animation-clip-loop?)) (define-record-type animator (make-animator clip start-tick) animator? (clip animator-clip set-animator-clip!) (start-tick animator-start-tick set-animator-start-tick!)) (define (animator-frame animator current-tick) (let* ((clip (animator-clip animator)) (frames (animation-clip-frames clip)) (elapsed (- current-tick (animator-start-tick animator))) (frame-idx (quotient elapsed (animation-clip-ticks-per-frame clip)))) (if (animation-clip-loop? clip) (list-ref frames (modulo frame-idx (length frames))) (list-ref frames (min frame-idx (- (length frames) 1)))))) (define (animator-done? animator current-tick) (let* ((clip (animator-clip animator)) (frames (animation-clip-frames clip)) (elapsed (- current-tick (animator-start-tick animator)))) (< (* (length frames) (animation-clip-ticks-per-frame clip)) elapsed))) (define* (draw-animator animator x y current-tick (flip 0) (rotate 0)) (let ((frame (animator-frame animator current-tick))) (when frame (t80::spr (car frame) x y 0 1 flip rotate (cadr frame) (caddr frame))))) (define (play! animator clip current-tick) (set-animator-clip! animator clip) (set-animator-start-tick! animator current-tick)) (define (sfx-hit) (t80::sfx 0 (+ (random 5) 50) 60 0 12 (random 3))) (define (sfx-wizard-hit) (t80::sfx 3 (+ (random 5) 10) 40 0 11 4)) (define (sfx-place) (t80::sfx 2 (+ (random 10) 5) 25 1 9 4)) (define (sfx-chime) (t80::sfx 1 (+ (random 5) 55) 60 2 10 0)) (define-record-type spellcaster (make-spellcaster hp tetris-x tetris-y) spellcaster? (hp spellcaster-hp set-spellcaster-hp!) (placing-tetris spellcaster-placing-tetris set-spellcaster-placing-tetris!) (tetris-x spellcaster-tetris-x set-spellcaster-tetris-x!) (tetris-y spellcaster-tetris-y set-spellcaster-tetris-y!)) (define (clamp minimum maximum amount) (cond ((< amount minimum) minimum) ((> amount maximum) maximum) (else amount))) (define (damage-wizard! wizard amount) (let* ((old-hp (spellcaster-hp wizard)) (new-hp (max 0 (- old-hp amount)))) (let loop ((i new-hp)) (when (< i old-hp) (ui-hp-component 'damage i) (loop (+ i 1)))) (set-spellcaster-hp! wizard new-hp) (sfx-wizard-hit) (shake-effect! 3 10))) (define (make-button id) (let ((state 'up) (time 0)) (lambda* (action) (case action ((update) (let ((is-pressed (t80::btn id))) (cond ((and (eq? state 'down) is-pressed) (set! time (+ time 1))) (else (set! time 0))) (set! state (cond (is-pressed 'down) ((eq? state 'down) 'released) (else 'up))))) ((time) time) (else state))))) (define (make-heart-display max-hp) (let ((animating (make-vector max-hp #f)) (shatter-frames 20) (shatter-sprite-base 273) (shatter-sprite-count 3)) (define (shatter! i) (vector-set! animating i shatter-frames) (spawn! (lambda (yield) (do ((elapsed 0 (+ elapsed 1))) ((= elapsed shatter-frames)) (vector-set! animating i (- shatter-frames elapsed)) (yield)) (vector-set! animating i #f)))) (define (render x y hp) (let loop ((i 0)) (when (< i max-hp) (let ((anim (vector-ref animating i))) (cond (anim (let ((frame (quotient (* (- shatter-frames anim) shatter-sprite-count) shatter-frames))) (t80::spr (+ shatter-sprite-base frame) (+ x 1 (* 8 i)) (+ 2 y) 0 1 0 0 1 1))) ((< i hp) (t80::spr 257 (+ x 1 (* 8 i)) (+ 2 y) 0 1 0 0 1 1)) (else (t80::spr 276 (+ x 1 (* 8 i)) (+ 2 y) 0 1 0 0 1 1)))) (loop (+ i 1)))) ) (lambda* (action . args) (case action ((render) (apply render args)) ((damage) (shatter! (car args))))))) (define ui-hp-component (make-heart-display 8)) (define (draw-sidebar wizard upcoming-pieces button-up button-down button-left button-right active-piece-timer points render-stash-piece render-active-piece) (t80::rect 0 0 70 136 0) (ui-hp-component 'render 2 50 (spellcaster-hp wizard)) (render-upcoming-pieces upcoming-pieces active-piece-timer) (render-active-piece (spellcaster-placing-tetris wizard) active-piece-timer) (render-stash-piece) (define button-color (lambda (button-state) (case button-state ('down 1) ('up 2) (else 3)))) (t80::print (string-append "Points: " (number->string points)) 2 120 11 #f 1 #f) (t80::rect 30 10 10 10 (button-color (button-up))) (t80::rect 30 30 10 10 (button-color (button-down))) (t80::rect 20 20 10 10 (button-color (button-left))) (t80::rect 40 20 10 10 (button-color (button-right)))) (define* (make-scrolling-background (rows 11) (start-x 80)) (define camera-x 0) (define left-most-column 0) (define rows rows) (define cols 9) (define tile-map (let* ((v (make-vector (list rows cols) #f))) (do ((i 0 (+ i 1))) ((= i rows) v) (do ((j 0 (+ j 1))) ((= j cols)) (vector-set! v i j (if (= 0 (random 3)) 1 3)))))) (lambda () (when (<= 16 camera-x) (set! camera-x 0) (set! left-most-column (modulo (+ 1 left-most-column) rows))) (do ((i 0 (+ i 1))) ((= i rows)) (do ((j 0 (+ j 1))) ((= j cols)) (t80::spr (vector-ref tile-map (modulo (+ left-most-column i) rows) j) (- (+ start-x ( * i 16)) (floor camera-x)) (* j 16) -1 1 0 0 2 2))) (do ((i 0 (+ i 1))) ((= i rows)) (t80::spr 5 (- (+ start-x (* i 16)) (floor camera-x)) (- (* 4 16) 4) 0 1 0 0 2 2)) (set! camera-x (+ camera-x 0.1)))) (define wizard-idle-clip (make-animation-clip '((289 2 4) (291 2 4)) 20 #t)) (define wizard-hit-clip (make-animation-clip '((293 2 4)) 20 #t)) (define goblin-idle-clip (make-animation-clip '((353 2 2) (355 2 2)) 12 #t)) (define explosion-clip (make-animation-clip '((357 2 2) (359 2 2) (361 2 2)) 6 #f)) (define goblin-blast-clip (make-animation-clip '((260 1 1) (261 1 1) (262 1 1)) 6 #t)) (define (goblin-blast-update self t) (let* ((target-x wizard-x) (target-y (+ 16 wizard-y))) (when (eq? (self :state) 'moving) (let* ((progress (ease-in-cubic (/ (self :elapsed) 60)))) (set! (self :x) (floor (+ (self :start-x) (* progress (- target-x (self :start-x)))))) (set! (self :y) (floor (+ (self :start-y) (* progress (- target-y (self :start-y)))))))) (when (= (self :elapsed) 60) (damage-wizard! (self :target) 1) (spawn! (lambda (yield) (play! wizard-animator wizard-hit-clip t) (let loop ((i 0)) (when (< i 6) (yield) (loop (+ i 1)))) (play! wizard-animator wizard-idle-clip t))) (set! (self :destroy) #t)) (set! (self :elapsed) (+ (self :elapsed) 1)))) (define (make-goblin-blast x y target) (define coords (grid-coords->screen x y)) (define x (car coords)) (define y (cadr coords)) (hash-table :x x :y y :start-x x :start-y y :target target :state 'moving :elapsed 0 :animator (make-animator goblin-blast-clip t) :update goblin-blast-update)) (define (goblin-attack-cooldown) (+ 2000 (random 500))) (define (goblin-update self t wizard spawn-entity!) (when (<= (self :attack-cooldown) 0) (set! (self :attack-cooldown) (goblin-attack-cooldown)) (set! (self :attack-cooldown-max) (self :attack-cooldown)) (spawn-entity! (make-goblin-blast (self :grid-x) (self :grid-y) wizard))) (set! (self :attack-cooldown) (- (self :attack-cooldown) 1))) (define (make-goblin x y wizard spawn-entity!) (define start-coords (grid-coords->screen (+ 10 (random 2)) (random 8))) (define start-x (car start-coords)) (define start-y (cadr start-coords)) (define end-coords (grid-coords->screen x y)) (define end-x (car end-coords)) (define end-y (cadr end-coords)) (let* ((attack-cooldown (goblin-attack-cooldown)) (goblin (hash-table :animator (make-animator goblin-idle-clip 0) :hp 1 :max-hp 1 :attack-cooldown attack-cooldown :attack-cooldown-max attack-cooldown :x start-x :y start-y :grid-x x :grid-y y :update (lambda (self t) (goblin-update self t wizard spawn-entity!))))) (spawn! (lambda (yield) (let loop ((elapsed 0)) (when (< elapsed 120) (let* ((progress (ease-out-cubic (/ elapsed 120)))) (set! (goblin :x) (floor (+ start-x (* progress (- end-x start-x))))) (set! (goblin :y) (floor (+ start-y (* progress (- end-y start-y))))) (yield) (loop (+ elapsed 1))))) (set! (goblin :x) end-x) (set! (goblin :y) end-y))) goblin)) (define (damage-entity! e amount) (set! (e :hp) (- (e :hp) amount)) (when (<= (e :hp) 0) (play! (e :animator) explosion-clip t) (sfx-hit) (shake-effect! 1 :duration 8) (spawn! (lambda (yield) (let loop () (if (animator-done? (e :animator) t) (set! (e :destroy) #t) (begin (yield) (loop)))))))) (define (select-empty-cell grid) (let* ((dim (vector-dimensions grid)) (rows (car dim)) (cols (cadr dim)) (empties '())) (let loop-i ((i 0)) (when (< i rows) (let loop-j ((j 0)) (when (< j cols) (when (not (vector-ref grid i j)) (set! empties (cons (list i j) empties))) (loop-j (+ j 1)))) (loop-i (+ i 1)))) (if (null? empties) #f (list-ref empties (random (length empties)))))) (define (spawn-wave! grid points wizard spawn-entity!) (let ((enemy-count (cond ((< points 2) 1) (else (+ 1 (quotient points 3)))))) (do ((i 0 (+ i 1))) ((= i enemy-count)) (let* ((coords (select-empty-cell grid)) (goblin (make-goblin (car coords) (cadr coords) wizard spawn-entity!))) (vector-set! grid (car coords) (cadr coords) goblin))))) (define* (shake-effect! intensity (duration 20)) (spawn! (lambda (yield) (do ((i 0 (+ i 1))) ((= i duration)) (t80::poke #x3FF9 (- (random (+ 1 (* 2 intensity))) intensity)) (t80::poke (+ #x3FF9 1) (- (random (+ 1 (* 2 intensity))) intensity)) (yield)) (t80::memset #x3FF9 0 2)))) (define pieces '(((#t) (#t) (#t) (#t)) ((#t)) ((#t #t)) ((#f #t #t #f) (#f #t #f #f) (#f #t #f #f) (#f #f #f #f)) ((#f #t #t #f) (#f #f #t #f) (#f #f #t #f) (#f #f #f #f)) ((#f #f #f #f) (#f #t #t #f) (#f #t #t #f) (#f #f #f #f)) ((#f #t #f #f) (#f #t #t #f) (#f #f #t #f) (#f #f #f #f)) ((#f #f #t #f) (#f #t #t #f) (#f #t #f #f) (#f #f #f #f)) ((#f #f #t #f) (#f #t #t #f) (#f #f #t #f) (#f #f #f #f)) ((#f #f #f #f) (#f #t #f #f) (#f #f #t #f) (#f #f #f #f)))) (define (loop-piece f piece) (let ((rows (length piece)) (cols (length (car piece)))) (do ((y 0 (+ y 1))) ((= y rows)) (do ((x 0 (+ x 1))) ((= x cols)) (f (list-ref piece y x) x y))))) (define (random-piece) (list-ref pieces (random (length pieces)))) (define (rotate-piece piece) (define (get-column piece col) (map (lambda (row) (list-ref row col)) piece)) (let ((cols (length (car piece)))) (map (lambda (c) (reverse (get-column piece c))) (range cols)))) (define (tetris-grid-cell piece-x piece-y cell-idx) (let* ((grid-y (+ piece-y (quotient cell-idx 4))) (grid-x (+ piece-x (modulo cell-idx 4)))) (values grid-x grid-y))) (define (piece->cells start-x start-y piece) (let ((active-cells (list))) (loop-piece (lambda (cell x y) (when cell (set! active-cells (cons (cons (+ start-x x) (+ start-y y)) active-cells)))) piece) active-cells)) (define (cell-placeable? active-cells coords) (let ((x (car coords)) (y (cdr coords))) (and (<= 0 x 7) (<= 0 y 7) (not (member coords active-cells))))) (define (cells-placeable? active-cells cells) (all (lambda (cell) (cell-placeable? active-cells cell)) cells)) (define (row-filled? active-cells row) "When row is filled returns cells that are filled and #f is not." (let ((cells-in-row (filter (lambda (cell) (= row (car cell))) active-cells))) (and (= 8 (length cells-in-row)) cells-in-row))) (define (column-filled? active-cells col) "When column is filled returns cells that are filled and #f is not." (let ((cells-in-col (filter (lambda (cell) (= col (cdr cell))) active-cells))) (and (= 8 (length cells-in-col)) cells-in-col))) (define (completed-cells active-cells) (let ((rows (filter id (map (lambda (row) (row-filled? active-cells row)) (range 8)))) (cols (filter id (map (lambda (col) (column-filled? active-cells col)) (range 8))))) (remove-duplicates (apply append (append rows cols))))) (define (remove-completed-cells active-cells completed-cells) (filter (lambda (cell) (not (member cell completed-cells))) active-cells)) (define (grid->list grid) (filter id (vector->list grid))) (define (grid-coords->screen x y) (let ((x (+ 108 (* 15 x))) (y (+ 8 (* 15 y)))) (list x y))) (define (draw-grid grid) (let* ((dimensions (vector-dimensions grid)) (rows (car dimensions)) (cols (cadr dimensions))) (do ((i 0 (+ i 1))) ((= i rows)) (do ((j 0 (+ j 1))) ((= j cols)) (let ((coords (grid-coords->screen i j))) (t80::rectb (car coords) (cadr coords) 16 16 0)))))) (define (add-piece-to-upcoming upcoming-list) (reverse (cons (random-piece) upcoming-list))) (define* (render-piece piece start-x start-y (scale 1) (color 2)) (let ((cell-size (floor (* scale 2))) (cell-buffer (floor (* scale 3))) (cell-padding (floor (* scale 2)))) (loop-piece (lambda (piece x y) (when piece (t80::rect (+ start-x cell-padding (* cell-buffer x)) (+ start-y cell-padding (* cell-buffer y)) cell-size cell-size color))) piece))) (define (render-upcoming-pieces upcoming-pieces t) (let* ((progress (ease-in-cubic (/ (min t 20) 20))) (start-x (floor (- 18 (* 16 progress)))) (start-y 66)) (for-each (lambda (piece idx) (t80::rectb (+ (* idx 16) 2) start-y 15 15 2) (render-piece piece (+ (* idx 16) start-x) start-y)) upcoming-pieces (range (length upcoming-pieces))))) (define (make-render-active-piece) (define piece #f) (define from-x 0) (define from-y 0) (define from-color 2) (define t 20) (define (render-active-piece) (let* ((progress (ease-in-cubic (/ (min t 20) 20))) (start-x (floor (lerp progress from-x 2))) (start-y (floor (lerp progress from-y 82)))) (t80::rectb 2 82 30 30 2) (when piece (render-piece piece start-x start-y :color (if (< t 20) from-color 15) :scale (lerp progress 1 2))))) (lambda* (action . args) (case action ((activate) (set! t 0) (set! piece (car args)) (set! from-x (cadr args)) (set! from-y (caddr args)) (set! from-color (cadddr args))) (else (set! t (+ t 1)) (render-active-piece))))) (define (make-render-stash-piece) (define piece #f) (define from-x 0) (define from-y 0) (define t 20) (define (render-stash-piece) (let* ((progress (ease-in-cubic (/ (min t 20) 20))) (start-x (floor (lerp progress from-x 33))) (start-y (floor (lerp progress from-y 82)))) (t80::rectb 33 82 15 15 7) (when piece (render-piece piece start-x start-y :color (if (< t 20) 15 7) :scale (lerp progress 2.2 1))))) (lambda* (action . args) (case action ((stash) (set! t 0) (set! piece (car args)) (set! from-x (cadr args)) (set! from-y (caddr args))) (else (set! t (+ t 1)) (render-stash-piece))))) (define (render-cells selected-cells flashing-cells) (for-each (lambda (cell) (let* ((coords (grid-coords->screen (car cell) (cdr cell)))) (t80::rect (+ 1 (car coords)) (+ 1 (cadr coords)) 14 14 14))) selected-cells) (for-each (lambda (cell) (let* ((coords (grid-coords->screen (car cell) (cdr cell))) (color (if (< (modulo t 40) 20) 14 8))) (t80::rect (+ 1 (car coords)) (+ 1 (cadr coords)) 14 14 color))) flashing-cells)) (define wizard-x 80) (define wizard-y 44) (define wizard-animator (make-animator wizard-idle-clip t)) (define button-up (make-button 0)) (define button-down (make-button 1)) (define button-left (make-button 2)) (define button-right (make-button 3)) (define button-a (make-button 4)) (define button-b (make-button 5)) (define button-x (make-button 6)) (define buttons (list button-up button-down button-left button-right button-a button-b button-x)) (define draw-scroll-background (make-scrolling-background 16 0)) (define (make-menu-scene) (define start-wizard-x 120) (define starting? #f) (lambda () (when (and (not starting?) (eq? (button-a) 'released)) (sfx-wizard-hit) (spawn! (lambda (yield) (set! starting? #t) (let ((start-x start-wizard-x) (end-x wizard-x) (duration 60)) (let loop ((elapsed 0)) (when (<= elapsed duration) (let ((progress (ease-out-cubic (/ elapsed duration)))) (set! start-wizard-x (floor (+ start-x (* progress (- end-x start-x)))))) (yield) (loop (+ elapsed 1))))) (set! scene (make-game-scene))))) (t80::cls 13) (draw-scroll-background) (t80::print "Railroad Wizard" 40 20 0 #f 2 #f) (t80::print "Press button A (z) to start" 40 100 0 #f 1 #f) (draw-animator wizard-animator start-wizard-x 44 t))) (define (make-game-scene) (define wizard (make-spellcaster 8 2 2)) (define grid (make-vector '(8 8) #f)) (define entities (list)) (define selected-cells (list)) (define flashing-cells (list)) (define upcoming-pieces (list)) (define active-piece-timer 0) (define stash #f) (define points 0) (define game-over? #f) (define render-stash-piece (make-render-stash-piece)) (define render-active-piece (make-render-active-piece)) (define (new-piece!) (set! active-piece-timer 0) (render-active-piece 'activate (car upcoming-pieces) 2 66 2) (set-spellcaster-placing-tetris! wizard (car upcoming-pieces)) (set! upcoming-pieces (reverse (cons (random-piece) (reverse (cdr upcoming-pieces)))))) (define (spawn-entity! e) (set! entities (cons e entities))) (define (handle-movement-button button direction) (when (or (eq? (button) 'released) (and (eq? (button) 'down) (< 10 (button 'time)) (= 0 (modulo (button 'time) 6)))) (case direction ((up) (set-spellcaster-tetris-y! wizard (- (spellcaster-tetris-y wizard) 1))) ((down) (set-spellcaster-tetris-y! wizard (+ (spellcaster-tetris-y wizard) 1))) ((left) (set-spellcaster-tetris-x! wizard (- (spellcaster-tetris-x wizard) 1))) ((right) (set-spellcaster-tetris-x! wizard (+ (spellcaster-tetris-x wizard) 1)))))) (set! upcoming-pieces (add-piece-to-upcoming (add-piece-to-upcoming (add-piece-to-upcoming (add-piece-to-upcoming upcoming-pieces))))) (new-piece!) (lambda () (set! entities (filter (lambda (e) (not (e :destroy))) entities)) (let ((enemies (filter (lambda (e) e) (grid->list grid)))) (for-each (lambda (e) (when (e :destroy) (set! points (+ points 1)) (vector-set! grid (e :grid-x) (e :grid-y) #f))) enemies)) (when (<= (spellcaster-hp wizard) 0) (set! game-over? #t)) (when (and game-over? (eq? (button-a) 'released)) (set! scene (make-menu-scene))) (when (not game-over?) (handle-movement-button button-up 'up) (handle-movement-button button-down 'down) (handle-movement-button button-left 'left) (handle-movement-button button-right 'right) (when (eq? (button-x) 'released) (let ((current (spellcaster-placing-tetris wizard))) (set-spellcaster-placing-tetris! wizard stash) (set! stash current) (render-stash-piece 'stash stash 2 82) (render-active-piece 'activate (spellcaster-placing-tetris wizard) 33 82 7) (when (not (spellcaster-placing-tetris wizard)) (new-piece!)))) (when (eq? (button-b) 'released) (set-spellcaster-placing-tetris! wizard (rotate-piece (spellcaster-placing-tetris wizard)))) (when (eq? (button-a) 'released) (let* ((tetris (spellcaster-placing-tetris wizard)) (start-x (spellcaster-tetris-x wizard)) (start-y (spellcaster-tetris-y wizard)) (cells (piece->cells start-x start-y tetris))) (when (cells-placeable? selected-cells cells) (shake-effect! 1 :duration 2) (sfx-place) (new-piece!) (set! selected-cells (append cells selected-cells)) (let ((completed-cells (completed-cells selected-cells))) (when (pair? completed-cells) (set! selected-cells (remove-completed-cells selected-cells completed-cells)) (set! flashing-cells completed-cells) (sfx-chime) (spawn! (lambda (yield) (do ((i 0 (+ i 1))) ((= i 80)) (yield)) (for-each (lambda (cell) (let ((enemy (vector-ref grid (car cell) (cdr cell)))) (when enemy (damage-entity! enemy 1)))) completed-cells) (when (equal? flashing-cells completed-cells) (set! flashing-cells (list)))))))))) (for-each (lambda (e) (when (e :update) ((e :update) e t))) entities) (for-each (lambda (e) (when (e :update) ((e :update) e t))) (grid->list grid)) (when (= 0 (length (grid->list grid))) (spawn-wave! grid points wizard spawn-entity!))) (t80::cls 13) (draw-scroll-background) (draw-animator wizard-animator wizard-x wizard-y t) (draw-grid grid) (render-cells selected-cells flashing-cells) ;; Draw placing tetris (let ((tetris (spellcaster-placing-tetris wizard)) (start-x (spellcaster-tetris-x wizard)) (start-y (spellcaster-tetris-y wizard))) (when tetris (let* ((cells (piece->cells start-x start-y tetris))) (for-each (lambda (c) (let ((coords (grid-coords->screen (car c) (cdr c))) (placeable? (cell-placeable? selected-cells c))) (t80::rect (+ 1 (car coords)) (+ 1 (cadr coords)) 14 14 (if placeable? 15 2)))) cells)))) ;; Draw goblins (for-each (lambda (e) (let ((x (e :x)) (y (e :y))) (draw-animator (e :animator) x y t) (t80::rect x (+ y 16) (floor (* 16 (/ (e :attack-cooldown) (e :attack-cooldown-max)))) 2 1))) (grid->list grid)) (for-each (lambda (e) (when (e :animator) (draw-animator (e :animator) (e :x) (e :y) t))) entities) (draw-sidebar wizard upcoming-pieces button-up button-down button-left button-right active-piece-timer points render-stash-piece render-active-piece) (when game-over? (t80::print "Game Over" 120 25 0 #f 2 #f) (t80::print "Press A (or z) to reset" 110 45 0 #f 1 #f)) (set! active-piece-timer (+ 1 active-piece-timer)))) (define scene (make-menu-scene)) (define (TIC) (for-each (lambda (b) (b 'update)) buttons) (pump-coroutines!) (scene) (inc! t 1))