scoring working! and other stuff

resources/migrations/20250312151923-create-game.up.sql

@@ -1,8 +1,5 @@
 CREATE TABLE IF NOT EXISTS game (
-  id text PRIMARY KEY,
+  code text PRIMARY KEY,
-  code text UNIQUE,
-  display_session text NOT NULL,
-  control_session text,
   current_player integer,
-  active boolean not null
+  player_count integer NOT NULL
 );

resources/migrations/20250312151928-create-players.up.sql

@@ -5,5 +5,6 @@ CREATE TABLE IF NOT EXISTS player (
   name text NOT NULL,
   game_code text NOT NULL,
   play_order integer NOT NULL,
+  last_move integer,
   FOREIGN KEY (game_code) REFERENCES game(code)
 );

src/com/biffweb/my_project.clj

@@ -1,25 +1,19 @@
 (ns com.biffweb.my-project
   (:require
-   [migratus.core :as migratus]
+   [clojure.test :as test] ;; [clojure.tools.logging :as log]
-   [clojure.test :as test]
-   [ring.adapter.jetty9 :as jetty]
-   ;; [clojure.tools.logging :as log]
    [clojure.tools.namespace.repl :as tn-repl]
    [com.biffweb :as biff]
    [com.biffweb.my-project.app :as app]
    [com.biffweb.my-project.auth-module :as auth-module]
-   [rum.core :as rum]
-   [honey.sql :as sql]
    [com.biffweb.my-project.email :as email]
    [com.biffweb.my-project.home :as home]
    [com.biffweb.my-project.middleware :as mid]
    [com.biffweb.my-project.ui :as ui]
    [com.biffweb.my-project.worker :as worker]
-   [taoensso.telemere :as t]
+   [migratus.core :as migratus]
-   [taoensso.telemere.tools-logging :as tlog]
-   [taoensso.telemere.timbre :as log]
    [next.jdbc :as jdbc]
-   [nrepl.cmdline :as nrepl-cmd])
+   [nrepl.cmdline :as nrepl-cmd]
+   [taoensso.telemere.timbre :as log])
   (:gen-class))
 
 (def modules

src/com/biffweb/my_project/app.clj

@@ -1,9 +1,10 @@
 (ns com.biffweb.my-project.app
   (:require
-   [clojure.pprint :as pp]
    [clojure.string :as str]
+   [rum.core :as rum]
    [com.biffweb :as biff]
-   [com.biffweb.my-project.middleware :refer [wrap-session]]
+   [ring.adapter.jetty9 :as jetty]
+   [com.biffweb.my-project.middleware :refer [wrap-clean-up-param-vals]]
    [com.biffweb.my-project.settings :as settings]
    [com.biffweb.my-project.ui :as ui]
    [honey.sql :as sql]
@@ -24,25 +25,20 @@
 (defn error-style [s]
   [:h4.pico-color-red-500 s])
 
-(defn create-game [{:keys [example/ds session params] :as _ctx}]
+(defn create-game [{:keys [example/ds params]}]
   (let [players (map str/trim (-> params :players str/split-lines))]
     (if (> 2 (count players))
       (error-style "Need at least two players")
-      (let [id (-> session :id)
+      (let [code (game-code)
-            code (game-code)
             random-order? (= "on" (-> params :random-player-order))
             player-order (if random-order?
                            (shuffle (range 0 (count players)))
                            (range 0 (count players)))]
 
         (jdbc/execute! ds (sql/format {:insert-into :game
-                                       :values [{:id id
+                                       :values [{:code code
-                                                 :code code
-                                                 :display_session id
                                                  :current_player 0
-                                                 :active false}]
+                                                 :player_count (count players)}]}))
-                                       :on-conflict :id
-                                       :do-update-set [:code :display_session :active]}))
 
         (jdbc/execute! ds (sql/format {:insert-into :player
                                        :values (for [[p o] (partition 2 (interleave players player-order))]
@@ -53,14 +49,10 @@
                                                   :game_code code})}))
 
         {:status 200
-         :headers {"HX-Redirect" (str/join "/" ["" "game" code "display"])}
+         :headers {"HX-Redirect" (str/join "/" ["" "game" code "display"])}}))))
-         :session {:id id}}))))
 
