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    70
   :typing-speed-var     90
   :time-between-haikus  1000
   :haikus-text          [
                          "At the age old pond
                           A frog leaps into water
                           A deep resonance"
                          "Two tires fly. Two wail.
                           A bamboo grove, all chopped down
                           From it, warring songs"
                          "This is my rifle
                           There are many like it, but
                           This rifle is mine."
                          "Antenna searches
                           Retriever's nose in the wind
                           Ether's far secrets"
                          "Manila's perfume
                           Fanned by the coconut palms
                           The thighs of Glory"]})


;; 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)))))