Start of chess board.

.drone.yml

@@ -20,6 +20,9 @@ steps:
   - name: build-clojure
     pull: always
     image: clojure:tools-deps
+    depends_on:
+      - fetch-clojure-deps
+      - fetch-npm-deps
     volumes:
       - name: cache
         path: /drone/cache/
@@ -46,6 +49,9 @@ steps:
   - name: build-static-blog
     pull: always
     image: clojure:tools-deps
+    depends_on:
+      - fetch-clojure-deps
+      - fetch-npm-deps
     volumes:
     - name: cache
       path: /drone/cache/

.vscode/settings.json

@@ -1,12 +0,0 @@
-{
-    "calva.replConnectSequences": [
-        {
-            "projectType": "deps.edn",
-            "name": "static-sites",
-            "cljsType": "none",
-            "menuSelections": {
-                "cljAliases": ["dev", "test", "+default"]
-            }
-        }
-    ]
-}

bases/do-blog/resources/public/index.html

@@ -6,6 +6,7 @@
     <meta charset="UTF-8">
     <link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.8.2/css/all.min.css" />
     <link rel="stylesheet" href="https://unpkg.com/tachyons@4.12.0/css/tachyons.min.css" />
+    <script src="https://cdn.tailwindcss.com"></script>
     <style type="text/css" media="screen">
         #loading {
             -webkit-animation: rotation 2s infinite linear;

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.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.render :refer [draw-board]]
-            [com.oly.static-sites.do-blog.pages.chess.state :refer [start-state]]
+            ;; [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

@@ -1,117 +1,169 @@
 (ns com.oly.static-sites.do-blog.pages.chess.movement)
 
-(defn line-horizontal [[x y] size]
+(defn get-square [pos game-state]
-  (loop [cords [[1 y]]]
+  (get game-state pos {}))
-    (if (every? #(< % size) (-> cords last))
-      (recur (conj cords [(+ 1 (-> cords last first)) y]))
-      cords)))
 
-(defn line-vertical [[x y] size]
+(defn edge?
-  (loop [cords [[x 1]]]
+  "Return true if x and are inside the grid"
-    (if (every? #(< % size) (-> cords last))
+  [[distance x y]]
-      (recur (conj cords [x (+ 1 (-> cords last last))]))
+  (if (or (nil? distance) (= distance 1))
-      cords)))
+    true
+    (and (and (< x 9) (< y 9))
+         (and (> x 0) (> y 0)))))
 
-(defn line-projection [[x y] size]
+(defn opposite-piece? [src-pos dest-pos board]
-  (concat (line-horizontal [x y] size)
+  (prn (str "opposite piece" dest-pos))
-          (line-vertical [x y] size)))
+  (and (-> (get board dest-pos) :piece :type some?)
+       (not= (-> (get board src-pos) :piece  :colour)
+             (-> (get board dest-pos) :piece  :colour))))
 
-(defn diagonal-start-ascending [x y]
+(defn piece?
-  [(+ 1 (- x (min x y)))
+  "Is the destination spot a piece or empty square ?"
-   (+ 1 (- y (min x y)))])
+  [src-pos dest-pos board]
+  (prn (str "piece" dest-pos))
+  (-> (get board dest-pos) :piece :type some?))
 
-(defn diagonal-start-descending [x y]
+(defn end-seq? [s]
-  [(+ x (- x y))
+  (if (empty? s)
-   (- y (- x y))])
+    false
+    (nil? (last s))))
+
+(defn identity-step [value _] value)
+
+(defn line-move
+  "Use the same function for horizontal vertical and diagonals
+  We can abstract this because all the change is which axes we calculate on
+  Just adjust the x1-fn x2-fn y1-fn y2-fn fn's"
+  [[x y] size x1-fn y1-fn x2-fn y2-fn board]
+  (prn "line-move")
+  (loop [step 1
+         cords-set-one []
+         cords-set-two []]
+
+    ;; nil at end of list indicates end of valid moves
+    (if (and (end-seq? cords-set-one)
+             (end-seq? cords-set-two))
+      (concat cords-set-one cords-set-two)
+      (recur (+ step 1)
+             (if (end-seq? cords-set-one)
+               cords-set-one
+               (if (and (edge? [step (x1-fn x step) (y1-fn y step)])
+                        (piece? [x y] [(x1-fn x step) (y1-fn y step)] board))
+                 (conj cords-set-one [step (x1-fn x step) (y1-fn y step)])
+                 (conj cords-set-one
+                       (when (opposite-piece? [x y] [(x1-fn x step) (y1-fn y step)] board)
+                         [(x1-fn x step) (y1-fn y step)] nil) nil)))
+             (if (end-seq? cords-set-two)
+               cords-set-two
+               (if (and (edge? [step (x2-fn x step) (y2-fn y step)])
+                        (piece? [x y] [(x2-fn x step) (y2-fn y step)] board))
+                 (conj cords-set-two [step (x2-fn x step) (y2-fn y step)])
+                 (conj cords-set-two nil)))))))
+
+(defn line-horizontal [[x y] size board]
+  (prn "horizontal")
+  (line-move [x y] size + identity-step - identity-step board))
+
+(defn line-vertical [[x y] size board]
+  (line-move [x y] size identity-step + identity-step - board))
 
 (defn diagonal-ascending
   "down and to the right"
-  [[x y] size]
+  [[x y] size board] (line-move [x y] size + + - - board))
-  (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]
+(defn diagonal-descending
-  (let [highest (max x y)
+  "down and to the left"
-        start (diagonal-start-descending x y)]
+  [[x y] size board] (line-move [x y] size + - - + board))
-    (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]
+(defn line-projection [[x y] size board]
-  (if (= direction :desc)
+  (concat (line-horizontal [x y] size board)
-    (diagonal-ascending xy size)
+          (line-vertical [x y] size board)))
-    (diagonal-descending xy size)))
 
-(defn diagonal-projection [[x y] size]
+(defn diagonal-projection [[x y] size board]
-  (concat (diagonal-ascending [x y] size)
+  (concat (diagonal-ascending [x y] size board)
-          (diagonal-descending [x y] size)))
+          (diagonal-descending [x y] size board)))
 
-(defn directional-projection [[x y] size]
+(defn directional-projection [[x y] size board]
-  (concat (diagonal-projection [x y] size)
+  (concat (diagonal-projection [x y] size board)
-          (line-projection [x y] 8)))
+          (line-projection [x y] size board)))
 
 (defn star [[x y] size]
-  (loop [s 1
+  (loop [step 1
-         cords [[x y]]]
+         cords [[0 x y]]]
-    (case s
+    (case step
       3
-      (recur (+ s 1)
+      (recur (+ step 1)
              (conj cords
-                   ;[(- (-> cords first first) s) (-> cords first last)]
+                   ;[(- (-> cords first second) s) (-> cords first last)]
-                   [(- (-> cords first first) 2)  (+ (-> cords first last) 1)]
+                   [step (- (-> cords first second) 2)  (+ (-> cords first last) 1)]
-                   [(- (-> cords first first) 2)  (- (-> cords first last) 1)]
+                   [step (- (-> cords first second) 2)  (- (-> cords first last) 1)]
 
-                   ;[(+ (-> cords first first) s) (-> cords first last)]
+                   ;[(+ (-> cords first second) s) (-> cords first last)]
-                   [(+ (-> cords first first) 2)  (- (-> cords first last) 1)]
+                   [step (+ (-> cords first second) 2)  (- (-> cords first last) 1)]
-                   [(+ (-> cords first first) 2)  (+ (-> cords first last) 1)]
+                   [step (+ (-> cords first second) 2)  (+ (-> cords first last) 1)]
 
-                   [(+ (-> cords first first) 1) (- (-> cords first last) 2)]
+                   [step (+ (-> cords first second) 1) (- (-> cords first last) 2)]
-                   [(- (-> cords first first) 1) (- (-> cords first last) 2)]
+                   [step (- (-> cords first second) 1) (- (-> cords first last) 2)]
 
-                   [(- (-> cords first first) 1) (+ (-> cords first last) 2)]
+                   [step (- (-> cords first second) 1) (+ (-> cords first last) 2)]
-                   [(+ (-> cords first first) 1) (+ (-> cords first last) 2)]))
+                   [step (+ (-> cords first second) 1) (+ (-> cords first last) 2)]))
       4 cords
-      (recur (+ s 1)
+      (recur (+ step 1)
-             (conj cords
+             cords
-                   [(- (-> cords first first) s) (-> cords first last)]
+             #_(conj cords
-                   [(+ (-> cords first first) s) (-> cords first last)]
+                     [step (- (-> cords first second) s) (-> cords first last)]
-                   [(-> cords first first)  (- (-> cords first last) s)]
+                     [(+ (-> cords first second) s) (-> cords first last)]
-                   [(-> cords first first)  (+ (-> cords first last) s)])))))
+                     [(-> cords first second)  (- (-> cords first last) s)]
+                     [(-> cords first second)  (+ (-> cords first last) s)])))))
 
 (defn all-around-projection [[x y] size]
-  [[(- x 1) (+ 1 y)] [x (+ 1 y)] [(+ 1 x) (+ 1 y)]
+  [[0 (- x 1) (+ 1 y)] [0 x (+ 1 y)] [0 (+ 1 x) (+ 1 y)]
-   [(- x 1) y] [(+ 1 x) y]
+   [0 (- x 1) y] [0 (+ 1 x) y]
-   [(- x 1) (- y 1)] [x (- y 1)] [(+ 1 x) (- y 1)]])
+   [0 (- x 1) (- y 1)] [0 x (- y 1)] [0 (+ 1 x) (- y 1)]])
 
