Return to Question

This is my first Clojure program. Source code and run instructions are posted here https://github.com/achikin/game2048-clj

This is my first Clojure program. If you want to run it locally please check out https://github.com/achikin/game2048-clj

core.clj

(ns game2048.core
 (:require [nightlight.core :refer [start]])
 (:require [game2048.ui :as ui])
 (:require [lanterna.screen :as s])
 (:require [game2048.game :as g])
 (:gen-class))
(def x 1)
(def y 1)
(defn game-loop
 [scr board]
 (recur 
 scr 
 (ui/draw-board
 scr x y
 (g/game-step (s/get-key-blocking scr) board))))
 
(defn -main []
 (let [scr (s/get-screen) board (g/new-board)]
 (s/in-screen scr 
 (do
 (ui/draw-board scr x y board)
 (ui/draw-agenda scr x (+ y (:height g/board-size) 1) g/agenda)
 (game-loop scr board)))))

game.clj

(ns game2048.game
 (:require [game2048.board :as b]))
(def max-score 2048)
(def board-size {:width 4 :height 4})
(def agenda
 '("←↑→↓ - make move"
 "r - reset"
 "q - quit"))
(defn new-board []
 (b/add-random-tiles (b/empty-board board-size)))
 
(defn process-key
 "Either exit or transform board according to a key passed"
 [key board]
 (case key
 (:up :down :left :right) (b/make-move key board)
 \q (System/exit 0)
 \r (b/empty-board board-size)))
(defn check-board
 "Check for logical conditions and transform board accordingly"
 [board-before-keypress board]
 (let [board-after-rand (b/add-random-tiles board)]
 (cond
 (= board-before-keypress board) board
 (b/full? board-after-rand) (new-board)
 (b/contains-max? max-score board) (new-board)
 :else board-after-rand)))
 
(defn game-step
 [key board]
 (check-board board
 (process-key key board)))

ui.clj

(ns game2048.ui
 (:require [game2048.board :as b])
 (:require [lanterna.screen :as s]))
(def maxlen 5)
(defn count-digits [n] 
 (if (zero? n) 1
 (-> n Math/log10 Math/floor long inc)))
(defn repeat-str
 [n st]
 (apply str (repeat n st)))
(defn pad-number
 [length number]
 (let [n (count-digits number)
 pads (/ (- length n) 2)]
 (apply str (repeat-str pads " ") (str number) (repeat-str pads " "))))
 
(defn max-number
 [board]
 (apply max board))
(defn max-length
 [board]
 (+ (count-digits (max-number board)) 2))
(defn draw-row
 ([screen x y row]
 (if-not (empty? row)
 (do
 (s/put-string screen x y (pad-number maxlen (first row))) 
 (recur screen (+ x maxlen) y (rest row))))))
(defn draw-rows
 "Draw each row and update screen"
 [screen x y rows]
 (if-not (empty? rows)
 (do 
 (draw-row screen x y (first rows))
 (recur screen x (inc y) (rest rows)))
 (s/redraw screen)))
 
(defn draw-board
 "Break board into horizontal rows and draw them into lanterna/screen
 returns initial board for further processing"
 [screen x y board]
 (do
 (draw-rows screen x y (b/part-board :horizontal board))
 board))
(defn draw-agenda
 [scr x y [first & rest]]
 (if first
 (do
 (s/put-string scr x y first)
 (recur scr x (inc y) rest))
 (s/redraw scr)))

board.clj

(ns game2048.board
 (:require [game2048.row :as row]))
(defn get-n-zeroes
 [n]
 (repeat n 0))
 
(defn empty-board 
 "Board is represented as width, height and 1 dimentional list of fields
 Zero represents empty field"
 [size]
 (merge size {:data (get-n-zeroes (* (:width size) (:height size)))}))
 
(defn part-board
 "Partition board list into horizontal or vertical slices"
 [direction board]
 (case direction
 :horizontal (partition (:width board) (:data board))
 :vertical (partition (:height board) 
 (apply interleave 
 (partition (:width board) (:data board))))))
(defn gather
 "Gather board from horizontal or vertical slices
back into map"
 [direction board]
 (case direction
 :horizontal {:width (-> board first count) 
 :height (count board) 
 :data (apply concat board)}
 :vertical {:width (count board) 
 :height (-> board first count) 
 :data (apply interleave board)}))
(defn find-indexes
 "Find all indexes of value in collection" 
 [val coll]
 (reduce-kv 
 (fn [a k v] (if (= v val) (conj a k) a)) 
 []
 coll)) 
 
(defn choose-index
 "Choose random value from collection"
 [indexes]
 (rand-nth indexes))
