Start of chess board.
continuous-integration/drone/push Build is passing Details

This commit is contained in:
Oly 2024-12-02 15:01:48 +00:00
parent 5a7da84ee9
commit 4af2c5899b
11 changed files with 697 additions and 142 deletions

View File

@ -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/

12
.vscode/settings.json vendored
View File

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

View File

@ -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;

View File

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

View File

@ -1,117 +1,169 @@
(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 get-square [pos game-state]
(get game-state pos {}))
(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 edge?
"Return true if x and are inside the grid"
[[distance x y]]
(if (or (nil? distance) (= distance 1))
true
(and (and (< x 9) (< y 9))
(and (> x 0) (> y 0)))))
(defn line-projection [[x y] size]
(concat (line-horizontal [x y] size)
(line-vertical [x y] size)))
(defn opposite-piece? [src-pos dest-pos board]
(prn (str "opposite piece" dest-pos))
(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]
[(+ 1 (- x (min x y)))
(+ 1 (- y (min x y)))])
(defn piece?
"Is the destination spot a piece or empty square ?"
[src-pos dest-pos board]
(prn (str "piece" dest-pos))
(-> (get board dest-pos) :piece :type some?))
(defn diagonal-start-descending [x y]
[(+ x (- x y))
(- y (- x y))])
(defn end-seq? [s]
(if (empty? s)
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]
(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))))
[[x y] size board] (line-move [x y] size + + - - board))
(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-descending
"down and to the left"
[[x y] size board] (line-move [x y] size + - - + board))
(defn diagonal [xy size direction]
(if (= direction :desc)
(diagonal-ascending xy size)
(diagonal-descending xy size)))
(defn line-projection [[x y] size board]
(concat (line-horizontal [x y] size board)
(line-vertical [x y] size board)))
(defn diagonal-projection [[x y] size]
(concat (diagonal-ascending [x y] size)
(diagonal-descending [x y] size)))
(defn diagonal-projection [[x y] size board]
(concat (diagonal-ascending [x y] size board)
(diagonal-descending [x y] size board)))
(defn directional-projection [[x y] size]
(concat (diagonal-projection [x y] size)
(line-projection [x y] 8)))
(defn directional-projection [[x y] size board]
(concat (diagonal-projection [x y] size board)
(line-projection [x y] size board)))
(defn star [[x y] size]
(loop [s 1
cords [[x y]]]
(case s
(loop [step 1
cords [[0 x y]]]
(case step
3
(recur (+ s 1)
(recur (+ step 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 second) s) (-> cords first last)]
[step (- (-> cords first second) 2) (+ (-> cords first last) 1)]
[step (- (-> cords first second) 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 second) s) (-> cords first last)]
[step (+ (-> cords first second) 2) (- (-> cords first last) 1)]
[step (+ (-> cords first second) 2) (+ (-> cords first last) 1)]
[(+ (-> cords first first) 1) (- (-> cords first last) 2)]
[(- (-> cords first first) 1) (- (-> cords first last) 2)]
[step (+ (-> cords first second) 1) (- (-> cords first last) 2)]
[step (- (-> cords first second) 1) (- (-> cords first last) 2)]
[(- (-> cords first first) 1) (+ (-> cords first last) 2)]
[(+ (-> cords first first) 1) (+ (-> cords first last) 2)]))
[step (- (-> cords first second) 1) (+ (-> cords first last) 2)]
[step (+ (-> cords first second) 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)])))))
(recur (+ step 1)
cords
#_(conj cords
[step (- (-> cords first second) s) (-> cords first last)]
[(+ (-> cords first second) s) (-> cords first last)]
[(-> 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)]
[(- x 1) y] [(+ 1 x) y]
[(- x 1) (- y 1)] [x (- y 1)] [(+ 1 x) (- y 1)]])
[[0 (- x 1) (+ 1 y)] [0 x (+ 1 y)] [0 (+ 1 x) (+ 1 y)]
[0 (- x 1) y] [0 (+ 1 x) y]
[0 (- x 1) (- y 1)] [0 x (- y 1)] [0 (+ 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 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))
[[0 x (+ y direction)] [1 x (+ y (* 2 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)
: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)
:king (all-around-projection pos #_(:pos piece) 8)
:queen (directional-projection pos #_(:pos piece) 8 game-state)
:rook (line-projection pos #_(:pos piece) 8 game-state)
:knight (star pos #_(:pos piece) 8)
:pawn (pawn-projection pos #_(:pos piece) (if (= :white (:colour piece)) 1 -1) 8 game-state)
: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)

View File

@ -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
(: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)
black-square
white-square
)))
(assoc :colour (if (= square :black)
white-square
black-square)
:class (if (= square :black)
"fl bg-white-80 black-80"
"fl bg-black-80 white-80")))))
"black-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))

View File

@ -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-rook "♖ ")
(def white-knight "♘ ")
(def white-bishop "♗ ")
(def white-queen "♕ ")
(def white-king "♔ ")
;; (def white-pawn "♙ ")
;; (def white-rook "♖ ")
;; (def white-knight "♘ ")
;; (def white-bishop "♗ ")
;; (def white-queen "♕ ")
;; (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]}])

View File

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

View File

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

View File

@ -1,24 +1,33 @@
(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 bg-colour class piece] :as sq}]
[:div.flex.items-center.justify-around.w-8.h-8.md:w-12.lg:w-24.md:h-12.lg:h-24.tc
{: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
squares items
row [:div.h3]
(loop [x-pos 1
y-pos 1
row [:div.h-8.md:h-12.lg:h-24]
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)
[:div.h3]
(conj result (conj row (square (first squares)))))
(recur (inc pos)
(rest squares)
(conj row (square (first squares)))
result))
result)))
(inc y-pos)
[:div.h-8.md:h-12.lg:h-24]
(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)))))

View File

@ -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"}