(fn pick-rand [tbl]
(. tbl (math.random (# tbl))))
(macro icollect* [iter-tbl value-expr]
`(let [tbl# []] (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) (local scores [0 0])
(var piece nil)
(var turn 1)
(var t 0)
(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]] [[0 1 1] [0 1 1]] [[0 0 1] [1 1 1]] [[1] [1 1 1]] [[0 1] [1 1 1]] [[0 1 1] [1 1]] [[1 1] [0 1 1]] ])
(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 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)))