Skip to content

Instantly share code, notes, and snippets.

@Solaxun
Created August 14, 2021 18:24
Show Gist options
  • Save Solaxun/46814c636eee9e70f9e3ebcad05dcd1b to your computer and use it in GitHub Desktop.
Save Solaxun/46814c636eee9e70f9e3ebcad05dcd1b to your computer and use it in GitHub Desktop.
Tetris in Clojure (basic game-play mostly done, no UI yet - switching to CLJS for that (can't use threads, reworking to use channels)
(ns tetris.game)
(def rows 20)
(def cols 10)
(def board (vec (repeat rows (vec (repeat cols " ")))))
(defn new-game-state []
{:board board
:active-piece nil
:game-over? false
:score 0})
(def game-state (atom (new-game-state)))
;; pieces, along with their starting positions and rotation-center (:mid)
(def I {:type :I :mid [4 1] :coords [[3 1] [4 1] [5 1] [6 1]]})
(def J {:type :J :mid [4 1] :coords [[3 1] [4 1] [5 1] [5 0]]})
(def L {:type :L :mid [3 1] :coords [[3 1] [4 1] [5 1] [3 0]]})
(def O {:type :O :mid [4 0] :coords [[4 0] [5 0] [4 1] [5 1]]})
(def S {:type :S :mid [4 1] :coords [[4 1] [4 0] [5 0] [3 1]]})
(def T {:type :T :mid [4 1] :coords [[3 1] [4 1] [5 1] [4 0]]})
(def Z {:type :Z :mid [4 0] :coords [[4 0] [4 1] [5 1] [3 0]]})
(defn get-random-piece [] (rand-nth [I J L O S T Z]))
(defn clear-piece [board {:keys [mid coords]}]
(reduce #(assoc-in %1 (reverse %2) " ") board coords))
(defn place-piece [board active-piece new-piece]
(let [new-board (clear-piece board active-piece)]
(reduce #(assoc-in %1 (reverse %2) "*")
new-board
(:coords new-piece))))
(defn piece-fits? [board {:keys [mid coords]}]
(let [[max-x max-y] [cols rows]
not-occupied (fn [x y] (= " " (get-in board [y x])))]
(every? (fn [[x y]] (and (< x max-x)
(< y max-y)
(not-occupied x y)))
coords)))
;; need to store piece type so we know if it's an "O" which doesn't rotate :/
(defn rotate-piece [{:keys [type mid coords] :as piece}]
(if (= type :O)
piece
(let [rasterized-coords (map #(map - % mid) coords)
rotated (map (fn [[x y]] [(- y) x]) rasterized-coords)
coords' (map #(map + mid %) rotated)]
(assoc piece :coords coords'))))
(defn rotate-active-piece [{:keys [board active-piece] :as game-state}]
(let [r (rotate-piece active-piece)]
;; TODO: duplication in this and down move, clear piece to check if fits
;; then clear piece again before placing (in place-piece)
(if (piece-fits? (clear-piece board active-piece) r)
(-> game-state (update :board place-piece active-piece r) (assoc :active-piece r))
game-state)))
(defn spawn-piece [{:keys [board active-piece] :as game-state}]
(let [spawned (get-random-piece)]
(if-not (piece-fits? board spawned)
(assoc game-state :game-over? true)
(-> game-state
(update :board place-piece active-piece spawned)
(assoc :active-piece spawned)))))
(defn move-piece [{:keys [mid coords] :as piece} dir]
(let [dir (get {:left [-1 0] :right [1 0] :down [0 1]} dir)]
(-> piece
(update :coords #(mapv (partial mapv + dir) %))
(update :mid #(mapv + % dir)))))
(defn piece-down [piece] (move-piece piece :down))
(defn piece-left [piece] (move-piece piece :left))
(defn piece-right [piece] (move-piece piece :right))
(defn make-new-rows [n]
(vec (repeat n (vec (repeat cols " ")))))
(defn full? [row]
(every? (partial = "*") row))
(defn clear-rows [board]
(let [cleared (remove full? board)
ncleared (- rows (count cleared))]
(vec (concat (make-new-rows ncleared)
cleared))))
(defn game-down [{:keys [board active-piece score] :as game-state}]
(if (nil? active-piece)
game-state
(let [piece (piece-down active-piece)]
(if (piece-fits? (clear-piece board active-piece) piece)
(-> game-state
(update :board place-piece active-piece piece)
(assoc :active-piece piece))
(assoc game-state :active-piece nil)))))
(defn hard-drop [game-state]
;; nil active piece means can't move further down
(some #(when (nil? (:active-piece %1)) %1)
(iterate game-down game-state)))
(defn game-move [{:keys [board active-piece score] :as game-state} move-func]
(let [piece (move-func active-piece)]
(if (piece-fits? (clear-piece board active-piece) piece)
(-> game-state
(update :board place-piece active-piece piece)
(assoc :active-piece piece))
game-state)))
(defn game-left [game-state] (game-move game-state piece-left))
(defn game-right [game-state] (game-move game-state piece-right))
(defn print-board [board]
(doseq [line board] (println line))
(print (str (char 27) "[2J")) ; clear
(print (str (char 27) "[;H"))) ; move cursor top-left
(defn game-loop
[game-state]
(loop [{:keys [board active-piece game-over?]} (swap! game-state spawn-piece)]
(print-board board)
(if game-over?
board
(do (when (some full? board)
(Thread/sleep 100)
(swap! game-state update :board clear-rows))
(when (nil? active-piece)
(Thread/sleep 100)
;; if game ends here, don't try downmove
(swap! game-state spawn-piece))
;; don't need to sleep on new spawns, since it has it's own 100 ms sleep
(when-not (nil? active-piece) (Thread/sleep 1000))
(recur (swap! game-state #(if (:game-over? %) % (game-down %))))))))
(defn get-user-moves []
(loop [gs @game-state]
(when-not (:game-over? gs)
(doseq [line (:board gs)] (println line))
(recur (case (read-line)
":U" (swap! game-state rotate-active-piece)
":D" (swap! game-state game-down)
":H" (swap! game-state hard-drop)
":L" (swap! game-state game-left)
":R" (swap! game-state game-right)
#_#_:space (swap! game-state hard-drop)
gs)))))
(defn -main []
(def f (future (get-user-moves)))
(game-loop game-state)
(println "game loop finished")
(System/exit 0))
(-main)
;; TODO: wall kicks (and piece kicks), top hidden row when full, levels, score.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment