问2048游戏在Clojure中的实现

EN

(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)))))

(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)))

(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)))

(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)))))

(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)))))

(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)})))