Start of chess board.
continuous-integration/drone/push Build is passing
Details
continuous-integration/drone/push Build is passing
Details
This commit is contained in:
parent
5a7da84ee9
commit
dde0d14928
|
@ -20,6 +20,9 @@ steps:
|
||||||
- name: build-clojure
|
- name: build-clojure
|
||||||
pull: always
|
pull: always
|
||||||
image: clojure:tools-deps
|
image: clojure:tools-deps
|
||||||
|
depends_on:
|
||||||
|
- fetch-clojure-deps
|
||||||
|
- fetch-npm-deps
|
||||||
volumes:
|
volumes:
|
||||||
- name: cache
|
- name: cache
|
||||||
path: /drone/cache/
|
path: /drone/cache/
|
||||||
|
@ -46,6 +49,9 @@ steps:
|
||||||
- name: build-static-blog
|
- name: build-static-blog
|
||||||
pull: always
|
pull: always
|
||||||
image: clojure:tools-deps
|
image: clojure:tools-deps
|
||||||
|
depends_on:
|
||||||
|
- fetch-clojure-deps
|
||||||
|
- fetch-npm-deps
|
||||||
volumes:
|
volumes:
|
||||||
- name: cache
|
- name: cache
|
||||||
path: /drone/cache/
|
path: /drone/cache/
|
||||||
|
|
|
@ -6,6 +6,7 @@
|
||||||
<meta charset="UTF-8">
|
<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://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" />
|
<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">
|
<style type="text/css" media="screen">
|
||||||
#loading {
|
#loading {
|
||||||
-webkit-animation: rotation 2s infinite linear;
|
-webkit-animation: rotation 2s infinite linear;
|
||||||
|
|
|
@ -19,12 +19,13 @@
|
||||||
;; [henryw374.js-joda-locale_en-us]
|
;; [henryw374.js-joda-locale_en-us]
|
||||||
[com.oly.static-sites.do-blog.pages.helpers.database
|
[com.oly.static-sites.do-blog.pages.helpers.database
|
||||||
:refer [state document conn schema latest-article search-articles]]
|
: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.home :refer [home-page]]
|
||||||
[com.oly.static-sites.do-blog.pages.article :refer [article-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.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]])
|
[com.oly.static-sites.do-blog.pages.about :refer [about-page]])
|
||||||
(:require-macros [cl-eorg.macros :refer [org-doc->move-process inline-filelist-map]]))
|
(:require-macros [cl-eorg.macros :refer [org-doc->move-process inline-filelist-map]]))
|
||||||
|
|
||||||
|
@ -92,6 +93,9 @@
|
||||||
{:name :tags
|
{:name :tags
|
||||||
:view 'post
|
:view 'post
|
||||||
:parameters {:path string?}}]
|
:parameters {:path string?}}]
|
||||||
|
["/chess"
|
||||||
|
{:name :chess
|
||||||
|
:view #'chess-page}]
|
||||||
["/about"
|
["/about"
|
||||||
{:name :about
|
{:name :about
|
||||||
:view #'about-page}]
|
:view #'about-page}]
|
||||||
|
@ -119,8 +123,7 @@
|
||||||
|
|
||||||
(defn ui-search [search]
|
(defn ui-search [search]
|
||||||
[:div
|
[:div
|
||||||
(board 8 (draw-board
|
|
||||||
start-state))
|
|
||||||
|
|
||||||
[:input.w-100.center.input-reset.ba.b--black-20.pa2.mb2
|
[:input.w-100.center.input-reset.ba.b--black-20.pa2.mb2
|
||||||
{:type "text"
|
{:type "text"
|
||||||
|
@ -181,6 +184,9 @@
|
||||||
[:li.lh-copy.pv3.b--black-30.ba.bt-0.bl-0.br-0
|
[:li.lh-copy.pv3.b--black-30.ba.bt-0.bl-0.br-0
|
||||||
[:a.black.f3.link.hover-green
|
[:a.black.f3.link.hover-green
|
||||||
{:href (rfe/href :archive {:tag ""})} "Past articles"]]
|
{: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
|
[:li.lh-copy.pv3.b--black-30.ba.bt-0.bl-0.br-0
|
||||||
[:a.black.f3.link.hover-green
|
[:a.black.f3.link.hover-green
|
||||||
{:href (rfe/href :about)} "About"]]
|
{:href (rfe/href :about)} "About"]]
|
||||||
|
|
|
@ -1,117 +1,204 @@
|
||||||
(ns com.oly.static-sites.do-blog.pages.chess.movement)
|
(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 piece? [src-pos dest-pos board]
|
||||||
(concat (line-horizontal [x y] size)
|
(prn (str "piece" dest-pos))
|
||||||
(line-vertical [x y] size)))
|
(let [piece (get board src-pos ) ]
|
||||||
|
(prn (:type (get board dest-pos ) ))
|
||||||
|
(prn (:colour piece))
|
||||||
|
(prn (:colour (get board dest-pos )))
|
||||||
|
(if (:type (get board dest-pos ) ) #_(=
|
||||||
|
#_#_(:colour piece) (:colour (get dest-pos board)))
|
||||||
|
false
|
||||||
|
true
|
||||||
|
)))
|
||||||
|
|
||||||
(defn diagonal-start-ascending [x y]
|
(defn end-seq? [s]
|
||||||
[(+ 1 (- x (min x y)))
|
(if (empty? s)
|
||||||
(+ 1 (- y (min x y)))])
|
false
|
||||||
|
(nil? (last s))))
|
||||||
|
|
||||||
(defn diagonal-start-descending [x y]
|
(defn line-horizontal [[x y] size board]
|
||||||
[(+ x (- x y))
|
(prn "horizontal")
|
||||||
(- y (- x y))])
|
(loop [step 1
|
||||||
|
cords-set-one []
|
||||||
|
cords-set-two []]
|
||||||
|
(prn (get-square [step (+ x step) y] board))
|
||||||
|
(prn (get-square [step (- x step) y] board))
|
||||||
|
|
||||||
|
;; 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 (+ x step) y])
|
||||||
|
(piece? [x y] [(+ x step) y] board))
|
||||||
|
(conj cords-set-one [step (+ x step) y])
|
||||||
|
(conj cords-set-one nil)
|
||||||
|
))
|
||||||
|
(if (end-seq? cords-set-two)
|
||||||
|
cords-set-two
|
||||||
|
(if (and (edge? [step (- x step) y] )
|
||||||
|
(piece? [x y] [(- x step) y] board))
|
||||||
|
(conj cords-set-two [step (- x step) y])
|
||||||
|
(conj cords-set-two nil))))
|
||||||
|
)))
|
||||||
|
|
||||||
|
(defn line-vertical [[x y] size board]
|
||||||
|
(loop [step 1
|
||||||
|
cords-set-one []
|
||||||
|
cords-set-two []
|
||||||
|
]
|
||||||
|
(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? (-> cords-set-one last ))
|
||||||
|
(piece? [x y] [x (+ y step)] board))
|
||||||
|
(conj cords-set-one [step x (+ y step)])
|
||||||
|
(conj cords-set-one nil)))
|
||||||
|
(if (end-seq? cords-set-two)
|
||||||
|
cords-set-two
|
||||||
|
(if (and (edge? (-> cords-set-two last ))
|
||||||
|
(piece? [x y] [x (- y step)] board))
|
||||||
|
(conj cords-set-two [step x (- y step)])
|
||||||
|
(conj cords-set-two nil)
|
||||||
|
))
|
||||||
|
#_(conj cords [step (+ 1 (-> cords last second)) y]))
|
||||||
|
#_(recur (+ step 1) (conj cords [step x (+ 1 (-> cords last last))]))
|
||||||
|
|
||||||
|
#_cords)))
|
||||||
|
|
||||||
|
(defn line-projection [[x y] size board]
|
||||||
|
(concat (line-horizontal [x y] size board)
|
||||||
|
(line-vertical [x y] size board)))
|
||||||
|
|
||||||
|
(nil? nil)
|
||||||
|
(last [])
|
||||||
|
|
||||||
(defn diagonal-ascending
|
(defn diagonal-ascending
|
||||||
"down and to the right"
|
"down and to the right"
|
||||||
[[x y] size]
|
[[x y] size]
|
||||||
(let [lowest (min (- 8 x) (- 8 y))
|
(loop [step 1
|
||||||
highest (max x y)
|
cords-set-one []
|
||||||
start (diagonal-start-ascending x y)]
|
cords-set-two []]
|
||||||
(loop [step lowest
|
(if (or (edge? (-> cords-set-one last)
|
||||||
cords [start]]
|
#_(or (-> cords-set-one last) (-> cords-set-two last)))
|
||||||
(if (or (< step 8)
|
(edge? (-> cords-set-two last)))
|
||||||
(every? #(< % 8) (-> cords last)))
|
(recur (+ step 1)
|
||||||
(recur (+ step 1)
|
;; generate 2 coordinates either side of actual position
|
||||||
(conj cords [(+ (-> cords last first) 1)
|
(conj cords-set-one
|
||||||
(+ (-> cords last last) 1)]))
|
[step (+ x step)
|
||||||
cords))))
|
(+ y step)])
|
||||||
|
(conj cords-set-two
|
||||||
|
[step (- x step)
|
||||||
|
(- y step)]))
|
||||||
|
(concat cords-set-one cords-set-two))))
|
||||||
|
|
||||||
(defn diagonal-descending [[x y] size]
|
(defn diagonal-descending [[x y] size]
|
||||||
(let [highest (max x y)
|
(loop [step 0
|
||||||
start (diagonal-start-descending x y)]
|
cords-set-one []
|
||||||
(loop [step (+ 1 highest)
|
cords-set-two []]
|
||||||
cords [start]]
|
(if (or (edge? (-> cords-set-one last))
|
||||||
(if (or (> step 1)
|
(edge? (-> cords-set-two last)))
|
||||||
(every? #(< % 1) (-> cords last)))
|
(recur (+ step 1)
|
||||||
(recur (- step 1)
|
;; generate 2 coordinates either side of actual position
|
||||||
(conj cords [(+ (-> cords last first) 1)
|
(conj cords-set-one
|
||||||
(- (-> cords last last) 1)]))
|
[step (+ x step)
|
||||||
cords))))
|
(- y step)])
|
||||||
|
(conj cords-set-two
|
||||||
|
[step (- x step)
|
||||||
|
(+ y step)]))
|
||||||
|
(concat cords-set-one cords-set-two))))
|
||||||
|
|
||||||
(defn diagonal [xy size direction]
|
(defn diagonal-projection [[x y] size board]
|
||||||
(if (= direction :desc)
|
|
||||||
(diagonal-ascending xy size)
|
|
||||||
(diagonal-descending xy size)))
|
|
||||||
|
|
||||||
(defn diagonal-projection [[x y] size]
|
|
||||||
(concat (diagonal-ascending [x y] size)
|
(concat (diagonal-ascending [x y] size)
|
||||||
(diagonal-descending [x y] size)))
|
(diagonal-descending [x y] size)))
|
||||||
|
|
||||||
(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]
|
(defn star [[x y] size]
|
||||||
(loop [s 1
|
(loop [step 1
|
||||||
cords [[x y]]]
|
cords [[0 x y]]]
|
||||||
(case s
|
(case step
|
||||||
3
|
3
|
||||||
(recur (+ s 1)
|
(recur (+ step 1)
|
||||||
(conj cords
|
(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
|
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]
|
(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]
|
||||||
(if (or (= y 2) (= y 7))
|
(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]
|
(defn fetch-selected-piece-moves [[pos piece] game-state]
|
||||||
(case (:type piece)
|
(case (:type piece)
|
||||||
:king (all-around-projection (:start-pos piece) 8)
|
:king (all-around-projection (:pos piece) 8)
|
||||||
:queen (directional-projection (:start-pos piece) 8)
|
:queen (directional-projection (:pos piece) 8 game-state)
|
||||||
:rook (line-projection (:start-pos piece) 8)
|
:rook (line-projection (:pos piece) 8 game-state)
|
||||||
:knight (star (:start-pos piece) 8)
|
:knight (star (:pos piece) 8)
|
||||||
:pawn (pawn-projection (:start-pos piece) (if (= :white (:colour piece)) 1 -1) 8)
|
:pawn (pawn-projection (:pos piece) (if (= :white (:colour piece)) 1 -1) 8)
|
||||||
:bishop (diagonal-projection (:start-pos piece) 8)
|
:bishop (diagonal-projection (:pos piece) 8 game-state)
|
||||||
(prn (str "type = " (:type piece)))))
|
(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
|
;; (deftest line-projection-test
|
||||||
;; (testing "Horizontal direction"
|
;; (testing "Horizontal direction"
|
||||||
;; (is (= (line-horizontal [2 3] 8)
|
;; (is (= (line-horizontal [2 3] 8)
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
(ns com.oly.static-sites.do-blog.pages.chess.render
|
(ns com.oly.static-sites.do-blog.pages.chess.render
|
||||||
(:require
|
(: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]]))
|
[com.oly.static-sites.do-blog.pages.chess.movement :refer [fetch-selected-piece-moves]]))
|
||||||
|
|
||||||
(defn calculate-black-white [pos]
|
(defn calculate-black-white [pos]
|
||||||
|
@ -13,16 +13,16 @@
|
||||||
(defn draw-square [pos pieces]
|
(defn draw-square [pos pieces]
|
||||||
(let [square (calculate-black-white pos)
|
(let [square (calculate-black-white pos)
|
||||||
piece (first (filter #(= pos (:start-pos %)) pieces))
|
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))]
|
moveable-square (first (filter #(= pos %) selected-piece-moveable))]
|
||||||
|
|
||||||
(-> {:text (cond
|
(-> piece (assoc :text (cond
|
||||||
(:selected piece) (:character piece) ;"S "
|
(:selected piece) (:character piece) ;"S "
|
||||||
piece (:character piece)
|
piece (:character piece)
|
||||||
moveable-square "O "
|
moveable-square "O "
|
||||||
:else (if (= (calculate-black-white pos) :black)
|
:else (if (= (calculate-black-white pos) :black)
|
||||||
white-square
|
white-square
|
||||||
black-square))}
|
black-square)))
|
||||||
(assoc :colour (if (= square :black)
|
(assoc :colour (if (= square :black)
|
||||||
white-square
|
white-square
|
||||||
black-square)
|
black-square)
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
(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-circle "○ ")
|
||||||
(def white-square "⬜")
|
(def white-square "⬜")
|
||||||
|
@ -25,103 +26,138 @@
|
||||||
(def get-y second)
|
(def get-y second)
|
||||||
;(def alternate-color (alternate-black-white))
|
;(def alternate-color (alternate-black-white))
|
||||||
(def board {:tile-size [8 8]})
|
(def board {:tile-size [8 8]})
|
||||||
|
(defonce game-state (r/atom []))
|
||||||
|
|
||||||
(def start-state
|
(def start-state
|
||||||
[{:character white-rook
|
[{:character white-rook
|
||||||
|
:colour :white
|
||||||
:type :rook
|
:type :rook
|
||||||
:start-pos [1 1]}
|
:start-pos [1 1]}
|
||||||
{:character white-knight
|
{:character white-knight
|
||||||
|
:colour :white
|
||||||
:type :knight
|
:type :knight
|
||||||
:start-pos [2 1]}
|
:start-pos [2 1]}
|
||||||
{:character white-bishop
|
{:character white-bishop
|
||||||
|
:colour :white
|
||||||
:type :bishop
|
:type :bishop
|
||||||
:start-pos [3 1]}
|
:start-pos [3 1]}
|
||||||
{:character white-king
|
{:character white-king
|
||||||
:type :queen
|
:colour :white
|
||||||
|
:type :king
|
||||||
:start-pos [4 1]}
|
:start-pos [4 1]}
|
||||||
{:character white-queen
|
{:character white-queen
|
||||||
:type :king
|
:colour :white
|
||||||
|
:type :queen
|
||||||
:start-pos [5 1]}
|
:start-pos [5 1]}
|
||||||
{:character white-bishop
|
{:character white-bishop
|
||||||
|
:colour :white
|
||||||
:type :bishop
|
:type :bishop
|
||||||
:start-pos [6 1]}
|
:start-pos [6 1]}
|
||||||
{:character white-knight
|
{:character white-knight
|
||||||
|
:colour :white
|
||||||
:type :knight
|
:type :knight
|
||||||
:start-pos [7 1]}
|
:start-pos [7 1]}
|
||||||
{:character white-rook
|
{:character white-rook
|
||||||
|
:colour :white
|
||||||
:type :rook
|
:type :rook
|
||||||
:start-pos [8 1]}
|
:start-pos [8 1]}
|
||||||
|
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
:character white-pawn
|
:colour :white
|
||||||
|
:character black-pawn
|
||||||
:start-pos [1 2]}
|
:start-pos [1 2]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
:character white-pawn
|
:colour :white
|
||||||
|
:character black-pawn
|
||||||
:start-pos [2 2]}
|
:start-pos [2 2]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
:character white-pawn
|
:colour :white
|
||||||
|
:character black-pawn
|
||||||
:start-pos [3 2]}
|
:start-pos [3 2]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
:character white-pawn
|
:colour :white
|
||||||
|
:character black-pawn
|
||||||
:start-pos [4 2]}
|
:start-pos [4 2]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
:character white-pawn
|
:colour :white
|
||||||
|
:character black-pawn
|
||||||
:start-pos [5 2]}
|
:start-pos [5 2]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
:character white-pawn
|
:colour :white
|
||||||
|
:character black-pawn
|
||||||
:start-pos [6 2]}
|
:start-pos [6 2]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
:character white-pawn
|
:colour :white
|
||||||
|
:character black-pawn
|
||||||
:start-pos [7 2]}
|
:start-pos [7 2]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
:character white-pawn
|
:colour :white
|
||||||
|
:character black-pawn
|
||||||
:start-pos [8 2]}
|
:start-pos [8 2]}
|
||||||
|
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
|
:colour :black
|
||||||
:character black-pawn
|
:character black-pawn
|
||||||
:start-pos [1 7]}
|
:start-pos [1 7]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
|
:colour :black
|
||||||
:character black-pawn
|
:character black-pawn
|
||||||
:start-pos [2 7]}
|
:start-pos [2 7]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
|
:colour :black
|
||||||
:character black-pawn
|
:character black-pawn
|
||||||
:start-pos [3 7]}
|
:start-pos [3 7]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
|
:colour :black
|
||||||
:character black-pawn
|
:character black-pawn
|
||||||
:start-pos [4 7]}
|
:start-pos [4 7]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
|
:colour :black
|
||||||
:character black-pawn
|
:character black-pawn
|
||||||
:start-pos [5 7]}
|
:start-pos [5 7]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
|
:colour :black
|
||||||
:character black-pawn
|
:character black-pawn
|
||||||
:start-pos [6 7]}
|
:start-pos [6 7]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
|
:colour :black
|
||||||
:character black-pawn
|
:character black-pawn
|
||||||
:start-pos [7 7]}
|
:start-pos [7 7]}
|
||||||
{:type :pawn
|
{:type :pawn
|
||||||
|
:colour :black
|
||||||
:character black-pawn
|
:character black-pawn
|
||||||
:start-pos [8 7]}
|
:start-pos [8 7]}
|
||||||
|
|
||||||
{:character black-rook
|
{:character black-rook
|
||||||
|
:colour :black
|
||||||
:type :rook
|
:type :rook
|
||||||
:start-pos [1 8]}
|
:start-pos [1 8]}
|
||||||
{:character black-knight
|
{:character black-knight
|
||||||
|
:colour :black
|
||||||
:type :knight
|
:type :knight
|
||||||
:start-pos [2 8]}
|
:start-pos [2 8]}
|
||||||
{:character black-bishop
|
{:character black-bishop
|
||||||
|
:colour :black
|
||||||
:type :bishop
|
:type :bishop
|
||||||
:start-pos [3 8]}
|
:start-pos [3 8]}
|
||||||
{:character black-king
|
{:character black-queen
|
||||||
|
:colour :black
|
||||||
:type :queen
|
:type :queen
|
||||||
:start-pos [4 8]}
|
:start-pos [4 8]}
|
||||||
{:character black-queen
|
{:character black-king
|
||||||
|
:colour :black
|
||||||
:type :king
|
:type :king
|
||||||
:start-pos [5 8]}
|
:start-pos [5 8]}
|
||||||
{:character black-bishop
|
{:character black-bishop
|
||||||
|
:colour :black
|
||||||
:type :bishop
|
:type :bishop
|
||||||
:start-pos [6 8]}
|
:start-pos [6 8]}
|
||||||
{:character black-knight
|
{:character black-knight
|
||||||
|
:colour :black
|
||||||
:type :knight
|
:type :knight
|
||||||
:start-pos [7 8]}
|
:start-pos [7 8]}
|
||||||
{:character black-rook
|
{:character black-rook
|
||||||
|
:colour :black
|
||||||
:type :rook
|
:type :rook
|
||||||
:start-pos [8 8]}])
|
:start-pos [8 8]}])
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,173 @@
|
||||||
|
(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]]
|
||||||
|
[com.oly.static-sites.do-blog.pages.chess.state
|
||||||
|
:refer [black-square start-state game-state white-square]]
|
||||||
|
[com.oly.static-sites.ui-hiccup.interface :refer [board]]
|
||||||
|
[reagent.core :as r]))
|
||||||
|
|
||||||
|
(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 get-square [pos]
|
||||||
|
(get @game-state pos {}))
|
||||||
|
|
||||||
|
(defn reset-square [pos value]
|
||||||
|
(swap! game-state assoc pos value))
|
||||||
|
|
||||||
|
(defn update-square [pos value]
|
||||||
|
(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-slate-200 black-80"
|
||||||
|
"bg-slate-800 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 collisions [ positions]
|
||||||
|
(print "collissions")
|
||||||
|
(print 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]
|
||||||
|
(->> (fetch-selected-piece-moves (first (filter (fn [[k v]] (:selected v)) @game-state)) @game-state)
|
||||||
|
(mapv (fn [[distance x y]]
|
||||||
|
(update-square
|
||||||
|
[x y]
|
||||||
|
{:highlight (str " bg-green-" (+ 2 distance) "00 ")
|
||||||
|
:pos [x y]})))))
|
||||||
|
|
||||||
|
(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 piece-attribute-match? [src-pos dest-pos attrib]
|
||||||
|
(let [src-piece (get-square src-pos)
|
||||||
|
dest-piece (get-square dest-pos)]
|
||||||
|
(if (and (:type dest-piece)
|
||||||
|
(= (get src-piece attrib) (get dest-piece attrib)))
|
||||||
|
true false)))
|
||||||
|
|
||||||
|
(defn move-piece [src-pos piece dest-pos]
|
||||||
|
;; check the colours don't match can't land on our own piece
|
||||||
|
(if (piece-attribute-match? src-pos dest-pos :colour)
|
||||||
|
nil
|
||||||
|
(when (valid-move? dest-pos @game-state)
|
||||||
|
(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-slate-200 " (if (= :white (:colour piece))
|
||||||
|
" black "
|
||||||
|
" white "))
|
||||||
|
|
||||||
|
(str "bg-slate-800 " (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] @game-state))]])
|
||||||
|
[:div (str (fetch-selected-piece-moves (first (filter (fn [[k v]] (:selected v)) @game-state)) @game-state))]
|
||||||
|
[:div (board 8 @game-state)]
|
||||||
|
[:div "Viking chess board"]
|
||||||
|
[:div (board 11 @game-state-viking)]]))
|
||||||
|
|
||||||
|
(comment
|
||||||
|
(get-selected-square)
|
||||||
|
@game-state)
|
||||||
|
|
||||||
|
|
|
@ -1,24 +1,30 @@
|
||||||
(ns com.oly.static-sites.ui-hiccup.chess)
|
(ns com.oly.static-sites.ui-hiccup.chess)
|
||||||
|
|
||||||
(defn square [{:keys [colour text class]}]
|
(defn square [{:keys [colour highlight selected on-click text class] :as sq}]
|
||||||
[:div.flex.items-center.justify-around.w3.h3.tc {:class class}
|
[:div.flex.items-center.justify-around.w3.h3.tc
|
||||||
[:p.v-mid.ma0.pa0 text]])
|
{:class (str "fl " class highlight (when selected " bg-red ")
|
||||||
|
;;" bg-green-500 "
|
||||||
|
(if (= :white colour) " black-80" " white-80")
|
||||||
|
|
||||||
|
)
|
||||||
|
:on-click #(on-click % sq)}
|
||||||
|
[:p.v-mid.ma0.pa0.f2 text]])
|
||||||
|
|
||||||
(defn board [size items]
|
(defn board [size items]
|
||||||
(loop [pos 1
|
(loop [x-pos 1
|
||||||
squares items
|
y-pos 1
|
||||||
row [:div.h3]
|
row [:div.h3]
|
||||||
result [:div]]
|
result [:div]]
|
||||||
(if (seq squares)
|
(if (and (= size (- y-pos 1)) (= size x-pos))
|
||||||
(if (= size pos)
|
result
|
||||||
|
(if (= size x-pos)
|
||||||
(recur 1
|
(recur 1
|
||||||
(rest squares)
|
(inc y-pos)
|
||||||
[:div.h3]
|
[:div.h3]
|
||||||
(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)))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue