Add demos for showcases

public/css/style.css

@@ -410,6 +410,13 @@ p {
     vertical-align: middle;
 }
 
+.controls-demos {
+    position: absolute;
+    right: 0;
+    top: 50%;
+    transform: translateY(-50%);
+}
+
 .set-background-btn {
     width: 15px;
     height: 15px;

src/bean/ui/demos.cljs

@@ -0,0 +1,62 @@
+(ns bean.ui.demos
+  (:require [cljs.reader :as reader]))
+
+(def file-name "demos.edn")
+(def db-name "bean-demos")
+(def object-store "bean-objects")
+(def demos-key "demos")
+
+(defn fetch-and-parse-edn [url]
+  (-> (js/fetch url)
+      (.then #(.text %))))
+
+(defn get-demos []
+  (js/Promise.
+   (fn [resolve _]
+     (let [request (.open js/indexedDB db-name 1)]
+       (set! (.-onsuccess request)
+             (fn [e]
+               (let [db (.. e -target -result)
+                     txn (.transaction db #js [object-store] "readonly")
+                     store (.objectStore txn object-store)
+                     get-request (.get store demos-key)]
+                 (set! (.-onsuccess get-request)
+                       #(resolve (reader/read-string (.. % -target -result)))))))))))
+
+(defn get-demo [demo-name]
+  (.then (get-demos)
+         #(get % demo-name)))
+
+(defn save-demos-locally [file]
+  (let [request (.open js/indexedDB db-name 1)]
+    (set! (.-onupgradeneeded request)
+          (fn [e]
+            (let [db (.. e -target -result)]
+              (when (not (.contains (.-objectStoreNames db) object-store))
+                (.createObjectStore db object-store)))))
+
+    (set! (.-onsuccess request)
+          (fn [e]
+            (let [db (.. e -target -result)
+                  txn (.transaction db #js [object-store] "readwrite")
+                  store (.objectStore txn object-store)]
+              (.put store file demos-key))))))
+
+(defn fetch-demos []
+  (.then (fetch-and-parse-edn (str "/" file-name))
+         #(save-demos-locally %)))
+
+(defn download-edn-as-file
+  "Takes data, a filename, and an optional MIME type, and triggers a file download."
+  [data]
+  (let [blob-data (str data)
+        blob (js/Blob. #js [blob-data] #js {:type "application/edn"})
+        url (.createObjectURL js/URL blob)
+        link (.createElement js/document "a")]
+    (set! (.-href link) url)
+    (set! (.-download link) file-name)
+    (.setAttribute link "download" file-name)
+    (.appendChild (.-body js/document) link)
+    (.click link)
+    (.removeChild (.-body js/document) link)
+    (.revokeObjectURL js/URL url)))

src/bean/ui/events.cljs

@@ -1,13 +1,14 @@
 (ns bean.ui.events
   (:require [bean.code :as code]
             [bean.code-errors :as code-errors]
-            [day8.re-frame.undo :as undo :refer [undoable]]
             [bean.frames :as frames]
             [bean.grid :as grid]
             [bean.ui.db :as db]
+            [bean.ui.demos :as demos]
             [bean.ui.paste :as paste]
             [bean.ui.provenance :as provenance]
             [bean.ui.util :as util]
+            [day8.re-frame.undo :as undo :refer [undoable]]
             [re-frame.core :as rf]
             [reagent.core :as rc]))
 
@@ -50,6 +51,57 @@
  (fn clear-area [db [_ area]]
    (update-in db [:sheet] #(grid/clear-area % area))))
 
+(rf/reg-event-fx
+ ::export-demos
+ (fn [{:keys [db]} [_]]
+   (.then
+    (demos/get-demos)
+    #(demos/download-edn-as-file
+      (if-let [current-demo-name (get-in db [:ui :current-demo-name])]
+        (assoc % current-demo-name (select-keys (:sheet db) [:grid
+                                                             :depgraph
+                                                             :frames
+                                                             :grid-dimensions
+                                                             :code-in-editor]))
+        %)))
+   {}))
+
+(rf/reg-event-fx
+ ::reset-demos
+ (undoable)
+ (fn [{:keys [db]} _]
+  ;; This is a bit of a hammer, should be able to reset better.
+   {:fx [[:dispatch [::initialize-db]]
+         [:dispatch [::load-demo-names (get-in db [:ui :demo-names])]]]}))
+
+(rf/reg-event-db
+ ::load-demo
+ (undoable)
+ (fn [db [_ demo-name demo]]
+   (-> db
+       (assoc-in [:ui :current-demo-name] demo-name)
+       (update-in [:sheet] merge demo))))
+
+(rf/reg-event-fx
+ ::select-demo
+ (fn [_ [_ demo-name]]
+   (.then (demos/get-demo demo-name)
+          #(rf/dispatch [::load-demo demo-name %]))
+   {}))
+
+(rf/reg-event-db
+ ::load-demo-names
+ (fn [db [_ demo-names]]
+   (assoc-in db [:ui :demo-names] demo-names)))
+
+(rf/reg-event-db
+ ::fetch-demos
+ (fn [db []]
+   (-> (demos/fetch-demos)
+       (.then #(demos/get-demos))
+       (.then #(rf/dispatch [::load-demo-names (keys %)])))
+   db))
+
 (rf/reg-event-fx
  ::handle-global-kbd
  (fn handle-global-kbd [{:keys [db]} [_ e]]
@@ -62,6 +114,9 @@
        (and (= (.-key e) "z") (or (.-ctrlKey e) (.-metaKey e)))
        (when (undo/undos?) (rf/dispatch [:undo]))
 
+       (and (= (.-key e) "e") (or (.-ctrlKey e) (.-metaKey e)))
+       {:fx [[:dispatch [::export-demos]]]}
+
        (or (.-ctrlKey e) (.-metaKey e)
            (= (.-key e) "Shift")
            (= (.-key e) "Escape")) nil

src/bean/ui/main.cljs

@@ -21,4 +21,5 @@
 
 (defn  ^:export main []
   (rf/dispatch-sync [::events/initialize-db])
+  (rf/dispatch [::events/fetch-demos])
   (main*))

src/bean/ui/subs.cljs

@@ -27,6 +27,16 @@
  (fn [db]
    (get-in db [:ui :grid :selection])))
 
+(re-frame/reg-sub
+ ::demo-names
+ (fn [db]
+   (get-in db [:ui :demo-names])))
+
+(re-frame/reg-sub
+ ::current-demo-name
+ (fn [db]
+   (get-in db [:ui :current-demo-name])))
+
 (re-frame/reg-sub
  ::route
  (fn [db]

src/bean/ui/views/code.cljs

@@ -34,4 +34,5 @@
         :content-editable ""
         :on-change #(rf/dispatch [::events/update-code (.-value (.-target %))])
         :spell-check false
+        :value (code/get-code @sheet)
         :default-value (code/get-code @sheet)}]]]))

src/bean/ui/views/root.cljs

@@ -18,4 +18,5 @@
 (defn routed []
   (let [route (rf/subscribe [::subs/route])]
     (case (:handler @route)
-      :root [root-page])))
+      :root [root-page]
+      [root-page])))

src/bean/ui/views/sheet.cljs

@@ -688,7 +688,7 @@
                 :worldHeight (:world-h styles/sizes)
                 :worldWidth (:world-w styles/sizes)})]
     (-> v
-        (.clampZoom #js {:maxHeight 10000 :maxWidth 10000})
+        (.clampZoom #js {:maxHeight 3000 :maxWidth 3000})
         (.drag #js {:clampWheel true :pressDrag false})
         (.wheel #js {:trackpadPinch true :wheelZoom false})
         (.clamp #js {:direction "all"}))))
@@ -843,7 +843,9 @@
 
 (defn controls []
   (let [selection @(rf/subscribe [::subs/selection])
-        sheet @(rf/subscribe [::subs/sheet])]
+        sheet @(rf/subscribe [::subs/sheet])
+        demo-names @(rf/subscribe [::subs/demo-names])
+        current-demo-name @(rf/subscribe [::subs/current-demo-name])]
     [:div {:class :controls-container}
      [:button {:class [:controls-btn
                        (when (grid/all-bold? sheet (area/area->addresses selection))
@@ -869,7 +871,20 @@
                   :on-mouse-down #(when selection
                                     (rf/dispatch [::events/set-cell-backgrounds
                                                   (area/area->addresses selection)
-                                                  color]))} ""])]]))
+                                                  color]))} ""])]
+     [:div {:class :controls-demos}
+      [:p {:style {:display :inline :margin-right "15px"}} "Demos"]
+      (for [demo demo-names]
+        [:button {:key demo
+                  :class [:controls-btn
+                          (when (= current-demo-name demo)
+                            :pressed)]
+                  :on-click #(rf/dispatch [::events/select-demo demo])}
+         demo])
+      [:button {:key "reset-demo"
+                :class [:controls-btn]
+                :on-click #(rf/dispatch [::events/reset-demos])}
+       "Reset"]]]))
 
 (defn sheet []
   [:div {:class :sheet-container}