Add some chess rendering logic.
continuous-integration/drone/push Build is passing Details

This commit is contained in:
Oly 2024-11-15 15:25:45 +00:00
parent d9f5ed284b
commit b3abc6dd1c
6 changed files with 309 additions and 7 deletions

View File

@ -20,6 +20,8 @@
[com.oly.static-sites.do-blog.pages.helpers.database
:refer [state document conn schema latest-article search-articles]]
[com.oly.static-sites.ui-hiccup.interface :refer [board square]]
[com.oly.static-sites.do-blog.pages.chess.render :refer [draw-board]]
[com.oly.static-sites.do-blog.pages.chess.state :refer [start-state]]
[com.oly.static-sites.do-blog.pages.home :refer [home-page]]
[com.oly.static-sites.do-blog.pages.article :refer [article-page]]
[com.oly.static-sites.do-blog.pages.archive :refer [archive-page]]
@ -117,6 +119,7 @@
(defn ui-search [search]
[:div
(board 8 (draw-board start-state))
(board 8
(into [] (mapv (fn [n] {:class "fl bg-black-80 white-80" :colour "black-80" :text (str n)})
(range 1 (* 8 9))))
@ -342,6 +345,9 @@
(select-initial-page (-> @state :current-route :parameters :path :path)))})
(reagent-render render-page))
;;(defonce start (init))
;;(comment )

View File