-(defn pawn-projection [[x y] direction size]
+(defn pawn-projection [[x y] direction size board]
+  (prn "pawn diagonal")
+  (prn (piece? [x y] [(+ x 1) (+ y direction)] board))
+  (prn (piece? [x y] [(- x 1) (+ y direction)] board))
+  #_(piece? [x y] [(+ x direction) y] board)
+  (prn (concat [(when (piece? [x y] [(+ x 1) (+ y direction)] board) [0 (+ x 1) (+ y direction)])
+                (when (piece? [x y] [(- x 1) (+ y direction)] board) [0 (- x 1) (+ y direction)])]
                (if (or (= y 2) (= y 7))
-    [[x (+ y direction)] [x (+ y (* 2 direction))]]
+                 [[0 x (+ y direction)] [1 x (+ y (* 2 direction))]]
-    [[x (+ y direction)]]))
+                 [[0 x (+ y direction)]])))
 
-(defn fetch-selected-piece-moves [piece]
+  (concat [(when  (opposite-piece? [x y] [(+ x 1) (+ y direction)] board) [0 (+ x 1) (+ y direction)])
+           (when  (opposite-piece? [x y] [(- x 1) (+ y direction)] board) [0 (- x 1) (+ y direction)])]
+          (if (or (= y 2) (= y 7))
+            [[0 x (+ y direction)] [1 x (+ y (* 2 direction))]]
+            [[0 x (+ y direction)]])))
+
+(defn fetch-selected-piece-moves [[pos {:keys [piece]}] game-state]
   (case (:type piece)
-    :king (all-around-projection (:start-pos piece) 8)
+    :king (all-around-projection pos #_(:pos piece) 8)
-    :queen (directional-projection (:start-pos piece) 8)
+    :queen (directional-projection pos #_(:pos piece) 8 game-state)
-    :rook (line-projection (:start-pos piece) 8)
+    :rook (line-projection pos #_(:pos piece) 8 game-state)
-    :knight (star (:start-pos piece) 8)
+    :knight (star pos #_(:pos piece) 8)
-    :pawn (pawn-projection (:start-pos piece) (if (= :white (:colour piece)) 1 -1) 8)
+    :pawn (pawn-projection pos #_(:pos piece) (if (= :white (:colour piece)) 1 -1) 8 game-state)
-    :bishop (diagonal-projection (:start-pos piece) 8)
+    :bishop (diagonal-projection pos #_(:pos piece) 8 game-state)
     (prn (str "type = " (:type piece)))))
 
+(defn valid-move? [dest-pos game-state]
+  (let [piece (first (filter (fn [[k v]] (:selected v)) game-state))
+        moves (fetch-selected-piece-moves piece game-state)]
+    ;; if selected and destintion pos are the same no need to move
+    (when (not= dest-pos (:pos piece))
+      (some (fn [[_distance x y]] (= [x y] dest-pos)) moves))))
+
+;; (line-horizontal [8 1] 8)
+;; (line-vertical [8 1] 8)
+
+;; ;(line-projection [8 1] 8)
+;; (directional-projection [1 1] 8)
+;; (directional-projection [8 1] 8)
+;; (star [8 1] 8)
+;; (directional-projection [5 1] 8)
+
 ;; (deftest line-projection-test
 ;;   (testing "Horizontal direction"
 ;;     (is (= (line-horizontal [2 3] 8)

bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/render.cljs

@@ -1,6 +1,6 @@
 (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.state :refer [game-state white-square black-square]]
    [com.oly.static-sites.do-blog.pages.chess.movement :refer [fetch-selected-piece-moves]]))
 
 (defn calculate-black-white [pos]
@@ -13,22 +13,23 @@
 (defn draw-square [pos pieces]
   (let [square (calculate-black-white pos)
         piece (first (filter #(= pos (:start-pos %)) pieces))
-        selected-piece-moveable (fetch-selected-piece-moves (first (filter :selected pieces)))
+        selected-piece-moveable (fetch-selected-piece-moves (first (filter :selected pieces)) @game-state)
         moveable-square (first (filter #(= pos %) selected-piece-moveable))]
 
-    (-> {:text (cond
+    (-> piece (assoc :text (cond
                              (:selected piece) (:character piece) ;"S "
                              piece (:character piece)
                              moveable-square "O "
                              :else (if (= (calculate-black-white pos) :black)
+                                     black-square
                                      white-square
-                         black-square))}
+                                     )))
         (assoc :colour (if (= square :black)
                          white-square
                          black-square)
                :class (if (= square :black)
-                        "fl bg-white-80 black-80"
+                        "black-80"
-                        "fl bg-black-80 white-80")))))
+                        "white-80")))))
 
 (defn draw-board [pieces]
   (loop [x 1
@@ -39,3 +40,48 @@
         (conj result (draw-square [x y] pieces))
         (recur 1 (+ 1 y) (conj result (draw-square [x y] pieces))))
       (recur (+ 1 x) y (conj result (draw-square [x y] pieces))))))
+
+(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 create-board [size square-defaults]
+  (->> (board-test size)
+       (mapv #(vector % (square-defaults %)) )
+       (into {})))
+
+(defn enhance-board [board on-click-fn]
+  (reduce-kv
+   (fn [m key square]
+     (assoc m key (assoc square :on-click on-click-fn :pos key)))
+   {}
+   board))
+
+(defn place-pieces-on-board [board pieces on-click-fn]
+  (reduce (fn [m piece]
+            (let [square-colour (calculate-black-white (:start-pos piece))]
+              (assoc m (:start-pos piece)
+                     (merge (get m (:start-pos piece))
+                            {:text (:character piece)
+                             :piece (assoc piece :pos (:start-pos piece))
+                             :selected false
+                             :colour (:colour piece)
+                             :on-click on-click-fn
+                             :class (if (= square-colour :white)
+                                      (str (if (= :white (:colour piece))
+                                             " white "
+                                             " black "))
+
+                                      (str (if (= :white (:colour piece)) " white " " black")))}))))
+          board
+          pieces))

bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess/state.cljs

@@ -1,14 +1,15 @@
-(ns com.oly.static-sites.do-blog.pages.chess.state)
+(ns com.oly.static-sites.do-blog.pages.chess.state
+  (:require [reagent.core :as r]))
 
 (def white-circle "○ ")
 (def white-square "⬜")
 
-(def white-pawn "♙ ")
+;; (def white-pawn "♙ ")
-(def white-rook "♖ ")
+;; (def white-rook "♖ ")
-(def white-knight "♘ ")
+;; (def white-knight "♘ ")
-(def white-bishop "♗ ")
+;; (def white-bishop "♗ ")
-(def white-queen "♕ ")
+;; (def white-queen "♕ ")
-(def white-king "♔ ")
+;; (def white-king "♔ ")
 
 (def black-circle "● ")
 (def black-square "⬛")
@@ -20,108 +21,152 @@
 (def black-queen "♛ ")
 (def black-king "♚ ")
 
+(def white-pawn "♟ ")
+(def white-rook "♜ ")
+(def white-knight "♞ ")
+(def white-bishop "♝ ")
+(def white-queen "♛ ")
+(def white-king "♚ ")
 
 (def get-x first)
 (def get-y second)
 ;(def alternate-color (alternate-black-white))
 (def board {:tile-size [8 8]})
+(defonce game-state
+  (r/atom {:player-one {}
+           :player-two {}
+           :board []}))
+
 (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
-    :type :queen
+    :colour :white
+    :type :king
     :start-pos [4 1]}
    {:character white-queen
-    :type :king
+    :colour :white
+    :type :queen
     :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
+    :colour :white
     :character white-pawn
     :start-pos [1 2]}
    {:type :pawn
+    :colour :white
     :character white-pawn
     :start-pos [2 2]}
    {:type :pawn
+    :colour :white
     :character white-pawn
     :start-pos [3 2]}
    {:type :pawn
+    :colour :white
     :character white-pawn
     :start-pos [4 2]}
    {:type :pawn
+    :colour :white
     :character white-pawn
     :start-pos [5 2]}
    {:type :pawn
+    :colour :white
     :character white-pawn
     :start-pos [6 2]}
    {:type :pawn
+    :colour :white
     :character white-pawn
     :start-pos [7 2]}
    {:type :pawn
+    :colour :white
     :character white-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
+   {:character black-queen
+    :colour :black
     :type :queen
     :start-pos [4 8]}
-   {:character black-queen
+   {:character black-king 
+    :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/vstate.cljs

@@ -0,0 +1,175 @@
+(ns com.oly.static-sites.do-blog.pages.chess.vstate
+  (:require [reagent.core :as r]))
+
+
+(def black-viking-rook "♜")
+(def black-viking-king "♚")
+
+(defonce game-state
+  (r/atom {:player-one {}
+           :player-two {}
+           :board []}))
+
+(def viking-start-state
+  [{:character black-viking-king
+    :colour :white
+    :type :king
+    :start-pos [6 6]}
+
+   {:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [5 6]}
+   {:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [7 6]}
+   {:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [6 5]}
+   {:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [6 7]}
+
+{:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [5 7]}
+{:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [7 7]}
+{:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [5 5]}
+{:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [7 5]}
+
+   {:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [4 6]}
+   {:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [8 6]}
+   {:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [6 4]}
+   {:character black-viking-rook
+    :colour :white
+    :type :knight
+    :start-pos [6 8]}
+
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [1 4]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [1 5]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [1 6]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [1 7]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [1 8]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [2 6]}
+
+
+
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [11 4]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [11 5]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [11 6]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [11 7]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [11 8]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [10 6]}
+
+
+
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [4 1]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [5 1]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [6 1]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [7 1]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [8 1]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [6 2]}
+
+
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [4 11]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [5 11]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [6 11]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [7 11]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [8 11]}
+{:character black-viking-rook
+    :colour :black
+    :type :knight
+    :start-pos [6 10]}
+   ])
+

bases/do-blog/src/com/oly/static_sites/do_blog/pages/chess_board.cljs

@@ -0,0 +1,227 @@
+(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 valid-move?]]
+   [com.oly.static-sites.do-blog.pages.chess.render
+    :refer [calculate-black-white create-board enhance-board place-pieces-on-board]]
+
+   [com.oly.static-sites.do-blog.pages.chess.state :refer [game-state start-state]]
+   [com.oly.static-sites.do-blog.pages.chess.vstate :as v :refer [viking-start-state]]
+   [com.oly.static-sites.ui-hiccup.interface :refer [board]]
+   [reagent.core :as r]))
+
+
+#_m.capability.screenshot
+
+(defn site-startup []
+  (prn "site start up")
+(.addEventListener js/window "message"
+                     (fn [event]
+                       (prn "message from element ")
+                       (prn (.-origin event))
+                       (prn (.-data event))))
+  (prn "send ready message")
+  (.postMessage js/window.parent #js {:api "fromWidget",
+                                    :v "1.0"
+                                    :msgtype "ready"
+                                    #_#_:action "supported_api_versions"}, "*")
+  (prn "send capability message")
+
+  (.postMessage js/window.parent #js {:api "fromWidget",
+                                      :v "1.0"
+                                      :msgtype "capabilities"
+                                      :capabilities #js ["m.room.send_message" "m.room.get_state"]
+                                      #_#_:action "supported_api_versions"}, "*")
+
+  )
+
+#_(def game-state-viking (r/atom {:board viking-start-state}))
+(defn setup []
+  (prn "register listener")
+
+  (set! (.-onload js/window) site-startup)
+
+  (.addEventListener js/window "message"
+                     (fn [event]
+                       (prn "message from element ")
+                       (prn (.-origin event))
+                       (prn (.-data event)))))
+
+(defonce test-event (setup))
+
+(defn square-defaults [pos]
+  {:piece {}
+   :bg-colour (name (calculate-black-white pos))
+   #_(if (= (calculate-black-white pos) :black)
+       "bg-slate-200 black-80"
+       "bg-slate-800 white-80")})
+
+(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 get-square [pos]
+  (get @game-state [:board pos] {}))
+
+(defn reset-square
+  ([board pos] (reset-square board pos (square-defaults pos)))
+  ([board pos value]
+   (swap! board assoc-in [:board pos]  value)))
+
+(defn update-square [pos value]
+  (prn (str "update square " pos " " value))
+  (swap! game-state update-in [:board pos]
+         merge #_(get-in @game-state [:board pos] {})
+         value))
+
+(defn collisions [positions]
+  (filterv (fn [[distance x y]]
+             (let [piece (get-square [x y])]
+               (prn (str "collision = " [x y] " - " (:type piece) " - " (:colour piece)))
+               (and (nil? (:type piece))
+                    (nil? (:colour piece))))) positions))
+
+(defn highlight-moves [pos]
+  (prn "highlight")
+  (prn (fetch-selected-piece-moves
+        (first (filter (fn [[k v]] (:selected v)) (-> @game-state :board)))
+        (-> @game-state :board)))
+  (->> (fetch-selected-piece-moves
+        (first (filter (fn [[k v]] (:selected v)) (-> @game-state :board)))
+        (-> @game-state :board))
+       (mapv (fn [[distance x y]]
+               (update-square
+                [x y]
+                {:highlight (str " bg-green-" (+ 2 distance) "00 ")
+                 :pos [x y]})))))
+
+(defn clear-keys [key]
+  (swap! game-state
+         assoc :board
+         (reduce-kv (fn [m pos piece]
+                      (assoc m pos (dissoc piece key))) {} (-> @game-state :board))))
+
+(defn get-selected-square []
+  (last (filter (fn [[_ square]] (true? (:selected square))) (-> @game-state :board))))
+
+(defn piece-attribute-match?
+  [src-piece dest-piece attrib]
+  (prn (str "attrib " attrib " " (get src-piece attrib) " - " (get dest-piece attrib)))
+  (if (and (:type dest-piece) (= (get src-piece attrib) (get dest-piece attrib)))
+    true false))
+
+(defn take-piece?
+  "Check we actually have a piece and not an empty square
+  Also check the colours do not match"
+  [piece-one piece-two]
+  (if (and (:type piece-two)
+           (not= (:colour piece-one) (:colour piece-two)))
+    true false))
+
+(defn switch-player []
+  (if (= (-> @game-state :player-one :selected) true)
+    (do (swap! game-state assoc-in [:player-one :selected] false)
+        (swap! game-state assoc-in [:player-two :selected] true))
+    (do (swap! game-state assoc-in [:player-one :selected] true)
+        (swap! game-state assoc-in [:player-two :selected] false))))
+
+(defn current-player []
+  (if (= (-> @game-state :player-one :selected) true)
+    (-> @game-state :player-one)
+    (-> @game-state :player-two)))
+
+(defn move-piece
+  [selected-piece dest-square]
+  ;; check the colours don't match can't land on our own piece
+  (if (piece-attribute-match? selected-piece dest-square :colour)
+    nil
+    (when
+     (valid-move? (:pos dest-square) (-> @game-state :board))
+      (prn "--------------")
+      (switch-player)
+      (when (take-piece? selected-piece dest-square)
+        (prn (str "taking " dest-square))
+        (prn (str "taking " (:colour dest-square)))
+        (swap! game-state update (if (= :white (:colour selected-piece)) :player-one :player-two) conj dest-square))
+
+      (prn "#####")
+      (update-square (:pos dest-square) (merge dest-square {:piece  (assoc selected-piece :pos (:pos dest-square))}))
+      (reset-square game-state (:pos selected-piece) (square-defaults (:pos selected-piece))))))
+
+(defn click-square [evt p]
+  (let [[selected-pos {selected-piece :piece} #_selected-piece] (get-selected-square)
+        clicked-square p]
+    (clear-keys :highlight)
+    (when (piece-attribute-match? (current-player) selected-piece :colour)
+      (when selected-pos
+        (prn "previously selected piece")
+        (move-piece selected-piece clicked-square)))
+
+    (clear-keys :selected)
+    (clear-keys :highlight)
+  ;; set new square as selected
+    (update-square (:pos p) (assoc (get-square (:pos p)) :selected true))
+    (highlight-moves (:pos p))))
+
+(defonce viking-chess-board-setup
+  (reset! v/game-state
+          {:player-one {:pieces []
+                        :colour :white
+                        :selected true}
+           :player-two {:pieces []
+                        :colour :black
+                        :selected false}
+           :board
+           (-> (create-board 11 square-defaults)
+               (enhance-board click-square)
+               (place-pieces-on-board v/viking-start-state click-square))}))
+
+(defonce chess-board-setup
+  (reset! game-state
+          {:player-one {:pieces []
+                        :colour :white
+                        :selected true}
+           :player-two {:pieces []
+                        :colour :black
+                        :selected false}
+           :board
+           (-> (create-board 8 square-defaults)
+               (enhance-board click-square)
+               (place-pieces-on-board start-state click-square))}))
+
+(defn chess-page [{:keys [path-params] :as route}]
+  (fn [{:keys [path-params] :as route}]
+    [:div
+     (let [[pos piece] (get-selected-square)]
+       [:div
+        [:div (if (-> @game-state :player-one :selected)
+                "Whites turn"
+                "Black turn")]
+        [:div "Player one " (str (mapv :type (-> @game-state :player-one :pieces)))]
+        [:div "Player two " (str (mapv :type (-> @game-state :player-two :pieces)))]
+        [:div (str "pos = " pos)]
+        [:div (str (:type piece))]
+        [:div (str piece)]
+        [:div (str "move = " (fetch-selected-piece-moves
+                              [pos piece]
+                              (-> @game-state :board)))]])
+
+     [:div (board 8 (-> @game-state :board))]
+     [:div "Viking chess board"]
+     [:div (board 11 (-> @v/game-state :board))]]))
+
+(comment
+  (get-selected-square)
+  @game-state)
+
+

components/ui-hiccup/src/com/oly/static_sites/ui_hiccup/chess.cljc

@@ -1,24 +1,33 @@
 (ns com.oly.static-sites.ui-hiccup.chess)
 
-(defn square [{:keys [colour text class]}]
+(defn square [{:keys [colour highlight selected on-click bg-colour class piece] :as sq}]
-  [:div.flex.items-center.justify-around.w3.h3.tc {:class class}
+  [:div.flex.items-center.justify-around.w-8.h-8.md:w-12.lg:w-24.md:h-12.lg:h-24.tc
-   [:p.v-mid.ma0.pa0 text]])
+   {:class (str "fl bg-slate-"  (if (= bg-colour "black") "200" "800") " "
+                ;;class
+                highlight
+                (when selected " bg-red ")
+                ;;" bg-green-500 "
+                (if (= (-> piece :colour) :white) " white white-80" " black black-80" )
+
+                )
+    :on-click #(on-click % sq)}
+   [:p.v-mid.ma0.pa0.f2 (-> piece :character)]])
 
 (defn board [size items]
-  (loop [pos 1
+  (loop [x-pos 1
-         squares items
+         y-pos 1
-         row [:div.h3]
+         row [:div.h-8.md:h-12.lg:h-24]
          result [:div]]
-    (if (seq squares)
+    (if (and (= size (- y-pos 1)) (= size x-pos))
-      (if (= size pos)
+      result
+      (if (= size x-pos)
         (recur 1
-               (rest squares)
+               (inc y-pos)
-               [:div.h3]
+               [:div.h-8.md:h-12.lg:h-24]
-               (conj result (conj row (square (first squares)))))
+               (conj result (conj row (square (get items [x-pos y-pos])))))
-        (recur (inc pos)
+        (recur (inc x-pos)
-               (rest squares)
+               y-pos
-               (conj row (square (first squares)))
+               (conj row (square (get items [x-pos y-pos])))
-               result))
+               result)))))
-      result)))
 
 

deps.edn

@@ -9,7 +9,7 @@
 
                                org.clojure/tools.deps.alpha {:mvn/version "0.12.1003"}
 
-                               cljs-ajax/cljs-ajax {:mvn/version "0.8.1"}
+                               cljs-ajax/cljs-ajax {:mvn/version "0.8.4"}
 
                                ;; dev libraries
                                thheller/shadow-cljs {:mvn/version "2.25.2"}