(ns unheard.cycles)

(defn l
  "List combinator: subdivides time evenly among children, advancing in lockstep.

  Each child receives an equal portion of the parent's time duration.
  All children advance synchronously through their patterns.

  Equivalent to TidalCycles/Strudel 'fastcat' operator.

  Example:
    (l :a :b :c) with cycle-length 1
    => [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c]]"
  [& args]
  {:v (vec args) :type :l})

(defn f
  "Fork combinator: cycles through children sequentially across iterations.

  Each iteration selects one child in round-robin fashion.
  The selected child gets the full time duration for that iteration.
  Forks extend the total pattern duration by (num-children × child-cycles).

  Equivalent to TidalCycles/Strudel 'slowcat' operator.

  Example:
    (f :a :b :c) with cycle-length 1
    => [[0 1 :a] [1 2 :b] [2 3 :c]]"
  [& args]
  {:v (vec args) :type :f})

(defn p
  "Parallel combinator: all children occur simultaneously.

  Each child gets the full time duration of the parent.
  All children are active at the same time, producing overlapping intervals.

  Equivalent to TidalCycles/Strudel 'stack' operator.

  Example:
    (p :a :b :c) with cycle-length 1
    => [[0 1 :a] [0 1 :b] [0 1 :c]]"
  [& args]
  {:v (vec args) :type :p})

(defn rate
  "Rate modifier: scales the speed of a pattern by a given ratio.

  A ratio > 1 speeds up the pattern (fits more cycles in the same time).
  A ratio < 1 slows down the pattern (stretches it over more time).
  A ratio of 2 means the pattern runs twice as fast.
  A ratio of 1/2 means the pattern runs at half speed.

  Equivalent to TidalCycles/Strudel '*' and '/' operators.

  Examples:
    (rate 2 (l :a :b)) - runs the list twice as fast
    (rate 1/2 (f :a :b :c)) - runs the fork at half speed"
  [ratio node]
  {:v node :rate ratio :type :rate})

(defn elongate
  "Elongation modifier: gives an element temporal weight.

  When used within a list, an elongated element takes up proportionally
  more time than other elements based on its weight. Elements without
  elongation have a default weight of 1.

  Equivalent to TidalCycles/Strudel '@' operator.

  Examples:
    (l (elongate 2 :a) :b :c) - :a takes twice as long as :b or :c
    (l :x (elongate 3 :y) :z) - :y takes 3x as long as :x or :z"
  [weight node]
  {:v node :weight weight :type :elongate})

(defn scalar? [x]
  (not (and (map? x) (:type x))))

(defn get-weight
  "Returns the weight of a node. Elongated nodes have their specified weight,
  all other nodes have a default weight of 1."
  [node]
  (if (and (map? node) (= :elongate (:type node)))
    (:weight node)
    1))

(defn gcd [a b]
  (if (zero? b) a (recur b (mod a b))))

(defn lcm [a b]
  (/ (* a b) (gcd a b)))

(defn compute-cycle [node]
  (cond
    (scalar? node) 1

    (= :f (:type node))
    (let [children (:v node)
          n (count children)]
      (* n (reduce lcm 1 (map compute-cycle children))))

    (= :l (:type node))
    (let [children (:v node)]
      (reduce lcm 1 (map compute-cycle children)))

    (= :p (:type node))
    (let [children (:v node)]
      (reduce lcm 1 (map compute-cycle children)))

    (= :rate (:type node))
    ;; Rate doesn't change the cycle count - it just compresses/expands time
    ;; The parent sees the same cycle count as the child
    (compute-cycle (:v node))

    (= :elongate (:type node))
    ;; Elongation doesn't change the cycle count - it just affects time division
    ;; The parent sees the same cycle count as the child
    (compute-cycle (:v node))))

(defn unfold-node [node start end iteration]
  (let [duration (- end start)]
    (cond
      (scalar? node)
      [[start end node]]

      (= :l (:type node))
      (let [children (:v node)
            weights (map get-weight children)
            total-weight (reduce + weights)
            weight-offsets (reductions + 0 weights)]
        (mapcat (fn [i child weight]
                  (let [child-start (+ start (* duration (/ (nth weight-offsets i) total-weight)))
                        child-end (+ start (* duration (/ (nth weight-offsets (inc i)) total-weight)))]
                    (unfold-node child child-start child-end iteration)))
                (range (count children))
                children
                weights))

      (= :f (:type node))
      (let [children (:v node)
            n (count children)
            child-idx (mod iteration n)]
        (unfold-node (nth children child-idx) start end (quot iteration n)))

      (= :p (:type node))
      (let [children (:v node)]
        (mapcat (fn [child]
                  (unfold-node child start end iteration))
                children))

      (= :rate (:type node))
      (let [ratio (:rate node)
            child (:v node)
            child-base-cycle (compute-cycle child)
            ;; rate scales how many times the base pattern repeats
            ;; rate 2 means fit 2x cycles in this span
            ;; rate 1/2 means fit 0.5x cycles (half a cycle)
            num-child-cycles (* ratio child-base-cycle)
            child-cycle-duration (/ duration num-child-cycles)]
        (vec (mapcat (fn [i]
                       (unfold-node child
                                    (+ start (* i child-cycle-duration))
                                    (+ start (* (inc i) child-cycle-duration))
                                    i))
                     (range num-child-cycles))))

      (= :elongate (:type node))
      ;; Elongate just wraps a child - unfold the child with the same time bounds
      (unfold-node (:v node) start end iteration))))

(defn unfold
  "Unfolds a pattern tree into concrete time intervals.

  Takes a cycle-length and a pattern node (scalar, list, or fork),
  and returns a vector of [start end value] intervals representing
  when each scalar value is active.

  Args:
    cycle-length - Duration of each iteration (can be any number)
    node         - Pattern tree built from scalars, (l ...), and (f ...)

  Returns:
    Vector of [start end value] tuples, where start and end are rational
    numbers representing time positions.

  The total duration of the result is (* cycle-length (compute-cycle node)).

  Examples:
    (unfold 1 :a)
    => [[0 1 :a]]

    (unfold 1 (l :a :b))
    => [[0 1/2 :a] [1/2 1 :b]]

    (unfold 1 (f :a :b))
    => [[0 1 :a] [1 2 :b]]"
  [cycle-length node]
  (let [cycle-count (compute-cycle node)]
    (vec (mapcat (fn [i]
                   (unfold-node node
                                (* i cycle-length)
                                (* (inc i) cycle-length)
                                i))
                 (range cycle-count)))))