Start of chess board.

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"]]

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)

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)

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

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)

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