@ -0,0 +1,133 @@
(ns com.oly.static-sites.do-blog.pages.chess.movement)
(defn line-horizontal [[x y] size]
(loop [cords [[1 y]]]
(if (every? #(< % size) (-> cords last))
(recur (conj cords [(+ 1 (-> cords last first)) y]))
cords)))
(defn line-vertical [[x y] size]
(loop [cords [[x 1]]]
(if (every? #(< % size) (-> cords last))
(recur (conj cords [x (+ 1 (-> cords last last))]))
cords)))
(defn line-projection [[x y] size]
(concat (line-horizontal [x y] size)
(line-vertical [x y] size)))
(defn diagonal-start-ascending [x y]
[(+ 1 (- x (min x y)))
(+ 1 (- y (min x y)))])
(defn diagonal-start-descending [x y]
[(+ x (- x y))
(- y (- x y))])
(defn diagonal-ascending
"down and to the right"
[[x y] size]
(let [lowest (min (- 8 x) (- 8 y))
highest (max x y)
start (diagonal-start-ascending x y)]
(loop [step lowest
cords [start]]
(if (or (< step 8)
(every? #(< % 8) (-> cords last)))
(recur (+ step 1)
(conj cords [(+ (-> cords last first) 1)
(+ (-> cords last last) 1)]))
cords))))
(defn diagonal-descending [[x y] size]
(let [highest (max x y)
start (diagonal-start-descending x y)]
(loop [step (+ 1 highest)
cords [start]]
(if (or (> step 1)
(every? #(< % 1) (-> cords last)))
(recur (- step 1)
(conj cords [(+ (-> cords last first) 1)
(- (-> cords last last) 1)]))
cords))))
(defn diagonal [xy size direction]
(if (= direction :desc)
(diagonal-ascending xy size)
(diagonal-descending xy size)))
(defn diagonal-projection [[x y] size]
(concat (diagonal-ascending [x y] size)
(diagonal-descending [x y] size)))
(defn directional-projection [[x y] size]
(concat (diagonal-projection [x y] size)
(line-projection [x y] 8)))
(defn star [[x y] size]
(loop [s 1
cords [[x y]]]
(case s
3
(recur (+ s 1)
(conj cords
;[(- (-> cords first first) s) (-> cords first last)]
[(- (-> cords first first) 2) (+ (-> cords first last) 1)]
[(- (-> cords first first) 2) (- (-> cords first last) 1)]
;[(+ (-> cords first first) s) (-> cords first last)]
[(+ (-> cords first first) 2) (- (-> cords first last) 1)]
[(+ (-> cords first first) 2) (+ (-> cords first last) 1)]
[(+ (-> cords first first) 1) (- (-> cords first last) 2)]
[(- (-> cords first first) 1) (- (-> cords first last) 2)]
[(- (-> cords first first) 1) (+ (-> cords first last) 2)]
[(+ (-> cords first first) 1) (+ (-> cords first last) 2)]))
4 cords
(recur (+ s 1)
(conj cords
[(- (-> cords first first) s) (-> cords first last)]
[(+ (-> cords first first) s) (-> cords first last)]
[(-> cords first first) (- (-> cords first last) s)]
[(-> cords first first) (+ (-> cords first last) s)])))))
(defn all-around-projection [[x y] size]
[[(- x 1) (+ 1 y)] [x (+ 1 y)] [(+ 1 x) (+ 1 y)]
[(- x 1) y] [(+ 1 x) y]
[(- x 1) (- y 1)] [x (- y 1)] [(+ 1 x) (- y 1)]])
(defn pawn-projection [[x y] direction size]
(if (or (= y 2) (= y 7))
[[x (+ y direction)] [x (+ y (* 2 direction))]]
[[x (+ y direction)]]))
(defn fetch-selected-piece-moves [piece]
(case (:type piece)
:king (all-around-projection (:start-pos piece) 8)
:queen (directional-projection (:start-pos piece) 8)
:rook (line-projection (:start-pos piece) 8)
:knight (star (:start-pos piece) 8)
:pawn (pawn-projection (:start-pos piece) (if (= :white (:colour piece)) 1 -1) 8)
:bishop (diagonal-projection (:start-pos piece) 8)
(prn (str "type = " (:type piece)))))
;; (deftest line-projection-test
;; (testing "Horizontal direction"
;; (is (= (line-horizontal [2 3] 8)
;; [[1 3] [2 3] [3 3] [4 3] [5 3] [6 3] [7 3] [8 3]])))
;; (testing "Vertical direction"
;; (is (= (line-vertical [2 3] 8)
;; [[2 1] [2 2] [2 3] [2 4] [2 5] [2 6] [2 7] [2 8]]))))
;; (deftest diagonal-projection-test
;; (testing "Diagonal ascending direction"
;; (is (= (diagonal-ascending [2 3] 8)
;; [[1 2] [2 3] [3 4] [4 5] [5 6] [6 7] [7 8]])))
;; (testing "Diagonal descending direction"
;; (is (= (diagonal-descending [2 3] 8)
;; [[8 7] [7 6] [6 5] [5 4] [4 3] [3 2] [2 1]])))
;; (testing "Diagonals "
;; (is (= (diagonal-projection [2 3] 8)
;; [[1 2] [2 3] [3 4] [4 5] [5 6] [6 7] [7 8]]))))

View File

@ -0,0 +1,38 @@
(ns com.oly.static-sites.do-blog.pages.chess.render
(:require
[com.oly.static-sites.do-blog.pages.chess.state :refer [white-square black-square]]
[com.oly.static-sites.do-blog.pages.chess.movement :refer [fetch-selected-piece-moves]]))
(defn calculate-black-white [pos]
(if (even? (first pos))
(if (even? (second pos))
:black :white)
(if (even? (second pos))
:white :black)))
(defn draw-square [pos pieces]
(let [piece (first (filter #(= pos (:start-pos %)) pieces))
selected-piece-moveable (fetch-selected-piece-moves (first (filter :selected pieces)))
moveable-square (first (filter #(= pos %) selected-piece-moveable))]
{:colour (if (= (calculate-black-white pos) :black)
white-square
black-square)
:text (cond
(:selected piece) (:character piece) ;"S "
piece (:character piece)
moveable-square "O "
:else (if (= (calculate-black-white pos) :black)
white-square
black-square))
}
))
(defn draw-board [pieces]
(loop [x 1
y 1
result []]
(if (>= x 8)
(if (>= y 8)
(conj result (draw-square [x y] pieces))
(recur 1 (+ 1 y) (conj result (str (draw-square [x y] pieces) "\n"))))
(recur (+ 1 x) y (conj result (draw-square [x y] pieces))))))

View File

@ -0,0 +1,127 @@
(ns com.oly.static-sites.do-blog.pages.chess.state)
(def white-circle "○ ")
(def white-square "⬜")
(def white-pawn "♙ ")
(def white-rook "♖ ")
(def white-knight "♘ ")
(def white-bishop "♗ ")
(def white-queen "♕ ")
(def white-king "♔ ")
(def black-circle "● ")
(def black-square "⬛")
(def black-pawn "♟ ")
(def black-rook "♜ ")
(def black-knight "♞ ")
(def black-bishop "♝ ")
(def black-queen "♛ ")
(def black-king "♚ ")
(def get-x first)
(def get-y second)
;(def alternate-color (alternate-black-white))
(def board {:tile-size [8 8]})
(def start-state
[{:character white-rook
:type :rook
:start-pos [1 1]}
{:character white-knight
:type :knight
:start-pos [2 1]}
{:character white-bishop
:type :bishop
:start-pos [3 1]}
{:character white-king
:type :queen
:start-pos [4 1]}
{:character white-queen
:type :king
:start-pos [5 1]}
{:character white-bishop
:type :bishop
:start-pos [6 1]}
{:character white-knight
:type :knight
:start-pos [7 1]}
{:character white-rook
:type :rook
:start-pos [8 1]}
{:type :pawn
:character white-pawn
:start-pos [1 2]}
{:type :pawn
:character white-pawn
:start-pos [2 2]}
{:type :pawn
:character white-pawn
:start-pos [3 2]}
{:type :pawn
:character white-pawn
:start-pos [4 2]}
{:type :pawn
:character white-pawn
:start-pos [5 2]}
{:type :pawn
:character white-pawn
:start-pos [6 2]}
{:type :pawn
:character white-pawn
:start-pos [7 2]}
{:type :pawn
:character white-pawn
:start-pos [8 2]}
{:type :pawn
:character black-pawn
:start-pos [1 7]}
{:type :pawn
:character black-pawn
:start-pos [2 7]}
{:type :pawn
:character black-pawn
:start-pos [3 7]}
{:type :pawn
:character black-pawn
:start-pos [4 7]}
{:type :pawn
:character black-pawn
:start-pos [5 7]}
{:type :pawn
:character black-pawn
:start-pos [6 7]}
{:type :pawn
:character black-pawn
:start-pos [7 7]}
{:type :pawn
:character black-pawn
:start-pos [8 7]}
{:character black-rook
:type :rook
:start-pos [1 8]}
{:character black-knight
:type :knight
:start-pos [2 8]}
{:character black-bishop
:type :bishop
:start-pos [3 8]}
{:character black-king
:type :queen
:start-pos [4 8]}
{:character black-queen
:type :king
:start-pos [5 8]}
{:character black-bishop
:type :bishop
:start-pos [6 8]}
{:character black-knight
:type :knight
:start-pos [7 8]}
{:character black-rook
:type :rook
:start-pos [8 8]}])

View File

@ -18,8 +18,7 @@
(recur (inc pos)
(rest squares)
(conj row (square (first squares)))
result)
)
result))
result)))

View File

@ -3,8 +3,7 @@
org.clojure/clojurescript {:mvn/version "1.11.60"}
no.cjohansen/portfolio {:mvn/version "2023.07.15"}}
:aliases {
:dev {:extra-paths ["development/src" "bases/portfolio/src" "bases/do-blog/src"]
:aliases {:dev {:extra-paths ["development/src" "bases/portfolio/src" "bases/do-blog/src"]
:extra-deps {org.clojure/clojure {:mvn/version "1.10.3"}
org.clojure/clojurescript {:mvn/version "1.11.60"}
@ -45,7 +44,7 @@
cider/cider-nrepl {:mvn/version "0.50.2"}
refactor-nrepl/refactor-nrepl {:mvn/version "3.10.0"}
cider/piggieback {:mvn/version "0.5.3"}}
:extra-paths ["dev" "bases/do-blog/src"]
:extra-paths ["dev" "bases/do-blog/src" "components/ui_hiccup/src"]
:main-opts ["-m" "shadow.cljs.devtools.cli"]}
:test {:extra-paths []}