;; title: go-tetris
;; author: technomancy
;; script: fennel

(fn pick-rand [tbl]
  (. tbl (math.random (# tbl))))

(macro icollect* [iter-tbl value-expr]
  `(let [tbl# []] ; from newer fennel
     (each ,iter-tbl
       (tset tbl# (+ (length tbl#) 1)
             ,value-expr))
     tbl#))

(fn copy2 [t]
  (icollect* [_ row (ipairs t)]
    (icollect* [_ x (ipairs row)]
      x)))

(local msgs [])
(fn p [...] (table.insert msgs (table.concat [...] " ")))

(local board 13) ; can't fit 19 =(
(local scores [0 0])
(var piece nil)
(var turn 1)
(var t 0)

;; turn a cell into a number for seen
(fn n [x y] (+ x (* y 100)))

(fn in-bounds? [x y]
  (and (< -1 x board) (< -1 y board)))

(local dirs [[0 -1]
             [-1 0]      [1 0]
             [0 1]])

(fn neighbors [x y kind]
  (icollect* [_ [dx dy] (ipairs dirs)]
    (let [nx (+ x dx) ny (+ y dy)]
      (when (in-bounds? nx ny)
        (if (= kind (mget nx ny))
            [nx ny])))))

(fn group [x y t seen out]
  (table.insert out [x y])
  (tset seen (n x y) true)
  (each [_ [nx ny] (ipairs (neighbors x y t))]
    (table.insert out [nx ny])
    (when (not (. seen (n nx ny)))
      (group nx ny t seen out)))
  out)

(fn alive? [x y]
  (var alive (. (neighbors x y 0) 1))
  (each [_ [gx gy] (ipairs (group x y (mget x y) {} {}))]
    (when (. (neighbors gx gy 0) 1)
      (set alive true)))
  alive)

(fn other-turn [] (if (= turn 1) 2 1))

(fn maybe-capture [cx cy captures]
  (each [_ [dx dy] (ipairs dirs)]
    (let [tx (+ cx dx) ty (+ cy dy)]
      (when (and (= (other-turn)
                    (mget tx ty))
                 (not (alive? tx ty)))
        (each [_ g (ipairs (group tx ty (other-turn) {} {}))]
          (table.insert captures g)))))
  (each [_ [x y] (ipairs captures)]
    (when (not= 0 (mget x y))
      (tset scores turn (+ 1 (. scores turn))))
    (mset x y 0)))

(fn look-for-captures [{: x : y : shape}]
  (each [r row (ipairs shape)]
    (each [c (ipairs row)]
      (maybe-capture (+ x c -1) (+ y r -1) []))))

(local shapes [
[[] [1 1 1 1]]    ; I
[[0 1 1] [0 1 1]] ; O
[[0 0 1] [1 1 1]] ; L
[[1] [1 1 1]]     ; J
[[0 1] [1 1 1]]   ; T
[[0 1 1] [1 1]]   ; S
[[1 1] [0 1 1]]   ; Z
])

(fn width [shape]
  (-> (icollect* [_ r (ipairs shape)]
        (# r))
      (table.unpack)
      (math.max)))

(fn height [shape] (length shape))

(fn recolor [shape]
  (let [r (math.random 4)
        c (math.random 4)
        t (. (or (. shape r) {}) c)]
    (if (= t 1)
        (tset (. shape r) c 2)
        (recolor shape))))

(fn make-piece []
  (let [shape (copy2 (pick-rand shapes))]
    (recolor shape)
    (recolor shape)
    {: shape :w (width shape)
     :x (// board 2) :y 0}))

(fn draw-piece [{: x : y : shape}]
  (each [r row (ipairs shape)]
    (each [c p (ipairs row)]
      (when (not= p 0)
        (spr p (* (+ x c -1) 8) (* (+ y r -1) 8))))))

(fn open? [shape x y]
  (var result true)
  (each [r row (ipairs shape)]
    (each [c p (ipairs row)]
      (when (and (not= p 0)
                 (not= 0 (mget (+ x c -1) (+ y r -1))))
        (set result false))))
  result)

(fn move [dir]
  (let [new-x (-> piece.x
                  (+ dir)
                  (math.min (- board (width piece.shape)))
                  (math.max 0))
        {: x : y : shape} piece]
    (when (open? shape new-x y)
      (set piece.x new-x))))

(fn on-piece? [x y shape]
  (var on? false)
  (each [r row (ipairs shape)]
    (each [c p (ipairs row)]
      (when (and (not= p 0) (not= 0 (mget (+ x c -1) (+ y r))))
        (set on? true))))
  on?)

(fn landed? [{: x : y : shape}]
  (or (= (+ y (height shape)) board)
      (on-piece? x y shape)))

(fn win [winner]
  (cls)
  (print "the winner is" 40 40)
  (print winner 80 80 9 true 3))

(fn win-check []
  (when (not= 0 (mget (// board 2) 0))
    (let [[b w] scores
          winner (if (< w b) :black
                     (< b w) :white
                     :nobody)]
      (set _G.TIC (partial win winner)))))

(fn land [{: x : y : shape}]
  (each [r row (ipairs shape)]
    (each [c p (ipairs row)]
      (when (not= 0 p)
        (mset (+ x c -1) (+ y r -1) p))))
  (look-for-captures piece)
  (set piece (make-piece))
  (set turn (other-turn))
  (set t -220)
  (win-check))

(fn down []
  (set t 0)
  (if (landed? piece)
      (land piece)
      (set piece.y (+ piece.y 1))))

(fn input []
  (when (= 0 (math.fmod t 8))
    ;; (when (btn 0) (rotate))
    (when (btn 2) (move -1))
    (when (btn 3) (move 1))
    (when (btn 1) (down))))

(local player-colors [15 12])

(set piece (make-piece))

(fn _G.TIC []
  (cls)
  (input)
  (each [player score (ipairs scores)]
    (print score 125 (* 12 player) (. player-colors player)))
  (map 0 0 board board 0 0)
  (draw-piece piece)
  (rectb 0 0 (* board 8) (* board 8)
         (. player-colors turn))
  (set t (+ t 1))
  (when (< 30 t)
    (set t 0)
    (down)))
;; <TILES>
;; 000:000ee000000ee000000ee000eeeeeeeeeeeeeeee000ee000000ee000000ee000
;; 001:000ee000000ff00000ffff00effffffeeffffcfe00ffcf00000ff000000ee000
;; 002:000ee000000cc00000cccc00ecccccceeccccfce00ccfc00000cc000000ee000
;; </TILES>

;; <WAVES>
;; 000:00000000ffffffff00000000ffffffff
;; 001:0123456789abcdeffedcba9876543210
;; 002:0123456789abcdef0123456789abcdef
;; </WAVES>

;; <SFX>
;; 000:000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000304000000000
;; </SFX>

;; <PALETTE>
;; 000:1a1c2c5d275db13e53ef7d57ffcd75a7f07038b76425717929366f3b5dc941a6f673eff7f4f4f494b0c2566c86333c57
;; </PALETTE>

Generated by Phil Hagelberg using scpaste at Sun Jan 24 13:22:27 2021. PST. (original)