-(defn display-game [{:keys [session params path-params]
+(defn player-summary [code ds]
-                     :example/keys [ds]
+  (let [players (into []
-                     :as _ctx}]
-  (let [code (:code path-params)
-        players (into []
                       (sort-by
                        :player/play_order
                        (jdbc/execute! ds (sql/format {:select :*
@@ -70,7 +62,47 @@
                                                 :from :game
                                                 :where [:= :code code]}))
         current-player (:game/current_player game)]
-    (println code game)
+    [:div#player-summary
+     {:hx-ext "ws,multi-swap"
+      :ws-connect (str "/game/" (:game/code game) "/connect")}
+     [:h4 "Game code is " (:game/code game)]
+     [:table
+      {:style {:table-layout :fixed}}
+      [:thead
+       [:tr
+        [:th {:scope "col"} "Player"]
+        [:th {:scope "col"} "Total Score"]]]
+
+      (into [:tbody]
+            (for [p players
+                  :let [{:player/keys [play_order game_score]} p]]
+
+              [:tr
+               [:th {:scope "row"} [:div
+                                    (:player/name p)
+                                    (when
+                                     (= (:player/play_order p) current-player)
+                                      [:span.pico-background-jade-600
+                                       {:style {:text-align "center"
+                                                :padding "4px 8px"
+                                                :width "8px"
+                                                :margin-left "20px"
+                                                :border-radius "5px"
+                                                :align-items "center"}}
+                                       "now playing"])]]
+
+               [:td  [:div
+                      {:id (str "player" "-" play_order "-game-score")}
+                      game_score]]]))]]))
+
+(defn display-game [{:keys [path-params]
+                     :example/keys [ds]
+                     :as _ctx}]
+  (let [code (:code path-params)
+
+        game (jdbc/execute-one! ds (sql/format {:select :*
+                                                :from :game
+                                                :where [:= :code code]}))]
 
     (if-not (and code game)
       {:status 200
@@ -83,69 +115,23 @@
          [:ul [:li (biff/form {:id "reset"
                                :hx-get "/reset"}
                               [:button.secondary "Reset"])]]]
-        [:h4 (:game/id game)]
 
-        (let [player-elements-swap-str  (->> players
+        (player-summary code ds)]))))
-                                             (map (fn [{:player/keys [id play_order]}]
-                                                    (str "#player" id "-" play_order)))
-                                             (str/join ",")
-                                             (str "multi:"))]
-          [:div
-           [:h4 "Game code is " (:game/code game)]
-           [:table
-            [:thead
-             [:tr
-              [:th {:scope "col"} "Player"]
-              [:th {:scope "col"} "Total Score"]]]
 
-            (into [:tbody
+(defn connect-ws [{:keys [path-params]
-                   {:hx-ext "ws,multi-swap"
+                   :example/keys [chat-clients]}]
-                    :ws-connect (str "/game/" (:game/code game) "/connect")
+  (let [code (:code path-params)]
-                    :hx-swap player-elements-swap-str}]
-                  (for [p players
-                        :let [{:player/keys [id play_order game_score]} p]]
-
-                    [:tr
-                     [:th {:scope "row"} [:div
-                                          (:player/name p)
-                                          (when (= (:player/play_order p) current-player)
-                                            [:span.pico-background-jade-600
-                                             {:style {:text-align "center"
-                                                      :padding "4px 8px"
-                                                      :width "8px"
-                                                      :margin-left "20px"
-                                                      :border-radius "5px"
-                                                      :align-items "center"}}
-                                             "now playing"])]]
-
-                     [:td  [:div
-                            {:id (str "player" id "-" play_order "-game-score")}
-                            game_score]]]))]])]))))
-
-(defn connect-ws [{:keys [session params]
-                   :example/keys [chat-clients ds] :as ctx}]
-  (let [{:game/keys [code]}
-        (jdbc/execute-one! ds (sql/format {:select :*
-                                           :from :game
-                                           :where [:= :id (:id session)]}))]
     {:status 101
      :headers {"upgrade" "websocket"
                "connection" "upgrade"}
      :ws {:on-connect (fn [ws]
                         (swap! chat-clients assoc code ws))
-          :on-close (fn [ws status-code reason]
+          :on-close (fn [ws _status-code _reason]
                       (swap! chat-clients
                              (fn [chat-clients]
-
                                (let [chat-clients (update chat-clients code disj ws)]
-
                                  (cond-> chat-clients
-
                                    (empty? (get chat-clients code)) (dissoc code))))))}}))
-(defn checkbox [n]
-  [:label
-   [:input {:type "checkbox", :name n}]
-   n])
 
 (def pig-position
   ["jowler"
@@ -155,46 +141,196 @@
    "no dot"
    "razorback"])
 
-(defn control-view [{:keys [session params path-params]
+(defn now-playing [current-player code ds]
+  (let [player (jdbc/execute-one! ds (sql/format {:select :*
+                                                  :from :player
+                                                  :where [:and
+                                                          [:= :game_code code]
+                                                          [:= :play_order current-player]]}))]
+    [:div#now-playing
+     [:h4 "Now playing: " [:b.pico-color-jade-600 (:player/name player)]]
+     [:h5 "Total score: " [:b.pico-color-jade-600 (:player/game_score player)]]
+     [:h5 "Score this round: " [:b.pico-color-jade-600 (:player/round_score player)]]
+
+     (biff/form {:id ::score-form
+                 :hx-post "/score-hand"
+                 :hx-target "#now-playing"}
+                [:input {:hidden true
+                         :name "game-code"
+                         :value code}]
+                [:input {:hidden true
+                         :name ::round-option
+                         :id ::round-option
+                         :value ::score-pigs}]
+                [:div;; .grid
+                 {:id ::pig-options
+                  :style {:display :flex
+                          :flex-direction :row}}
+
+                 (into [:fieldset
+                        {:flex "50%"}
+                        [:legend "Pig 1:"]]
+
+                       (for [p pig-position]
+                         [:label
+                          [:input {:type :radio
+                                   :value p
+                                   :name ::pig-1}
+
+                           p]]))
+
+                 (into [:fieldset
+                        {:flex "50%"}
+                        [:legend "Pig 2:"]]
+
+                       (for [p pig-position]
+                         [:label
+                          [:input {:type :radio
+                                   :value p
+                                   :name ::pig-2}
+
+                           p]]))]
+
+                [:fieldset;; .grid
+                 [:button {:type "submit"
+                           :_ "on click set #round-option.value to 'score-pigs'"} "Score pigs"]
+                 [:button.secondary {:type "submit"
+                                     :_ "on click set #round-option.value to 'pass-the-pigs'"} "Pass the pigs"]
+                 [:button.contrast {:type "submit"
+                                    :_ "on click set #round-option.value to 'oinker'"} "Pigs are touching! (lose all points)"]
+                 [:button.pico-background-red-500 {:type "submit"
+                                                   :_ "on click set #round-option.value to 'undo'"
+                                                   :disabled (= 0 (:player/round_score player))} "undo last move"]])]))
+
+(defn control-view [{:keys [path-params]
                      :example/keys [ds]
                      :as _ctx}]
 
   (let [code (:code path-params)
-        players (into []
+
-                      (sort-by
-                       :player/play_order
-                       (jdbc/execute! ds (sql/format {:select :*
-                                                      :from :player
-                                                      :where [:= :game_code code]}))))
         game (jdbc/execute-one! ds (sql/format {:select :*
                                                 :from :game
                                                 :where [:= :code code]}))
         current-player (:game/current_player game)]
+
     (ui/page {}
              [:div [:nav
                     [:ul [:li [:strong (str "Score the pigs - " code)]]]
                     [:ul [:li (biff/form {:id "reset"
                                           :hx-get "/reset"}
                                          [:button.secondary "Reset"])]]]
-              [:div.grid
+              (now-playing current-player code ds)])))
-               [:h4 "Now playing: " [:b.pico-color-jade-600 (-> (get players current-player) :player/name)]]]
 
-              (biff/form {:id ::score-form}
+(def double-score
-                         [:table
+  {:jowler 60
-                          [:thead
+   :snouter 40
-                           [:tr
+   :trotter 20
-                            [:th {:scope "col"} "Pig 1"]
+   :razorback 20
-                            [:th {:scope "col"} "Pig 2"]]]
+   :black-dot 1
+   :no-dot 1})
 
-                          [:tbody
+(def single-score
-                           (for [p pig-position]
+  {:jowler 15
-                             [:tr
+   :snouter 10
-                              [:td
+   :trotter 5
-                               (checkbox p)]
+   :razorback 5
+   :black-dot 0
+   :no-dot 0})
 
-                              [:td (checkbox p)]])]]
+(defn score-hand [{:keys [params]
-                         [:button {:type "submit"} "Score pigs"]
+                   :example/keys [ds chat-clients]}]
-                         [:button.contrast {:type "submit"} "Pigs are touching! (Lose all points)"])])))
+  (let [{:keys [game-code round-option]} params
+
+        game (jdbc/execute-one! ds (sql/format {:select :*
+                                                :from :game
+                                                :where [:= :code game-code]}))
+
+        current-player (:game/current_player game)
+
+        {:keys [pig-1 pig-2]} params
+        score (cond
+                (= pig-1 pig-2)
+                (get double-score pig-1)
+
+                (= #{:black-dot :no-dot} (set [pig-1 pig-2]))
+                ::pig-out
+
+                :else
+                (+ (single-score pig-1) (single-score pig-2)))
+
+        next-player (mod (inc current-player) (:game/player_count game))
+        next-player-query (sql/format
+                           {:update :game
+                            :set {:current_player next-player}
+                            :where [:= :code game-code]})
+        player-round-score (fn []
+                             (:player/round_score
+                              (jdbc/execute-one! ds (sql/format {:select :round_score
+                                                                 :from :player
+                                                                 :where [:and
+                                                                         [:= :game_code game-code]
+                                                                         [:= :play_order current-player]]}))))
+        update-display-table (delay (jetty/send! (get @chat-clients game-code)
+                                                 (rum/render-static-markup
+                                                  (player-summary game-code ds))))]
+
+    (cond
+      (= score ::pig-out)
+      (do
+        (jdbc/with-transaction [tx ds]
+          (jdbc/execute! tx (sql/format
+                             {:update :player
+                              :set {:round_score 0}
+                              :where [:and
+                                      [:= :game_code game-code]
+                                      [:= :play_order current-player]]}))
+          (jdbc/execute! tx next-player-query))
+        @update-display-table
+        (now-playing next-player game-code ds))
+
+      (= round-option :pass-the-pigs)
+      (if (zero? (player-round-score))
+        {:status 200
+         :headers {"HX-Retarget" (str "#" (name ::pig-options))
+                   "HX-Reswap" "afterend"}
+         :body
+         (rum/render-static-markup (error-style "Can't pass the pigs without playing!"))}
+        (do
+          (jdbc/with-transaction [tx ds]
+            (jdbc/execute! tx (sql/format
+                               {:update :player
+                                :set {:game_score :round_score
+                                      :round_score 0}}))
+            (jdbc/execute! tx next-player-query))
+          @update-display-table
+          (now-playing next-player game-code ds)))
+
+      (= round-option :oinker)
+      (do
+        (jdbc/with-transaction [tx ds]
+          (jdbc/execute! tx (sql/format
+                             {:update :player
+                              :set {:game_score 0
+                                    :round_score 0}}))
+          (jdbc/execute! tx next-player-query))
+        @update-display-table
+        (now-playing next-player game-code ds))
+
+      (= round-option :score-pigs)
+      (if (every? nil? [pig-1 pig-2])
+        {:status 200
+         :headers {"HX-Retarget" (str "#" (name ::pig-options))
+                   "HX-Reswap" "afterend"}
+         :body
+         (rum/render-static-markup (error-style "Need some pigs to score some pigs!"))}
+
+        (do (jdbc/execute! ds (sql/format
+                               {:update :player
+                                :set {:round_score [:+ :round_score score]}
+                                :where [:and
+                                        [:= :game_code game-code]
+                                        [:= :play_order current-player]]}))
+            (now-playing current-player game-code ds))))))
 
 (def game-code-input-attrs
   {:name "game-code",
@@ -204,7 +340,7 @@
    :type "text"})
 
 (defn route-to-game-view
-  [{:keys [session params]
+  [{:keys [params]
     :example/keys [ds]
     :as _ctx}]
   (let [code (:game-code params)
@@ -214,20 +350,15 @@
       (not (and code @game))
       (error-style "Couldn't find that game.")
 
-      (= view-type "show-scoreboard")
+      (= view-type :show-scoreboard)
       {:status 200
        :headers {"HX-Redirect" (str/join "/" ["/game" code "display"])}}
 
-      (= view-type "show-game-remote")
+      (= view-type :show-game-remote)
       {:status 200
        :headers {"HX-Redirect" (str/join "/" ["/game" code "control"])}})))
 
-(defn app [{:keys [session params]
+(defn app [_ctx]
-            :example/keys [ds]
-            :as _ctx}]
-  (pp/pprint session)
-  (let [id (:id session)]
-
   (ui/page
    {}
    [:div
@@ -236,7 +367,6 @@
      [:ul [:li (biff/form {:id "reset"
                            :hx-get "/reset"}
                           [:button.secondary "Reset"])]]]
-      [:h4 id]
 
     [:section
      [:button {:_ "on click toggle the *display of #new-game-form"} "New game"]]
@@ -283,7 +413,7 @@
         :value ::show-game-remote}]
       [:input game-code-input-attrs]
 
-        [:input.secondary {:type :submit :value "Control an existing game"}]])])))
+      [:input.secondary {:type :submit :value "Control an existing game"}]])]))
 
 (def about-page
   (ui/page
@@ -298,7 +428,7 @@
 
 (def module
   {:static {"/about/" about-page}
-   :routes ["/" {:middleware [wrap-session]}
+   :routes ["/" {:middleware [wrap-clean-up-param-vals]}
             ["" {:get app}]
             ["game/"
              ["create" {:post create-game}]
@@ -307,5 +437,6 @@
               ["/display" {:get display-game}]
               ["/control" {:get control-view}]
               ["/connect" {:get connect-ws}]]]
+            ["score-hand" {:post score-hand}]
             ["reset" {:get reset}]]
    :api-routes [["/api/echo" {:post echo}]]})

src/com/biffweb/my_project/middleware.clj

@@ -1,36 +1,24 @@
 (ns com.biffweb.my-project.middleware
-  (:require [com.biffweb :as biff]
+  (:require
+   [camel-snake-kebab.core :as csk]
+   [clojure.pprint :as pp]
+   [clojure.string :as str]
+   [com.biffweb :as biff]
    [muuntaja.middleware :as muuntaja]
-            [org.sqids.clojure :as sqids]
    [ring.middleware.anti-forgery :as csrf]
-            [ring.middleware.defaults :as rd]
+   [ring.middleware.defaults :as rd]))
-            [clojure.string :as str]))
 
-(defn wrap-redirect-signed-in [handler]
+(defn wrap-clean-up-param-vals [handler]
-  (fn [{:keys [session] :as ctx}]
+  (fn [req]
-    (if (some? (:uid session))
+    (pp/pprint (req :params))
-      {:status 303
+    (let [unknown-params (-> req
-       :headers {"location" "/app"}}
+                             :params
-      (handler ctx))))
+                             (dissoc :__anti-forgery-token :game-code :players)
-
+                             (update-vals csk/->kebab-case-keyword))
-(defn wrap-signed-in [handler]
+          req (-> req
-  (fn [{:keys [session] :as ctx}]
+                  (update-in [:path-params :code] #(when % (str/lower-case %)))
-    (if (some? (:uid session))
+                  (update :params merge unknown-params))]
-      (handler ctx)
+      (handler req))))
-      {:status 303
-       :headers {"location" "/signin?error=not-signed-in"}})))
-
-(defn wrap-session [handler]
-  (fn [{:keys [session] :as req}]
-    (let [req (update-in req [:path-params :code] #(when % (str/lower-case %)))]
-      (if (some? (:id session))
-        (do
-          (println "found session id" (:id session))
-          (handler req))
-
-        (let [new-id (random-uuid)]
-          (println "no session id, adding new one:" new-id)
-          (handler (assoc-in req [:session :id]  new-id)))))))
 
 ;; Stick this function somewhere in your middleware stack below if you want to
 ;; inspect what things look like before/after certain middleware fns run.
@@ -74,6 +62,5 @@
       biff/wrap-resource
       biff/wrap-internal-error
       biff/wrap-ssl
-
       ;; biff/wrap-log-requests
       ))