edtris/game/rules.fnl

(local lume (require :lib.lume))
(local map (require :game.tilemap))
(local tileset (require :game.tiles))
(local state (require :game.state))
(local helpers (require :game.helpers))

(local Rules {})

(local tetrominoes
  {:O [["##"
        "##"]]

   :L [["###"
        "#  "]

       ["# "
        "# "
        "##"]

       ["  #"
        "###"]

       ["##"
        " #"
        " #"]]

   :J [["###"
        "  #"]

       ["##"
        "# "
        "# "]

       ["#  "
        "###"]

       [" #"
        " #"
        "##"]]

   :I [["####"]

       ["#"
        "#"
        "#"
        "#"]]

   :S [[" ##"
        "## "]

       ["# "
        "##"
        " #"]]

   :Z [["## "
        " ##"]

       [" #"
        "##"
        "# "]]

   :T [["###"
        " # "]

       ["# "
        "##"
        "# "]

       [" # "
        "###"]

       [" #"
        "##"
        " #"]]})

(fn Rules.choose-random-tetromino []
  (let [possible-values (icollect [k (pairs tetrominoes)] k)
        ivalue (love.math.random (length possible-values))]
    (. possible-values ivalue)))

(fn Rules.tetromino [k irotation]
  (let [rotations (or (. tetrominoes k) [])
        irotation (+ (% (- irotation 1) (length rotations)) 1)]
    (. rotations irotation)))

(fn Rules.reset-game []
  (set state.well (map.new-tilemap 12 21))
  (for [y 0 19]
    (map.set-itile-at 0 y state.well "X")
    (map.set-itile-at 11 y state.well "X"))
  (for [x 0 11]
    (map.set-itile-at x 20 state.well "X"))
  (set state.drop-speed-ms 750)
  (Rules.play-next-piece))

(fn Rules.play-next-piece []
  (Rules.clear-lines)
  (let [piece (or state.next-piece (Rules.choose-random-tetromino))
        x (math.floor (/ (- (length (. state.well 1)) 2) 2))]
    (set state.current {: piece : x :y 0 :irotation 1})
    (set state.next-piece (Rules.choose-random-tetromino))))

(fn Rules.current-tetromino []
  (when state.current
    (Rules.tetromino state.current.piece state.current.irotation)))

(fn solid-positions [tetromino ?x ?y]
  (let [h (length tetromino)
        w (length (. tetromino 1))
        x (or ?x 0)
        y (or ?y 0)]
    (icollect [tx ty (helpers.all-coordinates w h)]
      (let [itile (map.itile-at tx ty tetromino)]
        (when (not= itile " ") [(+ x tx) (+ y ty) itile])))))

(fn Rules.collides? [tetromino x y]
  (var collides false)
  (when tetromino
    (each [_ [wx wy] (ipairs (solid-positions tetromino x y)) :until collides]
      (set collides (not= (map.itile-at wx wy state.well) " "))))
  collides)

(fn Rules.place-piece [tetromino x y]
  (each [_ [wx wy itile] (ipairs (solid-positions tetromino x y))]
    (map.set-itile-at wx wy state.well itile)))

(fn Rules.try-move-piece [dx dy]
  (when state.current
    (let [tetromino (Rules.current-tetromino)
          x (+ state.current.x dx)
          y (+ state.current.y dy)
          stopped (Rules.collides? tetromino x y)]
      (if (and stopped (not= dy 0)) ; dropping
          (do (Rules.place-piece tetromino state.current.x state.current.y)
              (Rules.play-next-piece)
              :placed)

          (not stopped)
          (do (set state.current.x x)
              (set state.current.y y)
              :moved)

          :blocked))))

(fn Rules.drop-piece []
  (while (not= (Rules.try-move-piece 0 1) :placed)))

(fn Rules.rotate [di]
  (when state.current
    (var settled false)
    (let [irotation (+ state.current.irotation di)
          tetromino (Rules.tetromino state.current.piece irotation)]
      (each [_ dx (ipairs [0 1 -1]) :until settled]
        (let [x (+ state.current.x dx)
              y state.current.y]
          (when (not (Rules.collides? tetromino x y))
            (set settled true)
            (set state.current.x x)
            (set state.current.irotation irotation)))))))

(fn Rules.clear-lines []
  (let [rows (icollect [irow row (ipairs state.well)] (when (not (row:match "^X%#+X$")) row))
        first-row (. state.well 1)
        empty-row (.. :X (string.rep " " (- (length first-row) 2)) :X)
        cleared-rows (math.max 0 (- (length state.well) (length rows)))]
    (when (> cleared-rows 0)
      (for [i 1 cleared-rows]
        (print i cleared-rows (length state.well))
        (table.insert rows 1 empty-row))
      (set state.well rows))))

(fn Rules.edit-game []
  (let [modes (require :editor.lovemode)
        core (require :core)
        filename "game/state.fnl"
        ldoc (core.open_doc filename)
        f (io.open filename :w)]
    (f:write (fv state))
    (f:close)
    (modes:cycle :editor)
    ; ensure existing state.fnl opens
    (each [_ view (ipairs (core.root_view.root_node:get_children))]
      (when (= view.doc ldoc) (core.set_active_view view)))
    (core.root_view:open_doc ldoc)))

(set Rules.commands
  {:move Rules.try-move-piece
   :drop Rules.drop-piece
   :rotate Rules.rotate
   :reset Rules.reset-game
   :edit Rules.edit-game})

(set Rules.keymap
  {:left  [:move -1 0]
   :right [:move 1 0]
   :down  [:move 0 1]
   :up    [:rotate -1]
   :space [:drop]
   :z     [:rotate 1]
   :x     [:rotate -1]
   :r     [:reset]
   :e     [:edit]})

(fn Rules.run-command [cmd]
  (when cmd
    (let [[command & args] cmd
          f (. Rules.commands command)]
      (when f (f (table.unpack args))))))

(fn Rules.keypressed [key]
  (Rules.run-command (. Rules.keymap key)))

(fn Rules.update [dt]
  (let [drop-ms (- (or state.drop-ms state.drop-speed-ms) (* dt 1000))]
    (if (<= drop-ms 0)
        (do (set state.drop-ms nil)
            (Rules.try-move-piece 0 1))
      (set state.drop-ms drop-ms))))

Rules