From 433f9e5bc619a2818842191a6dda9eb7393eb53d Mon Sep 17 00:00:00 2001 From: Johannes Barre Date: Fri, 22 Dec 2023 23:04:10 +0100 Subject: [PATCH] Dark (Dunkelschalung) --- src/signals/demo/aspect.cljs | 23 ++++++++---- src/signals/hl.cljs | 10 +++--- src/signals/hv_light.cljs | 6 ++-- src/signals/hv_semaphore.cljs | 4 +-- src/signals/ks.cljs | 6 ++-- src/signals/spec.cljs | 2 +- test/signals/hv_test.cljs | 66 +++++++++++++++++++++++++++++++++++ test/signals/ks_test.cljs | 50 ++++++++++++++++++++++++++ 8 files changed, 147 insertions(+), 20 deletions(-) diff --git a/src/signals/demo/aspect.cljs b/src/signals/demo/aspect.cljs index 8de3b36..21138d2 100644 --- a/src/signals/demo/aspect.cljs +++ b/src/signals/demo/aspect.cljs @@ -41,11 +41,20 @@ "Stelle das Signal auf Halt und aktiviere das Zs7") :active? zs7-active? :type "danger"} "Zs7"))) - (when (and (:indicator? main-state) - (not= :hv-semaphore (:system state))) + (when (or (#{:ks :hv-light} (:system state)) + (and (:indicator? main-state) + (= :hl (:system state)))) ($ :div - ($ button {:on-click #(set-state! {:aspect :off}) - :title "Betrieblich abschalten" - :active? (= :off current-aspect) - :type "light"} - "Aus")))))) + ($ :div.btn-group + (when (:indicator? main-state) + ($ button {:on-click #(set-state! {:aspect :off}) + :title "Betrieblich abschalten" + :active? (= :off current-aspect) + :type "light"} + "Aus")) + (when (#{:ks :hv-light} (:system state)) + ($ button {:on-click #(set-state! {:aspect :dark}) + :title "Dunkelschaltung" + :active? (= :dark current-aspect) + :type "light"} + "Dunkel")))))))) diff --git a/src/signals/hl.cljs b/src/signals/hl.cljs index 18906ff..759ecd3 100644 --- a/src/signals/hl.cljs +++ b/src/signals/hl.cljs @@ -36,12 +36,14 @@ :as signal}] {:pre [(p/arg! ::spec/signal signal)] :post [(p/ret! ::lights %)]} - (let [main-aspect (if (and (= :off main-aspect*) - (not main-indicator?)) + (let [main-aspect (if (or (= :dark main-aspect*) + (and (= :off main-aspect*) + (not main-indicator?))) :stop main-aspect*) - distant-aspect (if (and (= :off distant-aspect*) - (not distant-indicator?)) + distant-aspect (if (or (= :dark distant-aspect*) + (and (= :off distant-aspect*) + (not distant-indicator?))) :stop distant-aspect*) distant? (= :distant signal-type) diff --git a/src/signals/hv_light.cljs b/src/signals/hv_light.cljs index f53924c..b270358 100644 --- a/src/signals/hv_light.cljs +++ b/src/signals/hv_light.cljs @@ -49,7 +49,7 @@ (= :off distant-aspect*)) :stop distant-aspect*)] {:main (when-not (= :distant signal-type) {:green (if (or (stop-aspect? main-aspect) - (= :off main-aspect)) :off :on) + (#{:off :dark} main-aspect)) :off :on) :red (if (stop-aspect? main-aspect) :on :off) :yellow (let [has-light? (some #{40} main-slow-speed-lights)] (cond @@ -86,7 +86,7 @@ {:top-green (cond (stop-aspect? main-aspect) :off (stop-aspect? distant-aspect) :off - (= :off distant-aspect) :off + (#{:off :dark} distant-aspect) :off :else :on) :top-yellow (cond (stop-aspect? main-aspect) :off @@ -98,7 +98,7 @@ :bottom-green (cond (stop-aspect? main-aspect) :off (stop-aspect? distant-aspect) :off - (= :off distant-aspect) :off + (#{:off :dark} distant-aspect) :off slow-speed? :off :else :on) :bottom-yellow (cond diff --git a/src/signals/hv_semaphore.cljs b/src/signals/hv_semaphore.cljs index 41ce009..a13fd7a 100644 --- a/src/signals/hv_semaphore.cljs +++ b/src/signals/hv_semaphore.cljs @@ -37,8 +37,8 @@ :as signal}] {:pre [(p/arg! ::spec/signal signal)] :post [(p/ret! ::arms %)]} - (let [main-aspect (if (= :off main-aspect*) :stop main-aspect*) - distant-aspect (if (= :off distant-aspect*) :stop distant-aspect*)] + (let [main-aspect (if (#{:off :dark} main-aspect*) :stop main-aspect*) + distant-aspect (if (#{:off :dark} distant-aspect*) :stop distant-aspect*)] {:main (when-not (= :distant signal-type) {:top-arm (if (stop-aspect? main-aspect) :horizontal :inclined) :lower-arm (cond diff --git a/src/signals/ks.cljs b/src/signals/ks.cljs index 018c14e..e1a43f5 100644 --- a/src/signals/ks.cljs +++ b/src/signals/ks.cljs @@ -60,14 +60,14 @@ :green (cond (or (stop-aspect? main-aspect) (stop-aspect? distant-aspect) - (= :off main-aspect) - (= :off distant-aspect)) :off + (#{:dark :off} main-aspect) + (#{:dark :off} distant-aspect)) :off (and distant-speed-limit zs3) :blinking :else :on) :yellow (cond (= :main signal-type) nil (or (stop-aspect? main-aspect) - (= :off main-aspect)) :off + (#{:dark :off} main-aspect)) :off (stop-aspect? distant-aspect) :on :else :off) :center-white (cond diff --git a/src/signals/spec.cljs b/src/signals/spec.cljs index e08e9c6..a60743d 100644 --- a/src/signals/spec.cljs +++ b/src/signals/spec.cljs @@ -3,7 +3,7 @@ [cljs.spec.alpha :as s])) ;; Aspects -(s/def ::aspect #{:stop :proceed :stop+zs1 :stop+zs7 :stop+sh1 :off}) +(s/def ::aspect #{:stop :proceed :stop+zs1 :stop+zs7 :stop+sh1 :off :dark}) (s/def ::speed-limit (s/nilable (s/and int? pos?))) ;; Configuration diff --git a/test/signals/hv_test.cljs b/test/signals/hv_test.cljs index 0afbe69..5001b92 100644 --- a/test/signals/hv_test.cljs +++ b/test/signals/hv_test.cljs @@ -363,6 +363,72 @@ :system :hv-semaphore}) lights-or-arms)))))) + (testing "dark" + (testing "semaphore" + (testing "distant shows vr0" + (is (= (merge no-hp semaphore-vr0) + (-> (signal/distant {:aspect :dark + :system :hv-semaphore}) + lights-or-arms)))) + + (testing "main shows hp0" + (is (= (merge semaphore-hp0 no-vr) + (-> (signal/main {:aspect :dark + :system :hv-semaphore}) + lights-or-arms)))) + + (testing "combination shows hp0" + (is (= (merge (add-to-main semaphore-hp0 {:lower-arm :vertical}) + semaphore-vr0) + (-> (signal/combination {:main {:aspect :dark + :slow-speed-lights [40]} + :distant {:aspect :stop} + :system :hv-semaphore}) + lights-or-arms))) + + (is (= (merge semaphore-hp0 semaphore-vr0) + (-> (signal/combination {:main {:aspect :stop} + :distant {:aspect :dark} + :system :hv-semaphore}) + lights-or-arms))))) + + (testing "light signal" + (testing "distant shows nothing" + (is (= (merge no-hp light-vr-off) + (-> (signal/distant {:aspect :dark + :system :hv-light}) + lights-or-arms)))) + + (testing "main shows nothing" + (is (= (merge (add-to-main light-hp0 {:red :off}) + no-vr) + (-> (signal/main {:aspect :dark + :system :hv-light}) + lights-or-arms)))) + + (testing "combination" + (testing "distant dark" + (is (= (merge light-hp0 light-vr-off) + (-> (signal/combination {:main {:aspect :stop} + :distant {:aspect :dark} + :system :hv-light}) + lights-or-arms)))) + + (testing "main dark" + (is (= (merge (add-to-main light-hp0 {:red :off}) + light-vr0) + (-> (signal/combination {:main {:aspect :dark} + :distant {:aspect :stop} + :system :hv-light}) + lights-or-arms))) + + (is (= (merge (add-to-main light-hp0 {:red :off}) + light-vr1) + (-> (signal/combination {:main {:aspect :dark} + :distant {:aspect :proceed} + :system :hv-light}) + lights-or-arms))))))) + (testing "slow-speed-lights" (testing "stop" (testing "distant shows vr0" diff --git a/test/signals/ks_test.cljs b/test/signals/ks_test.cljs index 9abc1df..7b22243 100644 --- a/test/signals/ks_test.cljs +++ b/test/signals/ks_test.cljs @@ -338,6 +338,56 @@ :system :ks}) ks/lights)))))) + (testing "dark" + (testing "distant shows nothing" + (is (= {:top-white nil + :red nil + :green :off + :yellow :off + :center-white nil + :zs7 nil + :bottom-white nil} + (-> (signal/distant {:aspect :dark + :system :ks}) + ks/lights)))) + + (testing "combination shows nothing" + (is (= {:top-white nil + :red :off + :green :off + :yellow :off + :center-white nil + :zs7 nil + :bottom-white nil} + (-> (signal/combination {:distant {:aspect :stop} + :main {:aspect :dark} + :system :ks}) + ks/lights))) + + (is (= {:top-white nil + :red :off + :green :off + :yellow :off + :center-white nil + :zs7 nil + :bottom-white nil} + (-> (signal/combination {:distant {:aspect :proceed} + :main {:aspect :dark} + :system :ks}) + ks/lights))) + + (testing "main shows nothing" + (is (= {:top-white nil + :red :off + :green :off + :yellow nil + :center-white nil + :zs7 nil + :bottom-white nil} + (-> (signal/main {:aspect :dark + :system :ks}) + ks/lights)))))) + (testing "shortened break path" (testing "stop" (testing "distant shows ks2 plus top white"