<|start_filename|>src/pp_grid/api.cljc<|end_filename|>
(ns pp-grid.api
  #?(:bb
     (:require [pp-grid.core]
               [pp-grid.ansi-escape-code]
               [pp-grid.layout]
               [pp-grid.object])
     :clj
     (:require [potemkin :refer [import-vars]]

               [pp-grid.core]
               [pp-grid.ansi-escape-code]
               [pp-grid.layout]
               [pp-grid.object])))

#?(:bb
   (do
     (defmacro import-public-vars [ns]
       `(do ~@(for [[n# v#] (map (partial take 2) (ns-publics ns))]
                (let [meta# (meta v#)
                      doc# (:doc meta#)]
                  (if (nil? doc#)
                    `(def ~n# ~(symbol (str ns "/" n#)))
                    `(def ~n# ~doc# ~(symbol (str ns "/" n#))))))))

     (import-public-vars pp-grid.core)
     (import-public-vars pp-grid.object)
     (import-public-vars pp-grid.layout)
     (import-public-vars pp-grid.ansi-escape-code))

   :clj
   (import-vars
    [pp-grid.core

     add
     empty-grid
     grid?
     height
     render
     render-grid
     subtract
     update-ranges
     width

     tf-hflip
     tf-project
     tf-rotate
     tf-rotate-90-degrees
     tf-scale
     tf-shear
     tf-translate
     tf-transpose
     tf-vflip
     transform

     ++
     --]

    [pp-grid.layout

     valign
     halign
     vspacer
     hspacer
     pull
     spacer

     ===
     ||]

    [pp-grid.object

     arrow-down
     arrow-left
     arrow-left-right
     arrow-ne
     arrow-nw
     arrow-right
     arrow-se
     arrow-sw
     arrow-up
     arrow-up-down
     box
     box0
     box1
     box2
     box3
     box4
     box5
     chart-bar
     chart-xy
     decorate
     fill
     hfill
     hline
     matrix
     paragraph
     table
     table*
     table0
     table1
     table2
     table3
     text
     tree
     vfill
     vline]

    [pp-grid.ansi-escape-code

     ESCAPE-CODE-BOLD
     ESCAPE-CODE-UNDERLINE
     ESCAPE-CODE-REVERSED

     ESCAPE-CODE-BLACK
     ESCAPE-CODE-BLUE
     ESCAPE-CODE-CYAN
     ESCAPE-CODE-GREEN
     ESCAPE-CODE-MAGENTA
     ESCAPE-CODE-RED
     ESCAPE-CODE-WHITE
     ESCAPE-CODE-YELLOW

     ESCAPE-CODE-BRIGHT-BLACK
     ESCAPE-CODE-BRIGHT-BLUE
     ESCAPE-CODE-BRIGHT-CYAN
     ESCAPE-CODE-BRIGHT-GREEN
     ESCAPE-CODE-BRIGHT-MAGENTA
     ESCAPE-CODE-BRIGHT-RED
     ESCAPE-CODE-BRIGHT-WHITE
     ESCAPE-CODE-BRIGHT-YELLOW

     ESCAPE-CODE-BACKGROUND-BLACK
     ESCAPE-CODE-BACKGROUND-BLUE
     ESCAPE-CODE-BACKGROUND-CYAN
     ESCAPE-CODE-BACKGROUND-GREEN
     ESCAPE-CODE-BACKGROUND-MAGENTA
     ESCAPE-CODE-BACKGROUND-RED
     ESCAPE-CODE-BACKGROUND-WHITE
     ESCAPE-CODE-BACKGROUND-YELLOW

     ESCAPE-CODE-BACKGROUND-BRIGHT-BLACK
     ESCAPE-CODE-BACKGROUND-BRIGHT-BLUE
     ESCAPE-CODE-BACKGROUND-BRIGHT-CYAN
     ESCAPE-CODE-BACKGROUND-BRIGHT-GREEN
     ESCAPE-CODE-BACKGROUND-BRIGHT-MAGENTA
     ESCAPE-CODE-BACKGROUND-BRIGHT-RED
     ESCAPE-CODE-BACKGROUND-BRIGHT-WHITE
     ESCAPE-CODE-BACKGROUND-BRIGHT-YELLOW

     ESCAPE-CODE-RESET]))


<|start_filename|>dev/pp_grid/repl.clj<|end_filename|>
(ns pp-grid.repl
  #_{:clj-kondo/ignore [:unused-namespace]}
  (:require [clojure.string :as s]
            [clojure.java.io :as io]
            [clojure.pprint :as pp]

            [clojure.java.shell :as shell]

            [criterium.core :as criterium]

            [pp-grid.api :as g]
            [pp-grid.examples :as e]))


<|start_filename|>test/pp_grid/api_test.clj<|end_filename|>
(ns pp-grid.api-test
  (:require [clojure.test :refer [deftest is testing]]

            [pp-grid.api :as g]
            [pp-grid.examples :as e]))

(deftest test-empty-grid
  (testing "grid constructors"
    (let [grid (g/empty-grid)]
      (is (= 2 (:dimension grid)))
      (is (= 0 (:width grid)))
      (is (= 0 (:height grid)))
      (is (nil? (:mins grid)))
      (is (nil? (:maxs grid))))
    (let [grid (g/empty-grid 1)]
      (is (= 1 (:dimension grid)))
      (is (= 0 (:width grid)))
      (is (= 0 (:height grid)))
      (is (nil? (:mins grid)))
      (is (nil? (:maxs grid))))))

(deftest test-width
  (testing "string-widths"
    (is (= 0 (g/width "")))
    (is (= 0 (g/width "\n123")))
    (is (= 1 (g/width "1")))
    (is (= 1 (g/width "1\n1234")))
    (is (= 4 (g/width "abcd\nefgh"))))
  (testing "string-convertible-widths"
    (is (= 1 (g/width 1)))
    (is (= 4 (g/width 1234)))
    (is (= 7 (g/width 1234.26)))
    (is (= 2 (g/width :a)))
    (is (= 5 (g/width :abcd))))
  (testing "grid-widths"
    (is (= 0 (g/width (g/empty-grid))))
    (is (= 5 (g/width (g/text "HELLO"))))))

(deftest test-height
  (testing "string-heights"
    (is (= 1 (g/height "")))
    (is (= 2 (g/height "\n123")))
    (is (= 1 (g/height "1")))
    (is (= 2 (g/height "1\n1234")))
    (is (= 2 (g/height "abcd\nefgh"))))
  (testing "string-convertible-heights"
    (is (= 1 (g/height 1)))
    (is (= 1 (g/height 1234)))
    (is (= 1 (g/height 1234.26)))
    (is (= 1 (g/height :a)))
    (is (= 1 (g/height :abcd))))
  (testing "grid-heights"
    (is (= 0 (g/height (g/empty-grid))))
    (is (= 1 (g/height (g/text "HELLO"))))
    (is (= 4 (g/height (g/text "HELLO\nWorld\nof\ntesting"))))))

(deftest test-grid-2d
  (testing "2d grid"
    (let [grid (-> (g/empty-grid 2)
                   (assoc [0 0] \H
                          [1 0] \E
                          [2 0] \L
                          [3 0] \L
                          [4 0] \O))]
      (is (= 5 (:width grid)))
      (is (= 1 (:height grid)))
      (is (= 0 (:min-x grid)))
      (is (= 4 (:max-x grid)))
      (is (= 0 (:min-y grid)))
      (is (= 0 (:max-y grid)))
      (is (= "HELLO" (g/render grid))))))

(deftest test-text
  (testing "text grids"
    (is (= "hello" (g/text "hello")))
    (is (= "  hello  " (g/text "hello" 2 2)))
    (is (= "***hello**" (g/text "hello" 3 2 \*)))
    (is (= "1" (g/text 1)))
    (is (= ":a" (g/text :a)))
    (is (= "(+ 1 2 3)" (g/text '(+ 1 2 3))))))

(deftest test-examples
  (testing "grid illustration"
    (let [grid (e/make-grid-illustration 4 4)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 40))
      (is (= (:height grid) 18))
      (is (g/grid? grid))))
  (testing "hello world"
    (let [grid (e/make-hello-world)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 11))
      (is (= (:height grid) 1))
      (is (g/grid? grid))))
  (testing "abcd"
    (let [grid (e/make-abcd)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 11))
      (is (= (:height grid) 11))
      (is (g/grid? grid))))
  (testing "boxed abcd"
    (let [grid (e/make-boxed-abcd)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 15))
      (is (= (:height grid) 13))
      (is (g/grid? grid))))
  (testing "haligned boxes"
    (let [grid (e/make-haligned-boxes)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 35))
      (is (= (:height grid) 7))
      (is (g/grid? grid))))
  (testing "tables"
    (let [grid (e/make-tables)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 50))
      (is (= (:height grid) 41))
      (is (g/grid? grid))))
  (testing "nested-table"
    (let [grid (e/make-nested-table)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 74))
      (is (= (:height grid) 17))
      (is (g/grid? grid))))
  (testing "colored-table"
    (let [grid (e/make-colored-table)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 37))
      (is (= (:height grid) 8))
      (is (g/grid? grid))))
  (testing "colored-boxes"
    (let [grid (e/make-colored-boxes)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 50))
      (is (= (:height grid) 13))
      (is (g/grid? grid))))
  (testing "decorated text"
    (let [grid (e/make-decorated-text "HELLO")]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 5))
      (is (= (:height grid) 1))
      (is (g/grid? grid))))
  (testing "tree"
    (let [grid (e/make-tree)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 22))
      (is (= (:height grid) 19))
      (is (g/grid? grid))))
  (testing "chart-xy"
    (let [grid (e/make-chart-xy)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 45))
      (is (= (:height grid) 7))
      (is (g/grid? grid))))
  (testing "chart-bar"
    (let [grid (e/make-chart-bar)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 46))
      (is (= (:height grid) 5))
      (is (g/grid? grid))))
  (testing "chart-bar-vertical"
    (let [grid (e/make-chart-bar-vertical)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 10))
      (is (= (:height grid) 16))
      (is (g/grid? grid))))
  (testing "transformations"
    (let [grid (e/make-transformations)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 23))
      (is (= (:height grid) 20))
      (is (g/grid? grid))))
  (testing "diagram"
    (let [grid (e/make-diagram)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 82))
      (is (= (:height grid) 12))
      (is (g/grid? grid))))
  (testing "paragraphs"
    (let [grid (e/make-paragraphs)]
      (is (= (:dimension grid) 2))
      (is (= (:width grid) 80))
      (is (= (:height grid) 15))
      (is (g/grid? grid)))))


<|start_filename|>src/pp_grid/ansi_escape_code.clj<|end_filename|>
(ns pp-grid.ansi-escape-code)

(def ^:const ESCAPE-CODE-BOLD "\u001b[1m")
(def ^:const ESCAPE-CODE-UNDERLINE "\u001b[4m")
(def ^:const ESCAPE-CODE-REVERSED "\u001b[7m")

(def ^:const ESCAPE-CODE-BLACK "\u001b[30m")
(def ^:const ESCAPE-CODE-BLUE "\u001b[34m")
(def ^:const ESCAPE-CODE-CYAN "\u001b[36m")
(def ^:const ESCAPE-CODE-GREEN "\u001b[32m")
(def ^:const ESCAPE-CODE-MAGENTA "\u001b[35m")
(def ^:const ESCAPE-CODE-RED "\u001b[31m")
(def ^:const ESCAPE-CODE-WHITE "\u001b[37m")
(def ^:const ESCAPE-CODE-YELLOW "\u001b[33m")

(def ^:const ESCAPE-CODE-BRIGHT-BLACK "\u001b[30;1m")
(def ^:const ESCAPE-CODE-BRIGHT-BLUE "\u001b[34;1m")
(def ^:const ESCAPE-CODE-BRIGHT-CYAN "\u001b[36;1m")
(def ^:const ESCAPE-CODE-BRIGHT-GREEN "\u001b[32;1m")
(def ^:const ESCAPE-CODE-BRIGHT-MAGENTA "\u001b[35;1m")
(def ^:const ESCAPE-CODE-BRIGHT-RED "\u001b[31;1m")
(def ^:const ESCAPE-CODE-BRIGHT-WHITE "\u001b[37;1m")
(def ^:const ESCAPE-CODE-BRIGHT-YELLOW "\u001b[33;1m")

(def ^:const ESCAPE-CODE-BACKGROUND-BLACK "\u001b[40m")
(def ^:const ESCAPE-CODE-BACKGROUND-BLUE "\u001b[44m")
(def ^:const ESCAPE-CODE-BACKGROUND-CYAN "\u001b[46m")
(def ^:const ESCAPE-CODE-BACKGROUND-GREEN "\u001b[42m")
(def ^:const ESCAPE-CODE-BACKGROUND-MAGENTA "\u001b[45m")
(def ^:const ESCAPE-CODE-BACKGROUND-RED "\u001b[41m")
(def ^:const ESCAPE-CODE-BACKGROUND-WHITE "\u001b[47m")
(def ^:const ESCAPE-CODE-BACKGROUND-YELLOW "\u001b[43m")

(def ^:const ESCAPE-CODE-BACKGROUND-BRIGHT-BLACK "\u001b[40;1m")
(def ^:const ESCAPE-CODE-BACKGROUND-BRIGHT-BLUE "\u001b[44;1m")
(def ^:const ESCAPE-CODE-BACKGROUND-BRIGHT-CYAN "\u001b[46;1m")
(def ^:const ESCAPE-CODE-BACKGROUND-BRIGHT-GREEN "\u001b[42;1m")
(def ^:const ESCAPE-CODE-BACKGROUND-BRIGHT-MAGENTA "\u001b[45;1m")
(def ^:const ESCAPE-CODE-BACKGROUND-BRIGHT-RED "\u001b[41;1m")
(def ^:const ESCAPE-CODE-BACKGROUND-BRIGHT-WHITE "\u001b[47;1m")
(def ^:const ESCAPE-CODE-BACKGROUND-BRIGHT-YELLOW "\u001b[43;1m")

(def ^:const ESCAPE-CODE-RESET "\u001b[0m")


<|start_filename|>src/pp_grid/layout.clj<|end_filename|>
(ns pp-grid.layout
  (:require [pp-grid.core :as c]))

(defn valign
  "Constructs a grid containing given grids aligned vertically.

  For example, (valign [(text \"A\") (text \"B\") (text \"C\")]) is
  A
  B
  C
  "
  ([grids]
   (valign grids 0))
  ([grids y-padding]
   (valign grids y-padding false))
  ([grids y-padding center?]
   (reduce
    (fn [top bottom]
      (cond
        (empty? top) bottom
        (empty? bottom) top
        :else (let [top-width (:width top)
                    bottom-width (:width bottom)
                    top-center-x (+ (:min-x top) (/ top-width 2))
                    bottom-center-x (+ (:min-x bottom) (/ bottom-width 2))
                    x-diff (- top-center-x bottom-center-x)
                    dx (if center? x-diff 0)
                    dy (+ y-padding (:height top))]
                (c/add top (c/transform bottom (c/tf-translate dx dy))))))
    (first grids)
    (rest grids))))

(defn halign
  "Constructs a grid containing given grids aligned horizontally.

  For example, (halign [(text \"A\") (text \"B\") (text \"C\")]) is ABC."
  ([grids]
   (halign grids 0))
  ([grids x-padding]
   (halign grids x-padding false))
  ([grids x-padding center?]
   (reduce
    (fn [left right]
      (cond
        (empty? left) right
        (empty? right) left
        :else (let [dx (+ x-padding (:width left))
                    left-height (:height left)
                    right-height (:height right)
                    left-center-y (+ (:min-y left) (/ left-height 2))
                    right-center-y (+ (:min-y right) (/ right-height 2))
                    y-diff (- left-center-y right-center-y)
                    dy (if center? y-diff 0)]
                (c/add left (c/transform right (c/tf-translate dx dy))))))
    (first grids)
    (rest grids))))

(defn hspacer
  "Constructs a horizontal space of given length.

  For example, (hspacer 5) is \"     \"."
  ([n]
   (if (<= n 0) (c/empty-grid)
       (-> (c/empty-grid)
           (assoc [0 0] \space)
           (assoc [(dec n) 0] \space)))))

(defn vspacer
  "Constructs a vertical space of given length.

  For example, (vspacer 5) is
  (space)
  (space)
  (space)
  (space)
  (space)
  "
  ([n]
   (if (<= n 0) (c/empty-grid)
       (-> (c/empty-grid)
           (assoc [0 0] \space)
           (assoc [0 (dec n)] \space)))))

(defn spacer
  "Constructs a rectangular space of given width and height."
  ([width height]
   (c/add (hspacer width) (vspacer height))))

(defn ===
  "Horizontally aligns given grids with some defaults.

  Just a convenience wrapper for halign to accept grids as args and
  use some default values for padding and centering."
  [x-padding & grids]
  (halign grids x-padding true))

(defn ||
  "Vertically aligns given grids with some defaults.

  Just a convenience wrapper for valign to accept grids as args and
  use some default values for padding and centering."
  [y-padding & grids]
  (valign grids y-padding true))

(defn pull
  "Pulls a grid by given amounts horizontally and vertically.

  Just a convenience function for transforming with tf-translate. Useful
  for tweaking alignments."
  [g dx dy]
  (c/transform g (c/tf-translate dx dy)))


<|start_filename|>src/pp_grid/object.clj<|end_filename|>
(ns pp-grid.object
  (:require [clojure.string :as s]
            [clojure.pprint :as pp]

            [pp-grid.ansi-escape-code :as ecodes]
            [pp-grid.core :as c]
            [pp-grid.layout :as l]))

(defn text
  "Constructs a grid containing given string.

  If s is not a string, then (str s)
  will be used.

  Each line in the string is put in a new row."
  ([s]
   (text s 0))
  ([s padding]
   (text s padding padding))
  ([s pad-left pad-right]
   (text s pad-left pad-right \space))
  ([s pad-left pad-right pad-char]
   (if (string? s)
     (->> s
          s/split-lines
          (map vector (range))
          (reduce
           (fn [g [y ^String line]]
             (reduce
              (fn [g [x v]]
                (assoc g [x y] v))
              g
              (map vector
                   (range)
                   (str (apply str (repeat pad-left pad-char))
                        (if (empty? line) " " line)
                        (apply str (repeat pad-right pad-char))))))
           (c/empty-grid)))
     (text (str s) pad-left pad-right pad-char))))

(defn paragraph
  "Constructs a grid containing a paragraph of text.

  By default paragraphs have max-width of 80 chars. If any word
  is longer than max-width chars, it will appear alone in a line without
  being truncated."
  ([s]
   (paragraph s 0))
  ([s padding]
   (paragraph s padding padding))
  ([s pad-left pad-right]
   (paragraph s pad-left pad-right 80))
  ([s pad-left pad-right max-width]
   (paragraph s pad-left pad-right max-width 0))
  ([s pad-left pad-right max-width first-line-indent]
   (as-> s $
     (s/split $ #"\s+")
     (pp/cl-format nil (str "~{~<~%~1," max-width ":;~A~> ~}") $)
     (text (str (apply str (repeat first-line-indent \space)) $)
           pad-left pad-right))))

(defn decorate
  "Decorates a grid or a string-convertible value with given ansi-escape-codes."
  [x escape-code & escape-codes]
  (if (c/grid? x)
    (reduce
     (fn [acc [k v]]
       (let [escape-code (apply str escape-code escape-codes)
             new-v (if (c/escaped-char? v)
                     (c/->EscapedChar (apply str escape-code (:escape-code v))
                                      (:value v))
                     (c/->EscapedChar escape-code v))]
         (assoc acc k new-v)))
     (empty x)
     x)
    (apply decorate (text x) escape-code escape-codes)))

(defn hline
  "Constructs a horizontal line of given length.

  For example, (hline 3) is '---'."
  ([n]
   (hline n \─ \─ \─))
  ([n body-char]
   (hline n body-char body-char body-char))
  ([n body-char start-char end-char]
   (cond
     (<= n 0) nil
     (= n 1) (assoc (c/empty-grid) [0 0] body-char)
     (= n 2) (text (str start-char end-char))
     :else (text
            (s/join
             nil
             (list
              start-char
              (s/join nil (repeat (- n 2) body-char))
              end-char))))))

(defn vline
  "Constructs a vertical line of given length.

  For example, (vline 3) is
  |
  |
  |
  "
  ([n]
   (vline n \│ \│ \│))
  ([n body-char]
   (vline n body-char body-char body-char))
  ([n body-char start-char end-char]
   (cond
     (<= n 0) nil
     (= n 1) (assoc (c/empty-grid) [0 0] body-char)
     (= n 2) (text (str start-char \newline end-char))
     :else (text (s/join
                  \newline
                  (list
                   start-char
                   (s/join \newline (repeat (- n 2) body-char))
                   end-char))))))

(defn hfill
  "Constructs a horizontal-filler of given size.

  For example, (hfill 3 \\*) is '***'."
  ([n]
   (hfill n \space))
  ([n c]
   (hline n c)))

(defn vfill
  "Constructs a vertical-filler of given size.

  For example, (vfill 3 \\*) is
  *
  *
  *
  "
  ([n]
   (vfill n \space))
  ([n c]
   (vline n c)))

(defn fill
  "Constructs a filler of given width and height.

  For example, (fill 4 4 \\*) is
  ****
  ****
  ****
  ****
  "
  ([w h]
   (fill w h \space))
  ([w h c]
   (l/valign (repeat h (hfill w c)))))

(defn arrow-left
  "Constructs a left arrow of given length.

  For example, (arrow-left 4) is '◀───'."
  ([n]
   (arrow-left n \─ "◀"))
  ([n body-char]
   (arrow-left n body-char "◀"))
  ([n body-char head-char]
   (hline n body-char head-char body-char)))

(defn arrow-right
  "Constructs a right arrow of given length.

  For example, (arrow-right 4) is '───▶︎'."
  ([n]
   (arrow-right n "─" "▶"))
  ([n body-char]
   (arrow-right n body-char "▶"))
  ([n body-char head-char]
   (hline n body-char body-char head-char)))

(defn arrow-left-right
  "Constructs a left-right arrow of given length.

  For example, (arrow-left-right 4) is '◀──▶︎'."
  ([n]
   (arrow-left-right n \─ "◀" "▶︎"))
  ([n body-char]
   (arrow-left-right n body-char "◀" "▶︎"))
  ([n body-char left-head-char right-head-char]
   (hline n body-char left-head-char right-head-char)))

(defn arrow-up
  "Constructs an up arrow of given length.

  For example, (arrow-up 4) is
  ▲
  │
  │
  │
  "
  ([n]
   (arrow-up n \│ "▲"))
  ([n body-char]
   (arrow-up n body-char "▲"))
  ([n body-char head-char]
   (vline n body-char head-char body-char)))

(defn arrow-down
  "Constructs a down arrow of given length.

  For example, (arrow-down 4) is
  │
  │
  │
  ▼
  "
  ([n]
   (arrow-down n \│ "▼"))
  ([n body-char]
   (arrow-down n body-char "▼"))
  ([n body-char head-char]
   (vline n body-char body-char head-char)))

(defn arrow-up-down
  "Constructs a up-down arrow of given length.

  For example, (arrow-up-down 4) is
  ▲
  │
  │
  ▼
  "
  ([n]
   (arrow-up-down n \│ "▲" "▼"))
  ([n body-char]
   (arrow-up-down n body-char "▲" "▼"))
  ([n body-char up-head-char down-head-char]
   (vline n body-char up-head-char down-head-char)))

(defn arrow-se
  "Constructs an arrow pointing south-east of given length.

  For example, (arrow-se 4) is -- ignore the double lines. Can't put it here
  without escaping it!
  \\
   \\
    \\
     *
  "
  ([n]
   (arrow-se n "\\"))
  ([n body-char]
   (arrow-se n body-char body-char "*"))
  ([n body-char start-char end-char]
   (apply assoc
          (c/empty-grid)
          (interleave (for [x (range n)]
                        [x x])
                      (concat (list start-char)
                              (repeat (- n 2) body-char)
                              (list end-char))))))

(defn arrow-sw
  "Constructs an arrow pointing south-west of given length.

  For example, (arrow-sw 4) is
     /
    /
   /
  *
  "
  ([n]
   (arrow-sw n "/"))
  ([n body-char]
   (arrow-sw n body-char body-char "*"))
  ([n body-char start-char end-char]
   (c/transform
    (arrow-se n body-char start-char end-char)
    (c/tf-hflip))))

(defn arrow-ne
  "Constructs an arrow pointing north-east of given length.

  For example, (arrow-ne 4) is
     *
    /
   /
  /
  "
  ([n]
   (arrow-ne n "/"))
  ([n body-char]
   (arrow-ne n body-char body-char "*"))
  ([n body-char start-char end-char]
   (c/transform
    (arrow-se n body-char start-char end-char)
    (c/tf-vflip))))

(defn arrow-nw
  "Constructs an arrow pointing north-west of given length.

  For example, (arrow-nw 4) is -- ignore the double lines. Can't put it here
  without escaping it!
  *
   \\
    \\
     \\
  "
  ([n]
   (arrow-nw n "\\"))
  ([n body-char]
   (arrow-nw n body-char body-char "*"))
  ([n body-char start-char end-char]
   (c/transform
    (arrow-ne n body-char start-char end-char)
    (c/tf-hflip))))

(def default-box-options {:left-padding 0
                          :right-padding 0
                          :top-padding 0
                          :bottom-padding 0
                          :left-border-char \|
                          :right-border-char \|
                          :top-border-char \-
                          :bottom-border-char \-
                          :top-left-corner-char \+
                          :top-right-corner-char \+
                          :bottom-left-corner-char \+
                          :bottom-right-corner-char \+})

(defn box
  "Constructs a grid wrapping given grid (or a string-convertible value) into a box.

  For example, (box (text \"HELLO\")) is
  +-----+
  |HELLO|
  +-----+
  "
  [g & {:keys [left-padding
               right-padding
               top-padding
               bottom-padding
               left-border-char
               right-border-char
               top-border-char
               bottom-border-char
               top-left-corner-char
               top-right-corner-char
               bottom-left-corner-char
               bottom-right-corner-char
               fill-escape-codes]
        :or {left-padding 0
             right-padding 0
             top-padding 0
             bottom-padding 0
             left-border-char \|
             right-border-char \|
             top-border-char \-
             bottom-border-char \-
             top-left-corner-char \+
             top-right-corner-char \+
             bottom-left-corner-char \+
             bottom-right-corner-char \+}
        :as provided-opts}]
  (let [opts (merge default-box-options provided-opts)]
    (if (c/grid? g)
      (let [origin-x (:min-x g)
            origin-y (:min-y g)
            move-to-origin (fn [o]
                             (if (and (zero? origin-x) (zero? origin-y))
                               o
                               (c/transform o (c/tf-translate origin-x origin-y))))
            width (+ (:width g) left-padding right-padding)
            height (+ (:height g) top-padding bottom-padding 2)
            left-line (vline height left-border-char top-left-corner-char bottom-left-corner-char)
            right-line (vline height
                              right-border-char
                              top-right-corner-char
                              bottom-right-corner-char)
            top-line (hline width top-border-char)
            bottom-line (hline width bottom-border-char)
            content (l/valign [(vfill top-padding \space)
                               (l/halign [(hfill left-padding) g (hfill right-padding)])
                               (vfill bottom-padding \space)])
            filled-content (if (nil? fill-escape-codes)
                             content
                             (let [filled-box (fill (+ (:width g) left-padding right-padding)
                                                    (+ (:height g) top-padding bottom-padding)
                                                    \space)]
                               (apply decorate (assoc filled-box [0 0] content)
                                      fill-escape-codes)))]
        (l/halign
         [(move-to-origin left-line)
          (l/valign [(move-to-origin top-line)
                     filled-content
                     (move-to-origin bottom-line)])
          (move-to-origin right-line)]))
      (apply box (text (str g)) (apply concat opts)))))

(defn box0
  "Constructs a grid wrapping given grid into a border-less box.

  For example, (box0 (text \"HELLO\")) is

   HELLO

  "
  [g & {:keys [left-padding
               right-padding
               top-padding
               bottom-padding
               fill-escape-codes]
        :or {left-padding 0
             right-padding 0
             top-padding 0
             bottom-padding 0}}]
  (box g
       :left-padding left-padding
       :right-padding right-padding
       :top-padding top-padding
       :bottom-padding bottom-padding
       :fill-escape-codes fill-escape-codes
       :left-border-char ""
       :right-border-char ""
       :top-border-char ""
       :bottom-border-char ""
       :top-left-corner-char ""
       :top-right-corner-char ""
       :bottom-left-corner-char ""
       :bottom-right-corner-char ""))

(defn box1
  "Constructs a grid wrapping given grid into a box.

  Similar to box, but uses different border.

  For example, (box1 (text \"HELLO\")) is
  ┌─────┐
  │HELLO│
  └─────┘
  "
  [g & {:keys [left-padding
               right-padding
               top-padding
               bottom-padding
               fill-escape-codes]
        :or {left-padding 0
             right-padding 0
             top-padding 0
             bottom-padding 0}}]
  (box g
       :left-padding left-padding
       :right-padding right-padding
       :top-padding top-padding
       :bottom-padding bottom-padding
       :fill-escape-codes fill-escape-codes
       :left-border-char "│"
       :right-border-char "│"
       :top-border-char "─"
       :bottom-border-char "─"
       :top-left-corner-char "┌"
       :top-right-corner-char "┐"
       :bottom-left-corner-char "└"
       :bottom-right-corner-char "┘"))

(defn box2
  "Constructs a grid wrapping given grid into a box.

  Similar to box, but uses border with rounded corners.

  For example, (box2 (text \"HELLO\")) is
  ╭─────╮
  │HELLO│
  ╰─────╯
  "
  [g & {:keys [left-padding
               right-padding
               top-padding
               bottom-padding
               fill-escape-codes]
        :or {left-padding 0
             right-padding 0
             top-padding 0
             bottom-padding 0}}]
  (box g
       :left-padding left-padding
       :right-padding right-padding
       :top-padding top-padding
       :bottom-padding bottom-padding
       :fill-escape-codes fill-escape-codes
       :left-border-char "│"
       :right-border-char "│"
       :top-border-char "─"
       :bottom-border-char "─"
       :top-left-corner-char "╭"
       :top-right-corner-char "╮"
       :bottom-left-corner-char "╰"
       :bottom-right-corner-char "╯"))

(defn box3
  "Constructs a grid wrapping given grid into a box.

  Similar to box, but uses different border.

  For example, (box3 (text \"HELLO\")) is
  ╒═════╕
  │HELLO│
  ╘═════╛
  "
  [g & {:keys [left-padding
               right-padding
               top-padding
               bottom-padding
               fill-escape-codes]
        :or {left-padding 0
             right-padding 0
             top-padding 0
             bottom-padding 0}}]
  (box g
       :left-padding left-padding
       :right-padding right-padding
       :top-padding top-padding
       :bottom-padding bottom-padding
       :fill-escape-codes fill-escape-codes
       :left-border-char ":"
       :right-border-char ":"
       :top-border-char "."
       :bottom-border-char "."
       :top-left-corner-char "."
       :top-right-corner-char "."
       :bottom-left-corner-char "."
       :bottom-right-corner-char "."))

(defn box4
  "Constructs a grid wrapping given grid into a box.

  Similar to box, but uses different border.

  For example, (box4 (text \"HELLO\")) is
  ╒═════╕
  │HELLO│
  ╘═════╛
  "
  [g & {:keys [left-padding
               right-padding
               top-padding
               bottom-padding
               fill-escape-codes]
        :or {left-padding 0
             right-padding 0
             top-padding 0
             bottom-padding 0}}]
  (box g
       :left-padding left-padding
       :right-padding right-padding
       :top-padding top-padding
       :bottom-padding bottom-padding
       :fill-escape-codes fill-escape-codes
       :left-border-char "│"
       :right-border-char "│"
       :top-border-char "═"
       :bottom-border-char "═"
       :top-left-corner-char "╒"
       :top-right-corner-char "╕"
       :bottom-left-corner-char "╘"
       :bottom-right-corner-char "╛"))

(defn box5
  "Constructs a grid wrapping given grid into a box.

  Similar to box, but uses '*' for all border characters.

  For example, (box5 (text \"HELLO\")) is
  *******
  *HELLO*
  *******
  "
  [g & {:keys [left-padding
               right-padding
               top-padding
               bottom-padding
               fill-escape-codes]
        :or {left-padding 0
             right-padding 0
             top-padding 0
             bottom-padding 0}}]
  (box g
       :left-padding left-padding
       :right-padding right-padding
       :top-padding top-padding
       :bottom-padding bottom-padding
       :fill-escape-codes fill-escape-codes
       :left-border-char "*"
       :right-border-char "*"
       :top-border-char "*"
       :bottom-border-char "*"
       :top-left-corner-char "*"
       :top-right-corner-char "*"
       :bottom-left-corner-char "*"
       :bottom-right-corner-char "*"))

(defn table
  "Constructs a table.

  Produces similar table as clojure.pprint/print-table.

  Adapted from source-code of clojure.pprint/print-table.

  For example, (table [:a :b] [{:a 1 :b 2} {:a 3 :b 4}]) is
  +----+----+
  | :a | :b |
  +----+----+
  |  1 |  2 |
  |  3 |  4 |
  +----+----+

  row-decorations keyword-argument can be provided. It is a sequence
  of ansi-escape codes. If header? is true, the header will be decorated with
  the first ansi-escape code in row-decorations. And the other rows will be decorated
  with the rest -- if there aren't enough, we'll just cycle over the
  given ansi-escape-codes. For example, try
  (table [:a :b] [{:a 1 :b 2} {:a 3 :b 4}]
         :row-decorations [ESCAPE-CODE-BACKGROUND-BRIGHT-GREEN
                           ESCAPE-CODE-BACKGROUND-BRIGHT-MAGENTA
                           ESCAPE-CODE-BACKGROUND-BLUE])
  "
  [ks rows & {:keys [nsew-char
                     nse-char
                     nsw-char
                     ewn-char
                     ews-char
                     ns-char
                     ew-char
                     nw-char
                     ne-char
                     se-char
                     sw-char
                     header?
                     row-decorations]
              :or {nsew-char \+
                   nse-char \+
                   nsw-char \+
                   ewn-char \+
                   ews-char \+
                   ns-char \|
                   ew-char \-
                   nw-char \+
                   ne-char \+
                   se-char \+
                   sw-char \+
                   header? true}}]
  (let [widths (map
                (fn [k]
                  (apply max
                         (count (str k))
                         (map #(c/width (get % k)) rows)))
                ks)
        spacers (map #(apply str (repeat % ew-char)) widths)
        fmts (map #(str "%" % "s") widths)
        fmt-row (fn [leader divider trailer row]
                  (let [vs (map #(get row %) ks)
                        heights (map c/height vs)
                        max-height (apply max heights)
                        ->cols (fn [i]
                                 (for [v vs]
                                   (nth (s/split-lines (str v)) i "")))]
                    (s/join
                     \newline
                     (for [i (range max-height)
                           :let [cols (->cols i)]]
                       (as-> (interpose
                              divider
                              (for [[col fmt] (map vector cols fmts)]
                                (format fmt (str col)))) $
                         (apply str $)
                         (str leader $ trailer))))))
        top-border (text (fmt-row
                          (str se-char ew-char)
                          (str ew-char ews-char ew-char)
                          (str ew-char sw-char)
                          (zipmap ks spacers)))
        header-divider (text (fmt-row
                              (str nse-char ew-char)
                              (str ew-char nsew-char ew-char)
                              (str ew-char nsw-char)
                              (zipmap ks spacers)))
        bottom-border (text (fmt-row
                             (str ne-char ew-char)
                             (str ew-char ewn-char ew-char)
                             (str ew-char nw-char)
                             (zipmap ks spacers)))
        color-fn (fn [i]
                   (cond
                     (nil? row-decorations) nil
                     header? (nth (cons (first row-decorations)
                                        (cycle (rest row-decorations))) i nil)
                     :else (nth (cycle row-decorations) i nil)))
        reset (when (seq row-decorations)
                ecodes/ESCAPE-CODE-RESET)]
    (l/valign [top-border
               (when header?
                 (text (fmt-row
                        (str ns-char (color-fn 0) \space)
                        (str \space reset ns-char (color-fn 0) \space)
                        (str \space reset ns-char)
                        (zipmap ks ks))))
               (when header? header-divider)
               (l/valign (map (fn [row i]
                                (text (fmt-row (str ns-char (color-fn (inc i)) \space)
                                               (str \space reset ns-char (color-fn (inc i)) \space)
                                               (str \space reset ns-char)
                                               row)))
                              rows
                              (range)))
               bottom-border])))

(defn table0
  "Constructs a border-less table.

  For example, (table0 [:a :b] [{:a 1 :b 2} {:a 3 :b 4}]) is

   :a   :b

    1    2
    3    4

  Rows can be decorated with row-decorations argument, which is a sequence of ansi-escape-codes.
  Please see docstring for table."
  ([ks rows]
   (table0 ks rows true))
  ([ks rows header?]
   (table0 ks rows header? nil))
  ([ks rows header? row-decorations]
   (table ks rows
          :nsew-char ""
          :nse-char ""
          :nsw-char ""
          :ewn-char ""
          :ews-char ""
          :ns-char ""
          :ew-char ""
          :se-char ""
          :sw-char ""
          :ne-char ""
          :nw-char ""
          :header? header?
          :row-decorations row-decorations)))

(defn table1
  "Constructs a table.

  Similar to table but uses different border.

  For example, (table1 [:a :b] [{:a 1 :b 2} {:a 3 :b 4}]) is
  ┌────┬────┐
  │ :a │ :b │
  ├────┼────┤
  │  1 │  2 │
  │  3 │  4 │
  └────┴────┘

  Rows can be decorated with row-decorations argument, which is a sequence of ansi-escape-codes.
  Please see docstring for table."
  ([ks rows]
   (table1 ks rows true))
  ([ks rows header?]
   (table1 ks rows header? nil))
  ([ks rows header? row-decorations]
   (table ks rows
          :nsew-char "┼"
          :nse-char "├"
          :nsw-char "┤"
          :ewn-char "┴"
          :ews-char "┬"
          :ns-char "│"
          :ew-char "─"
          :se-char "┌"
          :sw-char "┐"
          :ne-char "└"
          :nw-char "┘"
          :header? header?
          :row-decorations row-decorations)))

(defn table2
  "Constructs a table.

  Similar to table but uses different border (rounded corners).

  For example, (table2 [:a :b] [{:a 1 :b 2} {:a 3 :b 4}]) is
  ╭────┬────╮
  │ :a │ :b │
  ├────┼────┤
  │  1 │  2 │
  │  3 │  4 │
  ╰────┴────╯

  Rows can be decorated with row-decorations argument, which is a sequence of ansi-escape-codes.
  Please see docstring for table."
  ([ks rows]
   (table2 ks rows true))
  ([ks rows header?]
   (table2 ks rows header? nil))
  ([ks rows header? row-decorations]
   (table ks rows
          :nsew-char "┼"
          :nse-char "├"
          :nsw-char "┤"
          :ewn-char "┴"
          :ews-char "┬"
          :ns-char "│"
          :ew-char "─"
          :se-char "╭"
          :sw-char "╮"
          :ne-char "╰"
          :nw-char "╯"
          :header? header?
          :row-decorations row-decorations)))

(defn table3
  "Constructs a table.

  Similar to table but uses dotted border.

  For example, (table3 [:a :b] [{:a 1 :b 2} {:a 3 :b 4}]) is
  ...........
  : :a : :b :
  ..........:
  :  1 :  2 :
  :  3 :  4 :
  :....:....:

  Rows can be decorated with row-decorations argument, which is a sequence of ansi-escape-codes.
  Please see docstring for table."
  ([ks rows]
   (table3 ks rows true))
  ([ks rows header?]
   (table3 ks rows header? nil))
  ([ks rows header? row-decorations]
   (table ks rows
          :nsew-char "."
          :nse-char "."
          :nsw-char ":"
          :ewn-char ":"
          :ews-char "."
          :ns-char ":"
          :ew-char "."
          :se-char "."
          :sw-char "."
          :ne-char ":"
          :nw-char ":"
          :header? header?
          :row-decorations row-decorations)))

(defn table*
  "Constructs a n-column, border-less, header-less table with given grids.

  Just a convenience wrapper around table0. For more customization, use
  table0 or table functions.
  "
  ([grids n]
   (let [ks (range n)
         rows (for [r (partition n n nil grids)]
                (zipmap ks r))]
     (table0 ks rows false))))

(defn matrix
  "Constructs a matrix.

  Similar to table, but changes the border to make it look more like a matrix.

  For example, (matrix [:a :b] [{:a 1 :b 2} {:a 3 :b 4}]) is
  ╭           ╮
  │  :a   :b  │
  │           │
  │   1    2  │
  │   3    4  │
  ╰           ╯
  "
  ([ks rows]
   (matrix ks rows true))
  ([ks rows header?]
   (l/halign [(vline (+ (if header? 4 2)
                        (count rows))
                     "│" "╭" "╰")
              (table0 ks rows header?)
              (vline (+ (if header? 4 2)
                        (count rows))
                     "│" "╮" "╯")])))

(defn tree
  "Constructs a tree representation of a sequence.

  An element of the sequence can be another sequence or a grid or
  anything that can be converted to a string.

  For example, (tree [1 2 [3 [4 5] [6 7] 8]]) is
  ┌───┐
  │ 1 │
  └───┘
  │
  ┌───┐
  │ 2 │
  └───┘
  │
  ┌───┐  ┌───┐  ┌───┐  ┌───┐
  │ 3 │  │ 4 │  │ 6 │  │ 8 │
  └───┘  └───┘  └───┘  └───┘
         │      │
         ┌───┐  ┌───┐
         │ 5 │  │ 7 │
         └───┘  └───┘
  "
  ([node]
   (tree node 2 0))
  ([node text-wrapper-fn]
   (tree node 2 0 text-wrapper-fn))
  ([node x-padding y-padding]
   (tree node x-padding y-padding box1))
  ([node x-padding y-padding text-wrapper-fn]
   (tree node x-padding y-padding text-wrapper-fn "│"))
  ([node x-padding y-padding text-wrapper-fn branch-marker]
   (cond
     (sequential? node) (let [args (list x-padding
                                         y-padding
                                         text-wrapper-fn
                                         branch-marker)
                              children (for [n node]
                                         (if (sequential? n)
                                           (l/halign (map #(apply tree % args) n) x-padding)
                                           (apply tree n args)))]
                          (as-> children $
                            (interpose (text (str branch-marker)) $)
                            (l/valign $ y-padding)))
     (c/grid? node) node
     :else (text-wrapper-fn (text (str node)) :left-padding 1 :right-padding 1))))

(defn chart-xy
  "Constructs a xy-chart (scatter plot).

  For example, (chart-xy (range) [0 1 2 1 0 1 2 1 0] :max-height 2 :max-width 10) is
  y
  ▲
  |
  |  *    *
  |*  * *  *
  *----*----*-▶ x
  "
  [xs ys & {:keys [point-symbol
                   draw-axis
                   x-label
                   y-label
                   max-width
                   max-height]
            :or {point-symbol \*
                 draw-axis true
                 x-label "x"
                 y-label "y"
                 max-width 40
                 max-height 10}}]
  (let [n (count (map vector xs ys))
        xs (take n xs)
        ys (take n ys)
        [min-x max-x] (apply (juxt min max) xs)
        [min-y max-y] (apply (juxt min max) ys)
        max-delta-x (- max-x min-x)
        max-delta-y (- max-y min-y)
        unit-x (/ max-width max-delta-x)
        unit-y (/ max-height max-delta-y)
        scaled-xs (map (fn [x] (c/round (* x unit-x))) xs)
        scaled-ys (map (fn [y] (c/round (* y unit-y))) ys)
        ks (map vector scaled-xs scaled-ys)
        p (as-> (c/empty-grid) $
            (apply assoc $ (interleave ks (repeat point-symbol))))
        p (if draw-axis
            (let [x-axis (l/===
                          1
                          (arrow-right (+ (:width p) 2) \-)
                          (text x-label))
                  y-axis (l/||
                          0
                          (vline (+ (:height p) 2) \| \| "▲")
                          (text y-label))
                  with-x-axis (assoc p [0 0] x-axis)
                  with-xy-axis (assoc with-x-axis [0 0] y-axis)]
              (c/add with-xy-axis p)) p)]
    (c/transform p (c/tf-vflip))))

(defn chart-bar
  "Constructs a bar chart.

  For example, (chart-bar [10 20 30 40]) is
  ■■■■■■■■■■■■■ 10
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■ 20
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 30
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ 40
  "
  [ns & {:keys [labels
                max-length
                bar-symbol
                horizontal]
         :or {labels ns
              horizontal true}}]
  {:pre [(or (nil? max-length)
             (pos? max-length))]}
  (let [min-n (apply min ns)
        max-n (apply max ns)
        max-length (or max-length (if horizontal 40 10))
        max-delta (- max-n min-n)
        unit (/ max-length (if (zero? max-delta) max-length max-delta))
        scaled-ns (map (fn [v] (c/round (* v unit))) ns)
        bar-symbol (cond
                     bar-symbol bar-symbol
                     horizontal "■"
                     :else "█")
        text-labels (if horizontal
                      (take (count ns) (map #(text (str %)) labels))
                      (take (count ns) (map (fn [l]
                                              (-> (str l)
                                                  text
                                                  (c/transform (c/tf-transpose))))
                                            labels)))]
    (if horizontal
      (l/valign (for [[n text-label] (map vector scaled-ns text-labels)]
                  (l/=== 1 (hline n bar-symbol) text-label)))
      (let [chart (l/halign (for [n scaled-ns]
                              (or (vline n bar-symbol) (text ""))) 2)
            flipped-chart (c/transform chart (c/tf-vflip))]
        (assoc flipped-chart
               [0 0]
               (l/halign text-labels 2))))))


<|start_filename|>src/pp_grid/examples.clj<|end_filename|>
(ns pp-grid.examples
  (:require [pp-grid.api :as g]))

(defn make-grid-illustration [max-x max-y]
  (let [cells (->> (for [y (range (inc max-y))]
                     (for [x (range (inc max-x))]
                       (g/box1 (g/text (str "(" x "," y ")")))))
                   (map g/halign)
                   g/valign)
        x-axis (g/===
                1
                (g/arrow-right (+ (:width cells) 2) \-)
                (g/text "x"))
        y-axis (g/||
                0
                (g/arrow-down (+ (:height cells) 2) \|)
                (g/text "y"))]
    (g/halign [y-axis (g/valign [x-axis cells])] 0)))

(defn make-hello-world []
  (-> (g/empty-grid)
      (assoc [0 0] \H
             [1 0] \E
             [2 0] \L
             [3 0] \L
             [4 0] \O
             [5 0] \space
             [6 0] \W
             [7 0] \O
             [8 0] \R
             [9 0] \L
             [10 0] \D)))

(defn make-abcd []
  (-> (g/empty-grid)
      (assoc [0 0] \A
             [10 0] \B
             [0 10] \C
             [10 10] \D
             [5 5] \*)))

(defn make-boxed-abcd []
  (-> (make-abcd)
      (g/box :left-padding 1 :right-padding 1)))

(defn make-haligned-boxes []
  (let [b (g/box "B")
        b0 (g/box0 "B0")
        b1 (g/box1 "B1")
        b2 (g/box2 "B2")
        b3 (g/box3 "B3")
        b4 (g/box4 "B4")
        b5 (g/box5 "B5" :left-padding 2 :right-padding 2 :top-padding 2 :bottom-padding 2)]
    (g/halign [b b0 b1 b2 b3 b4 b5] 1)))

(defn make-tables []
  (let [data [{:a 1 :b 2 :c 3}
              {:a 10 :b 20 :c 30}]
        t0 (g/table [:a :b] data)
        t1 (g/table1 [:a :b] data)
        t2 (g/table2 [:a :b] data)
        t3 (g/table3 [:a :b] data)
        matrix (g/matrix [:a :b] data)
        alphabets (g/table* (map #(g/box1 (char %)) (range 65 91)) 10)]
    (g/valign [t0 t1 t2 t3 matrix alphabets])))

(defn make-nested-table []
  (let [data [{:a 1 :b 2 :c 3 :d 4 :e 5}
              {:a 10 :b 20 :c 30 :d 40 :e 50}]
        t0 (g/table [:a :b :c :d :e] data)
        t1 (g/table1 [:a :b] data)
        abcd (make-boxed-abcd)]
    (g/table3 [:a :b :t0 :c :t1]
              [{:a 100
                :b 200
                :t0 t0
                :c abcd
                :t1 t1}])))

(defn make-colored-table []
  (let [data [{:a 1 :b 2}
              {:a 10 :b 20}
              {:a 100 :b 200}
              {:a 1000 :b 2000}]]
    (g/table2 [:a :b] data true [g/ESCAPE-CODE-BACKGROUND-GREEN
                                 g/ESCAPE-CODE-BACKGROUND-BRIGHT-MAGENTA
                                 g/ESCAPE-CODE-BACKGROUND-BRIGHT-BLUE])))

(defn make-colored-boxes []
  (let [abcd (make-abcd)
        b0 (g/box1
            abcd
            :fill-escape-codes [g/ESCAPE-CODE-BACKGROUND-BLUE])
        b1 (g/box1
            abcd
            :fill-escape-codes [g/ESCAPE-CODE-BOLD
                                g/ESCAPE-CODE-RED])
        b2 (g/box0
            abcd
            :fill-escape-codes [g/ESCAPE-CODE-BOLD
                                g/ESCAPE-CODE-BRIGHT-GREEN
                                g/ESCAPE-CODE-BACKGROUND-BRIGHT-WHITE])
        b3 (g/box2
            abcd
            :fill-escape-codes [g/ESCAPE-CODE-BOLD
                                g/ESCAPE-CODE-RED
                                g/ESCAPE-CODE-UNDERLINE])]
    (g/halign [b0 b1 b2 b3])))

(defn make-decorated-text [s]
  (-> s
      g/text
      (g/decorate g/ESCAPE-CODE-BACKGROUND-BLUE)))

(defn make-tree []
  (g/tree [1 2 [3 4] [:a :b [10 20]]]))

(defn make-chart-xy []
  (g/chart-xy (range)
              [0 1 2 3 2 1 0 1 2 3 2 1 0]
              :max-height 3))

(defn make-chart-bar []
  (g/chart-bar [20 80 100 200 400]))

(defn make-chart-bar-vertical []
  (g/chart-bar [100 200 250 360] :horizontal false))

(defn make-transformations []
  (let [abcd (make-boxed-abcd)
        width (:width abcd)
        height (:height abcd)
        hflipped-abcd (g/transform abcd (g/tf-hflip))
        vflipped-abcd (g/transform abcd (g/tf-vflip))
        vflipped-hflipped-abcd (g/transform hflipped-abcd (g/tf-vflip))]
    (-> abcd
        (assoc [width 0] hflipped-abcd)
        (assoc [0 height] vflipped-abcd)
        (assoc [width height] vflipped-hflipped-abcd)
        (g/transform (g/tf-scale 0.75 0.75)))))

(defn make-diagram []
  (let [a (g/box1 "a")
        b (g/box1 "b")
        c (g/box1 "c")
        d (g/box1 "d")

        abcd (g/transform (make-boxed-abcd) (g/tf-scale 0.75 0.75))
        chart (g/chart-bar [10 20 30] :max-length 4)

        ra (g/arrow-right 5)
        c0 (-> (interpose ra [a abcd b])
               (g/halign 1 true)
               g/box)
        c1 (-> (interpose ra [d chart])
               (g/halign 1 true)
               g/box)
        c2 (-> (g/arrow-ne 3 "/" "*" "e")
               (assoc [0 0] (g/arrow-se 3 "\\" "*" "f")))]
    (g/halign (interpose ra [c0 c c1 c2]) 1 true)))

(defn make-paragraphs []
  (let [p0 (g/paragraph
            "Lorem ipsum dolor sit amet. Et dolor minima non expedita
             exercitationem nam quibusdam totam. Et voluptatibus sint a
             provident harum ut totam reprehenderit.")
        p1 (g/paragraph
            "In quia voluptas ad voluptates enim ut officia quaerat
             quo illum atque. Ut veniam dolorem non nisi quia est facere
             iure est dolore eius non tenetur voluptatem. 33 autem
             sequi et itaque totam sed reiciendis adipisci est quaerat voluptas.
             Qui suscipit corrupti qui natus adipisci est voluptatibus cumque
             sed natus rerum et dolores blanditiis et iusto quibusdam?" 0 0 60 1)
        p2 (g/paragraph
            "Ut iste libero et debitis alias eum possimus maxime. Eum magnam
             aspernatur ex accusamus commodi distinctio quia aut nostrum
             molestiae non totam reprehenderit quo inventore sequi." 0 0 50 3)]
    (g/valign [p0 p1 p2] 1)))


<|start_filename|>project.clj<|end_filename|>
(defproject org.clojars.rorokimdim/pp-grid "0.1.15"
  :description "A clojure library for constructing formatted text."
  :url "https://github.com/rorokimdim/pp-grid"
  :license {:name "MIT License"
            :url "https://opensource.org/licenses/MIT"}

  :plugins [[cider/cider-nrepl "0.28.1"]
            [mx.cider/enrich-classpath "1.5.2"]
            [lein-ancient "1.0.0-RC3"]
            [lein-shell "0.5.0"]]

  :dependencies [[org.clojure/clojure "1.10.1"]
                 [potemkin "0.4.5"]]


  :repl-options {:init-ns pp-grid.repl}
  :aliases {"lint" ["shell" "clj-kondo" "--lint" "src" "test" "dev"]}


  :target-path "target/%s"
  :profiles {:uberjar {:aot :all
                       :jvm-opts ["-Dclojure.compiler.direct-linking=true"]}
             :repl {:source-paths ["dev"]
                    :dependencies [[criterium "0.4.6"]]}})


<|start_filename|>src/pp_grid/core.cljc<|end_filename|>
(ns pp-grid.core
  (:require
   #?@(:bb
       [[clojure.string :as s]
        [clojure.pprint]

        [pp-grid.ansi-escape-code :as ecodes]]
       :clj
       [[clojure.string :as s]
        [clojure.pprint]

        [potemkin :as p]

        [pp-grid.ansi-escape-code :as ecodes]])))

(declare
 add
 compute-ranges
 empty-grid
 empty-metadata
 escaped-char?
 grid?
 height
 render
 render-grid
 tf-translate
 transform
 update-ranges
 valid-key?
 valid-value?
 validate-key
 validate-value
 width)

(defrecord EscapedChar [escape-code value]
  Object
  (toString [this] (render this)))

#?(:bb
   :skip
   :clj
   #_:clj-kondo/ignore
   (p/def-map-type Grid [m metadata]
     (get [this k default-value]
          (if (vector? k)
            (get m k default-value)
            (cond
              (= k :min-x) (first (:mins metadata))
              (= k :max-x) (first (:maxs metadata))
              (= k :min-y) (second (:mins metadata))
              (= k :max-y) (second (:maxs metadata))
              (= k :width) (width this)
              (= k :height) (height this)
              (= k :m) m
              :else (get metadata k default-value))))
     (assoc [this k v]
            (when (and (validate-key (:dimension metadata) k) (validate-value v))
              (if (grid? v)
                (let [ds (map - k (:mins v))]
                  (add this (transform v (apply tf-translate ds))))
                (Grid. (assoc m k v) (update-ranges metadata k)))))
     (dissoc [this k]
             (when (validate-key (:dimension metadata) k)
               (let [new-g (Grid. (dissoc m k) metadata)
                     dimension (:dimension metadata)]
                 (with-meta new-g (apply update-ranges
                                         (empty-metadata dimension)
                                         (keys new-g))))))
     (keys [this] (keys m))
     (meta [this] metadata)
     (empty [this] (Grid. (empty m) (empty-metadata (:dimension metadata))))
     (with-meta [this metadata] (Grid. m metadata))
     clojure.lang.IPersistentCollection
     (equiv
      [this x]
      (if (string? x)
        (= (render this) x)
        (and (or (instance? java.util.Map x) (map? x))
             (= x m))))
     Object
     (toString [this] (render this))))

#?(:bb
   (defn ->Grid
     "Adapted from https://blog.wsscode.com/guide-to-custom-map-types/."
     [m metadata]
     (let [->GridEntry (fn [k v]
                         (proxy [clojure.lang.AMapEntry] []
                           (key [] k)
                           (val [] v)
                           (getKey [] k)
                           (getValue [] v)))
           lookup (fn [k default-value]
                    (if (vector? k)
                      (get m k default-value)
                      (cond
                        (= k :min-x) (first (:mins metadata))
                        (= k :max-x) (first (:maxs metadata))
                        (= k :min-y) (second (:mins metadata))
                        (= k :max-y) (second (:maxs metadata))
                        (= k :width) (width (->Grid m metadata))
                        (= k :height) (height (->Grid m metadata))
                        (= k :m) m
                        :else (get metadata k default-value))))]
       (proxy [clojure.lang.APersistentMap
               clojure.lang.IMeta
               clojure.lang.IObj]
           []
         (valAt
           ([k]
            (lookup k nil))
           ([k default-value]
            (lookup k default-value)))
         (iterator []
           (.iterator ^java.lang.Iterable
                      (eduction
                       (map #(->GridEntry % (get this %)))
                       (keys m))))

         (containsKey [k] (or (contains? m k)
                              (#{:min-x :max-x
                                 :min-y :max-y
                                 :width :height
                                 :m} k)))
         (entryAt [k]
           (let [default (gensym)
                 v (lookup k default)]
             (when (not= v default)
               (->GridEntry k v))))
         (equiv [x]
           (if (string? x)
             (= (render (->Grid m metadata)) x)
             (= m x)))
         (empty [] (->Grid (empty m) (empty-metadata (:dimension metadata))))
         (count [] (count m))
         (assoc [k v]
           (when (and (validate-key (:dimension metadata) k) (validate-value v))
             (if (grid? v)
               (let [ds (map - k (:mins v))]
                 (add (->Grid m metadata) (transform v (apply tf-translate ds))))
               (->Grid (assoc m k v) (update-ranges metadata k)))))
         (without [k]
           (when (validate-key (:dimension metadata) k)
             (let [dimension (:dimension metadata)
                   new-g (->Grid (dissoc m k) {})]
               (with-meta new-g (apply update-ranges
                                       (empty-metadata dimension)
                                       (keys new-g))))))
         (seq [] (some->> (keys m)
                          (map #(->GridEntry % (get this %)))))
         (meta [] metadata)
         (withMeta [meta] (->Grid m meta))
         (toString []
           (render-grid (->Grid m metadata))))))
   :clj
   (defn ->Grid [m metadata]
     (Grid. m metadata)))

(defn empty-metadata
  ([] (empty-metadata 2))
  ([dimension] {:dimension dimension :grid? true}))

(defn empty-grid
  ([]
   (empty-grid 2))
  ([dimension]
   {:pre [(integer? dimension)
          (pos? dimension)]}
   (->Grid {} (empty-metadata dimension))))

(defn width [x]
  (cond
    (string? x) (->> x
                     (take-while #(not= % \newline))
                     count)
    (grid? x) (if (empty? x)
                0
                (inc (- (:max-x x) (:min-x x))))
    :else (width (str x))))

(defn height [x]
  (cond
    (string? x) (->> x
                     (filter #(= % \newline))
                     count
                     inc)
    (grid? x) (if (empty? x) 0
                  (inc (- (:max-y x) (:min-y x))))
    :else (height (str x))))

(defn escaped-char? [x]
  (instance? EscapedChar x))

#?(:bb
   (defn grid? [x]
     (boolean (:grid? (meta x))))
   :clj
   (defn grid? [x]
     (instance? Grid x)))

(defn escaped-char [c escape-code]
  (->EscapedChar escape-code c))

(defn update-ranges
  [metadata & ks]
  (if (empty? ks)
    metadata
    (let [mins (:mins metadata nil)
          maxs (:maxs metadata nil)]
      (assoc metadata
             :mins (apply (partial map min)
                          (if (nil? mins) ks (conj ks mins)))
             :maxs (apply (partial map max)
                          (if (nil? maxs) ks (conj ks maxs)))))))

(defn add
  "Constructs a grid with all given grids added together."
  [& gs]
  (let [gs (remove empty? gs)]
    (cond
      (empty? gs) nil
      (= 1 (count gs)) (first gs)
      :else (let [ga (first gs)
                  metadata (meta ga)
                  new-m (apply assoc
                               (:m ga)
                               (mapcat identity (apply concat (rest gs))))]
              (->Grid new-m (apply update-ranges metadata (keys new-m)))))))

(defn subtract
  "Returns the first grid minus keys in rest of the grids."
  [& gs]
  (reduce
   (fn [ga gb]
     (cond
       (empty? gb) ga
       (empty? ga) (reduced ga)
       :else (apply dissoc ga (keys gb))))
   (first gs)
   (rest gs)))

(defn decorate
  "Decorates a grid with given ansi-escape-codes."
  [g & escape-codes]
  (reduce
   (fn [acc [k v]]
     (let [escape-code (apply str escape-codes)
           new-v (if (escaped-char? v)
                   (->EscapedChar (apply str escape-code (:escape-code v))
                                  (:value v))
                   (->EscapedChar escape-code v))]
       (assoc acc k new-v)))
   (empty g)
   g))

(defn ++
  "Convenience wrapper for add to accept grids as args."
  [& gs]
  (add gs))

(defn --
  "Convenience wrapper for subtract to accept grids as args."
  [& gs]
  (subtract gs))

(defn valid-key? [dimension k]
  (and
   (vector? k)
   (every? integer? k)
   (= (count k) dimension)))

(defn valid-value? [v]
  (or (grid? v)
      (string? v)
      (escaped-char? v)
      (char? v)
      (contains? (methods render) (type v))))

(defn validate-key [dimension k]
  (when-not (valid-key? dimension k)
    (throw (IllegalArgumentException. (str "Key expected to be a vector of "
                                           dimension " integers"))))
  k)

(defn validate-value [v]
  (when-not (valid-value? v)
    (throw (IllegalArgumentException. (str  "Value must be a char, a Grid or a EscapedChar; got " v))))
  true)

(defn round [n]
  (if (integer? n)
    n
    (Math/round (double n))))

(defn transform
  "Transforms a grid into another grid using given transformation function.

  A transformation function accepts a key (coordinate vector) and returns another key.

  For example transformation functions, take a look at the tf-* functions."
  ([g f] (transform g f (:dimension g)))
  ([g f dimension]
   (let [transformed (persistent!
                      (reduce
                       (fn [acc [k v]]
                         (let [new-k (into [] (map round (f k)))]
                           (assoc! acc new-k v)))
                       (transient {})
                       g))]
     (->Grid transformed
             (apply update-ranges
                    (empty-metadata dimension)
                    (keys transformed))))))

(defn tf-translate
  "Returns a function that translates a coordinate by given deltas.

  For example, ((tf-translate 10 20) [1 2]) = [11 22]."
  [& deltas]
  (fn [k]
    (map + k (take (count k) (concat deltas (repeat 0))))))

(defn tf-scale
  "Returns a function that scales a coordinate by given amounts.

  For example, ((tf-scale 10 2) [3 2]) = [30 4]."
  [& ns]
  (fn [k]
    (map * k (take (count k) (concat ns (repeat 1))))))

(defn tf-transpose
  "Returns a function that transposes a coordinate.

  Returns a function just to keep it consistent with other tf-*
  functions.

  For example, ((tf-transpose) [1 2]) = [2 1]."
  []
  (fn [k]
    (reverse k)))

(defn tf-hflip
  "Returns a function that horizontally flips a coordinate.

  Returns a function just to keep it consistent with other tf-*
  functions.

  For example, ((tf-hflip) [1 2]) = [-1 2]."
  []
  (fn [k]
    (let [[x y] (validate-key 2 k)]
      (list (- x) y))))

(defn tf-vflip
  "Returns a function that vertically flips a coordinate.

  Returns a function just to keep it consistent with other tf-*
  functions.

  For example, ((tf-vflip) [1 2]) = [1 -2]."
  []
  (fn [k]
    (let [[x y] (validate-key 2 k)]
      (list x (- y)))))

(defn tf-project
  "Returns a function that projects a coordinate into given dimension.

  For example, ((tf-project 2) [1 2 3 4 5]) = [1 2].

  A project-fn can be passed in to change how a coordinate is projected.
  By default, the identity function is used."
  ([target-dimension]
   (tf-project target-dimension identity))
  ([target-dimension project-fn]
   (fn [k]
     (take target-dimension (concat (project-fn k) (repeat 0))))))

(defn tf-rotate
  "Returns a function that rotates a coordinate by given angle in radians."
  [radians]
  (fn [k]
    (let [[x y] (validate-key 2 k)]
      (list
       (- (* x (Math/cos radians))
          (* y (Math/sin radians)))
       (+ (* x (Math/sin radians))
          (* y (Math/cos radians)))))))

(defn tf-rotate-90-degrees
  "Returns a function that rotates a coordinate by 90 degrees."
  []
  (fn [k]
    (let [[x y] (validate-key 2 k)]
      (list (- y) x))))

(defn tf-shear
  "Returns a function that shears a coordinate by given factors.

  See https://en.wikipedia.org/wiki/Shear_mapping.

  For example, ((tf-shear 2 3) [10 5]) = [10 + 2 * 5, 5 + 3 * 10] = [20 35]."
  [a b]
  (fn [[x y & zs]]
    (concat [(+ x (* a y)) (+ y (* b x))] zs)))

(defmulti ^String render-grid :dimension)

(defmethod render-grid 1 [g]
  (if (empty? g)
    nil
    (let [min-x (:min-x g)
          max-x (:max-x g)
          xs (range min-x (inc max-x))
          get-rendered (fn [x] (render (get g [x] " ")))]
      (apply str (map get-rendered xs)))))

#_{:clj-kondo/ignore [:unresolved-namespace]}
(defmethod render-grid 2 [g]
  (if (empty? g)
    nil
    (let [min-x (:min-x g)
          min-y (:min-y g)
          max-x (:max-x g)
          max-y (:max-y g)
          xs (range min-x (inc max-x))
          ys (range min-y (inc max-y))
          get-rendered (fn [x y] (render (get g [x y] " ")))]
      (s/join
       \newline
       (for [y ys]
         (apply str (map get-rendered xs (repeat y))))))))

(defmethod render-grid :default [g]
  (if (empty? g)
    nil
    (render-grid (transform g (tf-project 2) 2))))

(defmulti ^String render type)

(defmethod render String [x] x)

(defmethod render :default [x]
  (if (grid? x)
    (render-grid x)
    (str x)))

#_{:clj-kondo/ignore [:unresolved-namespace]}
(defmethod render EscapedChar [x]
  (str (:escape-code x)
       (:value x)
       ecodes/ESCAPE-CODE-RESET))


;;
;; Overwrite how Grid and EscapedChar get printed: Make them print the rendered string
;;
#?(:bb
   :skip
   :clj
   (do
     (defmethod print-method Grid [g ^java.io.Writer w]
       (.write w (render g)))

     (defmethod print-method EscapedChar [x ^java.io.Writer w]
       (.write w (render x)))

     (defmethod clojure.pprint/simple-dispatch Grid [g]
       (println (render g)))

     (defmethod clojure.pprint/simple-dispatch EscapedChar [x]
       (println (render x)))))
