├── .gitignore ├── LICENSE ├── README.md ├── cljs └── src │ └── gin │ ├── core.cljs │ ├── datascript_helpers.cljs │ ├── event_source.cljs │ ├── lobby │ └── core.cljs │ ├── local │ ├── game.cljs │ ├── services.cljs │ └── table.cljs │ ├── remote │ └── services.cljs │ ├── transact.cljs │ └── ui │ ├── animator.cljs │ ├── dom_helpers.cljs │ └── game_panel.cljs ├── dev ├── resources │ └── log4j.properties └── user.clj ├── project.clj ├── resources ├── log4j.properties ├── public │ ├── css │ │ ├── bootstrap-theme.css │ │ ├── bootstrap-theme.min.css │ │ ├── bootstrap.css │ │ ├── bootstrap.min.css │ │ └── custom.css │ ├── fonts │ │ ├── glyphicons-halflings-regular.eot │ │ ├── glyphicons-halflings-regular.svg │ │ ├── glyphicons-halflings-regular.ttf │ │ └── glyphicons-halflings-regular.woff │ ├── ico │ │ └── favicon.ico │ ├── images │ │ ├── b.png │ │ ├── b_blue.png │ │ ├── cards_sprite.png │ │ ├── club_2.png │ │ ├── club_3.png │ │ ├── club_4.png │ │ ├── club_5.png │ │ ├── club_6.png │ │ ├── club_7.png │ │ ├── club_8.png │ │ ├── club_9.png │ │ ├── club_A.png │ │ ├── club_A_plain.png │ │ ├── club_J.png │ │ ├── club_K.png │ │ ├── club_Q.png │ │ ├── club_T.png │ │ ├── diamond_2.png │ │ ├── diamond_3.png │ │ ├── diamond_4.png │ │ ├── diamond_5.png │ │ ├── diamond_6.png │ │ ├── diamond_7.png │ │ ├── diamond_8.png │ │ ├── diamond_9.png │ │ ├── diamond_A.png │ │ ├── diamond_A_plain.png │ │ ├── diamond_J.png │ │ ├── diamond_K.png │ │ ├── diamond_Q.png │ │ ├── diamond_T.png │ │ ├── heart_2.png │ │ ├── heart_3.png │ │ ├── heart_4.png │ │ ├── heart_5.png │ │ ├── heart_6.png │ │ ├── heart_7.png │ │ ├── heart_8.png │ │ ├── heart_9.png │ │ ├── heart_A.png │ │ ├── heart_A_closure.png │ │ ├── heart_A_plain.png │ │ ├── heart_J.png │ │ ├── heart_K.png │ │ ├── heart_Q.png │ │ ├── heart_T.png │ │ ├── spade_2.png │ │ ├── spade_3.png │ │ ├── spade_4.png │ │ ├── spade_5.png │ │ ├── spade_6.png │ │ ├── spade_7.png │ │ ├── spade_8.png │ │ ├── spade_9.png │ │ ├── spade_A.png │ │ ├── spade_A_plain.png │ │ ├── spade_J.png │ │ ├── spade_K.png │ │ ├── spade_Q.png │ │ └── spade_T.png │ └── js │ │ ├── bootstrap.js │ │ ├── bootstrap.min.js │ │ ├── eventsource.js │ │ ├── gin-dev.js │ │ ├── gin.js │ │ └── out │ │ ├── ajax │ │ ├── core.cljs │ │ └── core.js │ │ ├── cljs │ │ ├── core.cljs │ │ ├── core.js │ │ ├── reader.cljs │ │ └── reader.js │ │ ├── clojure │ │ ├── set.cljs │ │ ├── set.js │ │ ├── string.cljs │ │ ├── string.js │ │ ├── walk.cljs │ │ └── walk.js │ │ ├── datascript.cljs │ │ ├── datascript.js │ │ ├── gin │ │ ├── core.js │ │ ├── datascript_helpers.js │ │ ├── event_source.js │ │ ├── lobby │ │ │ └── core.js │ │ ├── local │ │ │ ├── game.js │ │ │ ├── services.js │ │ │ └── table.js │ │ ├── remote │ │ │ └── services.js │ │ ├── transact.js │ │ └── ui │ │ │ ├── animator.js │ │ │ ├── dom_helpers.js │ │ │ └── game_panel.js │ │ ├── quiescent.cljs │ │ ├── quiescent.js │ │ └── quiescent │ │ ├── dom.cljs │ │ └── dom.js └── templates │ ├── application.html │ ├── clojurescript_ai.html │ ├── game.html │ ├── lobby.html │ ├── local_game.html │ └── login.html ├── src └── gin │ ├── ai.clj │ ├── common.clj │ ├── core.clj │ ├── dealer.clj │ ├── game.clj │ ├── games.clj │ ├── lobby.clj │ ├── main.clj │ ├── migrations.clj │ ├── system │ ├── database_datomic.clj │ ├── ring.clj │ ├── ring │ │ ├── anti_forgery.clj │ │ └── jetty_async_adapter.clj │ └── server.clj │ └── util │ ├── helpers.clj │ └── layout.clj └── test └── gin ├── stream_test.clj └── test_core.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Gin 2 | 3 | Gin is a card game implemented with Clojure, ClojureScript and Datomic. 4 | 5 | More information at http://thegeez.net/2014/06/12/gin_datomic.html 6 | 7 | ### Development 8 | This uses an in-process/in-memory only database. In the `user` namespace, through `lein repl/cider` etc.: 9 | ``` 10 | (go) ;; to start the component system, localhost:3000 will serve the site 11 | (reset) ;; to reset the whole component system 12 | ``` 13 | 14 | ### Running production uberjar: 15 | ``` 16 | lein uberjar 17 | java -jar target/gin--standalone.jar 18 | ``` 19 | 20 | ### Compiling the ClojureScript 21 | ``` 22 | lein cljsbuild auto 23 | ``` 24 | 25 | ## About 26 | 27 | Written by: 28 | Gijs Stuurman / [@thegeez][twt] / [Blog][blog] / [GitHub][github] 29 | 30 | [twt]: http://twitter.com/thegeez 31 | [blog]: http://thegeez.net 32 | [github]: https://github.com/thegeez 33 | 34 | ## License 35 | 36 | Copyright © 2014 Gijs Stuurman 37 | 38 | Distributed under the Eclipse Public License either version 1.0 or (at 39 | your option) any later version. 40 | -------------------------------------------------------------------------------- /cljs/src/gin/core.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.core 2 | (:require [gin.ui.game-panel :as game-panel] 3 | [gin.transact :as transact] 4 | [gin.remote.services :as remote-services] 5 | [gin.local.services :as local-services] 6 | [datascript :as d])) 7 | 8 | (defn load-app 9 | "Return a map containing the initial application" 10 | [] 11 | {:conn (d/create-conn transact/schema) 12 | :render game-panel/start-game-panel 13 | :service remote-services/start-services}) 14 | 15 | (defn start-app [app-config] 16 | (let [{:keys [conn render service] :as app} app-config] 17 | #_(d/listen! conn (fn [report] 18 | (.log js/console "db-after" (pr-str (:db-after report))) 19 | (.log js/console "tx-data" (pr-str (:tx-data report))) 20 | (when (some (fn [d] 21 | (= (:e d) nil)) (:tx-data report)) 22 | (js/alert (str "Something broken with: " 23 | (pr-str (filter (fn [d] (nil? (:e d))) (:tx-data report)))))))) 24 | (render conn) 25 | (service conn) 26 | (def app app))) 27 | 28 | (defn ^:export main 29 | "Application entry point" 30 | [] 31 | (start-app (load-app))) 32 | 33 | (defn load-local-app 34 | [] 35 | {:conn (d/create-conn transact/schema) 36 | :render game-panel/start-game-panel 37 | :service local-services/start-services}) 38 | 39 | (defn ^:export client-local 40 | [] 41 | (start-app (load-local-app))) 42 | -------------------------------------------------------------------------------- /cljs/src/gin/datascript_helpers.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.datascript-helpers 2 | (:require [datascript :as d])) 3 | 4 | (defn entity-lookup [db av-key] 5 | (when-let [d (first (get-in (:av db) av-key))] 6 | (d/entity db (:e d)))) 7 | -------------------------------------------------------------------------------- /cljs/src/gin/event_source.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.event-source 2 | (:require [cljs.reader :as reader] 3 | [goog.Timer :as gtimer])) 4 | 5 | (defn event-source [url & {:keys [on-open on-message on-error] 6 | :or {on-open (fn []) 7 | on-message (fn [event]) 8 | on-error (fn [])}}] 9 | (let [source (js/EventSource. url) 10 | open (atom false)] 11 | (set! (.-onopen source) 12 | (fn [] 13 | (reset! open true) 14 | (on-open) 15 | nil)) 16 | (set! (.-onerror source) 17 | (fn [e] 18 | ;; can't connect is a problem, disconnecting is not 19 | (when-not @open 20 | (on-error)) 21 | (reset! open false) 22 | (goog.Timer/callOnce (fn [] 23 | ;; this sometimes happens in 24 | ;; firefox 25 | (when (= (.-readyState source) (.-CLOSED js/EventSource)) 26 | (event-source url :on-open on-open :on-message on-message :on-error on-error))) 27 | (* 9 1000)) 28 | nil)) 29 | (set! (.-onmessage source) 30 | (fn [e] 31 | (let [data (.-data e) 32 | event (reader/read-string data)] 33 | (on-message event)) 34 | nil)) 35 | source)) 36 | -------------------------------------------------------------------------------- /cljs/src/gin/lobby/core.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.lobby.core 2 | (:require [gin.event-source :as event-source] 3 | [gin.ui.dom-helpers :as domh] 4 | [quiescent :as q :include-macros true] 5 | [quiescent.dom :as dom] 6 | [ajax.core :refer [GET POST PUT] :as ajax-core])) 7 | 8 | (defn csrf-token [] 9 | (-> (goog.dom.getElement "csrf-token") 10 | (.getAttribute "value"))) 11 | 12 | (defn error-handler [] 13 | (domh/show-element (domh/get-element "network-header-error") true)) 14 | 15 | (defn goto-url [url] 16 | (set! (.-location js/window) url)) 17 | 18 | (defn POST-ACTION [url options] 19 | (POST url 20 | (merge {:params {} 21 | :handler (fn [res]) 22 | :error-handler (fn [res] 23 | (error-handler)) 24 | :format (merge (ajax-core/edn-request-format) 25 | {:read (fn [res] 26 | (let [res-text (.getResponseText res)] 27 | (when (pos? (count res-text)) 28 | (throw (js/Error. (str "Assumed no content response has content: " res-text)))))) 29 | :description "EDN (CUSTOM)"}) 30 | :headers {"X-CSRF-Token" (csrf-token)}} 31 | options))) 32 | 33 | (defn invite [slug] 34 | (POST-ACTION "/lobby/invite" 35 | {:params {:opp-slug slug}})) 36 | 37 | (defn play [slug] 38 | (POST-ACTION "/lobby/play" 39 | {:params {:opp-slug slug}})) 40 | 41 | (defn accept-play [slug] 42 | (POST-ACTION "/lobby/start" 43 | {:params {:opp-slug slug}})) 44 | 45 | (q/defcomponent Item 46 | [opp] 47 | (dom/li {:className "list-group-item"} 48 | (let [[text btn-class f] (cond 49 | (:available opp) 50 | ["Play" "btn-success" 51 | (fn [_] 52 | (play (:slug opp)))] 53 | (:invited opp) 54 | ["Awaiting invite reply ..." 55 | "btn-disabled" 56 | (fn [_])] 57 | :else 58 | ["Invite" "btn-primary" 59 | (fn [_] 60 | (invite (:slug opp)))])] 61 | (dom/div {} 62 | (dom/label {:className "opp-name"} 63 | (:username opp)) 64 | (dom/button {:className (str "btn btn-right btn-lobby-list " btn-class) 65 | :onClick f} 66 | text))))) 67 | 68 | (q/defcomponent OppList 69 | [opps] 70 | (apply dom/ul {:id "opp-list" 71 | :className "list-group opp-list-frame"} 72 | (if (seq opps) 73 | (map #(Item (val %)) (sort-by key opps)) 74 | [(dom/li {:className "list-group-item"} 75 | "No human opponents available")]))) 76 | 77 | (defn start-quiescent [opps] 78 | (add-watch opps :quiescent 79 | (fn [_ _ old state] 80 | (q/render (OppList state) 81 | (domh/get-element "opponent-list")))) 82 | (swap! opps identity)) 83 | 84 | (defn ^:export main [] 85 | (.log js/console "Hello world") 86 | (let [opps (atom {})] 87 | (start-quiescent opps) 88 | (let [source (event-source/event-source "/lobby/events" 89 | :on-message (fn [event] 90 | (cond 91 | (= (:type event) :open) 92 | (reset! opps (zipmap 93 | (map :slug (:opps event)) 94 | (:opps event))) 95 | (= (:type event) :joined) 96 | (swap! opps assoc 97 | (:slug event) 98 | {:slug (:slug event) 99 | :username (:username event)}) 100 | (= (:type event) :invited) 101 | (swap! opps assoc 102 | (:slug event) 103 | {:slug (:slug event) 104 | :username (:username event) 105 | :invited true}) 106 | (= (:type event) :available) 107 | (swap! opps assoc 108 | (:slug event) 109 | {:slug (:slug event) 110 | :username (:username event) 111 | :available true}) 112 | (= (:type event) :play) 113 | (do 114 | (accept-play (:slug event)) 115 | opps) 116 | (= (:type event) :game-created) 117 | (goto-url (:url event)))) 118 | :on-error (fn [] 119 | (error-handler)))]))) 120 | -------------------------------------------------------------------------------- /cljs/src/gin/local/game.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.local.game) 2 | 3 | ;; ;;;;;;;;;;;;; Finding Rummy and The Machine Player Strategy 4 | ;; ;;;;;;;;;;;;; ;;;;;;;; 5 | (def rank->value {:r2 2 :r3 3 :r4 4 :r5 5 :r6 6 :r7 7 :r8 8 :r9 9 6 | :T 10 :J 11 :Q 12 :K 13 :A 1}) 7 | 8 | (def value->rank (zipmap (vals rank->value) (keys rank->value))) 9 | 10 | (def suit->value {:heart 0 :club 1 :spade 2 :diamond 3}) 11 | 12 | (def value->suit (zipmap (vals suit->value) (keys suit->value))) 13 | 14 | (defn add-rank [rank n] 15 | (let [v (+ (rank->value rank) n)] 16 | (if (= v 14) 17 | :A 18 | (value->rank v)))) 19 | 20 | (defn value-sorted [cards] (sort-by (comp rank->value :rank) cards)) 21 | 22 | (def dec-rank {:r2 :A, :r3 :r2, :r4 :r3,:r5 :r4,:r6 :r5,:r7 :r6,:r8 :r7,:r9 :r8,:T :r9, :J :T, :Q :J, :K :Q,:A :K}) 23 | 24 | (defn remove-when-card [cards suit rank] ;; must be max 9 cards in the hand 25 | (let [[before after] (split-with #(not (and (= (:suit %) suit) 26 | (= (:rank %) rank))) cards)] 27 | (when (first after) ;; was the needle card in cards? 28 | (concat before (rest after))))) 29 | 30 | (defn remove-when-straight [cards end-suit end-rank] 31 | (when-let [found-middle (remove-when-card cards end-suit (dec-rank end-rank))] 32 | (remove-when-card found-middle end-suit end-rank))) 33 | 34 | (defn gin-hand-size 35 | [ginhand] 36 | (if (< (count ginhand) 3) 37 | 0 ;; need atleast 3 cards to form a set 38 | (let [pivot (first ginhand) 39 | postpivot (rest ginhand) 40 | ;; case 1: don't use the pivot in a set (to find best scores when the gin-size is less than 10) 41 | skipscore (+ 0 ;; the pivot is not used in a set 42 | (gin-hand-size postpivot)) 43 | ;; case 2: is there a trips using the pivot 44 | c1 (nth ginhand 1) 45 | c2 (nth ginhand 2) 46 | c3 (nth ginhand 3 nil) ;; might be considering the last 3 cards 47 | samescore (if (and (= (:rank pivot) (:rank c1)) 48 | (= (:rank c1) (:rank c2))) 49 | (max (+ 3 50 | (gin-hand-size (rest (rest postpivot)))) 51 | (if (and c3 52 | (= (:rank pivot) (:rank c3))) 53 | ;; when 4 of the same, there are 2 extra 54 | ;; trip possibilities 55 | (let [notsame (rest (rest (rest postpivot)))] 56 | (max 57 | (+ 3 58 | (gin-hand-size (conj notsame c1))) 59 | (+ 3 60 | (gin-hand-size (conj notsame c2))) 61 | (+ 4 62 | (gin-hand-size notsame)))) 63 | 0)) 64 | 0) ;; no trips possible 65 | ;; now try to find all the sets where the pivot is used in a straight flush 66 | ;; the pivot is always the lowest ranking remaining card in cards and therefore 67 | ;; always the first card of a straight 68 | ;; a card possibly makes a straight with the pivot as the lowest card if it is the same suit and 69 | ;; within window points of rank 70 | ;; case 4: find a straight flush with 3 cards with 71 | ;; pivot as the lowest (doesn't find Q-K-A, see 72 | ;; case 4a) 73 | wostraight (remove-when-straight postpivot (:suit pivot) (add-rank (:rank pivot) 2)) 74 | straightscore (if wostraight 75 | (max (+ 3 76 | (gin-hand-size wostraight)) 77 | (if-let [wo4straight (remove-when-card wostraight (:suit pivot) (add-rank (:rank pivot) 3))] 78 | (+ 4 79 | (gin-hand-size wo4straight)) 80 | 0)) 81 | 0) 82 | ;; special case 4: find Q-K-A and J-Q-K-A 83 | acescore (if-not (= :A (:rank pivot)) 84 | 0 ;; pivot is not an Ace, case does not apply 85 | (if-let [wostraight (remove-when-straight postpivot (:suit pivot) :K)] 86 | (max 87 | (+ 3 (gin-hand-size wostraight)) 88 | (if-let [woj (remove-when-card wostraight (:suit pivot) :J)] 89 | (+ 4 (gin-hand-size woj)) 90 | 0)) 91 | 0))] 92 | (max skipscore 93 | samescore 94 | straightscore 95 | acescore) 96 | ))) 97 | 98 | (defn gin-size [cards] 99 | "Finds the highest number of cards that can be put into sets." 100 | (gin-hand-size (value-sorted cards))) 101 | 102 | ;; helpers for pairrating 103 | ;; count-gone checks how many of a given value are known to be permanently 104 | ;; discarded 105 | (defn count-gone [rank gone-cards] 106 | (+ (if (gone-cards (+ rank 0)) 1 0) 107 | (if (gone-cards (+ rank 20)) 1 0) 108 | (if (gone-cards (+ rank 40)) 1 0) 109 | (if (gone-cards (+ rank 60)) 1 0))) 110 | 111 | ;; count-avail checks whether a given value/suit is 112 | ;; known to be discarded (returns 0) or not (returns 1) 113 | (defn count-avail [rank suit gone-cards] 114 | (if (gone-cards (+ (* suit 20) rank)) 115 | 0 116 | 1)) 117 | 118 | (defn cards-to-gone-cards [cards] 119 | (set (map #(+ (* (suit->value (:suit %)) 20) (rank->value (:rank %))) cards))) 120 | 121 | ;; rates the possibility for forming a straight given two card values in a 122 | ;; particular suit, and taking into account cards known to be discarded; the 123 | ;; rating is the number of non-discarded cards that would form a straight with 124 | ;; the given values 125 | (defn rate-straight [suit value value2 gone-cards] 126 | (let [v1 (if (= value 1) ;; use ace as top or bottom 127 | (if (> value2 6) 14 1) 128 | value) 129 | v2 (if (= value2 1) 130 | (if (> value 6) 14 1) 131 | value2)] 132 | (let [delta (- (max v1 v2) (min v1 v2))] 133 | (cond 134 | (= delta 1) 135 | (cond (or (= v1 1) (= v2 1)) 136 | ;; Might get the 3? 137 | (count-avail 3 suit gone-cards) 138 | (or (= v1 14) (= v2 14)) 139 | ;; Might get the queen? 140 | (count-avail 12 suit gone-cards) 141 | (or (= v1 13) (= v2 13)) 142 | ;; Might get the jack or ace? 143 | (+ (count-avail 11 suit gone-cards) 144 | (count-avail 1 suit gone-cards)) 145 | :else 146 | ;; Might get top or bottom? 147 | (+ (count-avail (dec (min v1 v2)) suit gone-cards) 148 | (count-avail (inc (max v1 v2)) suit gone-cards))) 149 | (= delta 2) 150 | ;; Might get the middle one? 151 | (let [middle (quot (+ v1 v2) 2)] 152 | (count-avail middle suit gone-cards)) 153 | :else 0)))) 154 | 155 | 156 | ;; This procedure is the second part of the machine's strategy. If the machine 157 | ;; sees two choices that are equally good according to gin-size, then it 158 | ;; computes a rating based on pairs, i.e., cards that might eventually go 159 | ;; together in a set. 160 | (defn pair-rating [cards goneset] 161 | (loop [rating 0 162 | cards cards] 163 | (if (= (count cards) 1) 164 | (+ 20 (* 2 rating)) ;; to conform to orig pair rating algo 165 | (let [card (first cards) 166 | others (rest cards) 167 | suit (:suit card) 168 | rank (:rank card) 169 | card-score (reduce + 170 | (map (fn [card2] 171 | (let [suit2 (:suit card2) 172 | rank2 (:rank card2)] 173 | (cond 174 | (= rank rank2) 175 | (- 2 (count-gone (rank->value rank) goneset)) 176 | (= suit suit2) 177 | (rate-straight (suit->value suit) (rank->value rank) (rank->value rank2) goneset) 178 | :else 0))) 179 | others))] 180 | (recur (+ rating card-score) 181 | others))))) 182 | 183 | ;; The procedure implements the discard choice 184 | ;; hand contains eleven cards, our hand plus the discard or new card from the deck 185 | (defn choosediscard [hand gone-cards] 186 | "Discard the card that leaves the hand with the largest gin-size. If 187 | multiple cards leave the same largest gin size, pick card leaving the best 188 | pair rating." 189 | ;; @TODO "in case of a tie involving the current discard, prefer that one" 190 | (let [sorted-hand (value-sorted hand)] 191 | (loop [best [] 192 | best-gin-size 0 193 | hands (map #(vector (remove #{%} sorted-hand) %) sorted-hand)] 194 | (if-let [h (first hands)] 195 | (let [gs (gin-size (first h))] 196 | (cond 197 | (> gs best-gin-size) 198 | (recur [h] 199 | gs 200 | (rest hands)) 201 | (= gs best-gin-size) 202 | (recur (conj best h) 203 | best-gin-size 204 | (rest hands)) 205 | :else 206 | (recur best 207 | best-gin-size 208 | (rest hands)))) 209 | ;; found all gin sizes 210 | ;; find best hand based on pair rating 211 | (if (= (count best) 1) 212 | (second (first best)) ;; discard for best gin-size 213 | (let [gone-set (cards-to-gone-cards gone-cards)] 214 | (second (apply max-key (comp #(pair-rating % gone-set) first) best)))) 215 | )))) 216 | 217 | (defn takediscardordeck [in-hand-cards discard gone-discards] 218 | "Simple strategy: we want the card if taking it will make the 219 | gin-size of our hand increase, or if taking it will not make the gin-size 220 | decrease but will increase the pair rating." 221 | (let [orig-size (gin-size in-hand-cards) 222 | hand-with-discard (conj in-hand-cards discard) 223 | trade-card (choosediscard hand-with-discard gone-discards) 224 | new-gin-cards (remove #(= trade-card %) hand-with-discard) 225 | new-size (gin-size new-gin-cards)] 226 | (if (or (> new-size orig-size) 227 | (and (= new-size orig-size) 228 | (let [gone-set (cards-to-gone-cards gone-discards)] 229 | (> (pair-rating new-gin-cards gone-set) 230 | (pair-rating in-hand-cards gone-set))))) 231 | :discard 232 | :pile))) 233 | 234 | (defn decide-move [table] 235 | (let [opp-hand (:opp-cards table) 236 | discards (:discards table) 237 | discard (peek discards) 238 | gone-discards (pop discards)] 239 | (takediscardordeck opp-hand discard gone-discards))) 240 | -------------------------------------------------------------------------------- /cljs/src/gin/local/services.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.local.services 2 | (:require [gin.transact :as t] 3 | [datascript :as d] 4 | [gin.datascript-helpers :as dh] 5 | [gin.local.game :as game] 6 | [gin.local.table :as table] 7 | [goog.Timer :as gtimer])) 8 | 9 | (defmulti handle 10 | (fn [event args report conn] event)) 11 | 12 | (defmethod handle :player-ready 13 | [event [game-id player] report conn] 14 | ;; when playing locally there is only our deal to wait on 15 | (let [game (dh/entity-lookup (:db-after report) [:game-id game-id]) 16 | starting (:starting game) 17 | {:keys [result opp-cards]} (table/table-state)] 18 | (d/transact! conn 19 | (if-let [result (get {:tie :pat-tie 20 | :our-win :pat-our-win 21 | :opp-win :pat-opp-win} result)] 22 | [[:db.fn/call t/game-finished game-id result opp-cards]] 23 | [[:db.fn/call t/turn-assigned game-id starting]])))) 24 | 25 | (defmethod handle :our-pile-picked 26 | [event [game-id card-id] {:keys [db-after] :as report} conn] 27 | (let [{:keys [suit rank] :as card} (table/get-pile-card)] 28 | (d/transact! conn [[:db.fn/call t/our-pile-pick-revealed game-id suit rank]]))) 29 | 30 | (defmethod handle :our-discard-picked 31 | [event [game-id card-id] {:keys [db-after] :as report} conn] 32 | (table/get-discard) ;; keeping local state correct 33 | ) 34 | 35 | (defmethod handle :our-discard-chosen 36 | [event [game-id card-id suit rank] {:keys [db-after] :as report} conn] 37 | (table/set-our-discard {:suit suit :rank rank}) 38 | (let [{:keys [result opp-cards]} (table/table-state)] 39 | (if (contains? #{:tie :our-win :opp-win} result) 40 | (d/transact! conn [[:db.fn/call t/game-finished game-id result opp-cards]]) 41 | (let [turn (get {:player1 :player2 42 | :player2 :player1} 43 | (:turn (dh/entity-lookup db-after [:game-id game-id])))] 44 | (.log js/console "find turn: " (pr-str (dh/entity-lookup db-after [:game-id game-id]))) 45 | (d/transact! conn [[:db.fn/call t/turn-assigned game-id turn]]))))) 46 | 47 | (defmethod handle :turn-assigned 48 | [event [game-id turn] {:keys [db-after] :as report} conn] 49 | (let [game (dh/entity-lookup db-after [:game-id game-id])] 50 | (when (not= turn (:us game)) 51 | (let [from (table/get-opponent-move) 52 | move (if (= from :pile) 53 | t/their-pile-picked 54 | t/their-discard-picked)] 55 | (d/transact! conn [[:db.fn/call move game-id]]))))) 56 | 57 | (defmethod handle :their-discard-picked 58 | [event [game-id] {:keys [db-after] :as report} conn] 59 | (let [[{:keys [suit rank]} from] (:last @table/table)] 60 | (d/transact! conn [[:db.fn/call t/their-discard-chosen game-id suit rank]]))) 61 | 62 | (defmethod handle :their-pile-picked 63 | [event [game-id] {:keys [db-after] :as report} conn] 64 | (d/transact! conn [[:db.fn/call t/their-pile-pick-revealed game-id]])) 65 | 66 | (defmethod handle :their-pile-pick-revealed 67 | [event [game-id] {:keys [db-after] :as report} conn] 68 | (let [[{:keys [suit rank]} from] (:last @table/table)] 69 | (d/transact! conn [[:db.fn/call t/their-discard-chosen game-id suit rank]]))) 70 | 71 | (defmethod handle :their-discard-chosen 72 | [event [game-id card-id suit rank] {:keys [db-after] :as report} conn] 73 | (let [{:keys [result opp-cards]} (table/table-state)] 74 | (if (contains? #{:tie :our-win :opp-win} result) 75 | (d/transact! conn [[:db.fn/call t/game-finished game-id result opp-cards]]) 76 | (let [turn (get {:player1 :player2 77 | :player2 :player1} 78 | (:turn (dh/entity-lookup db-after [:game-id game-id])))] 79 | ;; pretend we had to consider the move for a while 80 | (goog.Timer/callOnce #(d/transact! conn [[:db.fn/call t/turn-assigned game-id turn]]) 81 | 300))))) 82 | 83 | (defmethod handle :default 84 | [_ _] nil) 85 | 86 | (defn start-services [conn] 87 | (d/listen! conn (fn [{:keys [db-after] :as report}] 88 | (let [[event args] (first (d/q '{:find [?event ?args] 89 | :in [$ ?tx] 90 | :where [[?e :event ?event ?tx] 91 | [?e :args ?args]]} 92 | db-after (:max-tx db-after)))] 93 | (handle event args report conn)))) 94 | (let [game-id (str "game-local")] 95 | (d/transact! conn [[:db.fn/call t/game-created game-id "pone" "ptwo" :player1]]) 96 | (let [table (table/get-init-shuffle) 97 | to-start (if (= (:starting table) :us) 98 | :player1 99 | :player2)] 100 | (d/transact! conn [[:db.fn/call t/deal game-id (peek (:discards table)) (:our-cards table) to-start]])))) 101 | -------------------------------------------------------------------------------- /cljs/src/gin/local/table.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.local.table 2 | (:require [gin.local.game :as game])) 3 | 4 | ;; holds the game state, including the opponents cards and all the cards in 5 | ;; the deck when playing against the AI locally/not over the network 6 | 7 | (def table (atom {})) 8 | 9 | (defn table-state [] 10 | (let [table @table 11 | opp-gin-size (:opp-gin-size table) 12 | our-gin-size (:our-gin-size table)] 13 | (cond 14 | (and (= opp-gin-size 10) 15 | (= our-gin-size 10)) 16 | {:result :tie 17 | :opp-cards (:opp-cards table)} ;; only possible when both dealt gin 18 | (= opp-gin-size 10) 19 | {:result :opp-win 20 | :opp-cards (:opp-cards table)} 21 | (= our-gin-size 10) 22 | {:result :our-win 23 | :opp-cards (:opp-cards table)} 24 | :else {:result :continue}))) 25 | 26 | (defn shuffle-set [s n] 27 | "shuffles the n first items in set s" 28 | (let [ss (seq s)] 29 | (if (and ss 30 | (< 0 n)) 31 | (let [pick (rand-nth ss)] 32 | (cons pick (shuffle-set (disj s pick) (dec n)))) 33 | s))) 34 | 35 | (defn get-init-shuffle [] 36 | (let [deck (shuffle-set (set (for [suit [:heart :club :spade :diamond] 37 | rank [:A :K :Q :J :T :r9 :r8 :r7 :r6 :r5 :r4 :r3 :r2]] 38 | {:suit suit 39 | :rank rank})) 40 | 21) 41 | [opp-cards others] (split-at 10 deck) 42 | [our-cards [discard & pile]] (split-at 10 others) 43 | starting (rand-nth [:us :opp])] 44 | (swap! table merge {:our-cards (set our-cards) 45 | :our-gin-size (game/gin-size our-cards) 46 | :discards [discard] 47 | :pile-cards (set pile) 48 | :opp-cards (set opp-cards) 49 | :opp-gin-size (game/gin-size opp-cards) 50 | :starting starting}))) 51 | 52 | (defn restock-pile [] 53 | (swap! table (fn [t] 54 | (if (empty? (:pile-cards t)) 55 | (let [discards (:discards t)] 56 | (-> t 57 | (assoc :discards [(peek discards)]) 58 | (assoc :pile-cards (set (pop discards))))) 59 | t)))) 60 | 61 | (defn get-pile-card [] 62 | (let [new-card (:last (swap! table (fn [old-table] 63 | (let [card (rand-nth (seq (:pile-cards old-table)))] 64 | (-> old-table 65 | (update-in [:pile-cards] disj card) 66 | (update-in [:our-cards] conj card) 67 | (assoc :last card))))))] 68 | (restock-pile) 69 | new-card)) 70 | 71 | (defn get-discard [] 72 | (:last (swap! table (fn [old-table] 73 | (let [card (peek (:discards old-table))] 74 | (-> old-table 75 | (update-in [:discards] pop) 76 | (update-in [:our-cards] conj card) 77 | (assoc :last card))))))) 78 | 79 | (defn set-our-discard [discard] 80 | (swap! table 81 | #(-> % 82 | (update-in [:our-cards] disj discard) 83 | (update-in [:discards] conj discard))) 84 | (swap! table (fn [t] 85 | (assoc t :our-gin-size (game/gin-size (:our-cards t)))))) 86 | 87 | (defn get-opponent-move [] 88 | (let [[new-card from] (:last (swap! table 89 | (fn [t] 90 | (let [from (game/decide-move t) 91 | take-card (cond 92 | (= from :pile) 93 | (rand-nth (seq (:pile-cards t))) 94 | (= from :discard) 95 | (peek (:discards t))) 96 | t (-> (cond 97 | (= from :pile) 98 | (update-in t [:pile-cards] disj take-card) 99 | (= from :discard) 100 | (update-in t [:discards] pop)) 101 | (update-in [:opp-cards] conj take-card)) 102 | trade-card (game/choosediscard (:opp-cards t) (:discards t))] 103 | (-> t 104 | (update-in [:opp-cards] disj trade-card) 105 | (update-in [:discards] conj trade-card) 106 | (assoc :last [trade-card from]))))))] 107 | (when (= from :pile) 108 | (restock-pile)) 109 | (swap! table (fn [t] 110 | (assoc t :opp-gin-size (game/gin-size (:opp-cards t))))) 111 | from)) 112 | -------------------------------------------------------------------------------- /cljs/src/gin/remote/services.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.remote.services 2 | (:require [gin.transact :as t] 3 | [gin.event-source :as event-source] 4 | [ajax.core :refer [GET POST] :as ajax-core] 5 | [goog.dom :as gdom] 6 | [datascript :as d])) 7 | 8 | (defn game-url [] 9 | (str (.. js/window -location -pathname))) 10 | 11 | (defn csrf-token [] 12 | (-> (goog.dom.getElement "csrf-token") 13 | (.getAttribute "value"))) 14 | 15 | (defn error-handler [conn] 16 | (d/transact! conn [[:db.fn/call t/error "fail"]])) 17 | 18 | (defn POST-ACTION [url conn options] 19 | (POST url 20 | (merge {:params {} 21 | :handler (fn [res]) 22 | :error-handler (fn [res] 23 | (error-handler conn)) 24 | :format (merge (ajax-core/edn-request-format) 25 | {:read (fn [res] 26 | (let [res-text (.getResponseText res)] 27 | (when (pos? (count res-text)) 28 | (throw (js/Error. (str "Assumed no content response has content: " res-text)))))) 29 | :description "EDN (CUSTOM)"}) 30 | :headers {"X-CSRF-Token" (csrf-token)}} 31 | options))) 32 | 33 | (defmulti handle-client 34 | (fn [event args db conn] event)) 35 | 36 | (defmethod handle-client :player-ready 37 | [_ [game-id player] db conn] 38 | (POST-ACTION (str (game-url) "/player-ready") conn 39 | {:params {:game-id game-id 40 | :player player}})) 41 | 42 | (defmethod handle-client :our-discard-picked 43 | [_ [game-id card-id] db conn] 44 | (POST-ACTION (str (game-url) "/discard-picked") conn 45 | {:params {:game-id game-id}})) 46 | 47 | (defmethod handle-client :our-discard-chosen 48 | [_ [game-id card-id suit rank] db conn] 49 | (POST-ACTION (str (game-url) "/discard-chosen") conn 50 | {:params {:game-id game-id 51 | :suit suit 52 | :rank rank}})) 53 | 54 | (defmethod handle-client :our-pile-picked 55 | [_ [game-id card-id] db conn] 56 | (POST-ACTION (str (game-url) "/pile-picked") conn 57 | {:params {:game-id game-id}})) 58 | 59 | (defmethod handle-client :default 60 | [_ _] nil) 61 | 62 | (defmulti handle-server (fn [event conn] 63 | (:event event))) 64 | 65 | (defmethod handle-server :game-created 66 | [event conn] 67 | (let [{:keys [game-id player1 player2 us]} event] 68 | (d/transact! conn [[:db.fn/call t/game-created game-id player1 player2 us]]))) 69 | 70 | (defmethod handle-server :deal 71 | [event conn] 72 | (let [{:keys [game-id discard our-cards to-start]} event] 73 | (d/transact! conn [[:db.fn/call t/deal game-id discard our-cards to-start]]))) 74 | 75 | (defmethod handle-server :join-game 76 | [event conn] 77 | (let [{:keys [game-id player1 player2 us]} event] 78 | (d/transact! conn [[:db.fn/call t/game-created game-id player1 player2 us]])) 79 | (let [{:keys [game-id discards our-cards their-cards to-start turn result]} event] 80 | (d/transact! conn [[:db.fn/call t/join-game game-id discards our-cards their-cards to-start turn result]]))) 81 | 82 | (defmethod handle-server :turn-assigned 83 | [event conn] 84 | (let [{:keys [game-id turn]} event] 85 | (d/transact! conn [[:db.fn/call t/turn-assigned game-id turn]]))) 86 | 87 | (defmethod handle-server :our-discard-picked 88 | [event conn] 89 | ;; nothing todo, this is a confirmation only 90 | ) 91 | 92 | (defmethod handle-server :our-pile-picked 93 | [event conn] 94 | ;; nothing todo, this is a confirmation only 95 | ) 96 | 97 | (defmethod handle-server :our-pile-pick-revealed 98 | [event conn] 99 | (let [{:keys [game-id suit rank]} event] 100 | (d/transact! conn [[:db.fn/call t/our-pile-pick-revealed game-id suit rank]]))) 101 | 102 | (defmethod handle-server :our-discard-chosen 103 | [event conn] 104 | ;; nothing todo, this is a confirmation only 105 | ) 106 | 107 | (defmethod handle-server :their-discard-picked 108 | [event conn] 109 | (let [{:keys [game-id]} event] 110 | (d/transact! conn [[:db.fn/call t/their-discard-picked game-id]]))) 111 | 112 | (defmethod handle-server :their-pile-picked 113 | [event conn] 114 | (let [{:keys [game-id]} event] 115 | (d/transact! conn [[:db.fn/call t/their-pile-picked game-id]]))) 116 | 117 | (defmethod handle-server :their-pile-pick-revealed 118 | [event conn] 119 | (let [{:keys [game-id]} event] 120 | (d/transact! conn [[:db.fn/call t/their-pile-pick-revealed game-id]]))) 121 | 122 | (defmethod handle-server :their-discard-chosen 123 | [event conn] 124 | (let [{:keys [game-id]} event] 125 | (d/transact! conn [[:db.fn/call t/their-discard-chosen game-id (:suit event) (:rank event)]]))) 126 | 127 | (defmethod handle-server :game-finished 128 | [event conn] 129 | (let [{:keys [game-id result opp-cards]} event] 130 | (d/transact! conn [[:db.fn/call t/game-finished game-id result opp-cards]]))) 131 | 132 | (defmethod handle-server :default 133 | [event conn]) 134 | 135 | (defn start-services [conn] 136 | (d/listen! conn (fn [{:keys [db-after] :as report}] 137 | (let [[event args] (first (d/q '{:find [?event ?args] 138 | :in [$ ?tx] 139 | :where [[?e :event ?event ?tx] 140 | [?e :args ?args]]} 141 | db-after (:max-tx db-after)))] 142 | (handle-client event args report conn)))) 143 | (event-source/event-source (str (game-url) "/events") 144 | :on-message (fn [event] 145 | (handle-server event conn)) 146 | :on-error (fn [] 147 | (error-handler conn)))) 148 | -------------------------------------------------------------------------------- /cljs/src/gin/ui/animator.cljs: -------------------------------------------------------------------------------- 1 | (ns gin.ui.animator 2 | (:require [gin.ui.dom-helpers :as dom])) 3 | 4 | (def EL 0) 5 | (def START 1) 6 | (def DRAW 2) 7 | (def TO 3) 8 | (def STEP 4) 9 | (def STEPS 5) 10 | (def DX 6) 11 | (def DY 7) 12 | (def FINISH 8) 13 | 14 | (def FIELD_COUNT (count [EL START DRAW TO STEP STEPS DX DY FINISH])) 15 | 16 | (def a (make-array (+ (* 52 FIELD_COUNT) 17 | 1 ;; DO_DRAW 18 | ))) 19 | (def DO_DRAW (dec (alength a))) 20 | 21 | (def running (atom false)) 22 | 23 | (defn anim-loop [] 24 | (aset a DO_DRAW 0) 25 | (dotimes [card-idx 52] 26 | (let [i (* card-idx FIELD_COUNT)] 27 | (when (aget a (+ i DRAW)) ;; draw 28 | (aset a DO_DRAW 1) 29 | (let [el (aget a (+ i EL)) 30 | [start-x start-y] (aget a (+ i START)) 31 | [x y :as to] (aget a (+ i TO)) 32 | step (dec (aget a (+ i STEP))) 33 | dx (aget a (+ i DX)) 34 | dy (aget a (+ i DY)) 35 | steps (aget a (+ i STEPS)) 36 | nx (long (+ start-x (* (- steps step) dx))) 37 | ny (long (+ start-y (* (- steps step) dy)))] 38 | (dom/set-position el nx ny) 39 | (aset a (+ i STEP) step) 40 | (when (or (and (= x nx) 41 | (= y ny)) 42 | (zero? step) 43 | (and (zero? dx) 44 | (zero? dy))) 45 | (aset a (+ i STEP) 0) 46 | (aset a (+ i DRAW) false) 47 | (let [finish (aget a (+ i FINISH))] 48 | (when (fn? finish) 49 | (dom/set-timeout finish 0)))))))) 50 | ;; only schedule more drawing if we drew something this loop 51 | (if (= 1 (aget a DO_DRAW)) 52 | (dom/set-timeout anim-loop 10) 53 | (reset! running false))) 54 | 55 | (defn animate [] 56 | (when (compare-and-set! running false true) 57 | (anim-loop))) 58 | 59 | (defn slide [el to & [finish]] 60 | (let [idx (.-anim-idx el) 61 | i (* idx FIELD_COUNT) 62 | [from-x from-y :as from] (dom/get-position el) 63 | [to-x to-y] to 64 | step (aget a (+ i STEP)) 65 | steps (if (pos? step) step 30) 66 | dx (/ (- to-x from-x) steps) 67 | dy (/ (- to-y from-y) steps)] 68 | (aset a i el) 69 | (aset a (+ i START) from) 70 | (aset a (+ i DRAW) true) 71 | (aset a (+ i TO) to) 72 | (aset a (+ i STEP) steps) 73 | (aset a (+ i STEPS) steps) 74 | (aset a (+ i DX) dx) 75 | (aset a (+ i DY) dy) 76 | (aset a (+ i FINISH) finish) 77 | (aset a DO_DRAW 1) 78 | (animate))) 79 | -------------------------------------------------------------------------------- /cljs/src/gin/ui/dom_helpers.cljs: -------------------------------------------------------------------------------- 1 | ;; Parts are: 2 | ; Copyright (c) Rich Hickey. All rights reserved. 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this distribution. 6 | ; By using this software in any fashion, you are agreeing to be bound by 7 | ; the terms of this license. 8 | ; You must not remove this notice, or any other, from this software. 9 | 10 | (ns gin.ui.dom-helpers 11 | (:require [clojure.string :as string] 12 | [goog.style :as style] 13 | [goog.dom :as dom] 14 | [goog.dom.classes :as classes] 15 | [goog.dom.forms :as forms] 16 | [goog.fx :as fx] 17 | [goog.fx.dom :as fx-dom] 18 | [goog.Timer :as timer] 19 | )) 20 | 21 | (defn get-element 22 | "Return the element with the passed id." 23 | [id] 24 | (dom/getElement (name id))) 25 | 26 | (defn show-element [e b] 27 | (style/showElement e b)) 28 | 29 | (defn add-remove-class [e add-classes remove-classes] 30 | (classes/addRemove e remove-classes add-classes)) 31 | 32 | (defn get-radio-value [form-name name] 33 | (forms/getValueByName (get-element form-name) name)) 34 | 35 | (defn append 36 | "Append all children to parent." 37 | [parent & children] 38 | (do (doseq [child children] 39 | (dom/appendChild parent child)) 40 | parent)) 41 | 42 | (defn set-text 43 | "Set the text content for the passed element returning the 44 | element. If a keyword is passed in the place of e, the element with 45 | that id will be used and returned." 46 | [e s] 47 | (let [e (if (or (keyword? e) (string? e)) (get-element e) e)] 48 | (doto e (dom/setTextContent s)))) 49 | 50 | (defn normalize-args [tag args] 51 | (let [parts (string/split tag #"(\.|#)") 52 | [tag attrs] [(first parts) 53 | (apply hash-map (map #(cond (= % ".") :class 54 | (= % "#") :id 55 | :else %) 56 | (rest parts)))]] 57 | (if (map? (first args)) 58 | [tag (merge attrs (first args)) (rest args)] 59 | [tag attrs args]))) 60 | 61 | ;; TODO: replace call to .strobj with whatever we come up with for 62 | ;; creating js objects from Clojure maps. 63 | 64 | (defn element 65 | "Create a dom element using a keyword for the element name and a map 66 | for the attributes. Append all children to parent. If the first 67 | child is a string then the string will be set as the text content of 68 | the parent and all remaining children will be appended." 69 | [tag & args] 70 | (let [[tag attrs children] (normalize-args tag args) 71 | ;; keyword/string mangling screws up (name tag) 72 | parent (dom/createDom (subs tag 1) 73 | (clj->js (reduce (fn [m [k v]] 74 | (assoc m k v)) 75 | {} 76 | (map #(vector (name %1) %2) 77 | (keys attrs) 78 | (vals attrs))))) 79 | [parent children] (if (string? (first children)) 80 | [(set-text (element tag attrs) (first children)) 81 | (rest children)] 82 | [parent children])] 83 | (apply append parent children))) 84 | 85 | (defn remove-children 86 | "Remove all children from the element with the passed id." 87 | [parent-el] 88 | (dom/removeChildren parent-el)) 89 | 90 | (defn html 91 | "Create a dom element from an html string." 92 | [s] 93 | (dom/htmlToDocumentFragment s)) 94 | 95 | (defn- element-arg? [x] 96 | (or (keyword? x) 97 | (map? x) 98 | (string? x))) 99 | 100 | (defn build 101 | "Build up a dom element from nested vectors." 102 | [x] 103 | (if (vector? x) 104 | (let [[parent children] (if (keyword? (first x)) 105 | [(apply element (take-while element-arg? x)) 106 | (drop-while element-arg? x)] 107 | [(first x) (rest x)]) 108 | children (map build children)] 109 | (apply append parent children)) 110 | x)) 111 | 112 | (defn insert-at 113 | "Insert a child element at a specific location." 114 | [parent child index] 115 | (dom/insertChildAt parent child index)) 116 | 117 | (defn set-timeout [func ttime] 118 | (timer/callOnce func ttime)) 119 | 120 | (defn set-position [e x y] 121 | (style/setPosition e x y)) 122 | 123 | (defn get-position [e] 124 | (let [p (style/getPosition e)] 125 | [(.-x p) (.-y p)])) 126 | 127 | (defn get-bounds [e] 128 | (goog.style/getBounds e)) 129 | 130 | (def z-level (atom 100)) 131 | 132 | (defn show-on-top [card] 133 | (set! (.. card -style -zIndex) (swap! z-level inc))) 134 | 135 | (defn set-card-class [card-el card-class] 136 | ;; cards that are turned up loose the cursor_hand class 137 | ;; otherwise we have to find and remove the class for the face 138 | (if (= card-class "card_back") 139 | (classes/set card-el (str "card " card-class)) 140 | (add-remove-class card-el card-class "card_back") 141 | )) 142 | 143 | (defn toggle-class [el classname] 144 | (classes/toggle el classname)) 145 | 146 | (defn add-class [el classname] 147 | (classes/add el classname)) 148 | (defn remove-class [el classname] 149 | (classes/remove el classname)) 150 | -------------------------------------------------------------------------------- /dev/resources/log4j.properties: -------------------------------------------------------------------------------- 1 | # Root logger option 2 | log4j.rootLogger=DEBUG, stdout 3 | log4j.logger.org.eclipse.jetty=OFF, stdout 4 | log4j.logger.datomic=WARN, stdout 5 | 6 | # Direct log messages to stdout 7 | log4j.appender.stdout=org.apache.log4j.ConsoleAppender 8 | log4j.appender.stdout.Target=System.out 9 | log4j.appender.stdout.layout=org.apache.log4j.PatternLayout 10 | log4j.appender.stdout.layout.ConversionPattern=%d{yyyy-MM-dd HH:mm:ss} %-5p %c{1}:%L - %m%n 11 | -------------------------------------------------------------------------------- /dev/user.clj: -------------------------------------------------------------------------------- 1 | (ns user 2 | (:require [clojure.tools.logging :refer [info]] 3 | [com.stuartsierra.component :as component] 4 | [clojure.tools.namespace.repl :refer (refresh)] 5 | [clojure.java.io :as io] 6 | [clojure.string :as str] 7 | [clojure.pprint :refer (pprint)] 8 | [clojure.repl :refer :all] 9 | [clojure.test :as test] 10 | [gin.core :as app]) 11 | (:import [java.io PrintStream] 12 | [org.apache.log4j Logger WriterAppender PatternLayout])) 13 | 14 | ;; from cascalog playground for swank/slime 15 | (defn bootstrap-emacs [] 16 | (let [logger (Logger/getRootLogger)] 17 | (doto (. logger (getAppender "stdout")) 18 | (.setWriter *out*)) 19 | (alter-var-root #'clojure.test/*test-out* (constantly *out*)) 20 | (info "Logging to repl"))) 21 | 22 | (def be bootstrap-emacs) 23 | 24 | (def system nil) 25 | 26 | (defn init [] 27 | (alter-var-root #'system 28 | (constantly (app/dev-gin-system app/dev-config)))) 29 | 30 | (defn start [] 31 | (alter-var-root #'system component/start) 32 | :started) 33 | 34 | (defn stop [] 35 | (alter-var-root #'system 36 | (fn [s] (when s (component/stop s) nil)))) 37 | 38 | (defn go [] 39 | (if system 40 | "System not nil, use (reset) ?" 41 | (do (bootstrap-emacs) 42 | (init) 43 | (start)))) 44 | 45 | (defn reset [] 46 | (stop) 47 | (refresh :after 'user/go)) 48 | 49 | ;; lein trampoline run -m user/run 50 | (defn run [] 51 | (go) 52 | (.addShutdownHook (Runtime/getRuntime) 53 | (Thread. (fn [] 54 | (stop))))) 55 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject gin "0.0.1" 2 | :description "Gin" 3 | :url "http://thegeez.net" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.6.0"] 7 | [org.clojure/core.async "0.1.303.0-886421-alpha"] 8 | ;; logging 9 | [org.clojure/tools.logging "0.2.6"] 10 | [org.slf4j/slf4j-log4j12 "1.7.5"] 11 | 12 | ;; ring and webserver 13 | [ring/ring-core "1.2.1"] 14 | [ring/ring-jetty-adapter "1.2.1"] 15 | 16 | ;; has async for SSE 17 | [org.eclipse.jetty/jetty-server "8.1.2.v20120308"] 18 | 19 | ;; application structure 20 | [com.stuartsierra/component "0.2.1"] 21 | 22 | ;; request flow 23 | [liberator "0.11.0"] 24 | 25 | ;; routing 26 | [compojure "1.1.3"] 27 | ;; templates 28 | [enlive "1.1.5"] 29 | ;; auth 30 | [com.cemerick/friend "0.2.1" :exclusions [org.clojure/core.cache]] 31 | 32 | [com.datomic/datomic-free "0.9.4766" :exclusions [org.slf4j/log4j-over-slf4j org.slf4j/slf4j-nop]]] 33 | 34 | :profiles {:dev {:source-paths ["dev"] 35 | :resource-paths ["dev/resources"] 36 | :dependencies [[ring/ring-devel "1.2.1"] 37 | [org.clojure/tools.namespace "0.2.3"] 38 | [org.clojure/java.classpath "0.2.0"] 39 | [kerodon "0.3.0"] 40 | [org.clojure/clojurescript "0.0-2173"] 41 | ;; conflicts with cljs on tools.reader 42 | [ring/ring-core "1.2.1" :exclusions [org.clojure/tools.reader]] 43 | [cljs-ajax "0.2.3"] 44 | [datascript "0.1.4"] 45 | [quiescent "0.1.1"] 46 | [com.facebook/react "0.9.0.1"]] 47 | :plugins [[lein-cljsbuild "1.0.2"] 48 | [com.cemerick/clojurescript.test "0.3.0"]] 49 | :main user} 50 | :uberjar {:main gin.main 51 | :aot [gin.main]}} 52 | :cljsbuild {:builds {:dev {:source-paths ["cljs/src"] 53 | :compiler {:output-to "resources/public/js/gin-dev.js" 54 | :output-dir "resources/public/js/out" 55 | :optimizations :whitespace} 56 | :notify-command ["notify-send" "cljsbuild"]} 57 | :prod {:source-paths ["cljs/src"] 58 | :compiler {:output-to "resources/public/js/gin.js" 59 | :optimizations :advanced 60 | :elide-asserts true 61 | :pretty-print false 62 | :preamble ["react/react.min.js"] 63 | :externs ["react/externs/react.js"]}}}}) 64 | -------------------------------------------------------------------------------- /resources/log4j.properties: -------------------------------------------------------------------------------- 1 | # Root logger option 2 | log4j.rootLogger=INFO, stdout 3 | log4j.logger.org.eclipse.jetty=OFF, stdout 4 | log4j.logger.datomic=WARN, stdout 5 | 6 | # Direct log messages to stdout 7 | log4j.appender.stdout=org.apache.log4j.ConsoleAppender 8 | log4j.appender.stdout.Target=System.out 9 | log4j.appender.stdout.layout=org.apache.log4j.PatternLayout 10 | log4j.appender.stdout.layout.ConversionPattern=%d{yyyy-MM-dd HH:mm:ss} %-5p %c{1}:%L - %m%n 11 | -------------------------------------------------------------------------------- /resources/public/css/custom.css: -------------------------------------------------------------------------------- 1 | body { 2 | font-family: Arial, Helvetica, sans-serif; 3 | font-size: 10pt; 4 | } 5 | 6 | .navbar-spacer { 7 | height: 60px; 8 | } 9 | 10 | #game-panel { 11 | width: 580px; 12 | margin: 70px 0 0 0px; 13 | } 14 | 15 | .region { 16 | border: 1px solid grey; 17 | padding: 5px; 18 | width: 570px; 19 | height: 155px; 20 | } 21 | 22 | .their_region {} 23 | 24 | .our_region {} 25 | 26 | .region_hover { 27 | background-color: #25587E; 28 | } 29 | 30 | .pile_row { 31 | height: 143px; 32 | } 33 | 34 | 35 | .pile { 36 | width: 80px; 37 | height: 100px; 38 | margin-top: 19px; 39 | margin-left: 160px; 40 | padding: 4px; 41 | float: left; 42 | } 43 | 44 | .discard_pile { 45 | width: 95px; 46 | height: 121px; 47 | margin-top: 11px; 48 | margin-right: 150px; 49 | padding: 4px; 50 | border: 1px solid grey; 51 | float: right; 52 | } 53 | 54 | .card { 55 | background-image: url('../images/cards_sprite.png'); 56 | width: 71px; 57 | height: 96px; 58 | display: block; 59 | position: absolute; 60 | } 61 | 62 | .cursor_hand { 63 | cursor: pointer; 64 | } 65 | 66 | .cursor_drag { 67 | cursor: move; 68 | } 69 | /*** card images ***/ 70 | .offscreen_loading { 71 | left: -1000px; 72 | } 73 | .club_r2 { 74 | background-position: 0px 0px; 75 | } 76 | .club_r3 { 77 | background-position: -71px 0px; 78 | } 79 | .club_r4 { 80 | background-position: -142px 0px; 81 | } 82 | .club_r5 { 83 | background-position: -213px 0px; 84 | } 85 | .club_r6 { 86 | background-position: -284px 0px; 87 | } 88 | .club_r7 { 89 | background-position: -355px 0px; 90 | } 91 | .club_r8 { 92 | background-position: -426px 0px; 93 | } 94 | .club_r9 { 95 | background-position: -497px 0px; 96 | } 97 | .club_T { 98 | background-position: -568px 0px; 99 | } 100 | .club_J { 101 | background-position: -639px 0px; 102 | } 103 | .club_Q { 104 | background-position: -710px 0px; 105 | } 106 | .club_K { 107 | background-position: -781px 0px; 108 | } 109 | .club_A { 110 | background-position: -852px 0px; 111 | } 112 | .diamond_r2 { 113 | background-position: 0px -96px; 114 | } 115 | .diamond_r3 { 116 | background-position: -71px -96px; 117 | } 118 | .diamond_r4 { 119 | background-position: -142px -96px; 120 | } 121 | .diamond_r5 { 122 | background-position: -213px -96px; 123 | } 124 | .diamond_r6 { 125 | background-position: -284px -96px; 126 | } 127 | .diamond_r7 { 128 | background-position: -355px -96px; 129 | } 130 | .diamond_r8 { 131 | background-position: -426px -96px; 132 | } 133 | .diamond_r9 { 134 | background-position: -497px -96px; 135 | } 136 | .diamond_T { 137 | background-position: -568px -96px; 138 | } 139 | .diamond_J { 140 | background-position: -639px -96px; 141 | } 142 | .diamond_Q { 143 | background-position: -710px -96px; 144 | } 145 | .diamond_K { 146 | background-position: -781px -96px; 147 | } 148 | .diamond_A { 149 | background-position: -852px -96px; 150 | } 151 | .spade_r2 { 152 | background-position: 0px -192px; 153 | } 154 | .spade_r3 { 155 | background-position: -71px -192px; 156 | } 157 | .spade_r4 { 158 | background-position: -142px -192px; 159 | } 160 | .spade_r5 { 161 | background-position: -213px -192px; 162 | } 163 | .spade_r6 { 164 | background-position: -284px -192px; 165 | } 166 | .spade_r7 { 167 | background-position: -355px -192px; 168 | } 169 | .spade_r8 { 170 | background-position: -426px -192px; 171 | } 172 | .spade_r9 { 173 | background-position: -497px -192px; 174 | } 175 | .spade_T { 176 | background-position: -568px -192px; 177 | } 178 | .spade_J { 179 | background-position: -639px -192px; 180 | } 181 | .spade_Q { 182 | background-position: -710px -192px; 183 | } 184 | .spade_K { 185 | background-position: -781px -192px; 186 | } 187 | .spade_A { 188 | background-position: -852px -192px; 189 | } 190 | .heart_r2 { 191 | background-position: 0px -288px; 192 | } 193 | .heart_r3 { 194 | background-position: -71px -288px; 195 | } 196 | .heart_r4 { 197 | background-position: -142px -288px; 198 | } 199 | .heart_r5 { 200 | background-position: -213px -288px; 201 | } 202 | .heart_r6 { 203 | background-position: -284px -288px; 204 | } 205 | .heart_r7 { 206 | background-position: -355px -288px; 207 | } 208 | .heart_r8 { 209 | background-position: -426px -288px; 210 | } 211 | .heart_r9 { 212 | background-position: -497px -288px; 213 | } 214 | .heart_T { 215 | background-position: -568px -288px; 216 | } 217 | .heart_J { 218 | background-position: -639px -288px; 219 | } 220 | .heart_Q { 221 | background-position: -710px -288px; 222 | } 223 | .heart_K { 224 | background-position: -781px -288px; 225 | } 226 | .heart_A { 227 | background-position: -852px -288px; 228 | } 229 | .card_back { 230 | background-position: -923px 0px; 231 | } 232 | 233 | .msg { 234 | width: 570px; 235 | height: 32px; 236 | padding: 5px; 237 | margin-top: 5px; 238 | border: 1px solid grey; 239 | } 240 | 241 | 242 | /* debug watch table */ 243 | .watch_table { 244 | display: block; 245 | width: 290px; 246 | } 247 | .watch_table_card { 248 | float: left; 249 | width: 20px; 250 | height: 20px; 251 | border: 1px solid black; 252 | } 253 | .watch_table_our_card { 254 | float: left; 255 | width: 20px; 256 | height: 20px; 257 | border: 1px solid black; 258 | background-color: green; 259 | } 260 | .watch_table_discard { 261 | float: left; 262 | width: 20px; 263 | height: 20px; 264 | border: 1px solid black; 265 | background-color: orange; 266 | } 267 | .watch_table_discards { 268 | float: left; 269 | width: 20px; 270 | height: 20px; 271 | border: 1px solid black; 272 | background-color: yellow; 273 | } 274 | .watch_table_opp_card { 275 | float: left; 276 | width: 20px; 277 | height: 20px; 278 | border: 1px solid black; 279 | background-color: blue; 280 | } 281 | .watch_table_gone_card { 282 | float: left; 283 | width: 20px; 284 | height: 20px; 285 | border: 1px solid black; 286 | background-color: white; 287 | } 288 | .watch_table_gin_size { 289 | float: left; 290 | width: 284px; 291 | height: 15px; 292 | border: 1px solid black; 293 | background-color: white; 294 | } 295 | .back_button { 296 | display: block; 297 | float: right; 298 | width: 100px; 299 | height: 20px; 300 | padding-left: 9px; 301 | color: white; 302 | background-color: #25587E; 303 | } 304 | 305 | #about { 306 | width: 560px; 307 | margin: 10px 0 0 30px; 308 | background-color: #F5F5DC; 309 | } 310 | .rel-profile { 311 | margin: 5px 0 0 0; 312 | color: #FFFFFF; 313 | } 314 | .btn-right { 315 | float: right; 316 | } 317 | .opp-list-frame { 318 | padding: 0px; 319 | height: 300px; 320 | overflow-y: scroll; 321 | } 322 | label.opp-name { 323 | margin-bottom: 0px; 324 | } 325 | .btn-lobby-list { 326 | margin-top: -7px; 327 | } -------------------------------------------------------------------------------- /resources/public/fonts/glyphicons-halflings-regular.eot: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/fonts/glyphicons-halflings-regular.eot -------------------------------------------------------------------------------- /resources/public/fonts/glyphicons-halflings-regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/fonts/glyphicons-halflings-regular.ttf -------------------------------------------------------------------------------- /resources/public/fonts/glyphicons-halflings-regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/fonts/glyphicons-halflings-regular.woff -------------------------------------------------------------------------------- /resources/public/ico/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/ico/favicon.ico -------------------------------------------------------------------------------- /resources/public/images/b.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/b.png -------------------------------------------------------------------------------- /resources/public/images/b_blue.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/b_blue.png -------------------------------------------------------------------------------- /resources/public/images/cards_sprite.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/cards_sprite.png -------------------------------------------------------------------------------- /resources/public/images/club_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_2.png -------------------------------------------------------------------------------- /resources/public/images/club_3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_3.png -------------------------------------------------------------------------------- /resources/public/images/club_4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_4.png -------------------------------------------------------------------------------- /resources/public/images/club_5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_5.png -------------------------------------------------------------------------------- /resources/public/images/club_6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_6.png -------------------------------------------------------------------------------- /resources/public/images/club_7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_7.png -------------------------------------------------------------------------------- /resources/public/images/club_8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_8.png -------------------------------------------------------------------------------- /resources/public/images/club_9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_9.png -------------------------------------------------------------------------------- /resources/public/images/club_A.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_A.png -------------------------------------------------------------------------------- /resources/public/images/club_A_plain.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_A_plain.png -------------------------------------------------------------------------------- /resources/public/images/club_J.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_J.png -------------------------------------------------------------------------------- /resources/public/images/club_K.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_K.png -------------------------------------------------------------------------------- /resources/public/images/club_Q.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_Q.png -------------------------------------------------------------------------------- /resources/public/images/club_T.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/club_T.png -------------------------------------------------------------------------------- /resources/public/images/diamond_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_2.png -------------------------------------------------------------------------------- /resources/public/images/diamond_3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_3.png -------------------------------------------------------------------------------- /resources/public/images/diamond_4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_4.png -------------------------------------------------------------------------------- /resources/public/images/diamond_5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_5.png -------------------------------------------------------------------------------- /resources/public/images/diamond_6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_6.png -------------------------------------------------------------------------------- /resources/public/images/diamond_7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_7.png -------------------------------------------------------------------------------- /resources/public/images/diamond_8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_8.png -------------------------------------------------------------------------------- /resources/public/images/diamond_9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_9.png -------------------------------------------------------------------------------- /resources/public/images/diamond_A.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_A.png -------------------------------------------------------------------------------- /resources/public/images/diamond_A_plain.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_A_plain.png -------------------------------------------------------------------------------- /resources/public/images/diamond_J.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_J.png -------------------------------------------------------------------------------- /resources/public/images/diamond_K.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_K.png -------------------------------------------------------------------------------- /resources/public/images/diamond_Q.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_Q.png -------------------------------------------------------------------------------- /resources/public/images/diamond_T.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/diamond_T.png -------------------------------------------------------------------------------- /resources/public/images/heart_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_2.png -------------------------------------------------------------------------------- /resources/public/images/heart_3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_3.png -------------------------------------------------------------------------------- /resources/public/images/heart_4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_4.png -------------------------------------------------------------------------------- /resources/public/images/heart_5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_5.png -------------------------------------------------------------------------------- /resources/public/images/heart_6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_6.png -------------------------------------------------------------------------------- /resources/public/images/heart_7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_7.png -------------------------------------------------------------------------------- /resources/public/images/heart_8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_8.png -------------------------------------------------------------------------------- /resources/public/images/heart_9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_9.png -------------------------------------------------------------------------------- /resources/public/images/heart_A.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_A.png -------------------------------------------------------------------------------- /resources/public/images/heart_A_closure.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_A_closure.png -------------------------------------------------------------------------------- /resources/public/images/heart_A_plain.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_A_plain.png -------------------------------------------------------------------------------- /resources/public/images/heart_J.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_J.png -------------------------------------------------------------------------------- /resources/public/images/heart_K.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_K.png -------------------------------------------------------------------------------- /resources/public/images/heart_Q.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_Q.png -------------------------------------------------------------------------------- /resources/public/images/heart_T.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/heart_T.png -------------------------------------------------------------------------------- /resources/public/images/spade_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_2.png -------------------------------------------------------------------------------- /resources/public/images/spade_3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_3.png -------------------------------------------------------------------------------- /resources/public/images/spade_4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_4.png -------------------------------------------------------------------------------- /resources/public/images/spade_5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_5.png -------------------------------------------------------------------------------- /resources/public/images/spade_6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_6.png -------------------------------------------------------------------------------- /resources/public/images/spade_7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_7.png -------------------------------------------------------------------------------- /resources/public/images/spade_8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_8.png -------------------------------------------------------------------------------- /resources/public/images/spade_9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_9.png -------------------------------------------------------------------------------- /resources/public/images/spade_A.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_A.png -------------------------------------------------------------------------------- /resources/public/images/spade_A_plain.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_A_plain.png -------------------------------------------------------------------------------- /resources/public/images/spade_J.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_J.png -------------------------------------------------------------------------------- /resources/public/images/spade_K.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_K.png -------------------------------------------------------------------------------- /resources/public/images/spade_Q.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_Q.png -------------------------------------------------------------------------------- /resources/public/images/spade_T.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thegeez/gin/d59134fc7415da60886a375b2f6c4659ff5c9e1c/resources/public/images/spade_T.png -------------------------------------------------------------------------------- /resources/public/js/out/ajax/core.cljs: -------------------------------------------------------------------------------- 1 | (ns ajax.core 2 | (:require goog.net.EventType 3 | [goog.net.XhrIo :as xhr] 4 | [goog.net.XhrManager :as xhrm] 5 | [goog.Uri :as uri] 6 | [goog.Uri.QueryData :as query-data] 7 | [goog.json.Serializer] 8 | [goog.events :as events] 9 | [goog.structs :as structs] 10 | [cljs.reader :as reader] 11 | [clojure.string :as str])) 12 | 13 | (defprotocol AjaxImpl 14 | "An abstraction for a javascript class that implements 15 | Ajax calls." 16 | (-js-ajax-request [this uri method body headers handler opts] 17 | "Makes an actual ajax request. All parameters except opts 18 | are in JS format.")) 19 | 20 | (extend-type goog.net.XhrIo 21 | AjaxImpl 22 | (-js-ajax-request 23 | [this uri method body headers handler {:keys [timeout]}] 24 | (doto this 25 | (events/listen goog.net.EventType/COMPLETE handler) 26 | (.send uri method body headers timeout)))) 27 | 28 | (extend-type goog.net.XhrManager 29 | AjaxImpl 30 | (-js-ajax-request 31 | [this uri method body headers handler 32 | {:keys [id timeout priority max-retries]}] 33 | (.send this id uri method body headers 34 | priority handler max-retries))) 35 | 36 | (defn success? [status] 37 | (some #{status} [200 201 202 204 205 206])) 38 | 39 | (defn read-edn [xhrio] 40 | (reader/read-string (.getResponseText xhrio))) 41 | 42 | ; This code would be a heck of a lot shorter if ClojureScript 43 | ; had macros. As it is, a macro doesn't justify the extra build 44 | ; complication 45 | (defn edn-response-format [] {:read read-edn :description "EDN"}) 46 | (defn edn-request-format [] 47 | {:write pr-str 48 | :content-type "application/edn"}) 49 | 50 | (defn params-to-str [params] 51 | (if params 52 | (-> params 53 | clj->js 54 | structs/Map. 55 | query-data/createFromMap 56 | .toString))) 57 | 58 | (defn read-text [xhrio] 59 | (.getResponseText xhrio)) 60 | 61 | (defn url-request-format [] 62 | {:write params-to-str 63 | :content-type "application/x-www-form-urlencoded"}) 64 | 65 | (defn raw-response-format [] 66 | {:read read-text 67 | :description "raw text"}) 68 | 69 | (defn write-json [data] 70 | (.serialize (goog.json.Serializer.) (clj->js data))) 71 | 72 | (defn json-request-format [] 73 | {:write write-json 74 | :content-type "application/json"}) 75 | 76 | (defn json-response-format 77 | "Returns a JSON response format. Options include 78 | :keywords? Returns the keys as keywords 79 | :prefix A prefix that needs to be stripped off. This is to 80 | combat JSON hijacking. If you're using JSON with GET request, 81 | you should use this. 82 | http://stackoverflow.com/questions/2669690/why-does-google-prepend-while1-to-their-json-responses 83 | http://haacked.com/archive/2009/06/24/json-hijacking.aspx" 84 | ([{:keys [prefix keywords?]}] 85 | {:read (fn read-json [xhrio] 86 | (let [json (.getResponseJson xhrio prefix)] 87 | (js->clj json :keywordize-keys keywords?))) 88 | :description (str "JSON" 89 | (if prefix (str " prefix '" prefix "'")) 90 | (if keywords? " keywordize"))})) 91 | 92 | (defn get-default-format [xhrio] 93 | (let [ct (.getResponseHeader xhrio "Content-Type") 94 | format (if (and ct (>= (.indexOf ct "json") 0)) 95 | (json-response-format {}) 96 | (edn-response-format))] 97 | (update-in format [:description] #(str % " (default)")))) 98 | 99 | (defn use-content-type [format] 100 | (dissoc format :write)) 101 | 102 | (defn codec [request-format 103 | {:keys [read description] :as response-format}] 104 | (assoc request-format 105 | :read read 106 | :description description)) 107 | 108 | (defn get-format [format] 109 | (cond 110 | (map? format) format 111 | (ifn? format) (codec (url-request-format) 112 | {:read format :description "custom"}) 113 | :else (throw (js/Error. (str "unrecognized format: " format))))) 114 | 115 | (defn exception-response [e status {:keys [description]} xhrio] 116 | (let [response {:status status 117 | :response nil} 118 | status-text (str (.-message e) 119 | " Format should have been " 120 | description) 121 | parse-error (assoc response 122 | :status-text status-text 123 | :is-parse-error true 124 | :original-text (.getResponseText xhrio))] 125 | (if (success? status) 126 | parse-error 127 | (assoc response 128 | :status-text (.getStatusText xhrio) 129 | :parse-error parse-error)))) 130 | 131 | (defn interpret-response [format response get-default-format] 132 | (try 133 | (let [xhrio (.-target response) 134 | status (.getStatus xhrio) 135 | format (if (:read format) 136 | format 137 | (get-default-format xhrio)) 138 | parse (:read format)] 139 | (try 140 | (let [response (parse xhrio)] 141 | (if (success? status) 142 | [true response] 143 | [false {:status status 144 | :status-text (.getStatusText xhrio) 145 | :response response}])) 146 | (catch js/Object e 147 | [false (exception-response e status format xhrio)]))) 148 | (catch js/Object e ; These errors should never happen 149 | [false {:status 0 150 | :status-text (.-message e) 151 | :response nil}]))) 152 | 153 | (defn no-format [xhrio] 154 | (throw (js/Error. "No response format was supplied."))) 155 | 156 | (defn uri-with-params [uri params] 157 | (if params 158 | (str uri "?" (params-to-str params)) 159 | uri)) 160 | 161 | (defn process-inputs [uri method 162 | {:keys [write content-type] :as format} 163 | {:keys [params headers]}] 164 | (if (= method "GET") 165 | [(uri-with-params uri params) nil headers] 166 | (let [{:keys [write content-type]} format body (write params) 167 | content-type (if content-type 168 | {"Content-Type" content-type}) 169 | headers (merge (or headers {}) content-type)] 170 | [uri body headers]))) 171 | 172 | (defn normalize-method [method] 173 | (if (keyword? method) 174 | (str/upper-case (name method)) 175 | method)) 176 | 177 | (defn base-handler [format {:keys [handler get-default-format]}] 178 | (fn [xhrio] 179 | (handler (interpret-response format xhrio 180 | (or get-default-format no-format))))) 181 | 182 | (defn ajax-request 183 | ([uri method {:keys [format] :as opts} js-ajax] 184 | (let [format (get-format format) 185 | method (normalize-method method) 186 | [uri body headers] 187 | (process-inputs uri method format opts) 188 | handler (base-handler format opts)] 189 | (-js-ajax-request js-ajax uri method body 190 | (clj->js headers) handler opts))) 191 | ([uri method opts] 192 | (ajax-request uri method opts (new goog.net.XhrIo)))) 193 | 194 | (defn json-format [format-params] 195 | (codec (json-request-format) 196 | (json-response-format format-params))) 197 | 198 | (defn edn-format [] 199 | (codec (edn-request-format) (edn-response-format))) 200 | 201 | (defn raw-format [] 202 | (codec (url-request-format) (raw-response-format))) 203 | 204 | ; "Easy" API beyond this point 205 | 206 | (defn keyword-request-format [format format-params] 207 | (case format 208 | :json (json-request-format) 209 | :edn (edn-request-format) 210 | :raw (url-request-format) 211 | :url (url-request-format) 212 | (throw 213 | (js/Error. (str "unrecognized request format: " format))))) 214 | 215 | (defn keyword-response-format [format format-params] 216 | (case format 217 | :json (json-response-format format-params) 218 | :edn (edn-response-format) 219 | :raw (raw-response-format) 220 | nil)) 221 | 222 | (defn transform-handler [{:keys [handler error-handler finally]}] 223 | (fn easy-handler [[ok result]] 224 | (if-let [h (if ok handler error-handler)] 225 | (h result)) 226 | (when (fn? finally) 227 | (finally)))) 228 | 229 | (defn transform-format [{:keys [format response-format] :as opts}] 230 | (let [rf (keyword-response-format response-format opts)] 231 | (cond (nil? format) 232 | (codec (edn-request-format) rf) 233 | (keyword? format) 234 | (codec (keyword-request-format format opts) rf) 235 | :else format))) 236 | 237 | (defn transform-opts [opts] 238 | "Note that if you call GET and POST, this function gets called and 239 | will include JSON and EDN code in your JS. If you don't want 240 | this to happen, use ajax-request directly." 241 | (assoc opts 242 | :handler (transform-handler opts) 243 | :format (transform-format opts) 244 | :get-default-format get-default-format)) 245 | 246 | (defn GET 247 | "accepts the URI and an optional map of options, options include: 248 | :handler - the handler function for successful operation 249 | should accept a single parameter which is the deserialized 250 | response 251 | :error-handler - the handler function for errors, should accept a map 252 | with keys :status and :status-text 253 | :format - the format for the request 254 | :response-format - the format for the response 255 | :params - a map of parameters that will be sent with the request" 256 | [uri & [opts]] 257 | (ajax-request uri "GET" (transform-opts opts))) 258 | 259 | (defn PUT 260 | "accepts the URI and an optional map of options, options include: 261 | :handler - the handler function for successful operation 262 | should accept a single parameter which is the deserialized 263 | response 264 | :error-handler - the handler function for errors, should accept a map 265 | with keys :status and :status-text 266 | :format - the format for the request 267 | :response-format - the format for the response 268 | :params - a map of parameters that will be sent with the request" 269 | [uri & [opts]] 270 | (ajax-request uri "PUT" (transform-opts opts))) 271 | 272 | (defn POST 273 | "accepts the URI and an optional map of options, options include: 274 | :handler - the handler function for successful operation 275 | should accept a single parameter which is the deserialized 276 | response 277 | :error-handler - the handler function for errors, should accept a map 278 | with keys :status and :status-text 279 | :format - the format for the request 280 | :response-format - the format for the response 281 | :params - a map of parameters that will be sent with the request" 282 | [uri & [opts]] 283 | (ajax-request uri "POST" (transform-opts opts))) 284 | -------------------------------------------------------------------------------- /resources/public/js/out/clojure/set.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns ^{:doc "Set operations such as union/intersection." 10 | :author "Rich Hickey"} 11 | clojure.set) 12 | 13 | (defn- bubble-max-key [k coll] 14 | "Move a maximal element of coll according to fn k (which returns a number) 15 | to the front of coll." 16 | (let [max (apply max-key k coll)] 17 | (cons max (remove #(identical? max %) coll)))) 18 | 19 | (defn union 20 | "Return a set that is the union of the input sets" 21 | ([] #{}) 22 | ([s1] s1) 23 | ([s1 s2] 24 | (if (< (count s1) (count s2)) 25 | (reduce conj s2 s1) 26 | (reduce conj s1 s2))) 27 | ([s1 s2 & sets] 28 | (let [bubbled-sets (bubble-max-key count (conj sets s2 s1))] 29 | (reduce into (first bubbled-sets) (rest bubbled-sets))))) 30 | 31 | (defn intersection 32 | "Return a set that is the intersection of the input sets" 33 | ([s1] s1) 34 | ([s1 s2] 35 | (if (< (count s2) (count s1)) 36 | (recur s2 s1) 37 | (reduce (fn [result item] 38 | (if (contains? s2 item) 39 | result 40 | (disj result item))) 41 | s1 s1))) 42 | ([s1 s2 & sets] 43 | (let [bubbled-sets (bubble-max-key #(- (count %)) (conj sets s2 s1))] 44 | (reduce intersection (first bubbled-sets) (rest bubbled-sets))))) 45 | 46 | (defn difference 47 | "Return a set that is the first set without elements of the remaining sets" 48 | ([s1] s1) 49 | ([s1 s2] 50 | (if (< (count s1) (count s2)) 51 | (reduce (fn [result item] 52 | (if (contains? s2 item) 53 | (disj result item) 54 | result)) 55 | s1 s1) 56 | (reduce disj s1 s2))) 57 | ([s1 s2 & sets] 58 | (reduce difference s1 (conj sets s2)))) 59 | 60 | 61 | (defn select 62 | "Returns a set of the elements for which pred is true" 63 | [pred xset] 64 | (reduce (fn [s k] (if (pred k) s (disj s k))) 65 | xset xset)) 66 | 67 | (defn project 68 | "Returns a rel of the elements of xrel with only the keys in ks" 69 | [xrel ks] 70 | (set (map #(select-keys % ks) xrel))) 71 | 72 | (defn rename-keys 73 | "Returns the map with the keys in kmap renamed to the vals in kmap" 74 | [map kmap] 75 | (reduce 76 | (fn [m [old new]] 77 | (if (and (not= old new) 78 | (contains? m old)) 79 | (-> m (assoc new (get m old)) (dissoc old)) 80 | m)) 81 | map kmap)) 82 | 83 | (defn rename 84 | "Returns a rel of the maps in xrel with the keys in kmap renamed to the vals in kmap" 85 | [xrel kmap] 86 | (set (map #(rename-keys % kmap) xrel))) 87 | 88 | (defn index 89 | "Returns a map of the distinct values of ks in the xrel mapped to a 90 | set of the maps in xrel with the corresponding values of ks." 91 | [xrel ks] 92 | (reduce 93 | (fn [m x] 94 | (let [ik (select-keys x ks)] 95 | (assoc m ik (conj (get m ik #{}) x)))) 96 | {} xrel)) 97 | 98 | (defn map-invert 99 | "Returns the map with the vals mapped to the keys." 100 | [m] (reduce (fn [m [k v]] (assoc m v k)) {} m)) 101 | 102 | (defn join 103 | "When passed 2 rels, returns the rel corresponding to the natural 104 | join. When passed an additional keymap, joins on the corresponding 105 | keys." 106 | ([xrel yrel] ;natural join 107 | (if (and (seq xrel) (seq yrel)) 108 | (let [ks (intersection (set (keys (first xrel))) (set (keys (first yrel)))) 109 | [r s] (if (<= (count xrel) (count yrel)) 110 | [xrel yrel] 111 | [yrel xrel]) 112 | idx (index r ks)] 113 | (reduce (fn [ret x] 114 | (let [found (idx (select-keys x ks))] 115 | (if found 116 | (reduce #(conj %1 (merge %2 x)) ret found) 117 | ret))) 118 | #{} s)) 119 | #{})) 120 | ([xrel yrel km] ;arbitrary key mapping 121 | (let [[r s k] (if (<= (count xrel) (count yrel)) 122 | [xrel yrel (map-invert km)] 123 | [yrel xrel km]) 124 | idx (index r (vals k))] 125 | (reduce (fn [ret x] 126 | (let [found (idx (rename-keys (select-keys x (keys k)) k))] 127 | (if found 128 | (reduce #(conj %1 (merge %2 x)) ret found) 129 | ret))) 130 | #{} s)))) 131 | 132 | (defn subset? 133 | "Is set1 a subset of set2?" 134 | [set1 set2] 135 | (and (<= (count set1) (count set2)) 136 | (every? #(contains? set2 %) set1))) 137 | 138 | (defn superset? 139 | "Is set1 a superset of set2?" 140 | [set1 set2] 141 | (and (>= (count set1) (count set2)) 142 | (every? #(contains? set1 %) set2))) 143 | 144 | (comment 145 | (refer 'set) 146 | (def xs #{{:a 11 :b 1 :c 1 :d 4} 147 | {:a 2 :b 12 :c 2 :d 6} 148 | {:a 3 :b 3 :c 3 :d 8 :f 42}}) 149 | 150 | (def ys #{{:a 11 :b 11 :c 11 :e 5} 151 | {:a 12 :b 11 :c 12 :e 3} 152 | {:a 3 :b 3 :c 3 :e 7 }}) 153 | 154 | (join xs ys) 155 | (join xs (rename ys {:b :yb :c :yc}) {:a :a}) 156 | 157 | (union #{:a :b :c} #{:c :d :e }) 158 | (difference #{:a :b :c} #{:c :d :e}) 159 | (intersection #{:a :b :c} #{:c :d :e}) 160 | 161 | (index ys [:b])) 162 | 163 | -------------------------------------------------------------------------------- /resources/public/js/out/clojure/string.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.string 10 | (:refer-clojure :exclude [replace reverse]) 11 | (:require [goog.string :as gstring] 12 | [goog.string.StringBuffer :as gstringbuf])) 13 | 14 | (defn- seq-reverse 15 | [coll] 16 | (reduce conj () coll)) 17 | 18 | (defn reverse 19 | "Returns s with its characters reversed." 20 | [s] 21 | (.. s (split "") (reverse) (join ""))) 22 | 23 | (defn replace 24 | "Replaces all instance of match with replacement in s. 25 | match/replacement can be: 26 | 27 | string / string 28 | pattern / (string or function of match)." 29 | [s match replacement] 30 | (cond (string? match) 31 | (.replace s (js/RegExp. (gstring/regExpEscape match) "g") replacement) 32 | (.hasOwnProperty match "source") 33 | (.replace s (js/RegExp. (.-source match) "g") replacement) 34 | :else (throw (str "Invalid match arg: " match)))) 35 | 36 | (defn replace-first 37 | "Replaces the first instance of match with replacement in s. 38 | match/replacement can be: 39 | 40 | string / string 41 | pattern / (string or function of match)." 42 | [s match replacement] 43 | (.replace s match replacement)) 44 | 45 | (defn join 46 | "Returns a string of all elements in coll, as returned by (seq coll), 47 | separated by an optional separator." 48 | ([coll] 49 | (apply str coll)) 50 | ([separator coll] 51 | (apply str (interpose separator coll)))) 52 | 53 | (defn upper-case 54 | "Converts string to all upper-case." 55 | [s] 56 | (.toUpperCase s)) 57 | 58 | (defn lower-case 59 | "Converts string to all lower-case." 60 | [s] 61 | (.toLowerCase s)) 62 | 63 | (defn capitalize 64 | "Converts first character of the string to upper-case, all other 65 | characters to lower-case." 66 | [s] 67 | (if (< (count s) 2) 68 | (upper-case s) 69 | (str (upper-case (subs s 0 1)) 70 | (lower-case (subs s 1))))) 71 | 72 | ;; The JavaScript split function takes a limit argument but the return 73 | ;; value is not the same as the Java split function. 74 | ;; 75 | ;; Java: (.split "a-b-c" #"-" 2) => ["a" "b-c"] 76 | ;; JavaScript: (.split "a-b-c" #"-" 2) => ["a" "b"] 77 | ;; 78 | ;; For consistency, the three arg version has been implemented to 79 | ;; mimic Java's behavior. 80 | 81 | (defn- pop-last-while-empty 82 | [v] 83 | (loop [v v] 84 | (if (= "" (peek v)) 85 | (recur (pop v)) 86 | v))) 87 | 88 | (defn- discard-trailing-if-needed 89 | [limit v] 90 | (if (= 0 limit) 91 | (pop-last-while-empty v) 92 | v)) 93 | 94 | (defn- split-with-empty-regex 95 | [s limit] 96 | (if (or (<= limit 0) (>= limit (+ 2 (count s)))) 97 | (conj (vec (cons "" (map str (seq s)))) "") 98 | (condp = limit 99 | 1 (vector s) 100 | 2 (vector "" s) 101 | (let [c (- limit 2)] 102 | (conj (vec (cons "" (subvec (vec (map str (seq s))) 0 c))) (subs s c)))))) 103 | 104 | (defn split 105 | "Splits string on a regular expression. Optional argument limit is 106 | the maximum number of splits. Not lazy. Returns vector of the splits." 107 | ([s re] 108 | (split s re 0)) 109 | ([s re limit] 110 | (discard-trailing-if-needed limit 111 | (if (= (str re) "/(?:)/") 112 | (split-with-empty-regex s limit) 113 | (if (< limit 1) 114 | (vec (.split (str s) re)) 115 | (loop [s s 116 | limit limit 117 | parts []] 118 | (if (= limit 1) 119 | (conj parts s) 120 | (if-let [m (re-find re s)] 121 | (let [index (.indexOf s m)] 122 | (recur (.substring s (+ index (count m))) 123 | (dec limit) 124 | (conj parts (.substring s 0 index)))) 125 | (conj parts s))))))))) 126 | 127 | (defn split-lines 128 | "Splits s on \n or \r\n." 129 | [s] 130 | (split s #"\n|\r\n")) 131 | 132 | (defn trim 133 | "Removes whitespace from both ends of string." 134 | [s] 135 | (gstring/trim s)) 136 | 137 | (defn triml 138 | "Removes whitespace from the left side of string." 139 | [s] 140 | (gstring/trimLeft s)) 141 | 142 | (defn trimr 143 | "Removes whitespace from the right side of string." 144 | [s] 145 | (gstring/trimRight s)) 146 | 147 | (defn trim-newline 148 | "Removes all trailing newline \\n or return \\r characters from 149 | string. Similar to Perl's chomp." 150 | [s] 151 | (loop [index (.-length s)] 152 | (if (zero? index) 153 | "" 154 | (let [ch (get s (dec index))] 155 | (if (or (= ch \newline) (= ch \return)) 156 | (recur (dec index)) 157 | (.substring s 0 index)))))) 158 | 159 | (defn blank? 160 | "True is s is nil, empty, or contains only whitespace." 161 | [s] 162 | (gstring/isEmptySafe s)) 163 | 164 | (defn escape 165 | "Return a new string, using cmap to escape each character ch 166 | from s as follows: 167 | 168 | If (cmap ch) is nil, append ch to the new string. 169 | If (cmap ch) is non-nil, append (str (cmap ch)) instead." 170 | [s cmap] 171 | (let [buffer (gstring/StringBuffer.) 172 | length (.-length s)] 173 | (loop [index 0] 174 | (if (= length index) 175 | (. buffer (toString)) 176 | (let [ch (.charAt s index)] 177 | (if-let [replacement (get cmap ch)] 178 | (.append buffer (str replacement)) 179 | (.append buffer ch)) 180 | (recur (inc index))))))) 181 | -------------------------------------------------------------------------------- /resources/public/js/out/clojure/string.js: -------------------------------------------------------------------------------- 1 | // Compiled by ClojureScript 0.0-2173 2 | goog.provide('clojure.string'); 3 | goog.require('cljs.core'); 4 | goog.require('goog.string.StringBuffer'); 5 | goog.require('goog.string.StringBuffer'); 6 | goog.require('goog.string'); 7 | goog.require('goog.string'); 8 | clojure.string.seq_reverse = (function seq_reverse(coll){return cljs.core.reduce.call(null,cljs.core.conj,cljs.core.List.EMPTY,coll); 9 | }); 10 | /** 11 | * Returns s with its characters reversed. 12 | */ 13 | clojure.string.reverse = (function reverse(s){return s.split("").reverse().join(""); 14 | }); 15 | /** 16 | * Replaces all instance of match with replacement in s. 17 | * match/replacement can be: 18 | * 19 | * string / string 20 | * pattern / (string or function of match). 21 | */ 22 | clojure.string.replace = (function replace(s,match,replacement){if(typeof match === 'string') 23 | {return s.replace((new RegExp(goog.string.regExpEscape(match),"g")),replacement); 24 | } else 25 | {if(cljs.core.truth_(match.hasOwnProperty("source"))) 26 | {return s.replace((new RegExp(match.source,"g")),replacement); 27 | } else 28 | {if(new cljs.core.Keyword(null,"else","else",1017020587)) 29 | {throw [cljs.core.str("Invalid match arg: "),cljs.core.str(match)].join(''); 30 | } else 31 | {return null; 32 | } 33 | } 34 | } 35 | }); 36 | /** 37 | * Replaces the first instance of match with replacement in s. 38 | * match/replacement can be: 39 | * 40 | * string / string 41 | * pattern / (string or function of match). 42 | */ 43 | clojure.string.replace_first = (function replace_first(s,match,replacement){return s.replace(match,replacement); 44 | }); 45 | /** 46 | * Returns a string of all elements in coll, as returned by (seq coll), 47 | * separated by an optional separator. 48 | */ 49 | clojure.string.join = (function() { 50 | var join = null; 51 | var join__1 = (function (coll){return cljs.core.apply.call(null,cljs.core.str,coll); 52 | }); 53 | var join__2 = (function (separator,coll){return cljs.core.apply.call(null,cljs.core.str,cljs.core.interpose.call(null,separator,coll)); 54 | }); 55 | join = function(separator,coll){ 56 | switch(arguments.length){ 57 | case 1: 58 | return join__1.call(this,separator); 59 | case 2: 60 | return join__2.call(this,separator,coll); 61 | } 62 | throw(new Error('Invalid arity: ' + arguments.length)); 63 | }; 64 | join.cljs$core$IFn$_invoke$arity$1 = join__1; 65 | join.cljs$core$IFn$_invoke$arity$2 = join__2; 66 | return join; 67 | })() 68 | ; 69 | /** 70 | * Converts string to all upper-case. 71 | */ 72 | clojure.string.upper_case = (function upper_case(s){return s.toUpperCase(); 73 | }); 74 | /** 75 | * Converts string to all lower-case. 76 | */ 77 | clojure.string.lower_case = (function lower_case(s){return s.toLowerCase(); 78 | }); 79 | /** 80 | * Converts first character of the string to upper-case, all other 81 | * characters to lower-case. 82 | */ 83 | clojure.string.capitalize = (function capitalize(s){if((cljs.core.count.call(null,s) < 2)) 84 | {return clojure.string.upper_case.call(null,s); 85 | } else 86 | {return [cljs.core.str(clojure.string.upper_case.call(null,cljs.core.subs.call(null,s,0,1))),cljs.core.str(clojure.string.lower_case.call(null,cljs.core.subs.call(null,s,1)))].join(''); 87 | } 88 | }); 89 | clojure.string.pop_last_while_empty = (function pop_last_while_empty(v){var v__$1 = v;while(true){ 90 | if(cljs.core._EQ_.call(null,"",cljs.core.peek.call(null,v__$1))) 91 | {{ 92 | var G__21038 = cljs.core.pop.call(null,v__$1); 93 | v__$1 = G__21038; 94 | continue; 95 | } 96 | } else 97 | {return v__$1; 98 | } 99 | break; 100 | } 101 | }); 102 | clojure.string.discard_trailing_if_needed = (function discard_trailing_if_needed(limit,v){if(cljs.core._EQ_.call(null,0,limit)) 103 | {return clojure.string.pop_last_while_empty.call(null,v); 104 | } else 105 | {return v; 106 | } 107 | }); 108 | clojure.string.split_with_empty_regex = (function split_with_empty_regex(s,limit){if(((limit <= 0)) || ((limit >= (2 + cljs.core.count.call(null,s))))) 109 | {return cljs.core.conj.call(null,cljs.core.vec.call(null,cljs.core.cons.call(null,"",cljs.core.map.call(null,cljs.core.str,cljs.core.seq.call(null,s)))),""); 110 | } else 111 | {var pred__21042 = cljs.core._EQ_;var expr__21043 = limit;if(cljs.core.truth_(pred__21042.call(null,1,expr__21043))) 112 | {return (new cljs.core.PersistentVector(null,1,5,cljs.core.PersistentVector.EMPTY_NODE,[s],null)); 113 | } else 114 | {if(cljs.core.truth_(pred__21042.call(null,2,expr__21043))) 115 | {return (new cljs.core.PersistentVector(null,2,5,cljs.core.PersistentVector.EMPTY_NODE,["",s],null)); 116 | } else 117 | {var c = (limit - 2);return cljs.core.conj.call(null,cljs.core.vec.call(null,cljs.core.cons.call(null,"",cljs.core.subvec.call(null,cljs.core.vec.call(null,cljs.core.map.call(null,cljs.core.str,cljs.core.seq.call(null,s))),0,c))),cljs.core.subs.call(null,s,c)); 118 | } 119 | } 120 | } 121 | }); 122 | /** 123 | * Splits string on a regular expression. Optional argument limit is 124 | * the maximum number of splits. Not lazy. Returns vector of the splits. 125 | */ 126 | clojure.string.split = (function() { 127 | var split = null; 128 | var split__2 = (function (s,re){return split.call(null,s,re,0); 129 | }); 130 | var split__3 = (function (s,re,limit){return clojure.string.discard_trailing_if_needed.call(null,limit,((cljs.core._EQ_.call(null,[cljs.core.str(re)].join(''),"/(?:)/"))?clojure.string.split_with_empty_regex.call(null,s,limit):(((limit < 1))?cljs.core.vec.call(null,[cljs.core.str(s)].join('').split(re)):(function (){var s__$1 = s;var limit__$1 = limit;var parts = cljs.core.PersistentVector.EMPTY;while(true){ 131 | if(cljs.core._EQ_.call(null,limit__$1,1)) 132 | {return cljs.core.conj.call(null,parts,s__$1); 133 | } else 134 | {var temp__4090__auto__ = cljs.core.re_find.call(null,re,s__$1);if(cljs.core.truth_(temp__4090__auto__)) 135 | {var m = temp__4090__auto__;var index = s__$1.indexOf(m);{ 136 | var G__21045 = s__$1.substring((index + cljs.core.count.call(null,m))); 137 | var G__21046 = (limit__$1 - 1); 138 | var G__21047 = cljs.core.conj.call(null,parts,s__$1.substring(0,index)); 139 | s__$1 = G__21045; 140 | limit__$1 = G__21046; 141 | parts = G__21047; 142 | continue; 143 | } 144 | } else 145 | {return cljs.core.conj.call(null,parts,s__$1); 146 | } 147 | } 148 | break; 149 | } 150 | })()))); 151 | }); 152 | split = function(s,re,limit){ 153 | switch(arguments.length){ 154 | case 2: 155 | return split__2.call(this,s,re); 156 | case 3: 157 | return split__3.call(this,s,re,limit); 158 | } 159 | throw(new Error('Invalid arity: ' + arguments.length)); 160 | }; 161 | split.cljs$core$IFn$_invoke$arity$2 = split__2; 162 | split.cljs$core$IFn$_invoke$arity$3 = split__3; 163 | return split; 164 | })() 165 | ; 166 | /** 167 | * Splits s on 168 | * or 169 | * . 170 | */ 171 | clojure.string.split_lines = (function split_lines(s){return clojure.string.split.call(null,s,/\n|\r\n/); 172 | }); 173 | /** 174 | * Removes whitespace from both ends of string. 175 | */ 176 | clojure.string.trim = (function trim(s){return goog.string.trim(s); 177 | }); 178 | /** 179 | * Removes whitespace from the left side of string. 180 | */ 181 | clojure.string.triml = (function triml(s){return goog.string.trimLeft(s); 182 | }); 183 | /** 184 | * Removes whitespace from the right side of string. 185 | */ 186 | clojure.string.trimr = (function trimr(s){return goog.string.trimRight(s); 187 | }); 188 | /** 189 | * Removes all trailing newline \n or return \r characters from 190 | * string. Similar to Perl's chomp. 191 | */ 192 | clojure.string.trim_newline = (function trim_newline(s){var index = s.length;while(true){ 193 | if((index === 0)) 194 | {return ""; 195 | } else 196 | {var ch = cljs.core.get.call(null,s,(index - 1));if((cljs.core._EQ_.call(null,ch,"\n")) || (cljs.core._EQ_.call(null,ch,"\r"))) 197 | {{ 198 | var G__21048 = (index - 1); 199 | index = G__21048; 200 | continue; 201 | } 202 | } else 203 | {return s.substring(0,index); 204 | } 205 | } 206 | break; 207 | } 208 | }); 209 | /** 210 | * True is s is nil, empty, or contains only whitespace. 211 | */ 212 | clojure.string.blank_QMARK_ = (function blank_QMARK_(s){return goog.string.isEmptySafe(s); 213 | }); 214 | /** 215 | * Return a new string, using cmap to escape each character ch 216 | * from s as follows: 217 | * 218 | * If (cmap ch) is nil, append ch to the new string. 219 | * If (cmap ch) is non-nil, append (str (cmap ch)) instead. 220 | */ 221 | clojure.string.escape = (function escape__$1(s,cmap){var buffer = (new goog.string.StringBuffer());var length = s.length;var index = 0;while(true){ 222 | if(cljs.core._EQ_.call(null,length,index)) 223 | {return buffer.toString(); 224 | } else 225 | {var ch = s.charAt(index);var temp__4090__auto___21049 = cljs.core.get.call(null,cmap,ch);if(cljs.core.truth_(temp__4090__auto___21049)) 226 | {var replacement_21050 = temp__4090__auto___21049;buffer.append([cljs.core.str(replacement_21050)].join('')); 227 | } else 228 | {buffer.append(ch); 229 | } 230 | { 231 | var G__21051 = (index + 1); 232 | index = G__21051; 233 | continue; 234 | } 235 | } 236 | break; 237 | } 238 | }); 239 | -------------------------------------------------------------------------------- /resources/public/js/out/clojure/walk.cljs: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ;;; walk.cljs - generic tree walker with replacement 10 | 11 | ;; by Stuart Sierra 12 | ;; Jul5 17, 2011 13 | 14 | ;; CHANGE LOG: 15 | ;; 16 | ;; * July 17, 2011: Port to ClojureScript 17 | ;; 18 | ;; * December 15, 2008: replaced 'walk' with 'prewalk' & 'postwalk' 19 | ;; 20 | ;; * December 9, 2008: first version 21 | 22 | 23 | (ns 24 | ^{:author "Stuart Sierra", 25 | :doc "This file defines a generic tree walker for Clojure data 26 | structures. It takes any data structure (list, vector, map, set, 27 | seq), calls a function on every element, and uses the return value 28 | of the function in place of the original. This makes it fairly 29 | easy to write recursive search-and-replace functions, as shown in 30 | the examples. 31 | 32 | Note: \"walk\" supports all Clojure data structures EXCEPT maps 33 | created with sorted-map-by. There is no (obvious) way to retrieve 34 | the sorting function."} 35 | clojure.walk) 36 | 37 | (defn walk 38 | "Traverses form, an arbitrary data structure. inner and outer are 39 | functions. Applies inner to each element of form, building up a 40 | data structure of the same type, then applies outer to the result. 41 | Recognizes all Clojure data structures. Consumes seqs as with doall." 42 | 43 | {:added "1.1"} 44 | [inner outer form] 45 | (cond 46 | (seq? form) (outer (doall (map inner form))) 47 | (coll? form) (outer (into (empty form) (map inner form))) 48 | :else (outer form))) 49 | 50 | (defn postwalk 51 | "Performs a depth-first, post-order traversal of form. Calls f on 52 | each sub-form, uses f's return value in place of the original. 53 | Recognizes all Clojure data structures. Consumes seqs as with doall." 54 | {:added "1.1"} 55 | [f form] 56 | (walk (partial postwalk f) f form)) 57 | 58 | (defn prewalk 59 | "Like postwalk, but does pre-order traversal." 60 | {:added "1.1"} 61 | [f form] 62 | (walk (partial prewalk f) identity (f form))) 63 | 64 | (defn keywordize-keys 65 | "Recursively transforms all map keys from strings to keywords." 66 | {:added "1.1"} 67 | [m] 68 | (let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))] 69 | ;; only apply to maps 70 | (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) 71 | 72 | (defn stringify-keys 73 | "Recursively transforms all map keys from keywords to strings." 74 | {:added "1.1"} 75 | [m] 76 | (let [f (fn [[k v]] (if (keyword? k) [(name k) v] [k v]))] 77 | ;; only apply to maps 78 | (postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m))) 79 | 80 | (defn prewalk-replace 81 | "Recursively transforms form by replacing keys in smap with their 82 | values. Like clojure/replace but works on any data structure. Does 83 | replacement at the root of the tree first." 84 | {:added "1.1"} 85 | [smap form] 86 | (prewalk (fn [x] (if (contains? smap x) (smap x) x)) form)) 87 | 88 | (defn postwalk-replace 89 | "Recursively transforms form by replacing keys in smap with their 90 | values. Like clojure/replace but works on any data structure. Does 91 | replacement at the leaves of the tree first." 92 | {:added "1.1"} 93 | [smap form] 94 | (postwalk (fn [x] (if (contains? smap x) (smap x) x)) form)) 95 | -------------------------------------------------------------------------------- /resources/public/js/out/clojure/walk.js: -------------------------------------------------------------------------------- 1 | // Compiled by ClojureScript 0.0-2173 2 | goog.provide('clojure.walk'); 3 | goog.require('cljs.core'); 4 | /** 5 | * Traverses form, an arbitrary data structure. inner and outer are 6 | * functions. Applies inner to each element of form, building up a 7 | * data structure of the same type, then applies outer to the result. 8 | * Recognizes all Clojure data structures. Consumes seqs as with doall. 9 | */ 10 | clojure.walk.walk = (function walk(inner,outer,form){if(cljs.core.seq_QMARK_.call(null,form)) 11 | {return outer.call(null,cljs.core.doall.call(null,cljs.core.map.call(null,inner,form))); 12 | } else 13 | {if(cljs.core.coll_QMARK_.call(null,form)) 14 | {return outer.call(null,cljs.core.into.call(null,cljs.core.empty.call(null,form),cljs.core.map.call(null,inner,form))); 15 | } else 16 | {if(new cljs.core.Keyword(null,"else","else",1017020587)) 17 | {return outer.call(null,form); 18 | } else 19 | {return null; 20 | } 21 | } 22 | } 23 | }); 24 | /** 25 | * Performs a depth-first, post-order traversal of form. Calls f on 26 | * each sub-form, uses f's return value in place of the original. 27 | * Recognizes all Clojure data structures. Consumes seqs as with doall. 28 | */ 29 | clojure.walk.postwalk = (function postwalk(f,form){return clojure.walk.walk.call(null,cljs.core.partial.call(null,postwalk,f),f,form); 30 | }); 31 | /** 32 | * Like postwalk, but does pre-order traversal. 33 | */ 34 | clojure.walk.prewalk = (function prewalk(f,form){return clojure.walk.walk.call(null,cljs.core.partial.call(null,prewalk,f),cljs.core.identity,f.call(null,form)); 35 | }); 36 | /** 37 | * Recursively transforms all map keys from strings to keywords. 38 | */ 39 | clojure.walk.keywordize_keys = (function keywordize_keys(m){var f = (function (p__19817){var vec__19818 = p__19817;var k = cljs.core.nth.call(null,vec__19818,0,null);var v = cljs.core.nth.call(null,vec__19818,1,null);if(typeof k === 'string') 40 | {return new cljs.core.PersistentVector(null, 2, 5, cljs.core.PersistentVector.EMPTY_NODE, [cljs.core.keyword.call(null,k),v], null); 41 | } else 42 | {return new cljs.core.PersistentVector(null, 2, 5, cljs.core.PersistentVector.EMPTY_NODE, [k,v], null); 43 | } 44 | });return clojure.walk.postwalk.call(null,(function (x){if(cljs.core.map_QMARK_.call(null,x)) 45 | {return cljs.core.into.call(null,cljs.core.PersistentArrayMap.EMPTY,cljs.core.map.call(null,f,x)); 46 | } else 47 | {return x; 48 | } 49 | }),m); 50 | }); 51 | /** 52 | * Recursively transforms all map keys from keywords to strings. 53 | */ 54 | clojure.walk.stringify_keys = (function stringify_keys(m){var f = (function (p__19821){var vec__19822 = p__19821;var k = cljs.core.nth.call(null,vec__19822,0,null);var v = cljs.core.nth.call(null,vec__19822,1,null);if((k instanceof cljs.core.Keyword)) 55 | {return new cljs.core.PersistentVector(null, 2, 5, cljs.core.PersistentVector.EMPTY_NODE, [cljs.core.name.call(null,k),v], null); 56 | } else 57 | {return new cljs.core.PersistentVector(null, 2, 5, cljs.core.PersistentVector.EMPTY_NODE, [k,v], null); 58 | } 59 | });return clojure.walk.postwalk.call(null,(function (x){if(cljs.core.map_QMARK_.call(null,x)) 60 | {return cljs.core.into.call(null,cljs.core.PersistentArrayMap.EMPTY,cljs.core.map.call(null,f,x)); 61 | } else 62 | {return x; 63 | } 64 | }),m); 65 | }); 66 | /** 67 | * Recursively transforms form by replacing keys in smap with their 68 | * values. Like clojure/replace but works on any data structure. Does 69 | * replacement at the root of the tree first. 70 | */ 71 | clojure.walk.prewalk_replace = (function prewalk_replace(smap,form){return clojure.walk.prewalk.call(null,(function (x){if(cljs.core.contains_QMARK_.call(null,smap,x)) 72 | {return smap.call(null,x); 73 | } else 74 | {return x; 75 | } 76 | }),form); 77 | }); 78 | /** 79 | * Recursively transforms form by replacing keys in smap with their 80 | * values. Like clojure/replace but works on any data structure. Does 81 | * replacement at the leaves of the tree first. 82 | */ 83 | clojure.walk.postwalk_replace = (function postwalk_replace(smap,form){return clojure.walk.postwalk.call(null,(function (x){if(cljs.core.contains_QMARK_.call(null,smap,x)) 84 | {return smap.call(null,x); 85 | } else 86 | {return x; 87 | } 88 | }),form); 89 | }); 90 | -------------------------------------------------------------------------------- /resources/public/js/out/gin/core.js: -------------------------------------------------------------------------------- 1 | // Compiled by ClojureScript 0.0-2173 2 | goog.provide('gin.core'); 3 | goog.require('cljs.core'); 4 | goog.require('gin.transact'); 5 | goog.require('datascript'); 6 | goog.require('gin.ui.game_panel'); 7 | goog.require('gin.local.services'); 8 | goog.require('gin.remote.services'); 9 | goog.require('datascript'); 10 | goog.require('gin.local.services'); 11 | goog.require('gin.transact'); 12 | goog.require('gin.ui.game_panel'); 13 | goog.require('gin.remote.services'); 14 | /** 15 | * Return a map containing the initial application 16 | */ 17 | gin.core.load_app = (function load_app(){return new cljs.core.PersistentArrayMap(null, 3, [new cljs.core.Keyword(null,"conn","conn",1016963742),datascript.create_conn.call(null,gin.transact.schema),new cljs.core.Keyword(null,"render","render",4374279432),gin.ui.game_panel.start_game_panel,new cljs.core.Keyword(null,"service","service",2998057511),gin.remote.services.start_services], null); 18 | }); 19 | gin.core.start_app = (function start_app(app_config){var map__20038 = app_config;var map__20038__$1 = ((cljs.core.seq_QMARK_.call(null,map__20038))?cljs.core.apply.call(null,cljs.core.hash_map,map__20038):map__20038);var app = map__20038__$1;var service = cljs.core.get.call(null,map__20038__$1,new cljs.core.Keyword(null,"service","service",2998057511));var render = cljs.core.get.call(null,map__20038__$1,new cljs.core.Keyword(null,"render","render",4374279432));var conn = cljs.core.get.call(null,map__20038__$1,new cljs.core.Keyword(null,"conn","conn",1016963742));render.call(null,conn); 20 | service.call(null,conn); 21 | gin.core.app = app; 22 | }); 23 | /** 24 | * Application entry point 25 | */ 26 | gin.core.main = (function main(){return gin.core.start_app.call(null,gin.core.load_app.call(null)); 27 | }); 28 | goog.exportSymbol('gin.core.main', gin.core.main); 29 | gin.core.load_local_app = (function load_local_app(){return new cljs.core.PersistentArrayMap(null, 3, [new cljs.core.Keyword(null,"conn","conn",1016963742),datascript.create_conn.call(null,gin.transact.schema),new cljs.core.Keyword(null,"render","render",4374279432),gin.ui.game_panel.start_game_panel,new cljs.core.Keyword(null,"service","service",2998057511),gin.local.services.start_services], null); 30 | }); 31 | gin.core.client_local = (function client_local(){return gin.core.start_app.call(null,gin.core.load_local_app.call(null)); 32 | }); 33 | goog.exportSymbol('gin.core.client_local', gin.core.client_local); 34 | -------------------------------------------------------------------------------- /resources/public/js/out/gin/datascript_helpers.js: -------------------------------------------------------------------------------- 1 | // Compiled by ClojureScript 0.0-2173 2 | goog.provide('gin.datascript_helpers'); 3 | goog.require('cljs.core'); 4 | goog.require('datascript'); 5 | goog.require('datascript'); 6 | gin.datascript_helpers.entity_lookup = (function entity_lookup(db,av_key){var temp__4092__auto__ = cljs.core.first.call(null,cljs.core.get_in.call(null,new cljs.core.Keyword(null,"av","av",1013907367).cljs$core$IFn$_invoke$arity$1(db),av_key));if(cljs.core.truth_(temp__4092__auto__)) 7 | {var d = temp__4092__auto__;return datascript.entity.call(null,db,new cljs.core.Keyword(null,"e","e",1013904343).cljs$core$IFn$_invoke$arity$1(d)); 8 | } else 9 | {return null; 10 | } 11 | }); 12 | -------------------------------------------------------------------------------- /resources/public/js/out/gin/event_source.js: -------------------------------------------------------------------------------- 1 | // Compiled by ClojureScript 0.0-2173 2 | goog.provide('gin.event_source'); 3 | goog.require('cljs.core'); 4 | goog.require('goog.Timer'); 5 | goog.require('goog.Timer'); 6 | goog.require('cljs.reader'); 7 | goog.require('cljs.reader'); 8 | /** 9 | * @param {...*} var_args 10 | */ 11 | gin.event_source.event_source = (function() { 12 | var event_source__delegate = function (url,p__22465){var map__22467 = p__22465;var map__22467__$1 = ((cljs.core.seq_QMARK_.call(null,map__22467))?cljs.core.apply.call(null,cljs.core.hash_map,map__22467):map__22467);var on_error = cljs.core.get.call(null,map__22467__$1,new cljs.core.Keyword(null,"on-error","on-error",1418576908),((function (map__22467,map__22467__$1){ 13 | return (function (){return null; 14 | });})(map__22467,map__22467__$1)) 15 | );var on_message = cljs.core.get.call(null,map__22467__$1,new cljs.core.Keyword(null,"on-message","on-message",1496225163),((function (map__22467,map__22467__$1,on_error){ 16 | return (function (event){return null; 17 | });})(map__22467,map__22467__$1,on_error)) 18 | );var on_open = cljs.core.get.call(null,map__22467__$1,new cljs.core.Keyword(null,"on-open","on-open",3936747754),((function (map__22467,map__22467__$1,on_error,on_message){ 19 | return (function (){return null; 20 | });})(map__22467,map__22467__$1,on_error,on_message)) 21 | );var source = (new EventSource(url));var open = cljs.core.atom.call(null,false);source.onopen = (function (){cljs.core.reset_BANG_.call(null,open,true); 22 | on_open.call(null); 23 | return null; 24 | }); 25 | source.onerror = (function (e){if(cljs.core.truth_(cljs.core.deref.call(null,open))) 26 | {} else 27 | {on_error.call(null); 28 | } 29 | cljs.core.reset_BANG_.call(null,open,false); 30 | goog.Timer.callOnce((function (){if(cljs.core._EQ_.call(null,source.readyState,EventSource.CLOSED)) 31 | {return event_source.call(null,url,new cljs.core.Keyword(null,"on-open","on-open",3936747754),on_open,new cljs.core.Keyword(null,"on-message","on-message",1496225163),on_message,new cljs.core.Keyword(null,"on-error","on-error",1418576908),on_error); 32 | } else 33 | {return null; 34 | } 35 | }),(9 * 1000)); 36 | return null; 37 | }); 38 | source.onmessage = (function (e){var data_22468 = e.data;var event_22469 = cljs.reader.read_string.call(null,data_22468);on_message.call(null,event_22469); 39 | return null; 40 | }); 41 | return source; 42 | }; 43 | var event_source = function (url,var_args){ 44 | var p__22465 = null;if (arguments.length > 1) { 45 | p__22465 = cljs.core.array_seq(Array.prototype.slice.call(arguments, 1),0);} 46 | return event_source__delegate.call(this,url,p__22465);}; 47 | event_source.cljs$lang$maxFixedArity = 1; 48 | event_source.cljs$lang$applyTo = (function (arglist__22470){ 49 | var url = cljs.core.first(arglist__22470); 50 | var p__22465 = cljs.core.rest(arglist__22470); 51 | return event_source__delegate(url,p__22465); 52 | }); 53 | event_source.cljs$core$IFn$_invoke$arity$variadic = event_source__delegate; 54 | return event_source; 55 | })() 56 | ; 57 | -------------------------------------------------------------------------------- /resources/public/js/out/gin/lobby/core.js: -------------------------------------------------------------------------------- 1 | // Compiled by ClojureScript 0.0-2173 2 | goog.provide('gin.lobby.core'); 3 | goog.require('cljs.core'); 4 | goog.require('ajax.core'); 5 | goog.require('quiescent'); 6 | goog.require('ajax.core'); 7 | goog.require('ajax.core'); 8 | goog.require('gin.event_source'); 9 | goog.require('quiescent.dom'); 10 | goog.require('quiescent.dom'); 11 | goog.require('gin.event_source'); 12 | goog.require('quiescent'); 13 | goog.require('gin.ui.dom_helpers'); 14 | goog.require('gin.ui.dom_helpers'); 15 | gin.lobby.core.csrf_token = (function csrf_token(){return goog.dom.getElement("csrf-token").getAttribute("value"); 16 | }); 17 | gin.lobby.core.error_handler = (function error_handler(){return gin.ui.dom_helpers.show_element.call(null,gin.ui.dom_helpers.get_element.call(null,"network-header-error"),true); 18 | }); 19 | gin.lobby.core.goto_url = (function goto_url(url){return window.location = url; 20 | }); 21 | gin.lobby.core.POST_ACTION = (function POST_ACTION(url,options){return ajax.core.POST.call(null,url,cljs.core.merge.call(null,new cljs.core.PersistentArrayMap(null, 5, [new cljs.core.Keyword(null,"params","params",4313443576),cljs.core.PersistentArrayMap.EMPTY,new cljs.core.Keyword(null,"handler","handler",1706707644),(function (res){return null; 22 | }),new cljs.core.Keyword(null,"error-handler","error-handler",1866823671),(function (res){return gin.lobby.core.error_handler.call(null); 23 | }),new cljs.core.Keyword(null,"format","format",4040092521),cljs.core.merge.call(null,ajax.core.edn_request_format.call(null),new cljs.core.PersistentArrayMap(null, 2, [new cljs.core.Keyword(null,"read","read",1017400584),(function (res){var res_text = res.getResponseText();if((cljs.core.count.call(null,res_text) > 0)) 24 | {throw (new Error([cljs.core.str("Assumed no content response has content: "),cljs.core.str(res_text)].join(''))); 25 | } else 26 | {return null; 27 | } 28 | }),new cljs.core.Keyword(null,"description","description",3584325486),"EDN (CUSTOM)"], null)),new cljs.core.Keyword(null,"headers","headers",1809212152),new cljs.core.PersistentArrayMap(null, 1, ["X-CSRF-Token",gin.lobby.core.csrf_token.call(null)], null)], null),options)); 29 | }); 30 | gin.lobby.core.invite = (function invite(slug){return gin.lobby.core.POST_ACTION.call(null,"/lobby/invite",new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"params","params",4313443576),new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"opp-slug","opp-slug",765077115),slug], null)], null)); 31 | }); 32 | gin.lobby.core.play = (function play(slug){return gin.lobby.core.POST_ACTION.call(null,"/lobby/play",new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"params","params",4313443576),new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"opp-slug","opp-slug",765077115),slug], null)], null)); 33 | }); 34 | gin.lobby.core.accept_play = (function accept_play(slug){return gin.lobby.core.POST_ACTION.call(null,"/lobby/start",new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"params","params",4313443576),new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"opp-slug","opp-slug",765077115),slug], null)], null)); 35 | }); 36 | /** 37 | * 38 | */ 39 | gin.lobby.core.Item = quiescent.component.call(null,(function (opp){return quiescent.dom.li.call(null,new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"className","className",1004015509),"list-group-item"], null),(function (){var vec__22517 = (cljs.core.truth_(new cljs.core.Keyword(null,"available","available",4574969403).cljs$core$IFn$_invoke$arity$1(opp))?new cljs.core.PersistentVector(null, 3, 5, cljs.core.PersistentVector.EMPTY_NODE, ["Play","btn-success",(function (_){return gin.lobby.core.play.call(null,new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(opp)); 40 | })], null):(cljs.core.truth_(new cljs.core.Keyword(null,"invited","invited",2973935085).cljs$core$IFn$_invoke$arity$1(opp))?new cljs.core.PersistentVector(null, 3, 5, cljs.core.PersistentVector.EMPTY_NODE, ["Awaiting invite reply ...","btn-disabled",(function (_){return null; 41 | })], null):((new cljs.core.Keyword(null,"else","else",1017020587))?new cljs.core.PersistentVector(null, 3, 5, cljs.core.PersistentVector.EMPTY_NODE, ["Invite","btn-primary",(function (_){return gin.lobby.core.invite.call(null,new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(opp)); 42 | })], null):null)));var text = cljs.core.nth.call(null,vec__22517,0,null);var btn_class = cljs.core.nth.call(null,vec__22517,1,null);var f = cljs.core.nth.call(null,vec__22517,2,null);return quiescent.dom.div.call(null,cljs.core.PersistentArrayMap.EMPTY,quiescent.dom.label.call(null,new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"className","className",1004015509),"opp-name"], null),new cljs.core.Keyword(null,"username","username",748190792).cljs$core$IFn$_invoke$arity$1(opp)),quiescent.dom.button.call(null,new cljs.core.PersistentArrayMap(null, 2, [new cljs.core.Keyword(null,"className","className",1004015509),[cljs.core.str("btn btn-right btn-lobby-list "),cljs.core.str(btn_class)].join(''),new cljs.core.Keyword(null,"onClick","onClick",3956969051),f], null),text)); 43 | })()); 44 | })); 45 | /** 46 | * 47 | */ 48 | gin.lobby.core.OppList = quiescent.component.call(null,(function (opps){return cljs.core.apply.call(null,quiescent.dom.ul,new cljs.core.PersistentArrayMap(null, 2, [new cljs.core.Keyword(null,"id","id",1013907597),"opp-list",new cljs.core.Keyword(null,"className","className",1004015509),"list-group opp-list-frame"], null),((cljs.core.seq.call(null,opps))?cljs.core.map.call(null,(function (p1__22518_SHARP_){return gin.lobby.core.Item.call(null,cljs.core.val.call(null,p1__22518_SHARP_)); 49 | }),cljs.core.sort_by.call(null,cljs.core.key,opps)):new cljs.core.PersistentVector(null, 1, 5, cljs.core.PersistentVector.EMPTY_NODE, [quiescent.dom.li.call(null,new cljs.core.PersistentArrayMap(null, 1, [new cljs.core.Keyword(null,"className","className",1004015509),"list-group-item"], null),"No human opponents available")], null))); 50 | })); 51 | gin.lobby.core.start_quiescent = (function start_quiescent(opps){cljs.core.add_watch.call(null,opps,new cljs.core.Keyword(null,"quiescent","quiescent",2379764173),(function (_,___$1,old,state){return quiescent.render.call(null,gin.lobby.core.OppList.call(null,state),gin.ui.dom_helpers.get_element.call(null,"opponent-list")); 52 | })); 53 | return cljs.core.swap_BANG_.call(null,opps,cljs.core.identity); 54 | }); 55 | gin.lobby.core.main = (function main(){console.log("Hello world"); 56 | var opps = cljs.core.atom.call(null,cljs.core.PersistentArrayMap.EMPTY);gin.lobby.core.start_quiescent.call(null,opps); 57 | var source = gin.event_source.event_source.call(null,"/lobby/events",new cljs.core.Keyword(null,"on-message","on-message",1496225163),(function (event){if(cljs.core._EQ_.call(null,new cljs.core.Keyword(null,"type","type",1017479852).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"open","open",1017321916))) 58 | {return cljs.core.reset_BANG_.call(null,opps,cljs.core.zipmap.call(null,cljs.core.map.call(null,new cljs.core.Keyword(null,"slug","slug",1017437725),new cljs.core.Keyword(null,"opps","opps",1017322262).cljs$core$IFn$_invoke$arity$1(event)),new cljs.core.Keyword(null,"opps","opps",1017322262).cljs$core$IFn$_invoke$arity$1(event))); 59 | } else 60 | {if(cljs.core._EQ_.call(null,new cljs.core.Keyword(null,"type","type",1017479852).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"joined","joined",4154342075))) 61 | {return cljs.core.swap_BANG_.call(null,opps,cljs.core.assoc,new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.PersistentArrayMap(null, 2, [new cljs.core.Keyword(null,"slug","slug",1017437725),new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"username","username",748190792),new cljs.core.Keyword(null,"username","username",748190792).cljs$core$IFn$_invoke$arity$1(event)], null)); 62 | } else 63 | {if(cljs.core._EQ_.call(null,new cljs.core.Keyword(null,"type","type",1017479852).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"invited","invited",2973935085))) 64 | {return cljs.core.swap_BANG_.call(null,opps,cljs.core.assoc,new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.PersistentArrayMap(null, 3, [new cljs.core.Keyword(null,"slug","slug",1017437725),new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"username","username",748190792),new cljs.core.Keyword(null,"username","username",748190792).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"invited","invited",2973935085),true], null)); 65 | } else 66 | {if(cljs.core._EQ_.call(null,new cljs.core.Keyword(null,"type","type",1017479852).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"available","available",4574969403))) 67 | {return cljs.core.swap_BANG_.call(null,opps,cljs.core.assoc,new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.PersistentArrayMap(null, 3, [new cljs.core.Keyword(null,"slug","slug",1017437725),new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"username","username",748190792),new cljs.core.Keyword(null,"username","username",748190792).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"available","available",4574969403),true], null)); 68 | } else 69 | {if(cljs.core._EQ_.call(null,new cljs.core.Keyword(null,"type","type",1017479852).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"play","play",1017347750))) 70 | {gin.lobby.core.accept_play.call(null,new cljs.core.Keyword(null,"slug","slug",1017437725).cljs$core$IFn$_invoke$arity$1(event)); 71 | return opps; 72 | } else 73 | {if(cljs.core._EQ_.call(null,new cljs.core.Keyword(null,"type","type",1017479852).cljs$core$IFn$_invoke$arity$1(event),new cljs.core.Keyword(null,"game-created","game-created",3250098047))) 74 | {return gin.lobby.core.goto_url.call(null,new cljs.core.Keyword(null,"url","url",1014020321).cljs$core$IFn$_invoke$arity$1(event)); 75 | } else 76 | {return null; 77 | } 78 | } 79 | } 80 | } 81 | } 82 | } 83 | }),new cljs.core.Keyword(null,"on-error","on-error",1418576908),(function (){return gin.lobby.core.error_handler.call(null); 84 | }));return null; 85 | }); 86 | goog.exportSymbol('gin.lobby.core.main', gin.lobby.core.main); 87 | -------------------------------------------------------------------------------- /resources/public/js/out/gin/ui/animator.js: -------------------------------------------------------------------------------- 1 | // Compiled by ClojureScript 0.0-2173 2 | goog.provide('gin.ui.animator'); 3 | goog.require('cljs.core'); 4 | goog.require('gin.ui.dom_helpers'); 5 | goog.require('gin.ui.dom_helpers'); 6 | gin.ui.animator.EL = 0; 7 | gin.ui.animator.START = 1; 8 | gin.ui.animator.DRAW = 2; 9 | gin.ui.animator.TO = 3; 10 | gin.ui.animator.STEP = 4; 11 | gin.ui.animator.STEPS = 5; 12 | gin.ui.animator.DX = 6; 13 | gin.ui.animator.DY = 7; 14 | gin.ui.animator.FINISH = 8; 15 | gin.ui.animator.FIELD_COUNT = cljs.core.count.call(null,new cljs.core.PersistentVector(null, 9, 5, cljs.core.PersistentVector.EMPTY_NODE, [gin.ui.animator.EL,gin.ui.animator.START,gin.ui.animator.DRAW,gin.ui.animator.TO,gin.ui.animator.STEP,gin.ui.animator.STEPS,gin.ui.animator.DX,gin.ui.animator.DY,gin.ui.animator.FINISH], null)); 16 | gin.ui.animator.a = (new Array(((52 * gin.ui.animator.FIELD_COUNT) + 1))); 17 | gin.ui.animator.DO_DRAW = (gin.ui.animator.a.length - 1); 18 | gin.ui.animator.running = cljs.core.atom.call(null,false); 19 | gin.ui.animator.anim_loop = (function anim_loop(){(gin.ui.animator.a[gin.ui.animator.DO_DRAW] = 0); 20 | var n__17509__auto___19336 = 52;var card_idx_19337 = 0;while(true){ 21 | if((card_idx_19337 < n__17509__auto___19336)) 22 | {var i_19338 = (card_idx_19337 * gin.ui.animator.FIELD_COUNT);if(cljs.core.truth_((gin.ui.animator.a[(i_19338 + gin.ui.animator.DRAW)]))) 23 | {(gin.ui.animator.a[gin.ui.animator.DO_DRAW] = 1); 24 | var el_19339 = (gin.ui.animator.a[(i_19338 + gin.ui.animator.EL)]);var vec__19334_19340 = (gin.ui.animator.a[(i_19338 + gin.ui.animator.START)]);var start_x_19341 = cljs.core.nth.call(null,vec__19334_19340,0,null);var start_y_19342 = cljs.core.nth.call(null,vec__19334_19340,1,null);var vec__19335_19343 = (gin.ui.animator.a[(i_19338 + gin.ui.animator.TO)]);var x_19344 = cljs.core.nth.call(null,vec__19335_19343,0,null);var y_19345 = cljs.core.nth.call(null,vec__19335_19343,1,null);var to_19346 = vec__19335_19343;var step_19347 = ((gin.ui.animator.a[(i_19338 + gin.ui.animator.STEP)]) - 1);var dx_19348 = (gin.ui.animator.a[(i_19338 + gin.ui.animator.DX)]);var dy_19349 = (gin.ui.animator.a[(i_19338 + gin.ui.animator.DY)]);var steps_19350 = (gin.ui.animator.a[(i_19338 + gin.ui.animator.STEPS)]);var nx_19351 = cljs.core.long$.call(null,(start_x_19341 + ((steps_19350 - step_19347) * dx_19348)));var ny_19352 = cljs.core.long$.call(null,(start_y_19342 + ((steps_19350 - step_19347) * dy_19349)));gin.ui.dom_helpers.set_position.call(null,el_19339,nx_19351,ny_19352); 25 | (gin.ui.animator.a[(i_19338 + gin.ui.animator.STEP)] = step_19347); 26 | if(((cljs.core._EQ_.call(null,x_19344,nx_19351)) && (cljs.core._EQ_.call(null,y_19345,ny_19352))) || ((step_19347 === 0)) || (((dx_19348 === 0)) && ((dy_19349 === 0)))) 27 | {(gin.ui.animator.a[(i_19338 + gin.ui.animator.STEP)] = 0); 28 | (gin.ui.animator.a[(i_19338 + gin.ui.animator.DRAW)] = false); 29 | var finish_19353 = (gin.ui.animator.a[(i_19338 + gin.ui.animator.FINISH)]);if(cljs.core.fn_QMARK_.call(null,finish_19353)) 30 | {gin.ui.dom_helpers.set_timeout.call(null,finish_19353,0); 31 | } else 32 | {} 33 | } else 34 | {} 35 | } else 36 | {} 37 | { 38 | var G__19354 = (card_idx_19337 + 1); 39 | card_idx_19337 = G__19354; 40 | continue; 41 | } 42 | } else 43 | {} 44 | break; 45 | } 46 | if(cljs.core._EQ_.call(null,1,(gin.ui.animator.a[gin.ui.animator.DO_DRAW]))) 47 | {return gin.ui.dom_helpers.set_timeout.call(null,anim_loop,10); 48 | } else 49 | {return cljs.core.reset_BANG_.call(null,gin.ui.animator.running,false); 50 | } 51 | }); 52 | gin.ui.animator.animate = (function animate(){if(cljs.core.compare_and_set_BANG_.call(null,gin.ui.animator.running,false,true)) 53 | {return gin.ui.animator.anim_loop.call(null); 54 | } else 55 | {return null; 56 | } 57 | }); 58 | /** 59 | * @param {...*} var_args 60 | */ 61 | gin.ui.animator.slide = (function() { 62 | var slide__delegate = function (el,to,p__19355){var vec__19359 = p__19355;var finish = cljs.core.nth.call(null,vec__19359,0,null);var idx = el.anim_idx;var i = (idx * gin.ui.animator.FIELD_COUNT);var vec__19360 = gin.ui.dom_helpers.get_position.call(null,el);var from_x = cljs.core.nth.call(null,vec__19360,0,null);var from_y = cljs.core.nth.call(null,vec__19360,1,null);var from = vec__19360;var vec__19361 = to;var to_x = cljs.core.nth.call(null,vec__19361,0,null);var to_y = cljs.core.nth.call(null,vec__19361,1,null);var step = (gin.ui.animator.a[(i + gin.ui.animator.STEP)]);var steps = (((step > 0))?step:30);var dx = ((to_x - from_x) / steps);var dy = ((to_y - from_y) / steps);(gin.ui.animator.a[i] = el); 63 | (gin.ui.animator.a[(i + gin.ui.animator.START)] = from); 64 | (gin.ui.animator.a[(i + gin.ui.animator.DRAW)] = true); 65 | (gin.ui.animator.a[(i + gin.ui.animator.TO)] = to); 66 | (gin.ui.animator.a[(i + gin.ui.animator.STEP)] = steps); 67 | (gin.ui.animator.a[(i + gin.ui.animator.STEPS)] = steps); 68 | (gin.ui.animator.a[(i + gin.ui.animator.DX)] = dx); 69 | (gin.ui.animator.a[(i + gin.ui.animator.DY)] = dy); 70 | (gin.ui.animator.a[(i + gin.ui.animator.FINISH)] = finish); 71 | (gin.ui.animator.a[gin.ui.animator.DO_DRAW] = 1); 72 | return gin.ui.animator.animate.call(null); 73 | }; 74 | var slide = function (el,to,var_args){ 75 | var p__19355 = null;if (arguments.length > 2) { 76 | p__19355 = cljs.core.array_seq(Array.prototype.slice.call(arguments, 2),0);} 77 | return slide__delegate.call(this,el,to,p__19355);}; 78 | slide.cljs$lang$maxFixedArity = 2; 79 | slide.cljs$lang$applyTo = (function (arglist__19362){ 80 | var el = cljs.core.first(arglist__19362); 81 | arglist__19362 = cljs.core.next(arglist__19362); 82 | var to = cljs.core.first(arglist__19362); 83 | var p__19355 = cljs.core.rest(arglist__19362); 84 | return slide__delegate(el,to,p__19355); 85 | }); 86 | slide.cljs$core$IFn$_invoke$arity$variadic = slide__delegate; 87 | return slide; 88 | })() 89 | ; 90 | -------------------------------------------------------------------------------- /resources/public/js/out/quiescent.cljs: -------------------------------------------------------------------------------- 1 | (ns quiescent) 2 | 3 | (def ^:dynamic *component* 4 | "Within a component render function, will be bound to the raw 5 | ReactJS component." nil) 6 | 7 | (defn component 8 | "Return a function that will return a ReactJS component, using the 9 | provided function as the implementation for React's 'render' method 10 | on the component. 11 | 12 | The given render function should take a single immutable value as 13 | its first argument, and return a single ReactJS component. 14 | Additional arguments to the component constructor will be passed as 15 | additional arguments to the render function whenever it is invoked, 16 | but will *not* be included in any calculations regarding whether the 17 | component should re-render." 18 | [renderer] 19 | (let [react-component 20 | (.createClass js/React 21 | #js {:shouldComponentUpdate 22 | (fn [next-props _] 23 | (this-as this 24 | (not= (aget (.-props this) "value") 25 | (aget next-props "value")))) 26 | :render 27 | (fn [] 28 | (this-as this 29 | (binding [*component* this] 30 | (apply renderer 31 | (aget (.-props this) "value") 32 | (aget (.-props this) "statics")))))})] 33 | (fn [value & static-args] 34 | (react-component #js {:value value :statics static-args})))) 35 | 36 | (def WrapperComponent 37 | "Wrapper component used to mix-in lifecycle access" 38 | (.createClass js/React 39 | #js {:render 40 | (fn [] (this-as this (aget (.-props this) "wrappee"))) 41 | :componentDidUpdate 42 | (fn [prev-props prev-state] 43 | (this-as this 44 | (when-let [f (aget (.-props this) "onUpdate")] 45 | (binding [*component* this] 46 | (f (.getDOMNode this)))))) 47 | :componentDidMount 48 | (fn [] 49 | (this-as this 50 | (when-let [f (aget (.-props this) "onMount")] 51 | (f (.getDOMNode this)))))})) 52 | 53 | (defn on-update 54 | "Wrap a component, specifying a function to be called on the 55 | componentDidUpdate lifecycle event. 56 | 57 | The function will be passed the rendered DOM node." 58 | [child f] 59 | (WrapperComponent #js {:wrappee child 60 | :onUpdate f})) 61 | 62 | (defn on-initial-render 63 | "Wrap a component, specifying a function to be called on the 64 | componentDidMount lifecycle event. 65 | 66 | The function will be passed the rendered DOM node." 67 | [child f] 68 | (WrapperComponent #js {:wrappee child 69 | :onMount f})) 70 | 71 | (defn on-render 72 | "Wrap a component, specifying a function to be called on the 73 | componentDidMount AND the componentDidUpdate lifecycle events. 74 | 75 | The function will be passed the rendered DOM node." 76 | [child f] 77 | (WrapperComponent #js {:wrappee child 78 | :onUpdate f 79 | :onMount f})) 80 | 81 | (defn render 82 | "Given a ReactJS component, immediately render it, rooted to the 83 | specified DOM node." 84 | [component node] 85 | (.renderComponent js/React component node)) 86 | -------------------------------------------------------------------------------- /resources/public/js/out/quiescent.js: -------------------------------------------------------------------------------- 1 | // Compiled by ClojureScript 0.0-2173 2 | goog.provide('quiescent'); 3 | goog.require('cljs.core'); 4 | /** 5 | * Within a component render function, will be bound to the raw 6 | * ReactJS component. 7 | */ 8 | quiescent._STAR_component_STAR_ = null; 9 | /** 10 | * Return a function that will return a ReactJS component, using the 11 | * provided function as the implementation for React's 'render' method 12 | * on the component. 13 | * 14 | * The given render function should take a single immutable value as 15 | * its first argument, and return a single ReactJS component. 16 | * Additional arguments to the component constructor will be passed as 17 | * additional arguments to the render function whenever it is invoked, 18 | * but will *not* be included in any calculations regarding whether the 19 | * component should re-render. 20 | */ 21 | quiescent.component = (function component(renderer){var react_component = React.createClass({"render": (function (){var this$ = this;var _STAR_component_STAR_23477 = quiescent._STAR_component_STAR_;try{quiescent._STAR_component_STAR_ = this$; 22 | return cljs.core.apply.call(null,renderer,(this$.props["value"]),(this$.props["statics"])); 23 | }finally {quiescent._STAR_component_STAR_ = _STAR_component_STAR_23477; 24 | }}), "shouldComponentUpdate": (function (next_props,_){var this$ = this;return cljs.core.not_EQ_.call(null,(this$.props["value"]),(next_props["value"])); 25 | })});return (function() { 26 | var G__23478__delegate = function (value,static_args){return react_component.call(null,{"statics": static_args, "value": value}); 27 | }; 28 | var G__23478 = function (value,var_args){ 29 | var static_args = null;if (arguments.length > 1) { 30 | static_args = cljs.core.array_seq(Array.prototype.slice.call(arguments, 1),0);} 31 | return G__23478__delegate.call(this,value,static_args);}; 32 | G__23478.cljs$lang$maxFixedArity = 1; 33 | G__23478.cljs$lang$applyTo = (function (arglist__23479){ 34 | var value = cljs.core.first(arglist__23479); 35 | var static_args = cljs.core.rest(arglist__23479); 36 | return G__23478__delegate(value,static_args); 37 | }); 38 | G__23478.cljs$core$IFn$_invoke$arity$variadic = G__23478__delegate; 39 | return G__23478; 40 | })() 41 | ; 42 | }); 43 | /** 44 | * Wrapper component used to mix-in lifecycle access 45 | */ 46 | quiescent.WrapperComponent = React.createClass({"componentDidMount": (function (){var this$ = this;var temp__4092__auto__ = (this$.props["onMount"]);if(cljs.core.truth_(temp__4092__auto__)) 47 | {var f = temp__4092__auto__;return f.call(null,this$.getDOMNode()); 48 | } else 49 | {return null; 50 | } 51 | }), "componentDidUpdate": (function (prev_props,prev_state){var this$ = this;var temp__4092__auto__ = (this$.props["onUpdate"]);if(cljs.core.truth_(temp__4092__auto__)) 52 | {var f = temp__4092__auto__;var _STAR_component_STAR_23480 = quiescent._STAR_component_STAR_;try{quiescent._STAR_component_STAR_ = this$; 53 | return f.call(null,this$.getDOMNode()); 54 | }finally {quiescent._STAR_component_STAR_ = _STAR_component_STAR_23480; 55 | }} else 56 | {return null; 57 | } 58 | }), "render": (function (){var this$ = this;return (this$.props["wrappee"]); 59 | })}); 60 | /** 61 | * Wrap a component, specifying a function to be called on the 62 | * componentDidUpdate lifecycle event. 63 | * 64 | * The function will be passed the rendered DOM node. 65 | */ 66 | quiescent.on_update = (function on_update(child,f){return quiescent.WrapperComponent.call(null,{"onUpdate": f, "wrappee": child}); 67 | }); 68 | /** 69 | * Wrap a component, specifying a function to be called on the 70 | * componentDidMount lifecycle event. 71 | * 72 | * The function will be passed the rendered DOM node. 73 | */ 74 | quiescent.on_initial_render = (function on_initial_render(child,f){return quiescent.WrapperComponent.call(null,{"onMount": f, "wrappee": child}); 75 | }); 76 | /** 77 | * Wrap a component, specifying a function to be called on the 78 | * componentDidMount AND the componentDidUpdate lifecycle events. 79 | * 80 | * The function will be passed the rendered DOM node. 81 | */ 82 | quiescent.on_render = (function on_render(child,f){return quiescent.WrapperComponent.call(null,{"onMount": f, "onUpdate": f, "wrappee": child}); 83 | }); 84 | /** 85 | * Given a ReactJS component, immediately render it, rooted to the 86 | * specified DOM node. 87 | */ 88 | quiescent.render = (function render(component,node){return React.renderComponent(component,node); 89 | }); 90 | -------------------------------------------------------------------------------- /resources/public/js/out/quiescent/dom.cljs: -------------------------------------------------------------------------------- 1 | (ns quiescent.dom 2 | (:refer-clojure :exclude [time map meta]) 3 | (:require [quiescent :as q]) 4 | (:require-macros [quiescent.dom :as dm])) 5 | 6 | (defn js-props 7 | "Utility function. Takes an object which is (possibly) a 8 | ClojureScript map. If the value is a ClojureScript map, convert it 9 | to a JavaScript properties object. Otherwise, return the argument 10 | unchanged." 11 | [obj] 12 | (if (map? obj) 13 | (let [o (js-obj)] 14 | (doseq [[k v] obj] (aset o (name k) (js-props v))) 15 | o) 16 | obj)) 17 | 18 | (dm/define-tags 19 | a abbr address area article aside audio b base bdi bdo big blockquote body br 20 | button canvas caption cite code col colgroup data datalist dd del details dfn 21 | div dl dt em embed fieldset figcaption figure footer form h1 h2 h3 h4 h5 h6 22 | head header hr html i iframe img input ins kbd keygen label legend li link main 23 | map mark menu menuitem meta meter nav noscript object ol optgroup option output 24 | p param pre progress q rp rt ruby s samp script section select small source 25 | span strong style sub summary sup table tbody td textarea tfoot th thead time 26 | title tr track u ul var video wbr circle g line path polygon polyline rect svg 27 | text) 28 | -------------------------------------------------------------------------------- /resources/templates/application.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Gin 10 | 11 | 12 | 13 | 14 | 15 | 16 | 20 | 21 | 22 | 23 | 52 | 53 |
54 |
55 |
56 |
57 | Content div. 58 |
59 |
60 | 61 |
62 |
63 | 64 | 69 |
70 | 71 | 73 | 74 | 75 | 76 | 77 | 78 | -------------------------------------------------------------------------------- /resources/templates/clojurescript_ai.html: -------------------------------------------------------------------------------- 1 |
2 |
3 |
4 |
5 | How to 6 | play?: Racket Gin Rummy documentation 8 |
9 | 10 | 13 |
14 | -------------------------------------------------------------------------------- /resources/templates/game.html: -------------------------------------------------------------------------------- 1 |
2 |
3 |
4 |
5 |
6 | How to 7 | play?: Racket Gin Rummy documentation 9 |
10 | 11 | 12 | 13 | 16 |
17 | -------------------------------------------------------------------------------- /resources/templates/lobby.html: -------------------------------------------------------------------------------- 1 |
2 |
3 |
4 |
5 |
Network game - Remote AI
6 |
7 | Play against an AI on the server 8 |
10 | 12 |
13 |
14 |
15 |
16 |
Network game - 17 | Human opponent 18 | 19 |
20 |
21 |
22 | Opponent list 23 |
24 |
25 | 26 |
27 |
28 | 29 | 30 | 31 |
32 | -------------------------------------------------------------------------------- /resources/templates/local_game.html: -------------------------------------------------------------------------------- 1 |
2 |
3 |
Local game
4 |
5 | Play against a ClojureScript AI 6 | Play against 7 | CLJS AI 8 |
9 |
10 |
11 | 12 | -------------------------------------------------------------------------------- /resources/templates/login.html: -------------------------------------------------------------------------------- 1 |
2 |
3 |
4 |
5 |
Network game - Pick a username
6 |
7 |
8 |
9 | 10 |
11 | 13 | 14 |
15 |
16 |
17 |
18 | 19 |
20 |
21 |
22 |
23 |
24 | 25 |
26 | 27 | -------------------------------------------------------------------------------- /src/gin/ai.clj: -------------------------------------------------------------------------------- 1 | (ns gin.ai 2 | (:require [clojure.tools.logging :refer [info debug spy error]] 3 | [com.stuartsierra.component :as component] 4 | [clojure.core.async :refer [go chan > (iterate :card.discard/next (:game/discard game)) 48 | (take-while identity) 49 | (mapv (fn [card] 50 | {:suit (:card/suit card) 51 | :rank (:card/rank card)}))) 52 | move (try (game/takediscardordeck in-hand-cards discard gone-discards) 53 | (catch Exception e 54 | (.printStackTrace e) 55 | (throw e)))] 56 | @(d/transact conn 57 | [(if (= move :pile) 58 | [:pile-picked game-ref player] 59 | [:discard-picked game-ref player])])))) 60 | 61 | (defn handle-picked [event conn] 62 | (when-let [[game-ref player] (player event)] 63 | (let [game (:event/game event) 64 | in-hand-cards (for [card (get game 65 | (if (= player :player1) 66 | :game/player1-cards 67 | :game/player2-cards))] 68 | {:suit (:card/suit card) 69 | :rank (:card/rank card)}) 70 | discards (->> (iterate :card.discard/next (:game/discard game)) 71 | (take-while identity) 72 | (mapv (fn [card] 73 | {:suit (:card/suit card) 74 | :rank (:card/rank card)}))) 75 | trade-card (game/choosediscard in-hand-cards discards)] 76 | @(d/transact conn 77 | [[:discard-chosen game-ref player (:suit trade-card) (:rank trade-card)]])))) 78 | 79 | (defmethod handle :pile-pick-revealed 80 | [event conn] 81 | (handle-picked event conn)) 82 | 83 | (defmethod handle :discard-picked 84 | [event conn] 85 | (handle-picked event conn)) 86 | 87 | (defmethod handle :default 88 | [event conn] 89 | nil) 90 | 91 | (defrecord AI [ch database] 92 | component/Lifecycle 93 | (start [component] 94 | (info "Starting ai") 95 | (let [conn (:connection database) 96 | listen (:listen database)] 97 | (go (loop [] 98 | (when-let [txr (AI {:ch (chan)})) 118 | -------------------------------------------------------------------------------- /src/gin/common.clj: -------------------------------------------------------------------------------- 1 | (ns gin.common 2 | (:require [clojure.tools.logging :refer [info debug spy]] 3 | [gin.util.layout :as l] 4 | [net.cgrand.enlive-html :as html] 5 | [cemerick.friend :as friend])) 6 | 7 | (def application-html (html/html-resource "templates/application.html")) 8 | 9 | (defn emit-application [ctx & clauses] 10 | (assert (even? (count clauses)) "Need even number of clauses for enlive (forgot to pass ctx?)") 11 | (let [friend-auth (friend/current-authentication (:request ctx))] 12 | (apply 13 | l/emit application-html 14 | [:#flash] (when-let [flash (get-in ctx [:request :flash])] 15 | (html/content flash)) 16 | [:ul.navbar-nav :li] (if (contains? (:roles friend-auth) :admin) 17 | (html/after [{:tag :li 18 | :attrs nil 19 | :content [{:tag :a 20 | :attrs {:href "/admin"} 21 | :content ["Admin"]}]}]) 22 | identity) 23 | [:#logged-in] (when friend-auth 24 | (html/transform-content 25 | [:.rel-profile] (html/content (str "Welcome, " (:username friend-auth))))) 26 | (concat clauses 27 | [[[:form (html/nth-child 1)]] 28 | (html/append [{:tag :input 29 | :attrs {:type "hidden" 30 | :name "__anti-forgery-token" 31 | :value (get-in ctx [:request :session "__anti-forgery-token"])} 32 | :content []}])])))) 33 | -------------------------------------------------------------------------------- /src/gin/core.clj: -------------------------------------------------------------------------------- 1 | (ns gin.core 2 | (:require [clojure.tools.logging :refer [info debug spy error]] 3 | [com.stuartsierra.component :as component] 4 | [gin.system.ring :as ring] 5 | [gin.system.ring.jetty-async-adapter :as jetty-async-adapter] 6 | [gin.system.server :as server] 7 | [gin.system.database-datomic :as database-datomic] 8 | [gin.dealer :as dealer] 9 | [gin.ai :as ai] 10 | [gin.lobby :as lobby] 11 | [gin.games :as games] 12 | [compojure.core :as compojure] 13 | [cemerick.friend :as friend] 14 | [cemerick.friend.workflows :as workflows] 15 | [cemerick.friend.credentials :as credentials] 16 | [datomic.api :as d])) 17 | 18 | (compojure/defroutes main-routes 19 | lobby/lobby-routes 20 | games/games-routes 21 | (compojure/ANY "*" _ "Not found") 22 | ) 23 | 24 | (defn main-handler [] 25 | (-> #'main-routes 26 | ((fn save-friend-session [handler] 27 | (fn friend-session [req] 28 | (let [res (handler req)] 29 | (if (contains? (get res :session) ::friend/identity) 30 | res 31 | (if-let [auth (get-in req [:session ::friend/identity])] 32 | (assoc-in res [:session ::friend/identity] auth) 33 | res) 34 | ))))) 35 | (friend/authenticate {:login-uri "/login" 36 | :default-landing-uri "/" 37 | :workflows [(fn [req] 38 | ((workflows/interactive-form 39 | :credential-fn (fn friend-credential-fn [creds] 40 | (lobby/lookup-friend-identity (:conn req) creds))) 41 | req))]}) 42 | 43 | ring/wrap-common)) 44 | 45 | (defn dev-handler [] 46 | (-> (main-handler) 47 | ring/wrap-dev 48 | (ring/wrap-dev-cljs 49 | "" 50 | " 51 | 52 | "))) 53 | 54 | (defrecord DevDBFixtures [database] 55 | component/Lifecycle 56 | (start [component] 57 | (info "Insert test fixtures") 58 | (let [conn (:connection database)] 59 | @(d/transact conn 60 | (let [event-id (d/tempid :db.part/user) 61 | game-id (d/tempid :db.part/user) 62 | p1-id (d/tempid :db.part/user) 63 | p2-id (d/tempid :db.part/user) 64 | tx-id (d/tempid :db.part/tx)] 65 | [{:db/id event-id 66 | :event/type :game-created 67 | :event/game game-id 68 | :event/tx tx-id 69 | :event/by :migrations} 70 | {:db/id game-id 71 | :game/id "fix1" 72 | :game/player1 p1-id 73 | :game/player2 p2-id 74 | :game/to-start p1-id 75 | :game/last-event event-id} 76 | {:db/id p1-id 77 | :account/slug "user1" 78 | :account/username "User One"} 79 | {:db/id p2-id 80 | :account/slug "user2" 81 | :account/username "Player Two"}]))) 82 | component) 83 | (stop [component] 84 | (info "Not bothering to remove test fixtures") 85 | component)) 86 | 87 | (defn dev-db-fixtures [] 88 | (map->DevDBFixtures {})) 89 | 90 | (defrecord GinSystem [] 91 | component/Lifecycle 92 | (start [this] 93 | (component/start-system this (filter (partial satisfies? component/Lifecycle) (keys this)))) 94 | (stop [this] 95 | (component/stop-system this (filter (partial satisfies? component/Lifecycle) (keys this))))) 96 | 97 | (defn dev-gin-system [config-options] 98 | (info "Hello world!") 99 | (let [{:keys [db-connect-string port]} config-options] 100 | (map->GinSystem 101 | {:config-options config-options 102 | :db (database-datomic/database-datomic db-connect-string) 103 | :db-migrator (component/using 104 | (database-datomic/dev-migrator) 105 | {:database :db}) 106 | :db-fixtures (component/using 107 | (dev-db-fixtures) 108 | {:database :db 109 | :db-migrator :db-migrator 110 | :dealer :dealer}) 111 | :dealer (component/using 112 | (dealer/dealer) 113 | {:database :db 114 | :db-migrator :db-migrator}) 115 | :ai (component/using 116 | (ai/ai) 117 | {:database :db 118 | :db-migrator :db-migrator}) 119 | :ring-handler (component/using 120 | (ring/ring-handler (dev-handler)) 121 | {:database :db}) 122 | :server (component/using 123 | (jetty-async-adapter/async-jetty port) 124 | {:handler :ring-handler})}))) 125 | 126 | (def dev-config {:db-connect-string "datomic:mem://gin-local" :port 3000}) 127 | 128 | (defn gin-system [config-options] 129 | (info "Hello world, this is the production system!") 130 | (let [{:keys [db-connect-string port]} config-options] 131 | (map->GinSystem 132 | {:config-options config-options 133 | :db (database-datomic/database-datomic db-connect-string) 134 | :db-migrator (component/using 135 | (database-datomic/dev-migrator) 136 | {:database :db}) 137 | :dealer (component/using 138 | (dealer/dealer) 139 | {:database :db 140 | :db-migrator :db-migrator}) 141 | :ai (component/using 142 | (ai/ai) 143 | {:database :db 144 | :db-migrator :db-migrator}) 145 | :ring-handler (component/using 146 | (ring/ring-handler (main-handler)) 147 | {:database :db}) 148 | :server (component/using 149 | (jetty-async-adapter/async-jetty port) 150 | {:handler :ring-handler})}))) 151 | -------------------------------------------------------------------------------- /src/gin/dealer.clj: -------------------------------------------------------------------------------- 1 | (ns gin.dealer 2 | (:require [clojure.tools.logging :refer [info debug spy error]] 3 | [com.stuartsierra.component :as component] 4 | [clojure.core.async :refer [go chan [[:log-event :deal game-ref :dealer] 36 | {:db/id game-ref 37 | :game/to-start starting}] 38 | (into (for [[location cards] [[:game/_player1-cards player1-cards] 39 | [:game/_player2-cards player2-cards] 40 | [:game/_pile pile] 41 | [:game/_discard [discard]]] 42 | {:keys [suit rank]} cards] 43 | {:db/id (d/tempid :db.part/user) 44 | :card/suit suit 45 | :card/rank rank 46 | location game-ref}))))))) 47 | 48 | (defmethod handle :player-ready 49 | [event conn] 50 | (let [game (:event/game event) 51 | game-ref (:db/id game)] 52 | (when (= 2 (count (:game/ready game))) 53 | (let [player1-ginsize (game/gin-size (for [card (:game/player1-cards game)] 54 | {:suit (:card/suit card) 55 | :rank (:card/rank card)})) 56 | player2-ginsize (game/gin-size (for [card (:game/player2-cards game)] 57 | {:suit (:card/suit card) 58 | :rank (:card/rank card)}))] 59 | (cond 60 | (= 10 player1-ginsize player2-ginsize) 61 | @(d/transact conn [[:log-event :game-finished game-ref :dealer] 62 | {:db/id game-ref 63 | :game/result :pat-tie}]) 64 | (= 10 player1-ginsize) 65 | @(d/transact conn [[:log-event :game-finished game-ref :dealer] 66 | {:db/id game-ref 67 | :game/result :pat-win 68 | :game/winner (:db/id (:game/player1 game))}]) 69 | (= 10 player2-ginsize) 70 | @(d/transact conn [[:log-event :game-finished game-ref :dealer] 71 | {:db/id game-ref 72 | :game/result :pat-win 73 | :game/winner (:db/id (:game/player2 game))}]) 74 | :else 75 | (let [player-ref (:db/id (:game/to-start game))] 76 | @(d/transact conn [[:turn-assigned game-ref player-ref :dealer]]))))))) 77 | 78 | (defmethod handle :discard-chosen 79 | [event conn] 80 | (let [game (:event/game event) 81 | game-ref (:db/id game) 82 | player-ref (:db/id (:game/turn game)) 83 | card-attr (if (= player-ref (get-in game [:game/player1 :db/id])) 84 | :game/player1-cards 85 | :game/player2-cards)] 86 | (let [player-ginsize (game/gin-size (for [card (get game card-attr)] 87 | {:suit (:card/suit card) 88 | :rank (:card/rank card)}))] 89 | (if (= 10 player-ginsize) 90 | @(d/transact conn [[:log-event :game-finished game-ref :dealer] 91 | {:db/id game-ref 92 | :game/result :win 93 | :game/winner player-ref}]) 94 | (let [next-player-ref (get-in game [(if (= player-ref (get-in game [:game/player1 :db/id])) 95 | :game/player2 96 | :game/player1) :db/id])] 97 | @(d/transact conn [[:turn-assigned game-ref next-player-ref :dealer]])))))) 98 | 99 | (defmethod handle :pile-picked 100 | [event conn] 101 | (let [game (:event/game event) 102 | game-ref (:db/id game) 103 | player-ref (:db/id (:game/turn game)) 104 | card (rand-nth (seq (:game/pile game)))] 105 | @(d/transact conn [[:pile-pick-revealed game-ref player-ref card :dealer]]))) 106 | 107 | (defmethod handle :default 108 | [event conn] 109 | nil) 110 | 111 | (defrecord Dealer [ch database] 112 | component/Lifecycle 113 | (start [component] 114 | (info "Starting dealer") 115 | ;; TODO make dealer survive restarts by using stream-from and 116 | ;; marking its progress in the db 117 | (let [conn (:connection database) 118 | listen (:listen database)] 119 | (go (loop [] 120 | (when-let [txr (Dealer {:ch (chan)})) 140 | -------------------------------------------------------------------------------- /src/gin/game.clj: -------------------------------------------------------------------------------- 1 | (ns gin.game) 2 | 3 | ;; ;;;;;;;;;;;;; Finding Rummy and The Machine Player Strategy 4 | ;; ;;;;;;;;;;;;; ;;;;;;;; 5 | (def rank->value {:r2 2 :r3 3 :r4 4 :r5 5 :r6 6 :r7 7 :r8 8 :r9 9 6 | :T 10 :J 11 :Q 12 :K 13 :A 1}) 7 | 8 | (def value->rank (zipmap (vals rank->value) (keys rank->value))) 9 | 10 | (def suit->value {:heart 0 :club 1 :spade 2 :diamond 3}) 11 | 12 | (def value->suit (zipmap (vals suit->value) (keys suit->value))) 13 | 14 | (defn add-rank [rank n] 15 | (let [v (+ (rank->value rank) n)] 16 | (if (= v 14) 17 | :A 18 | (value->rank v)))) 19 | 20 | (defn value-sorted [cards] (sort-by (comp rank->value :rank) cards)) 21 | 22 | (def dec-rank {:r2 :A, :r3 :r2, :r4 :r3,:r5 :r4,:r6 :r5,:r7 :r6,:r8 :r7,:r9 :r8,:T :r9, :J :T, :Q :J, :K :Q,:A :K}) 23 | 24 | (defn remove-when-card [cards suit rank] ;; must be max 9 cards in the hand 25 | (let [[before after] (split-with #(not (and (= (:suit %) suit) 26 | (= (:rank %) rank))) cards)] 27 | (when (first after) ;; was the needle card in cards? 28 | (concat before (rest after))))) 29 | 30 | (defn remove-when-straight [cards end-suit end-rank] 31 | (when-let [found-middle (remove-when-card cards end-suit (dec-rank end-rank))] 32 | (remove-when-card found-middle end-suit end-rank))) 33 | 34 | (defn gin-hand-size 35 | [ginhand] 36 | (if (< (count ginhand) 3) 37 | 0 ;; need atleast 3 cards to form a set 38 | (let [pivot (first ginhand) 39 | postpivot (rest ginhand) 40 | ;; case 1: don't use the pivot in a set (to find best scores when the gin-size is less than 10) 41 | skipscore (+ 0 ;; the pivot is not used in a set 42 | (gin-hand-size postpivot)) 43 | ;; case 2: is there a trips using the pivot 44 | c1 (nth ginhand 1) 45 | c2 (nth ginhand 2) 46 | c3 (nth ginhand 3 nil) ;; might be considering the last 3 cards 47 | samescore (if (and (= (:rank pivot) (:rank c1)) 48 | (= (:rank c1) (:rank c2))) 49 | (max (+ 3 50 | (gin-hand-size (rest (rest postpivot)))) 51 | (if (and c3 52 | (= (:rank pivot) (:rank c3))) 53 | ;; when 4 of the same, there are 2 extra 54 | ;; trip possibilities 55 | (let [notsame (rest (rest (rest postpivot)))] 56 | (max 57 | (+ 3 58 | (gin-hand-size (conj notsame c1))) 59 | (+ 3 60 | (gin-hand-size (conj notsame c2))) 61 | (+ 4 62 | (gin-hand-size notsame)))) 63 | 0)) 64 | 0) ;; no trips possible 65 | ;; now try to find all the sets where the pivot is used in a straight flush 66 | ;; the pivot is always the lowest ranking remaining card in cards and therefore 67 | ;; always the first card of a straight 68 | ;; a card possibly makes a straight with the pivot as the lowest card if it is the same suit and 69 | ;; within window points of rank 70 | ;; case 4: find a straight flush with 3 cards with 71 | ;; pivot as the lowest (doesn't find Q-K-A, see 72 | ;; case 4a) 73 | wostraight (remove-when-straight postpivot (:suit pivot) (add-rank (:rank pivot) 2)) 74 | straightscore (if wostraight 75 | (max (+ 3 76 | (gin-hand-size wostraight)) 77 | (if-let [wo4straight (remove-when-card wostraight (:suit pivot) (add-rank (:rank pivot) 3))] 78 | (+ 4 79 | (gin-hand-size wo4straight)) 80 | 0)) 81 | 0) 82 | ;; special case 4: find Q-K-A and J-Q-K-A 83 | acescore (if-not (= :A (:rank pivot)) 84 | 0 ;; pivot is not an Ace, case does not apply 85 | (if-let [wostraight (remove-when-straight postpivot (:suit pivot) :K)] 86 | (max 87 | (+ 3 (gin-hand-size wostraight)) 88 | (if-let [woj (remove-when-card wostraight (:suit pivot) :J)] 89 | (+ 4 (gin-hand-size woj)) 90 | 0)) 91 | 0))] 92 | (max skipscore 93 | samescore 94 | straightscore 95 | acescore) 96 | ))) 97 | 98 | (defn gin-size [cards] 99 | "Finds the highest number of cards that can be put into sets." 100 | (gin-hand-size (value-sorted cards))) 101 | 102 | ;; helpers for pairrating 103 | ;; count-gone checks how many of a given value are known to be permanently 104 | ;; discarded 105 | (defn count-gone [rank gone-cards] 106 | (+ (if (gone-cards (+ rank 0)) 1 0) 107 | (if (gone-cards (+ rank 20)) 1 0) 108 | (if (gone-cards (+ rank 40)) 1 0) 109 | (if (gone-cards (+ rank 60)) 1 0))) 110 | 111 | ;; count-avail checks whether a given value/suit is 112 | ;; known to be discarded (returns 0) or not (returns 1) 113 | (defn count-avail [rank suit gone-cards] 114 | (if (gone-cards (+ (* suit 20) rank)) 115 | 0 116 | 1)) 117 | 118 | (defn cards-to-gone-cards [cards] 119 | (set (map #(+ (* (suit->value (:suit %)) 20) (rank->value (:rank %))) cards))) 120 | 121 | ;; rates the possibility for forming a straight given two card values in a 122 | ;; particular suit, and taking into account cards known to be discarded; the 123 | ;; rating is the number of non-discarded cards that would form a straight with 124 | ;; the given values 125 | (defn rate-straight [suit value value2 gone-cards] 126 | (let [v1 (if (= value 1) ;; use ace as top or bottom 127 | (if (> value2 6) 14 1) 128 | value) 129 | v2 (if (= value2 1) 130 | (if (> value 6) 14 1) 131 | value2)] 132 | (let [delta (- (max v1 v2) (min v1 v2))] 133 | (cond 134 | (= delta 1) 135 | (cond (or (= v1 1) (= v2 1)) 136 | ;; Might get the 3? 137 | (count-avail 3 suit gone-cards) 138 | (or (= v1 14) (= v2 14)) 139 | ;; Might get the queen? 140 | (count-avail 12 suit gone-cards) 141 | (or (= v1 13) (= v2 13)) 142 | ;; Might get the jack or ace? 143 | (+ (count-avail 11 suit gone-cards) 144 | (count-avail 1 suit gone-cards)) 145 | :else 146 | ;; Might get top or bottom? 147 | (+ (count-avail (dec (min v1 v2)) suit gone-cards) 148 | (count-avail (inc (max v1 v2)) suit gone-cards))) 149 | (= delta 2) 150 | ;; Might get the middle one? 151 | (let [middle (quot (+ v1 v2) 2)] 152 | (count-avail middle suit gone-cards)) 153 | :else 0)))) 154 | 155 | 156 | ;; This procedure is the second part of the machine's strategy. If the machine 157 | ;; sees two choices that are equally good according to gin-size, then it 158 | ;; computes a rating based on pairs, i.e., cards that might eventually go 159 | ;; together in a set. 160 | (defn pair-rating [cards goneset] 161 | (loop [rating 0 162 | cards cards] 163 | (if (= (count cards) 1) 164 | (+ 20 (* 2 rating)) ;; to conform to orig pair rating algo 165 | (let [card (first cards) 166 | others (rest cards) 167 | suit (:suit card) 168 | rank (:rank card) 169 | card-score (reduce + 170 | (map (fn [card2] 171 | (let [suit2 (:suit card2) 172 | rank2 (:rank card2)] 173 | (cond 174 | (= rank rank2) 175 | (- 2 (count-gone (rank->value rank) goneset)) 176 | (= suit suit2) 177 | (rate-straight (suit->value suit) (rank->value rank) (rank->value rank2) goneset) 178 | :else 0))) 179 | others))] 180 | (recur (+ rating card-score) 181 | others))))) 182 | 183 | ;; The procedure implements the discard choice 184 | ;; hand contains eleven cards, our hand plus the discard or new card from the deck 185 | (defn choosediscard [hand gone-cards] 186 | "Discard the card that leaves the hand with the largest gin-size. If 187 | multiple cards leave the same largest gin size, pick card leaving the best 188 | pair rating." 189 | ;; @TODO "in case of a tie involving the current discard, prefer that one" 190 | (let [sorted-hand (value-sorted hand)] 191 | (loop [best [] 192 | best-gin-size 0 193 | hands (map #(vector (remove #{%} sorted-hand) %) sorted-hand)] 194 | (if-let [h (first hands)] 195 | (let [gs (gin-size (first h))] 196 | (cond 197 | (> gs best-gin-size) 198 | (recur [h] 199 | gs 200 | (rest hands)) 201 | (= gs best-gin-size) 202 | (recur (conj best h) 203 | best-gin-size 204 | (rest hands)) 205 | :else 206 | (recur best 207 | best-gin-size 208 | (rest hands)))) 209 | ;; found all gin sizes 210 | ;; find best hand based on pair rating 211 | (if (= (count best) 1) 212 | (second (first best)) ;; discard for best gin-size 213 | (let [gone-set (cards-to-gone-cards gone-cards)] 214 | (second (apply max-key (comp #(pair-rating % gone-set) first) best)))) 215 | )))) 216 | 217 | (defn takediscardordeck [in-hand-cards discard gone-discards] 218 | "Simple strategy: we want the card if taking it will make the 219 | gin-size of our hand increase, or if taking it will not make the gin-size 220 | decrease but will increase the pair rating." 221 | (let [orig-size (gin-size in-hand-cards) 222 | hand-with-discard (conj in-hand-cards discard) 223 | trade-card (choosediscard hand-with-discard gone-discards) 224 | new-gin-cards (remove #(= trade-card %) hand-with-discard) 225 | new-size (gin-size new-gin-cards)] 226 | (if (or (> new-size orig-size) 227 | (and (= new-size orig-size) 228 | (let [gone-set (cards-to-gone-cards gone-discards)] 229 | (> (pair-rating new-gin-cards gone-set) 230 | (pair-rating in-hand-cards gone-set))))) 231 | :discard 232 | :pile))) 233 | 234 | (defn decide-move [table] 235 | (let [opp-hand (:opp-cards table) 236 | discards (:discards table) 237 | discard (peek discards) 238 | gone-discards (pop discards)] 239 | (takediscardordeck opp-hand discard gone-discards))) 240 | -------------------------------------------------------------------------------- /src/gin/main.clj: -------------------------------------------------------------------------------- 1 | (ns gin.main 2 | (:require [clojure.tools.logging :refer [info debug spy error]] 3 | [com.stuartsierra.component :as component] 4 | [gin.core :as core]) 5 | (:gen-class)) 6 | 7 | (def prod-config {:db-connect-string "datomic:mem://gin-local" :port 80}) 8 | 9 | (defn -main [& args] 10 | (info "Running production") 11 | (let [system (-> (core/gin-system prod-config) 12 | component/start)] 13 | (.addShutdownHook (Runtime/getRuntime) 14 | (Thread. (fn [] 15 | (info "Shutting down main") 16 | (component/stop system)))))) 17 | -------------------------------------------------------------------------------- /src/gin/system/database_datomic.clj: -------------------------------------------------------------------------------- 1 | (ns gin.system.database-datomic 2 | (:require [clojure.tools.logging :refer [info debug spy error]] 3 | [com.stuartsierra.component :as component] 4 | [datomic.api :refer [db q] :as d] 5 | [gin.migrations :as migrations] 6 | [clojure.core.async :refer [go tap untap chan alt! >! onto-chan pipe close!] :as async] 7 | [clojure.core.async.impl.protocols :as impl]) 8 | (:import [java.util LinkedList])) 9 | 10 | ;; sanity check 11 | (let [ms migrations/migrations] 12 | (assert (every? (fn [m] 13 | (and (vector? m) 14 | (= 2 (count m)) 15 | (= (number? (first m))) 16 | (= #{:up :down} (set (keys (second m)))) 17 | (fn? (:up (second m))) 18 | (fn? (:down (second m))))) ms) 19 | "Migrations format is [[ {:up (fn [db] ...) :down (fn [db] ...)}") 20 | (assert 21 | (and (= 1 (ffirst ms)) 22 | (apply < (map first ms))) 23 | "Migrations should start at id 1 and be increasing")) 24 | 25 | (defn current-db-version [conn] 26 | (get (d/entity (db conn) :schema-version) :schema/version 0)) 27 | 28 | (defn update-current-version [conn version] 29 | @(d/transact conn [[:db/add :schema-version :schema/version version]])) 30 | 31 | (defn migrate! 32 | ([conn] (migrate! conn (first (last migrations/migrations)))) 33 | ([conn to-version] 34 | (let [current-version (current-db-version conn) 35 | todo (cond 36 | (< current-version to-version) 37 | (->> migrations/migrations 38 | (drop-while (fn [[migration-version migration]] 39 | (<= migration-version current-version))) 40 | (take-while (fn [[migration-version migration]] 41 | (<= migration-version to-version))) 42 | (map (juxt first (comp :up second)))) 43 | (> current-version to-version) 44 | (->> migrations/migrations 45 | reverse 46 | (drop-while (fn [[migration-version migration]] 47 | (< current-version migration-version))) 48 | (take-while (fn [[migration-version migration]] 49 | (< to-version migration-version))) 50 | (map (juxt first (comp :down second)))) 51 | :else nil)] 52 | (info "todo" current-version to-version todo) 53 | (doseq [[migration-version migration] todo] 54 | (debug "Run migration" migration-version) 55 | (try (migration conn) 56 | (update-current-version conn migration-version) 57 | (catch Exception e 58 | (error "Migration " migration-version " failed: " e (with-out-str (.printStackTrace e))) 59 | (throw e)))) 60 | (update-current-version conn to-version)))) 61 | 62 | (defrecord DevMigrator [database] 63 | component/Lifecycle 64 | (start [component] 65 | (info "Migrate database up") 66 | (let [conn (:connection database)] 67 | (migrate! conn) 68 | component)) 69 | (stop [component] 70 | (info "Migrate database down" component) 71 | (migrate! (:connection database) 0) 72 | component)) 73 | 74 | (defn dev-migrator [] 75 | (map->DevMigrator {})) 76 | 77 | 78 | ;; mult repeated here because of ASYNC-72 79 | (require '[clojure.core.async :refer [go-loop put! close? 85 | m (reify 86 | Mux 87 | (muxch* [_] ch) 88 | 89 | Mult 90 | (tap* [_ ch close?] 91 | (swap! cs assoc ch close?) nil) 92 | (untap* [_ ch] (swap! cs dissoc ch) nil) 93 | (untap-all* [_] (reset! cs {}) nil)) 94 | dchan (chan 1) 95 | dctr (atom nil) 96 | done (fn [_] (when (zero? (swap! dctr dec)) 97 | (put! dchan true)))] 98 | (go-loop [] 99 | (let [val (!! tx-reports-ch report)))) 131 | (catch Exception e 132 | (debug "TX-REPORT-TAKE exception: " e) 133 | (throw e)))) 134 | (assoc component 135 | :connection conn 136 | :tx-report-ch tx-reports-ch 137 | :listen listen))) 138 | 139 | (stop [component] 140 | (info ";; Stopping datomic database") 141 | (d/release (:connection component)) 142 | (async/close! (:tx-report-ch component)) 143 | component)) 144 | 145 | (defn database-datomic [db-connect-string] 146 | (map->DatabaseDatomic {:db-connect-string db-connect-string})) 147 | 148 | ;; shh! nothing to see here 149 | (deftype UnboundedBuffer [^LinkedList buf] 150 | impl/UnblockingBuffer 151 | impl/Buffer 152 | (full? [this] 153 | false) 154 | (remove! [this] 155 | (.removeLast buf)) 156 | (add! [this itm] 157 | (.addFirst buf itm)) 158 | clojure.lang.Counted 159 | (count [this] 160 | (.size buf))) 161 | 162 | (defn unbounded-buffer [] 163 | (UnboundedBuffer. (LinkedList.))) 164 | 165 | (defn close-and-drain! [c] 166 | (close! c) 167 | (async/into [] c)) 168 | 169 | (defn stream-from [conn listen from eid attr out] 170 | ;; out <- .. 171 | ;; this stream is the concatenation of db's at tx t from (db conn) 172 | ;; in 'catch-up' and from (listen! ..) in 'stream' 173 | ;; only tx's after 'from' are put into 'out' 174 | ;; 'catch-up' and 'stream' may overlap or have a 175 | ;; gap between them (not sure on the timing between (db conn) and 176 | ;; (listen! ..) notifications) 177 | ;; the number of tx's to get from (db conn) for 'catch-up' is bounded so it should 178 | ;; be safe to use an unbounded buffer for 'stream', while it 179 | ;; waits on the first part to finish 180 | (let [catch-up (chan) 181 | stream (chan (unbounded-buffer)) 182 | txrs (fn [db from to] 183 | (let [about-entity (d/entity db eid)] 184 | (for [tx (->> (q '{:find [?tx] 185 | :in [$ ?from-tx ?to-tx ?attr ?about] 186 | :where [[?about ?attr _ ?tx true] 187 | [(< ?from-tx ?tx)] 188 | [(<= ?tx ?to-tx)]]} 189 | (d/history db) (d/t->tx from) (d/t->tx to) 190 | attr 191 | (:db/id about-entity)) 192 | (map first) 193 | (sort <))] 194 | {:db-after (d/as-of db tx) 195 | :db-before :not-reconstructed 196 | :tx-data :not-reconstructed 197 | :tempids :not-reconstructed}))) 198 | from-tap (chan) 199 | relevant-tx (fn [{:keys [db-after tx-data] :as txr}] 200 | (let [game-e (d/entity db-after eid)] 201 | (seq (q '{:find [?e] 202 | :in [$ ?attr ?game-e] 203 | :where [[?game-e ?attr ?e _ true]]} 204 | tx-data (d/entid db-after attr) (:db/id game-e))))) 205 | _ (go (loop [] 206 | (when-let [txr (! stream txr) 209 | (close! from-tap))) 210 | (recur))) 211 | (close! stream)) 212 | _ (tap listen from-tap) 213 | res (go 214 | (try 215 | (loop [in catch-up 216 | last-t from 217 | at-gap false] 218 | (let [{:keys [db-after] :as txr} (! out txr) 226 | (recur (rest txs-in-gap)) 227 | false) 228 | true)) 229 | (recur in t false) 230 | (close-and-drain! from-tap)) 231 | ;; usual case 232 | (if (< last-t t) 233 | (if (>! out txr) 234 | (recur in t false) 235 | (close-and-drain! from-tap)) 236 | (recur in last-t false)))) 237 | ;; when in is closed switch from catch-up to stream 238 | (if (= in catch-up) 239 | (recur stream last-t true) 240 | ;; both catch-up and stream have closed 241 | (close! out)) 242 | ))) 243 | (catch Exception e 244 | (debug "Stream from loop " e) 245 | (throw e))))] 246 | (let [db (db conn) 247 | ts (txrs db from Long/MAX_VALUE)] 248 | (onto-chan catch-up ts)) 249 | res)) 250 | -------------------------------------------------------------------------------- /src/gin/system/ring.clj: -------------------------------------------------------------------------------- 1 | (ns gin.system.ring 2 | (:require [clojure.tools.logging :refer [info debug spy error]] 3 | [clojure.string :as string] 4 | [com.stuartsierra.component :as component] 5 | [ring.middleware.params :as params] 6 | [ring.middleware.keyword-params :as keyword-params] 7 | [gin.system.ring.anti-forgery :as anti-forgery] 8 | [ring.middleware.session :as session] 9 | [ring.middleware.session.cookie :as session-cookie] 10 | [ring.middleware.flash :as flash] 11 | [ring.middleware.resource :as resource] 12 | [ring.middleware.file-info :as file-info] 13 | [ring.middleware.content-type :as content-type] 14 | [ring.util.response :as response] 15 | [ring.util.time :as ring-time] 16 | [liberator.dev :as lib-dev])) 17 | 18 | (defn wrap-database [handler database] 19 | (fn [req] 20 | (-> req 21 | (assoc :database database) 22 | handler))) 23 | 24 | (defn wrap-database-conn [handler conn] 25 | (fn [req] 26 | (-> req 27 | (assoc :conn conn) 28 | handler))) 29 | 30 | (defn wrap-database-report-ch [handler report-ch] 31 | (fn [req] 32 | (-> req 33 | (assoc :listen report-ch) 34 | handler))) 35 | 36 | (defn wrap-emailer [handler emailer] 37 | (fn [req] 38 | (-> req 39 | (assoc :emailer emailer) 40 | handler))) 41 | 42 | (defrecord RingHandler [handler database emailer] 43 | component/Lifecycle 44 | (start [component] 45 | (info "Starting handler") 46 | (assoc component :app (-> handler 47 | (wrap-database-conn (:connection database)) 48 | (wrap-database-report-ch (:listen database)) 49 | (wrap-emailer emailer)))) 50 | (stop [component] 51 | (info "Stopping handler") 52 | component)) 53 | 54 | (defn ring-handler [handler] 55 | (map->RingHandler {:handler handler})) 56 | 57 | (defn wrap-redirect-trailing-slash [handler] 58 | (fn [{:keys [uri] :as req}] 59 | (if (and (.endsWith ^String uri "/") 60 | (not= uri "/")) 61 | (response/redirect (subs uri 0 (dec (count uri)))) 62 | (handler req)))) 63 | 64 | (defn wrap-accept-uri [handler] 65 | ;; when uri ends with .json / .edn then use that for accept header 66 | (fn [{:keys [uri] :as req}] 67 | (handler (if-let [[type chopped-uri] (cond 68 | (.endsWith ^String uri ".json") 69 | ["application/json" (subs uri 0 (- (count uri) 5))] 70 | (.endsWith ^String uri ".edn") 71 | ["application/edn" (subs uri 0 (- (count uri) 4))])] 72 | (spy (-> req 73 | (assoc-in [:headers "accept"] type) 74 | (assoc-in [:uri] chopped-uri))) 75 | req)))) 76 | 77 | ;; works with the redirect of *out* to repl 78 | (defn wrap-stacktrace-to-log [handler] 79 | (fn [req] 80 | (try (handler req) 81 | (catch Exception e 82 | (let [res (java.io.StringWriter.) 83 | pw (java.io.PrintWriter. res) 84 | st (.printStackTrace ^Throwable e pw) 85 | st-str (.toString res)] 86 | (error "Exception e: " e "str:" st-str)))))) 87 | 88 | (defn wrap-dev-cljs [handler match replace] 89 | (fn [req] 90 | (let [res (handler req)] 91 | (if (and (.startsWith (get-in res [:headers "Content-Type"] "") "text/html" ) 92 | (not (.contains ^String (str "" (get req :query-string)) "dev"))) 93 | (update-in res [:body] 94 | string/replace match replace) 95 | res)))) 96 | 97 | ;; h/t james reeves 98 | (defn wrap-swank [handler] 99 | (if-let [conn-var (try (find-var 'swank.core.connection/*current-connection*) 100 | (catch IllegalArgumentException e 101 | nil))] 102 | (let [conn (var-get conn-var)] 103 | (fn [request] 104 | (with-redefs-fn {(find-var 'swank.core.connection/*current-connection*) conn} 105 | (fn [] 106 | (handler request))))) 107 | handler)) 108 | 109 | (defn wrap-common [handler] 110 | (let [handler (-> handler 111 | anti-forgery/wrap-anti-forgery 112 | flash/wrap-flash 113 | ;; todo put this in db / split flash / account-session store? 114 | (session/wrap-session {:cookie-name "ccs" 115 | :store (session-cookie/cookie-store)}) 116 | keyword-params/wrap-keyword-params 117 | params/wrap-params 118 | (resource/wrap-resource "/") 119 | ;; add Cache-Control:public, max-age=31536000 to 120 | ;; files, to improve heroku performance, should be 121 | ;; in wrap-resource 122 | ((fn [handler] 123 | (fn wrap-cache-control [req] 124 | (let [res (handler req)] 125 | (if (and (= :get (:request-method req)) 126 | ;; InputStream when running from 127 | ;; heroku 128 | ;; does not apply to File when 129 | ;; running from localhost 130 | (instance? java.io.InputStream (:body res))) 131 | (-> res 132 | (assoc-in [:headers "Cache-Control"] "public, max-age=31536000") 133 | (assoc-in [:headers "Expires"] 134 | ;; 3 days in the future, 135 | ;; hacky hack 136 | (ring-time/format-date (-> (java.util.Date.) 137 | .getTime 138 | (+ (* 3 24 60 60 1000)) 139 | (java.util.Date.))))) 140 | res))))) 141 | file-info/wrap-file-info 142 | content-type/wrap-content-type 143 | wrap-accept-uri 144 | wrap-redirect-trailing-slash 145 | wrap-stacktrace-to-log)] 146 | (fn wrap-common [req] 147 | (handler req)))) 148 | 149 | (defn wrap-dev [handler] 150 | (let [handler (-> handler 151 | ;; have seen jetty crash on header too full with :header 152 | (lib-dev/wrap-trace :ui) 153 | wrap-swank)] 154 | (fn wrap-dev [req] 155 | (handler req)))) 156 | -------------------------------------------------------------------------------- /src/gin/system/ring/anti_forgery.clj: -------------------------------------------------------------------------------- 1 | (ns gin.system.ring.anti-forgery 2 | (:require [clojure.tools.logging :refer [info debug spy]])) 3 | 4 | ;; ring.middleware.anti-forgery does not use the session properly: 5 | ;; https://github.com/weavejester/ring-anti-forgery/issues/10 6 | ;; IMHO this commit is wrong: 7 | ;; https://github.com/weavejester/ring-anti-forgery/commit/e4e3d8b4a7d073bb33ef4e279c1b4773172ad0cb 8 | ;; test should verify session data put on response survives. Session 9 | ;; data on request is responsibility of whoever put it there 10 | 11 | (def anti-forgery-key "__anti-forgery-token") 12 | 13 | (defn wrap-anti-forgery [handler] 14 | (fn anti-forgery [req] 15 | (if (and (not (#{:head :get} (get req :request-method))) 16 | (let [session-token (get-in req [:session anti-forgery-key]) 17 | submitted-token (or (get-in req [:params (keyword anti-forgery-key)]) 18 | (get-in req [:headers "x-csrf-token"]))] 19 | (not (= session-token submitted-token)))) 20 | {:status 403 21 | :headers {"Content-Type" "text/html"} 22 | :body "

Invalid anti-forgery token

"} 23 | (let [token (or (get-in req [:session anti-forgery-key]) 24 | (str (java.util.UUID/randomUUID)))] 25 | ;; put in request so templates can inject the token, will 26 | ;; overwrite existing token with the same one 27 | (-> (handler (assoc-in req [:session anti-forgery-key] token)) 28 | (assoc-in [:session anti-forgery-key] token)))))) 29 | -------------------------------------------------------------------------------- /src/gin/system/ring/jetty_async_adapter.clj: -------------------------------------------------------------------------------- 1 | (ns gin.system.ring.jetty-async-adapter 2 | "Adapter for the Jetty webserver, with async HTTP." 3 | (:import (org.eclipse.jetty.server.handler AbstractHandler) 4 | (org.eclipse.jetty.server Server Request Response) 5 | (org.eclipse.jetty.server.nio SelectChannelConnector) 6 | (org.eclipse.jetty.continuation Continuation ContinuationSupport ContinuationListener) 7 | (org.eclipse.jetty.io EofException) 8 | (javax.servlet.http HttpServletRequest)) 9 | (:require [clojure.tools.logging :refer [info debug]] 10 | [ring.util.servlet :as servlet] 11 | [com.stuartsierra.component :as component] 12 | [clojure.core.async :refer [go AsyncJetty {:port port})) 122 | -------------------------------------------------------------------------------- /src/gin/system/server.clj: -------------------------------------------------------------------------------- 1 | (ns gin.system.server 2 | (:require [clojure.tools.logging :refer [info]] 3 | [com.stuartsierra.component :as component] 4 | [ring.adapter.jetty :as jetty])) 5 | 6 | 7 | (defrecord Jetty [port handler] 8 | component/Lifecycle 9 | (start [component] 10 | (info "Starting jetty on port: " port) 11 | (assoc component :jetty (jetty/run-jetty (:app handler) {:port port 12 | :join? false}))) 13 | (stop [component] 14 | (info "Stopping jetty") 15 | (when-let [jetty (:jetty component)] 16 | (when-not (.isStopped jetty) 17 | (.stop jetty))) 18 | component)) 19 | 20 | (defn jetty [port] 21 | (map->Jetty {:port port})) 22 | -------------------------------------------------------------------------------- /src/gin/util/helpers.clj: -------------------------------------------------------------------------------- 1 | (ns gin.util.helpers 2 | (:require [clojure.tools.logging :refer [spy debug]] 3 | [liberator.representation :as lib-rep] 4 | [clojure.string :as string] 5 | [clojure.walk :as walk])) 6 | 7 | (defn db [ctx] 8 | (get-in ctx [:request :database])) 9 | 10 | (defn conn [ctx] 11 | (get-in ctx [:request :conn])) 12 | 13 | (defn location-flash [uri flash] 14 | {:headers {"Location" uri} 15 | :status 303 16 | :flash flash}) 17 | 18 | (defn get? [ctx] 19 | (= :get (get-in ctx [:request :request-method]))) 20 | 21 | (defn put? [ctx] 22 | (= :put (get-in ctx [:request :request-method]))) 23 | 24 | (defn post? [ctx] 25 | (= :post (get-in ctx [:request :request-method]))) 26 | 27 | (defn edit? [ctx] 28 | (let [^String uri (get-in ctx [:request :uri])] 29 | (.contains uri "/edit"))) 30 | 31 | (defn home-uri [ctx] 32 | (let [request (get ctx :request) 33 | scheme (name (:scheme request)) 34 | ;; is this the url or the listening host? 35 | server-name (:server-name request) 36 | port (:server-port request)] 37 | (if-not (= port 80) 38 | (format "%s://%s:%s" 39 | scheme 40 | server-name 41 | port) 42 | (format "%s://%s" 43 | scheme 44 | server-name)))) 45 | 46 | (defn uri-parts [ctx] 47 | (let [request (get ctx :request) 48 | root (format "%s://%s:%s" 49 | ;; is this the url or the listening host? 50 | (name (:scheme request)) 51 | (:server-name request) 52 | (:server-port request)) 53 | [uri view] (let [uri (:uri request)] 54 | (if (.endsWith ^String uri "/edit") 55 | [(subs uri 0 (- (count uri) 5)) "/edit"] 56 | [uri nil]))] 57 | {:root root 58 | :uri (str root uri) 59 | :view view})) 60 | 61 | (defn with-home-uri [d ctx] 62 | (let [home-uri (home-uri ctx)] 63 | (walk/prewalk 64 | (fn [n] 65 | (if (and (map? n) 66 | (contains? n :uri) 67 | (not (.startsWith (:uri n) "http"))) 68 | (update-in n [:uri] (fn [old] 69 | (str home-uri old))) 70 | n)) 71 | d))) 72 | 73 | (def slug-characters 74 | (let [ab "abcdefghijklmnopqrstuvwxyz" 75 | nums "0123456789" 76 | syms "-_"] 77 | (-> #{} 78 | (into ab) 79 | (into (string/capitalize ab)) 80 | (into nums) 81 | (into syms)))) 82 | 83 | (defn slugify [name] 84 | (let [name (str name)] 85 | (-> name 86 | str 87 | string/lower-case 88 | (->> 89 | (filter slug-characters) 90 | (apply str))))) 91 | -------------------------------------------------------------------------------- /src/gin/util/layout.clj: -------------------------------------------------------------------------------- 1 | (ns gin.util.layout 2 | (:require [clojure.tools.logging :refer [info debug spy]] 3 | [clojure.pprint :as pprint] 4 | [liberator.representation :as lib-rep] 5 | [net.cgrand.enlive-html :as html] 6 | [gin.util.helpers :as h])) 7 | 8 | (defn maybe-error [msg] 9 | (if msg 10 | (html/do-> 11 | (html/add-class "has-error") 12 | (html/transform-content 13 | [:span.help-block] 14 | (html/do-> 15 | (html/remove-class "hidden") 16 | (html/content msg)))) 17 | identity)) 18 | 19 | (defn as-template-response [transform] 20 | (fn [d ctx] 21 | (let [status (get ctx :status)] 22 | (if-not (<= 200 status 299) 23 | (if (<= 300 status 399) 24 | (if-let [loc (get-in d [:headers "Location"])] 25 | (assoc-in d [:headers "Location"] 26 | (if (.startsWith loc "http") 27 | loc 28 | (str (h/home-uri ctx) loc))) 29 | d) 30 | d) 31 | (let [d (h/with-home-uri d ctx)] 32 | (if (= (get-in ctx [:representation :media-type]) "text/html") 33 | {:headers {"Content-Type" "text/html;charset=utf-8"} 34 | :body (transform (assoc ctx :data d))} 35 | (lib-rep/as-response d ctx))))))) 36 | 37 | (defn emit [root & clauses] 38 | (apply str 39 | (html/emit* 40 | (html/at* root 41 | (partition 2 clauses))))) 42 | 43 | (defn flash [ctx] 44 | (when-let [flash (get-in ctx [:request :flash])] 45 | (html/content flash))) 46 | -------------------------------------------------------------------------------- /test/gin/stream_test.clj: -------------------------------------------------------------------------------- 1 | (ns gin.stream-test 2 | (:require [clojure.tools.logging :refer [info debug spy]] 3 | [clojure.test :refer :all] 4 | [gin.core :refer :all] 5 | [gin.test-core :as tc] 6 | [gin.system.database-datomic :as dd] 7 | [clojure.core.async :refer [go ! chan timeout close!] :as async] 8 | [datomic.api :refer [db q] :as d])) 9 | 10 | (deftest event-stream-test 11 | (debug "start event-stream-test") 12 | (let [sys (tc/reuse-system) 13 | conn (get-in sys [:db :connection]) 14 | listen (get-in sys [:db :listen]) 15 | start (chan) 16 | start-out (async/into [] (async/take 100 start)) 17 | mid (chan) 18 | mid-out (async/into [] (async/take 100 mid)) 19 | sixty (chan) 20 | sixty-out (async/into [] (async/take 40 sixty)) 21 | end (chan) 22 | end-out (async/into [] (async/take 100 end)) 23 | setup-counter (chan) 24 | setup-counter-done (go (try 25 | (loop [] 26 | (let [tx-report ( (core/dev-gin-system test-config) 15 | (dissoc :server) 16 | component/start)))))) 17 | 18 | (defn reuse-handler [] 19 | (get-in (reuse-system) [:ring-handler :app])) 20 | 21 | (defn at? [res url] 22 | (test/is (= url (get-in res [:request :uri]))) 23 | res) 24 | 25 | ;; hot patch kerodon for (press ...) to work on input as well as 26 | ;; button 27 | (require 'kerodon.impl) 28 | (require '[net.cgrand.enlive-html :as enlive]) 29 | (alter-var-root #'kerodon.impl/form-and-submit 30 | (fn [f] 31 | (let [form-and-button (fn form-and-button-patch [form selector] 32 | (let [button (or (first 33 | (enlive/select form 34 | [[:input 35 | (enlive/attr= :type "submit") 36 | (if (string? selector) 37 | (enlive/attr= :value selector) 38 | selector)]])) 39 | (when-let [button (first 40 | (enlive/select form 41 | [[:button 42 | (enlive/attr= :type "submit") 43 | ]]))] 44 | (when (and (string? selector) 45 | (= (enlive/text button) selector)) 46 | button)))] 47 | [form button]))] 48 | (fn form-and-submit-patch [node selector] 49 | (if-let [found 50 | (first (filter (fn [[form button]] (not (nil? button))) 51 | (map (fn [form] (form-and-button form selector)) 52 | (enlive/select node [:form]))))] 53 | found 54 | (#'kerodon.impl/not-found "button" selector))) 55 | ))) 56 | --------------------------------------------------------------------------------