Guest User

Untitled

a guest
Jan 22nd, 2018
69
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.68 KB | None | 0 0
  1. (ns tetris.core
  2. (:import (java.awt Color Dimension BorderLayout)
  3. (javax.swing JPanel JFrame JOptionPane JButton JLabel)
  4. (java.awt.event KeyListener))
  5. (:use clojure.contrib.import-static deflayout.core
  6. clojure.contrib.swing-utils)
  7. (:gen-class))
  8.  
  9. (import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_DOWN VK_UP VK_SPACE)
  10.  
  11. (def empty-cell 0)
  12. (def filled-cell 2)
  13. (def moving-cell 1)
  14. (def glass-width 10)
  15. (def glass-height 20)
  16. (def zero-coords [3 0])
  17.  
  18. (def stick [[0 0 0 0]
  19. [1 1 1 1]
  20. [0 0 0 0]
  21. [0 0 0 0]])
  22.  
  23. (def square [[1 1]
  24. [1 1]])
  25.  
  26. (def tblock [[0 0 0]
  27. [1 1 1]
  28. [0 1 0]])
  29.  
  30. (def sblock [[0 1 0]
  31. [0 1 1]
  32. [0 0 1]])
  33.  
  34. (def zblock [[0 0 1]
  35. [0 1 1]
  36. [0 1 0]])
  37.  
  38. (def lblock [[1 1 0]
  39. [0 1 0]
  40. [0 1 0]])
  41.  
  42. (def jblock [[0 1 1]
  43. [0 1 0]
  44. [0 1 0]])
  45.  
  46. (def figures [stick square tblock sblock zblock lblock jblock])
  47.  
  48. (def create-vector (comp vec repeat))
  49.  
  50. (defn create-glass []
  51. (create-vector glass-height
  52. (create-vector glass-width empty-cell)))
  53.  
  54. (defn pick-cell [figure x y]
  55. (get-in figure [y x]))
  56.  
  57. (defn mapmatrix [func matrix]
  58. (into [] (map-indexed (fn [y vect]
  59. (into [] (map-indexed (fn [x el]
  60. (func el x y))
  61. vect)))
  62. matrix)))
  63.  
  64. (defn rotate-figure [fig]
  65. (let [fsize (count fig)]
  66. (mapmatrix #(pick-cell fig (- fsize %3 1) %2) fig)))
  67.  
  68. (defn apply-fig [glass fig [figx figy]]
  69. (let [fsize (count fig)]
  70. (mapmatrix (fn[el gx gy]
  71. (if (and
  72. (<= figx gx (+ figx fsize -1))
  73. (<= figy gy (+ figy fsize -1)))
  74. (+ el (pick-cell fig (- gx figx) (- gy figy)))
  75. el))
  76. glass)))
  77.  
  78. (defn destroy-filled [glass]
  79. (let [clear-glass
  80. (remove (fn[vect]
  81. (not-any? #(= % empty-cell) vect)) glass)
  82. destroyed (- glass-height (count clear-glass))]
  83. [(into (vec (repeat
  84. destroyed
  85. (create-vector glass-width empty-cell)))
  86. (vec clear-glass)) destroyed]))
  87.  
  88. (defn fix-figure [glass-with-fig]
  89. (mapmatrix (fn [el & _]
  90. (if (= el moving-cell)
  91. filled-cell
  92. el))
  93. glass-with-fig))
  94.  
  95. (defn count-cells [glass value]
  96. (reduce + (map (fn [vect]
  97. (count (filter #{value} vect)))
  98. glass)))
  99.  
  100. (defn legal? [glass]
  101. (= (count-cells glass moving-cell) 4))
  102.  
  103. (defn move
  104. ([glass fig [figx figy] shiftx shifty]
  105. (let [newx (+ figx shiftx)
  106. newy (+ figy shifty)
  107. newglass (apply-fig glass fig [newx newy])]
  108. (when (legal? newglass) [newx newy])))
  109. ([glass fig coords direction]
  110. (condp = direction
  111. :down (move glass fig coords 0 1)
  112. :left (move glass fig coords -1 0)
  113. :right (move glass fig coords 1 0))))
  114.  
  115. (def score-per-line 10)
  116.  
  117. (defmacro defatoms [& atoms]
  118. `(do
  119. ~@(map (fn[a#] `(def ~a# (atom nil))) atoms)))
  120.  
  121. (defatoms *glass* *fig-coords* *current-fig* *next-fig* *score*)
  122.  
  123. (defn complete-glass []
  124. (apply-fig @*glass* @*current-fig* @*fig-coords*))
  125.  
  126. (defn done-callback [n]
  127. (swap! *score* #(+ % (* n score-per-line))))
  128.  
  129. (defn move-to-side [side]
  130. (let [newcoords
  131. (move @*glass* @*current-fig* @*fig-coords* side)]
  132. (if newcoords
  133. (reset! *fig-coords* newcoords))))
  134.  
  135. (defn move-down []
  136. (let [newcoords
  137. (move @*glass* @*current-fig* @*fig-coords* :down)]
  138. (if newcoords
  139. (reset! *fig-coords* newcoords)
  140. (let [[newglass d-count] (-> (complete-glass)
  141. fix-figure
  142. destroy-filled)]
  143. (reset! *glass* newglass)
  144. (reset! *fig-coords* zero-coords)
  145. (reset! *current-fig* @*next-fig*)
  146. (reset! *next-fig* (rand-nth figures))
  147. (done-callback d-count)
  148. (when-not (legal? (complete-glass)) :lose)))))
  149.  
  150. (defn move-all-down []
  151. (move-down)
  152. (let [newcoords
  153. (move @*glass* @*current-fig* @*fig-coords* :down)]
  154. (when newcoords (recur))))
  155.  
  156. (defn rotate-current []
  157. (let [rotated (rotate-figure @*current-fig*)]
  158. (if (legal? (apply-fig @*glass* rotated @*fig-coords*))
  159. (swap! *current-fig* rotate-figure))))
  160.  
  161. (defn new-game []
  162. (reset! *glass* (create-glass))
  163. (reset! *fig-coords* zero-coords)
  164. (reset! *current-fig* (rand-nth figures))
  165. (reset! *next-fig* (rand-nth figures))
  166. (reset! *score* 0))
  167.  
  168. (def cell-size 20)
  169. (def border-size 3)
  170. (def timer-interval 300)
  171. (def game-running (atom false))
  172.  
  173. (defn fill-point [g [x y] color]
  174. (.setColor g color)
  175. (.fillRect g
  176. (* x cell-size) (* y cell-size)
  177. cell-size cell-size)
  178. (when-not (= color (Color/gray))
  179. (.setColor g (.brighter color))
  180. (.fillRect g
  181. (* x cell-size) (* y cell-size)
  182. border-size cell-size)
  183. (.fillRect g
  184. (* x cell-size) (* y cell-size)
  185. cell-size border-size)
  186. (.setColor g (.darker color))
  187. (.fillRect g
  188. (- (* (inc x) cell-size) border-size) (* y cell-size)
  189. border-size cell-size)
  190. (.fillRect g
  191. (* x cell-size) (- (* (inc y) cell-size) border-size)
  192. cell-size border-size)))
  193.  
  194. (defn get-color [cell]
  195. (condp = cell
  196. empty-cell (Color/gray)
  197. filled-cell (Color. 128 0 0)
  198. moving-cell (Color. 0 128 0)
  199. (Color/black)))
  200.  
  201. (defn paint-glass [g glass]
  202. (mapmatrix (fn[cell x y]
  203. (fill-point g [x y] (get-color cell)))
  204. glass))
  205.  
  206. (defn game-panel []
  207. (proxy [JPanel KeyListener] []
  208. (paintComponent [g]
  209. (proxy-super paintComponent g)
  210. (doall (paint-glass g (complete-glass))))
  211. (keyPressed [e]
  212. (let [keycode (.getKeyCode e)]
  213. (do (condp = keycode
  214. VK_LEFT (move-to-side :left)
  215. VK_RIGHT (move-to-side :right)
  216. VK_DOWN (move-down)
  217. VK_UP (rotate-current)
  218. VK_SPACE (move-all-down))
  219. (.repaint this))))
  220. (getPreferredSize []
  221. (Dimension. (* glass-width cell-size)
  222. (* glass-height cell-size)))
  223. (keyReleased [e])
  224. (keyTyped [e])))
  225.  
  226. (defn next-panel []
  227. (proxy [JPanel] []
  228. (paintComponent [g]
  229. (proxy-super paintComponent g)
  230. (doall (paint-glass g @*next-fig*)))
  231. (getPreferredSize []
  232. (Dimension. (* 4 cell-size)
  233. (* 4 cell-size)))))
  234.  
  235. (defn game[]
  236. (new-game)
  237. (reset! game-running true)
  238. (let [gamepanel (game-panel)
  239. sidepanel (JPanel.)
  240. nextpanel (next-panel)
  241. scorelabel (JLabel. "Score: 0")
  242. exitbutton (JButton. "Exit")
  243. frame (JFrame. "Tetris")]
  244. (deflayout
  245. frame (:border)
  246. {:WEST gamepanel
  247. :EAST (deflayout (JPanel.) (:border)
  248. {:NORTH (deflayout sidepanel (:flow :TRAILING)
  249. [nextpanel scorelabel])
  250. :SOUTH exitbutton})})
  251. (doto gamepanel
  252. (.setFocusable true)
  253. (.addKeyListener gamepanel)
  254. (.repaint))
  255. (doto frame
  256. (.pack)
  257. (.setVisible true))
  258. (doto exitbutton
  259. (add-action-listener #(reset! game-running false)))
  260. (loop []
  261. (when @game-running
  262. (let [res (move-down)]
  263. (if (= res :lose)
  264. (JOptionPane/showMessageDialog frame "You lose!" )
  265. (do
  266. (.repaint gamepanel)
  267. (.repaint nextpanel)
  268. (.setText scorelabel (str "Score: " @*score*))
  269. (. Thread sleep timer-interval)
  270. (recur))))))))
  271.  
  272. (defn -main [& args]
  273. (game))
Add Comment
Please, Sign In to add comment