haiku.cljs

(ns almost.haiku
  (:require [inky.sketch :as sketch]
            [dommy.core :as dom]
            [clojure.string :as str]
            [cljs.core.async :as async
             :refer [<! >! put! chan timeout]])
  (:require-macros [dommy.macros :refer [sel1 node]]
                   [cljs.core.async.macros :refer [go]]))

(enable-console-print!)


;; Config

(def config
  {:body-bg              (str "http://psrdownloads.s3.amazonaws.com/textures"
                              "/flypaper/hires/AppleBlushtaster.jpg")
   :typing-speed-base    30
   :typing-speed-var     70
   :time-between-haikus  3000
   :haikus-text          ["this is three
                           this is significantly more than seven
                           I'm not very good at this"]})


;; Logic

(defn sylables-in-word
  "Heuristic-based sylable counter, questionable accuracy."
  [word]
  (when word
    (let [overrides {"searches" 2}
          word (-> word
                   str/lower-case
                   (str/replace #"[^a-z]" ""))]
      (cond
        (get overrides word) (get overrides word)
        (< (count word) 4) 1
        :else (->> (-> word
                       (str/replace #"(?:[^laeiouy]es|ed|[^laeiouy]e)$" "")
                       (str/replace #"^y" ""))
                   (re-seq #"[aeiouy]{1,2}")
                   count)))))

(defn count-sylables [words]
  (->> (str/split words #"\s+")
       (map sylables-in-word)
       (reduce +)))

(defn type-text [$line text]
  (let [done-chan (chan)
        $input (sel1 $line :input)]
    (go
      (loop [chars text]
        (when-not (or (empty? chars)
                      (not @!autotype))
          (dom/set-value! $input
            (str (dom/value $input) (first chars)))
          (dom/fire! $input :input)
          (<! (timeout (+ (config :typing-speed-base)
                         (rand (config :typing-speed-var)))))
          (recur (rest chars))))
      (put! done-chan true))
    done-chan))


;; Templates

(defn $line [target-syl]
  (let [$input (node [:input {:type "text"}])
        $syl (node [:span.sylables "0 syl"])
        $el (node [:div.input-row $syl $input])
        update (fn [_]
                 (let [num-syl (-> $input dom/value count-sylables)]
                   (dom/set-text! $syl
                     (str num-syl " syl"))
                   (if (= num-syl target-syl)
                     (dom/add-class! $syl :valid)
                     (dom/remove-class! $syl :valid))))]
    (dom/listen! $el :input update)
    (update)
    $el))


;; State

(def !haikus (atom (cycle (config :haikus-text))))

(def !autotype (atom true))

(def $lines (map $line [5 7 5]))


;; Sketch

(sketch/page-style!
  ["html, body, .sketch" {:width "100%"
                          :height "100%"
                          :padding "0"
                          :margin "0"
                          :font-family "cursive"}
   ".sketch" {:background-image (str "url('" (config :body-bg) "')")
              :background-size "cover"
              :display "table"}
   ".input-row span, .input-row input" {:display "inline-block"
                                        :font-size "30px"
                                        :line-height "1em"}
   ".input-row span" {:width "80px"
                      :margin-right "20px"
                      :text-align "right"}
   "input" {:padding "20px 10px"
            :background-color "transparent"
            :margin "10px 0"
            :border "none"
            :outline "none"
            :width "480px"
            :font-family "cursive"
            :text-align "center"}
   "input:hover" {:background-color "rgba(255,255,255,0.1)"}
   ".content-wrap" {:vertical-align "middle"
                    :display "table-cell"}
   ".words" {:width "600px"
             :margin "0 auto"}
   ".sylables.valid" {:color "green"}])

(sketch/content!
  (node
    [:div.content-wrap
     [:div.words
      $lines]]))

(doseq [$line $lines]
  (let [$input (sel1 $line :input)]
    (dom/listen! $input :focus
      (fn []
        (when @!autotype
          (reset! !autotype false)
          (doseq [$line $lines]
            (let [$input (sel1 $line :input)]
              (dom/set-value! $input "")
              (dom/fire! $input :input))))))))


;; Auto-Type Loop

(defn clear-line [$line]
  (let [$input (sel1 $line :input)]
    (dom/set-value! $input "")
    (dom/fire! $input :input)))

(defn clear-lines [$lines]
  (doseq [$line $lines] (clear-line $line)))

(go
  (while @!autotype
    (let [haiku (first @!haikus)
          lines (map str/trim (-> haiku
                                  str/trim
                                  (str/split #"\n+")))]
      (swap! !haikus rest)
      (clear-lines $lines)
      (doseq [[$line line] (map #(vector %1 %2) $lines lines)]
        (clear-line $line)
        (<! (type-text $line line))
        (<! (timeout 500))))
    (<! (timeout (config :time-between-haikus)))))