From 712e3eea6238bae0c9946caf82e4c5de40d4bc56 Mon Sep 17 00:00:00 2001 From: Oly Date: Mon, 2 Dec 2024 15:01:48 +0000 Subject: [PATCH] Start of chess board. --- .../com/oly/static_sites/do_blog/core.cljs | 16 +- .../do_blog/pages/chess/movement.cljs | 3 +- .../do_blog/pages/chess/render.cljs | 14 +- .../do_blog/pages/chess/state.cljs | 48 +++++- .../do_blog/pages/chess_board.cljs | 158 ++++++++++++++++++ .../com/oly/static_sites/ui_hiccup/chess.cljc | 33 ++-- 6 files changed, 237 insertions(+), 35 deletions(-) create mode 100644 bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess_board.cljs diff --git a/bases/do-blog/src/com/oly/static_sites/do_blog/core.cljs b/bases/do-blog/src/com/oly/static_sites/do_blog/core.cljs index 57fe3a2..d80e82c 100644 --- a/bases/do-blog/src/com/oly/static_sites/do_blog/core.cljs +++ b/bases/do-blog/src/com/oly/static_sites/do_blog/core.cljs @@ -19,12 +19,13 @@ ;; [henryw374.js-joda-locale_en-us] [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.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]] + [com.oly.static-sites.do-blog.pages.chess-board :refer [chess-page]] [com.oly.static-sites.do-blog.pages.about :refer [about-page]]) (:require-macros [cl-eorg.macros :refer [org-doc->move-process inline-filelist-map]])) @@ -92,6 +93,9 @@ {:name :tags :view 'post :parameters {:path string?}}] + ["/chess" + {:name :chess + :view #'chess-page}] ["/about" {:name :about :view #'about-page}] @@ -119,8 +123,7 @@ (defn ui-search [search] [:div - (board 8 (draw-board - start-state)) + [:input.w-100.center.input-reset.ba.b--black-20.pa2.mb2 {:type "text" @@ -181,6 +184,9 @@ [:li.lh-copy.pv3.b--black-30.ba.bt-0.bl-0.br-0 [:a.black.f3.link.hover-green {:href (rfe/href :archive {:tag ""})} "Past articles"]] + [:li.lh-copy.pv3.b--black-30.ba.bt-0.bl-0.br-0 + [:a.black.f3.link.hover-green + {:href (rfe/href :chess)} "Chess"]] [:li.lh-copy.pv3.b--black-30.ba.bt-0.bl-0.br-0 [:a.black.f3.link.hover-green {:href (rfe/href :about)} "About"]] diff --git a/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/movement.cljs b/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/movement.cljs index 30b7b5d..ac7a331 100644 --- a/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/movement.cljs +++ b/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/movement.cljs @@ -102,7 +102,8 @@ [[x (+ y direction)] [x (+ y (* 2 direction))]] [[x (+ y direction)]])) -(defn fetch-selected-piece-moves [piece] +(defn fetch-selected-piece-moves [[pos piece]] + (prn piece) (case (:type piece) :king (all-around-projection (:start-pos piece) 8) :queen (directional-projection (:start-pos piece) 8) diff --git a/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/render.cljs b/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/render.cljs index f875be6..d22a115 100644 --- a/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/render.cljs +++ b/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/render.cljs @@ -16,13 +16,13 @@ selected-piece-moveable (fetch-selected-piece-moves (first (filter :selected pieces))) moveable-square (first (filter #(= pos %) selected-piece-moveable))] - (-> {:text (cond - (:selected piece) (:character piece) ;"S " - piece (:character piece) - moveable-square "O " - :else (if (= (calculate-black-white pos) :black) - white-square - black-square))} + (-> piece (assoc :text (cond + (:selected piece) (:character piece) ;"S " + piece (:character piece) + moveable-square "O " + :else (if (= (calculate-black-white pos) :black) + white-square + black-square))) (assoc :colour (if (= square :black) white-square black-square) diff --git a/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/state.cljs b/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/state.cljs index c459751..75da19f 100644 --- a/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/state.cljs +++ b/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/state.cljs @@ -27,101 +27,133 @@ (def board {:tile-size [8 8]}) (def start-state [{:character white-rook + :colour :white :type :rook :start-pos [1 1]} {:character white-knight + :colour :white :type :knight :start-pos [2 1]} {:character white-bishop + :colour :white :type :bishop :start-pos [3 1]} {:character white-king + :colour :white :type :queen :start-pos [4 1]} {:character white-queen + :colour :white :type :king :start-pos [5 1]} {:character white-bishop + :colour :white :type :bishop :start-pos [6 1]} {:character white-knight + :colour :white :type :knight :start-pos [7 1]} {:character white-rook + :colour :white :type :rook :start-pos [8 1]} {:type :pawn - :character white-pawn + :colour :white + :character black-pawn :start-pos [1 2]} {:type :pawn - :character white-pawn + :colour :white + :character black-pawn :start-pos [2 2]} {:type :pawn - :character white-pawn + :colour :white + :character black-pawn :start-pos [3 2]} {:type :pawn - :character white-pawn + :colour :white + :character black-pawn :start-pos [4 2]} {:type :pawn - :character white-pawn + :colour :white + :character black-pawn :start-pos [5 2]} {:type :pawn - :character white-pawn + :colour :white + :character black-pawn :start-pos [6 2]} {:type :pawn - :character white-pawn + :colour :white + :character black-pawn :start-pos [7 2]} {:type :pawn - :character white-pawn + :colour :white + :character black-pawn :start-pos [8 2]} {:type :pawn + :colour :black :character black-pawn :start-pos [1 7]} {:type :pawn + :colour :black :character black-pawn :start-pos [2 7]} {:type :pawn + :colour :black :character black-pawn :start-pos [3 7]} {:type :pawn + :colour :black :character black-pawn :start-pos [4 7]} {:type :pawn + :colour :black :character black-pawn :start-pos [5 7]} {:type :pawn + :colour :black :character black-pawn :start-pos [6 7]} {:type :pawn + :colour :black :character black-pawn :start-pos [7 7]} {:type :pawn + :colour :black :character black-pawn :start-pos [8 7]} {:character black-rook + :colour :black :type :rook :start-pos [1 8]} {:character black-knight + :colour :black :type :knight :start-pos [2 8]} {:character black-bishop + :colour :black :type :bishop :start-pos [3 8]} {:character black-king + :colour :black :type :queen :start-pos [4 8]} {:character black-queen + :colour :black :type :king :start-pos [5 8]} {:character black-bishop + :colour :black :type :bishop :start-pos [6 8]} {:character black-knight + :colour :black :type :knight :start-pos [7 8]} {:character black-rook + :colour :black :type :rook :start-pos [8 8]}]) diff --git a/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess_board.cljs b/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess_board.cljs new file mode 100644 index 0000000..5973554 --- /dev/null +++ b/bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess_board.cljs @@ -0,0 +1,158 @@ +(ns com.oly.static-sites.do-blog.pages.chess-board + (:require + [com.oly.static-sites.do-blog.pages.chess.movement + :refer [fetch-selected-piece-moves]] + [com.oly.static-sites.do-blog.pages.chess.render + :refer [calculate-black-white]] + [com.oly.static-sites.do-blog.pages.chess.state + :refer [black-square start-state white-square]] + [com.oly.static-sites.ui-hiccup.interface :refer [board]] + [reagent.core :as r])) + +(defonce game-state (r/atom [])) +(defonce game-state-viking (r/atom [])) + +(defn board-test [size] + (loop [x-pos 1 + y-pos 1 + result []] + (if (and (= x-pos size) (= y-pos size)) + result + (if (= size x-pos) + (recur 1 + (inc y-pos) + (conj result [x-pos y-pos])) + (recur (inc x-pos) + y-pos + (conj result [x-pos y-pos])))))) + +(defn reset-square [pos value] + (prn (str "update " pos)) + (swap! game-state assoc pos value)) + +(defn update-square [pos value] + (prn (str "update " pos)) + (swap! game-state assoc pos + (merge (get @game-state pos {}) + value))) + +;; (update-square [1 1] {:class "fl bg-green"}) +;; (update-square [2 2] {:class "fl bg-green"}) + +(defn square-defaults [pos] + {:class (if (= (calculate-black-white pos) :black) + "bg-black-20 black-80" + "bg-black-80 white-80")}) + +(defn create-board [size] + (->> (board-test size) + (mapv #(let [square-colour (calculate-black-white %)] + (vector % (square-defaults %) + #_{;:colour (calculate-black-white %) + :class (if (= square-colour :black) + "bg-white-80 black-80" + "bg-black-60 white-80")}))) + (into {}))) + +(defn highlight-moves [pos] + (->> (fetch-selected-piece-moves (first (filter (fn [[k v]] (:selected v)) @game-state))) + (mapv (fn [pos] + (update-square + pos + {:highlight " bg-green "}))))) + +(defn clear-keys [key] + (reset! game-state + (reduce-kv (fn [m pos piece] + (assoc m pos (dissoc piece key))) {} @game-state))) + +(defn get-selected-square [] + (last (filter (fn [[_ square]] (true? (:selected square))) @game-state))) + +(defn valid-move? [dest-pos] + (let [piece (first (filter (fn [[k v]] (:selected v)) @game-state)) + moves (fetch-selected-piece-moves piece)] + (prn (some (fn [p] (= p dest-pos)) moves)) + (some (fn [p] (= p dest-pos)) moves))) + +(defn move-piece [src-pos piece dest-pos] + (prn (str "move piece from " src-pos " to " dest-pos)) + (prn piece) + (when (valid-move? dest-pos) + (update-square dest-pos piece) + (reset-square src-pos (square-defaults src-pos)))) + +(defn click-square [evt p] + (let [[selected-pos selected-piece] (get-selected-square)] + (clear-keys :highlight) + + (if selected-pos + (do (prn "previously selected piece") + (move-piece (:pos selected-piece) selected-piece (:pos p)) + (clear-keys :selected)) + (do + (prn "no previously selected piece") + (clear-keys :selected) + (update-square (:pos p) (assoc p :selected true)) + (highlight-moves (:pos p))))) + + (clear-keys :selected) + (clear-keys :highlight) + (update-square (:pos p) (assoc p :selected true)) + (highlight-moves (:pos p)) + (prn (get @game-state (:pos p)))) + +(defn enhance-board [board] + (reduce-kv + (fn [m key square] + (assoc m key (assoc square :on-click click-square :pos key))) + {} + board)) + +(defn place-pieces-on-board [board pieces] + (reduce (fn [m piece] + (let [square-colour (calculate-black-white (:start-pos piece))] + (assoc m (:start-pos piece) + (-> piece + (assoc :pos (:start-pos piece) + :text (:character piece) + :selected false + ;; :colour (if (= square-colour :black) + ;; white-square + ;; black-square) + :on-click click-square + :class (if (= square-colour :black) + (str "bg-black-20 " (if (= :white (:colour piece)) + " black " + " white ")) + + (str "bg-black-80 " (if (= :white (:colour piece)) " black" " white ")))))))) + + board + pieces)) + +(reset! game-state-viking + (-> (create-board 11))) + +(reset! game-state + (-> (create-board 8) + (enhance-board) + (place-pieces-on-board start-state))) + +(defn chess-page [{:keys [path-params] :as route}] + (fn [{:keys [path-params] :as route}] + [:div + (let [[pos piece] (get-selected-square)] + [:div + [:div (str "pos = " pos)] + [:div (str (:type piece))] + [:div (str piece)] + [:div (str "move = " (fetch-selected-piece-moves [pos piece]))]]) + [:div (str (fetch-selected-piece-moves (first (filter (fn [[k v]] (:selected v)) @game-state))))] + [:div (board 8 @game-state)] + [:div "Viking chess board"] + [:div (board 11 @game-state-viking)]])) + +(comment + (get-selected-square) + @game-state) diff --git a/components/ui-hiccup/src/com/oly/static_sites/ui_hiccup/chess.cljc b/components/ui-hiccup/src/com/oly/static_sites/ui_hiccup/chess.cljc index dfc5cb7..e2831ce 100644 --- a/components/ui-hiccup/src/com/oly/static_sites/ui_hiccup/chess.cljc +++ b/components/ui-hiccup/src/com/oly/static_sites/ui_hiccup/chess.cljc @@ -1,24 +1,29 @@ (ns com.oly.static-sites.ui-hiccup.chess) -(defn square [{:keys [colour text class]}] - [:div.flex.items-center.justify-around.w3.h3.tc {:class class} - [:p.v-mid.ma0.pa0 text]]) +(defn square [{:keys [colour highlight selected on-click text class] :as sq}] + (prn on-click) + [:div.flex.items-center.justify-around.w3.h3.tc + {:class (str "fl " class highlight (when selected " bg-red ") + + (if (= :white colour) " black-80" " white-80")) + :on-click #(on-click % sq)} + [:p.v-mid.ma0.pa0.f2 text]]) (defn board [size items] - (loop [pos 1 - squares items + (loop [x-pos 1 + y-pos 1 row [:div.h3] result [:div]] - (if (seq squares) - (if (= size pos) + (if (and (= size (- y-pos 1)) (= size x-pos)) + result + (if (= size x-pos) (recur 1 - (rest squares) + (inc y-pos) [:div.h3] - (conj result (conj row (square (first squares))))) - (recur (inc pos) - (rest squares) - (conj row (square (first squares))) - result)) - result))) + (conj result (conj row (square (get items [x-pos y-pos]))))) + (recur (inc x-pos) + y-pos + (conj row (square (get items [x-pos y-pos]))) + result)))))