(defn choose-value 
 "2 chosen with 2/3 probability
 4 chosen with 1/3 probability"
 []
 (rand-nth '(2 2 4)))
 
(defn rand-replace
 "Replace one value in collection with another one chosen with index-fn"
 [index-fn oldval value-fn coll]
 (let [array (into [] coll)
 indexes (find-indexes oldval array)]
 (if (empty? indexes)
 coll
 (seq (assoc array 
 (index-fn indexes) (value-fn))))))
(defn add-random-tile
 "Replace random zero with 2 or 4 in seq"
 [board]
 (rand-replace choose-index 0 choose-value board))
(defn add-random-tiles
 "Replace random zero with 2 or 4 in board
 in case if you want to add more than one tile"
 [board]
 (assoc board :data (add-random-tile (:data board))))
(defn which-partition
 "Determine if move is horizontal or vertical"
 [direction]
 (if (contains? #{:left :right} direction)
 :horizontal
 :vertical))
"Up movement is eqivalent to left movement
and down movement equivalent to right movement"
(def dir-map 
 {:up :left 
 :down :right 
 :left :left 
 :right :right})
(defn make-move
 "Break board into either horizontal or vertical slices
perform move on each slice, and gather result back into new board"
 [direction board]
 (let [part (which-partition direction)]
 (gather part
 (map #(row/move (direction dir-map) %) (part-board part board)))))
(defn full?
 "True if there are no empty(0) fields left"
 [board]
 (not-any? #{0} (:data board)))
(defn contains-max?
 "True if one of the sells reached maximum value"
 [max-score board]
 (not (empty? (filter #(= max-score %) (:data board)))))

row.clj

(ns game2048.row)
(defmulti padd (fn [direction len coll] direction))
"Pad collections with zeroes either on the left or on the right"
(defmethod padd :left
 [direction len coll]
 (concat (repeat (- len (count coll)) 0) coll))
(defmethod padd :right
 [direction len coll]
 (concat coll (repeat (- len (count coll)) 0)))
 
(defmulti merger(fn [dir & args] dir))
"Check if there are equal adjustent fields and merge them
e.g. (merger :left '(1 1 2 2)) -> (2 4)"
(defmethod merger :left
 ([dir [first second & rest] newrow]
 (if first
 (if (= first second)
 (recur dir rest (cons (+ first second) newrow))
 (recur dir (cons second rest) (cons first newrow)))
 (reverse newrow)))
 ([dir row]
 (merger dir row '())))
(defmethod merger :right
 [dir row]
 (reverse (merger :left (reverse row))))
(defn remove-zeroes
 "Return collection dropping all zeroes"
 [coll]
 (filter (fn [x] (not (zero? x))) 
 coll))
(defn opposite-dir
 [dir]
 (case dir
 :left :right
 :right :left))
(defn move
 "Remove zeroes, then merge values, then pad result with zeroes
 e.g. (move :left '(1 1 0 2 2) -> (1 1 2 2) -> (2 4 0 0 0)"
 [dir row]
 (let [row-size (count row)]
 (padd (opposite-dir dir) row-size (merger dir (remove-zeroes row)))))

board_test.clj

(ns game2048.board-test
 (:use clojure.test)
 (:require [game2048.board :as b]))
(def empty-board-3-3 
 {:width 3
 :height 3
 :data '(0 0 0 0 0 0 0 0 0)})
(def empty-board-2-4 
 {:width 2
 :height 4
 :data '(0 0 0 0 0 0 0 0)})
(deftest empty-board
 (is (= (b/empty-board {:width 3 :height 3}) empty-board-3-3))
 (is (= (b/empty-board {:width 2 :height 4}) empty-board-2-4)))
(def part-board-2-2
 {:width 2
 :height 2
 :data '(1 1 2 2)})
(def part-board-2-2-left
 {:width 2
 :height 2
 :data '(2 0 4 0)})
 
(def part-board-2-2-horizontal '((1 1)(2 2)))
(def part-board-2-2-vertical '((1 2)(1 2)))
(deftest part-board
 (is (= (b/part-board :horizontal part-board-2-2) part-board-2-2-horizontal))
 (is (= (b/part-board :vertical part-board-2-2) part-board-2-2-vertical)))
(deftest gather
 (is (= (b/gather :horizontal '((1 1) (2 2))) part-board-2-2))
 (is (= (b/gather :vertical '((1 2) (1 2))) part-board-2-2)))
(defn index-fn-1
 [coll]
 1)
(defn index-fn-3
 [coll]
 3)
(defn value-fn-2
 []
 2)
(defn value-fn-4
 []
 4)
(deftest rand-replace
 (is (= (b/rand-replace index-fn-1 0 value-fn-2 '(0 0 0)) '(0 2 0)))
 (is (= (b/rand-replace index-fn-3 0 value-fn-4 '(0 0 0 0 0)) '(0 0 0 4 0))))
 
(def board-move
 {:width 2
 :height 2
 :data '(2 4 2 4)})
(def board-move-up
 {:width 2
 :height 2
 :data '(4 8 0 0)})
(def board-move-down
 {:width 2
 :height 2
 :data '(0 0 4 8)})
 
(deftest make-move
 (is (= (b/make-move :left part-board-2-2) part-board-2-2-left))
 (is (= (b/make-move :up board-move) board-move-up))
 (is (= (b/make-move :down board-move) board-move-down))
 (is (= (b/make-move :right board-move) board-move)))
(deftest full
 (is (b/full? {:width 2 :height 2 :data '(1 2 3 4)}))
 (is (not (b/full? {:width 2 :height 2 :data '(1 2 3 0)}))))
(deftest contains-max
 (is (b/contains-max? 2048 {:width 2 :height 2 :data '(1 2 2048 4)})))

Flowchart enter image description here