├── .gitignore ├── LICENSE ├── bb.edn ├── cli.org ├── deps.edn ├── examples ├── algorithms.clj ├── algorithms.html ├── basics.clj ├── basics.html ├── bezier.clj ├── bezier.html ├── blossom.clj ├── blossom.svg ├── circles.svg ├── layout.clj ├── layout.html ├── load-svg-test.svg ├── offset.clj ├── offset.html └── quilt.png ├── readme.md ├── release.edn ├── src └── svg_clj │ ├── algorithms.cljc │ ├── composites.cljc │ ├── elements.cljc │ ├── jvm_utils.clj │ ├── layout.cljc │ ├── parametric.cljc │ ├── path.cljc │ ├── tools.clj │ ├── transforms.cljc │ ├── utils.cljc │ └── viewers.cljs ├── svg-clj.org └── test └── svg_clj ├── elements_test.cljc ├── path_test.cljc ├── tools_test.cljc └── utils_test.cljc /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | *.jar 4 | *.class 5 | .lsp/ 6 | .clj-kondo/ 7 | /public/ 8 | /lib/ 9 | /classes/ 10 | /target/ 11 | /checkouts/ 12 | .lein-deps-sum 13 | .lein-repl-history 14 | .lein-plugins/ 15 | .lein-failures 16 | .nrepl-port 17 | .cpcache/ 18 | .shadow-cljs/ 19 | _tmp.svg 20 | *.txt 21 | svgcli 22 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 adam-james 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /bb.edn: -------------------------------------------------------------------------------- 1 | {:tasks 2 | {:requires ([babashka.fs :as fs] 3 | [clojure.string :as str]) 4 | :init (def windows? (str/starts-with? (System/getProperty "os.name") 5 | "Windows")) 6 | lint 7 | {:doc "Lint the project with clj-kondo" 8 | :task (shell "clj-kondo --lint src/svg_clj examples")} 9 | 10 | test 11 | {:doc "Run the tests" 12 | :task (shell "clj -M:test")} 13 | 14 | run-main 15 | {:doc "Run main" 16 | :task (apply clojure "-M -m svg-clj.cli" *command-line-args*)} 17 | 18 | uberjar 19 | {:doc "Builds uberjar" 20 | :task (when (seq (fs/modified-since "svg_clj.jar" "src")) 21 | (clojure "-X:uberjar"))} 22 | 23 | run-uber 24 | {:doc "Run uberjar" 25 | :depends [uberjar] 26 | :task (apply shell "java -jar svg_clj.jar" *command-line-args*)}}} 27 | -------------------------------------------------------------------------------- /cli.org: -------------------------------------------------------------------------------- 1 | * ;; 2 | #+Title: cli 3 | #+AUTHOR: adam-james 4 | #+STARTUP: overview 5 | #+EXCLUDE_TAGS: excl 6 | #+PROPERTY: header-args :cache yes :noweb yes :results value :mkdirp yes :padline yes :async 7 | #+HTML_DOCTYPE: html5 8 | #+OPTIONS: toc:2 num:nil html-style:nil html-postamble:nil html-preamble:nil html5-fancy:t 9 | 10 | Use this org file to experiment with CLI creation. Keep CLI functionality out of the main library, to keep things clean and lean. 11 | 12 | ** deps.edn 13 | #+NAME: deps.edn 14 | #+begin_src clojure 15 | {:deps 16 | {org.clojure/clojure {:mvn/version "1.10.3"} 17 | org.clojure/tools.cli {:mvn/version "1.0.206"} 18 | org.clojure/test.check {:mvn/version "1.1.0"} 19 | org.clojure/data.xml {:mvn/version "0.0.8"} 20 | same/ish {:mvn/version "0.1.4"} 21 | hawk/hawk {:mvn/version "0.2.11"} 22 | hiccup/hiccup {:mvn/version "2.0.0-alpha2"} 23 | batik-rasterize/batik-rasterize {:local/root "/Users/adam/dev/batik-rasterize"} #_{:mvn/version "0.1.2"} 24 | borkdude/sci {:mvn/version "0.2.5"}} 25 | 26 | :aliases {:test {:extra-paths ["test"] 27 | :extra-deps {com.cognitect/test-runner {:git/url "https://github.com/cognitect-labs/test-runner.git" 28 | :sha "209b64504cb3bd3b99ecfec7937b358a879f55c1"}} 29 | :main-opts ["-m" "cognitect.test-runner"]} 30 | :uberjar 31 | {:replace-deps 32 | {com.github.seancorfield/depstar {:mvn/version "2.0.216"}} 33 | :exec-fn hf.depstar/uberjar 34 | :exec-args {:jar svg_clj.jar 35 | :main-class svg-clj.cli 36 | :aot true}}}} 37 | 38 | #+end_src 39 | 40 | ** bb.edn 41 | always need GRAALVM_HOME set 42 | If you want to run an agent to help build a reflect-config.json, then you need to set JAVA executable to GRAAL version as well. 43 | 44 | export GRAALVM_HOME=/Users/adam/Downloads/graalvm-ce-java11-21.1.0/Contents/Home 45 | export JAVA_HOME=$GRAALVM_HOME 46 | 47 | binary file reduction: 'upx', which is a binary compression tool. 48 | 49 | 1. Run bb gen-reflect with -i drawing.clj -w 50 | 51 | This causes the GraalVM agent to correctly walk the codepath that requires the watcher libs/classes. 52 | 53 | Check that the uberjar is running by making a trivial change (such as adding a space) to drawing.clj and saving. You should see a message in the terminal. If successful, you can quit the watcher with CTRL-C in the terminal. 54 | 55 | 2. Edit the generated reflect-config.json. Manually Replace 56 | 57 | { 58 | "name":"java.lang.reflect.Method", 59 | "methods":[{"name":"canAccess","parameterTypes":["java.lang.Object"] }] 60 | }, 61 | 62 | with 63 | 64 | { 65 | "name":"java.lang.reflect.AccessibleObject", 66 | "methods":[{"name":"canAccess"}] 67 | }, 68 | 69 | And add the following to the end of the list: 70 | 71 | { 72 | "name":"com.barbarysoftware.watchservice.StandardWatchEventKind$StdWatchEventKind[]", 73 | "allPublicMethods":true 74 | }, 75 | 76 | This is true on MacOS... I don't yet know how this works on linux or windows. 77 | 78 | 79 | 3. Run bb native-image 80 | 81 | 4. Test the binary by running ./svg_clj -i drawing.clj 82 | 83 | This should successfully produce drawing.svg in the directory. 84 | 85 | 5. Test the binary by running ./svg_clj -i drawing.clj -w 86 | 87 | This should successfully start a watcher. Check that it responds to file changes by saving a trivial change to drawing.clj. For example, add a space somewhere and save. 88 | 89 | 90 | #+begin_src clojure 91 | {:tasks 92 | {:requires ([babashka.fs :as fs] 93 | [clojure.string :as str]) 94 | :init (def windows? (str/starts-with? (System/getProperty "os.name") 95 | "Windows")) 96 | run-main 97 | {:doc "Run main" 98 | :task (apply clojure "-M -m svg-clj.cli" *command-line-args*)} 99 | 100 | uberjar 101 | {:doc "Builds uberjar" 102 | :task (when (seq (fs/modified-since "svg_clj.jar" "src")) 103 | (clojure "-X:uberjar"))} 104 | 105 | run-uber 106 | {:doc "Run uberjar" 107 | :depends [uberjar] 108 | :task (apply shell "java -jar svg_clj.jar" *command-line-args*)} 109 | 110 | graalvm 111 | {:doc "Checks GRAALVM_HOME env var" 112 | :task 113 | (let [env (System/getenv "GRAALVM_HOME")] 114 | (assert "Set GRAALVM_HOME") 115 | env)} 116 | 117 | gen-reflect-config 118 | {:doc "Runs scripts/gen-reflect-config.clj on the compiled jar." 119 | :depends [graalvm uberjar] 120 | :task (binding [*command-line-args* ["java" "-jar" "svg_clj.jar" "-i" "drawing.clj"]] 121 | (load-file "scripts/gen-reflect-config.clj"))} 122 | 123 | native-image 124 | {:doc "Builds native image" 125 | :depends [graalvm uberjar gen-reflect-config] 126 | :task (do 127 | (shell (str (fs/file graalvm 128 | "bin" 129 | (if windows? 130 | "gu.cmd" 131 | "gu"))) 132 | "install" "native-image") 133 | (shell (str (fs/file graalvm 134 | "bin" 135 | (if windows? 136 | "native-image.cmd" 137 | "native-image"))) 138 | "-H:Name=svg-clj" 139 | "-H:ReflectionConfigurationFiles=reflect-config-cleaned.json" 140 | "-jar" "svg_clj.jar" 141 | "--initialize-at-build-time" 142 | "--no-fallback" 143 | "--no-server"))}}} 144 | 145 | #+end_src 146 | 147 | ** build-scripts 148 | Use these scripts to help with the native-image build process. Jar/uberjar builds work just fine with bb tasks already. 149 | 150 | This script is from borkdude's example repo: 151 | 152 | [[https://github.com/borkdude/refl/blob/main/script/gen-reflect-config.clj]] 153 | 154 | This script takes a reflect-config.json and cleans it up by removing unnecessary clojure classes and fixing the bug(?) where java.lang.reflect.Method causes native-image to fail at setup phase. 155 | 156 | #+begin_src clojure :tangle ./scripts/gen-reflect-config.clj 157 | #!/usr/bin/env bb 158 | 159 | (require '[babashka.process :refer [process]] 160 | '[cheshire.core :as cheshire] 161 | '[clojure.string :as str]) 162 | 163 | (def trace-cmd *command-line-args*) 164 | 165 | (def trace-agent-env "-agentlib:native-image-agent=trace-output=trace-file.json") 166 | (def config-agent-env "-agentlib:native-image-agent=config-output-dir=.") 167 | 168 | @(process trace-cmd {:inherit true :extra-env {"JAVA_TOOL_OPTIONS" trace-agent-env}}) 169 | @(process trace-cmd {:inherit true :extra-env {"JAVA_TOOL_OPTIONS" config-agent-env}}) 170 | 171 | (def trace-json (cheshire/parse-string (slurp "trace-file.json") true)) 172 | 173 | ;; [Z = boolean 174 | ;; [B = byte 175 | ;; [S = short 176 | ;; [I = int 177 | ;; [J = long 178 | ;; [F = float 179 | ;; [D = double 180 | ;; [C = char 181 | ;; [L = any non-primitives(Object) 182 | 183 | (defn normalize-array-name [n] 184 | ({"[F" "float[]" 185 | "[B" "byte[]" 186 | "[Z" "boolean[]" 187 | "[C" "char[]" 188 | "[D" "double[]" 189 | "[I" "int[]" 190 | "[J" "long[]" 191 | "[S" "short[]"} n n)) 192 | 193 | (def ignored (atom #{})) 194 | (def unignored (atom #{})) 195 | 196 | (defn ignore [{:keys [:tracer :caller_class :function :args] :as _m}] 197 | (when (= "reflect" tracer) 198 | (when-let [arg (first args)] 199 | (let [arg (normalize-array-name arg)] 200 | (if (and caller_class 201 | (or (= "clojure.lang.RT" caller_class) 202 | (= "clojure.genclass__init" caller_class) 203 | (and (str/starts-with? caller_class "clojure.core$fn") 204 | (= "java.sql.Timestamp" arg))) 205 | (= "forName" function)) 206 | (swap! ignored conj arg) 207 | (when (= "clojure.lang.RT" caller_class) 208 | ;; unignore other reflective calls in clojure.lang.RT 209 | (swap! unignored conj arg))))))) 210 | 211 | (run! ignore trace-json) 212 | 213 | ;; (prn @ignored) 214 | ;; (prn @unignored) 215 | 216 | (defn process-1 [{:keys [:name] :as m}] 217 | (when-not (and (= 1 (count m)) 218 | (contains? @ignored name) 219 | (not (contains? @unignored name))) 220 | ;; fix bug(?) in automated generated config 221 | (if (= "java.lang.reflect.Method" name) 222 | (assoc m :name "java.lang.reflect.AccessibleObject") 223 | m))) 224 | 225 | (def config-json (cheshire/parse-string (slurp "reflect-config.json") true)) 226 | 227 | (def cleaned (keep process-1 config-json)) 228 | 229 | (spit "reflect-config-cleaned.json" (cheshire/generate-string cleaned {:pretty true})) 230 | 231 | #+end_src 232 | 233 | * tools 234 | ** ns 235 | #+begin_src clojure :tangle ./src/svg_clj/tools.clj 236 | (ns svg-clj.tools 237 | (:require [clojure.string :as str] 238 | [clojure.java.shell :refer [sh]] 239 | [clojure.java.browse] 240 | [clojure.java.io] 241 | [hiccup.core :refer [html]] 242 | [svg-clj.elements :as svg] 243 | [svg-clj.composites :refer [svg]] 244 | [svg-clj.path :as path] 245 | [svg-clj.transforms :as tf] 246 | [batik.rasterize :as b] 247 | [svg-clj.utils :as utils])) 248 | 249 | #+end_src 250 | 251 | ** png 252 | #+begin_src clojure :tangle ./src/svg_clj/tools.clj 253 | (defn sh-png! [svg-data fname] 254 | (sh "convert" "-background" "none" "/dev/stdin" fname 255 | :in (html svg-data))) 256 | 257 | (defn png! [svg-data fname] 258 | (b/render-svg-string (html svg-data) fname)) 259 | 260 | #+end_src 261 | 262 | ** save-load 263 | #+begin_src clojure :tangle ./src/svg_clj/tools.clj 264 | (defn save-svg 265 | [svg-data fname] 266 | (let [data (if (= (first svg-data) :svg) 267 | svg-data 268 | (svg svg-data))] 269 | (spit fname (html data)))) 270 | 271 | (defn load-svg 272 | [fname] 273 | (-> fname 274 | slurp 275 | utils/svg-str->elements)) 276 | #+end_src 277 | 278 | ** repl-show 279 | #+begin_src clojure :tangle ./src/svg_clj/tools.clj 280 | (defn cider-show 281 | [svg-data] 282 | (let [fname "_imgtmp.png" 283 | data (if (= (first svg-data) :svg) 284 | svg-data 285 | (svg svg-data))] 286 | (do (png! data fname) 287 | (clojure.java.io/file fname)))) 288 | 289 | (defn show 290 | [svg-data] 291 | (let [fname "_tmp.svg"] 292 | (do (save-svg svg-data fname)) 293 | (clojure.java.io/file fname))) 294 | 295 | #+end_src 296 | 297 | * cli 298 | This is a WIP. 299 | 300 | The idea is to have a CLI tool that 'compiles' svg-clj code into an SVG file. 301 | 302 | GraalVM native image: 303 | 304 | bb native-image 305 | 306 | The resulting executable will be svg_clj and works for exporting .svg files, but fails with .png due to reflection issues with the Batik library. 307 | 308 | Fixing this might be possible with alteration to reflect-config.json and/or adding type hints (via a Github pull request perhaps?) to the batik library. 309 | 310 | #+begin_src clojure 311 | (ns svg-clj.cli 312 | (:require [clojure.string :as str] 313 | [clojure.tools.cli :as cli] 314 | [hiccup.core :refer [html]] 315 | [svg-clj.composites :as cp :refer [svg]] 316 | [svg-clj.utils :as utils] 317 | [svg-clj.elements :as el] 318 | [svg-clj.path :as path] 319 | [svg-clj.transforms :as tf] 320 | [svg-clj.layout :as lo] 321 | [sci.core :as sci]) 322 | (:gen-class)) 323 | 324 | #+end_src 325 | 326 | ** load-file 327 | For GraalVM native image, you can't use Clojure's loading functions. Luckily, Borkdude's Simple Clojure Interpreter (SCI) has eval-string capability which we can use to load our namespaces and evaluate files from a native image. 328 | 329 | #+begin_src clojure 330 | (def my-ns-map 331 | (into {} 332 | (map #(vector % (ns-publics %)) 333 | ['svg-clj.composites 334 | 'svg-clj.utils 335 | 'svg-clj.elements 336 | 'svg-clj.path 337 | 'svg-clj.transforms 338 | 'svg-clj.layout]))) 339 | 340 | (defn sci-load-file 341 | [fname] 342 | (-> (slurp fname) 343 | (sci/eval-string {:namespaces my-ns-map}))) 344 | 345 | #+end_src 346 | 347 | ** cli 348 | #+begin_src clojure 349 | (def cli-options 350 | [["-i" "--infile FNAME" "The file to be compiled." 351 | :default nil] 352 | ["-o" "--outfile FNAME" "The output filename. Valid Extensions: svg" 353 | :default nil] 354 | ["-h" "--help"]]) 355 | 356 | (defn -main [& args] 357 | (let [parsed (cli/parse-opts args cli-options) 358 | {:keys [:infile :outfile :watch :help]} (:options parsed) 359 | [in _] (when infile (str/split infile #"\.")) 360 | outfile (if outfile outfile (str in ".svg")) 361 | [out ext] (str/split outfile #"\.")] 362 | (cond 363 | help 364 | (do (println "Usage:") 365 | (println (:summary parsed))) 366 | 367 | (nil? infile) 368 | (println "Please specify an input file") 369 | 370 | (not (contains? #{"svg"} ext)) 371 | (println "Please specify a valid output format. Valid formats: svg.") 372 | 373 | :else 374 | (let [result (deref (sci-load-file infile)) 375 | data (if (= :svg (first result)) result (svg result)) 376 | msg (str "| Compiling " infile " into " outfile ". |")] 377 | (println (apply str (repeat (count msg) "-"))) 378 | (println msg) 379 | (println (apply str (repeat (count msg) "-"))) 380 | (spit outfile (html data)) 381 | (println "Success! Have a nice day :)"))))) 382 | 383 | #+end_src 384 | * cli2 385 | This is a WIP. 386 | 387 | The idea is to have a CLI tool that 'compiles' svg-clj code into an SVG file. 388 | 389 | GraalVM native image: 390 | 391 | bb native-image 392 | 393 | The resulting executable will be svg_clj and works for exporting .svg files, but fails with .png due to reflection issues with the Batik library. 394 | 395 | Fixing this might be possible with alteration to reflect-config.json and/or adding type hints (via a Github pull request perhaps?) to the batik library. 396 | 397 | #+begin_src clojure 398 | (ns svg-clj.cli2 399 | (:require [clojure.string :as str] 400 | [clojure.tools.cli :as cli] 401 | [hiccup.core :refer [html]] 402 | [hawk.core :as hawk] 403 | [svg-clj.composites :as cp :refer [svg]] 404 | [svg-clj.utils :as utils] 405 | [svg-clj.elements :as el] 406 | [svg-clj.path :as path] 407 | [svg-clj.transforms :as tf] 408 | [svg-clj.layout :as lo] 409 | [sci.core :as sci]) 410 | (:gen-class)) 411 | 412 | #+end_src 413 | 414 | ** load-file 415 | For GraalVM native image, you can't use Clojure's loading functions. Luckily, Borkdude's Simple Clojure Interpreter (SCI) has eval-string capability which we can use to load our namespaces and evaluate files from a native image. 416 | 417 | #+begin_src clojure 418 | (def my-ns-map 419 | (into {} 420 | (map #(vector % (ns-publics %)) 421 | ['svg-clj.composites 422 | 'svg-clj.utils 423 | 'svg-clj.elements 424 | 'svg-clj.path 425 | 'svg-clj.transforms 426 | 'svg-clj.layout]))) 427 | 428 | (defn sci-load-file 429 | [fname] 430 | (-> (slurp fname) 431 | (sci/eval-string {:namespaces my-ns-map}))) 432 | 433 | #+end_src 434 | 435 | ** watcher 436 | This fn is not working yet, but the idea is to let the CLI watch a source file, launch a basic server, compile the SVG, and display it in the web browser, which will be auto-refreshed any time the file is updated. 437 | 438 | #+begin_src clojure 439 | (defn watch! 440 | [infile outfile] 441 | (let [ [name ext] (str/split infile #"\.")] 442 | (hawk/watch! 443 | [{:paths [infile] 444 | :handler 445 | (fn [ctx e] 446 | (let [result (deref (sci-load-file infile)) 447 | data (if (= :svg (first result)) result (svg result)) 448 | msg (str "| Compiling " infile " into " outfile ". |")] 449 | (println (apply str (repeat (count msg) "-"))) 450 | (println msg) 451 | (println (apply str (repeat (count msg) "-"))) 452 | (spit outfile (html data)) 453 | (println "Done. Waiting for changes") 454 | ctx))}]))) 455 | 456 | #+end_src 457 | 458 | ** cli 459 | Experimental... trying to compile with more features like a file watcher and rasterizing. 460 | 461 | #+begin_src clojure 462 | (def cli-options 463 | [["-i" "--infile FNAME" "The file to be compiled." 464 | :default nil] 465 | ["-o" "--outfile FNAME" "The output filename. Valid Extensions: svg" 466 | :default nil] 467 | ["-w" "--watch" "Watch the file for changes and re-compile on change." 468 | :default false] 469 | ["-h" "--help"]]) 470 | 471 | (defn -main [& args] 472 | (let [parsed (cli/parse-opts args cli-options) 473 | {:keys [:infile :outfile :watch :help]} (:options parsed) 474 | [in _] (when infile (str/split infile #"\.")) 475 | outfile (if outfile outfile (str in ".svg")) 476 | [out ext] (str/split outfile #"\.")] 477 | (cond 478 | help 479 | (do (println "Usage:") 480 | (println (:summary parsed))) 481 | 482 | (nil? infile) 483 | (println "Please specify an input file") 484 | 485 | (not (contains? #{"svg"} ext)) 486 | (println "Please specify a valid output format. Valid formats: svg.") 487 | 488 | watch 489 | (do (println (str "Waiting for changes to " infile ".")) 490 | (watch! infile outfile)) 491 | 492 | :else 493 | (let [result (deref (sci-load-file infile)) 494 | data (if (= :svg (first result)) result (svg result)) 495 | msg (str "| Compiling " infile " into " outfile ". |")] 496 | (println (apply str (repeat (count msg) "-"))) 497 | (println msg) 498 | (println (apply str (repeat (count msg) "-"))) 499 | (spit outfile (html data)) 500 | (println "Success! Have a nice day :)"))))) 501 | 502 | #+end_src 503 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps 2 | {org.clojure/clojure {:mvn/version "1.11.1"} 3 | org.clojure/data.xml {:mvn/version "0.2.0-alpha6"} 4 | hiccup/hiccup {:mvn/version "2.0.0-alpha2"} 5 | io.github.nextjournal/clerk {:mvn/version "RELEASE"} 6 | org.clojure/clojurescript {:mvn/version "RELEASE"} 7 | thheller/shadow-cljs {:mvn/version "RELEASE"} 8 | applied-science/js-interop {:mvn/version "0.3.3"} 9 | org.babashka/sci {:mvn/version "RELEASE"} 10 | reagent/reagent {:mvn/version "1.1.1"} 11 | io.github.babashka/sci.configs {:git/sha "fcd367c6a6115c5c4e41f3a08ee5a8d5b3387a18"} 12 | io.github.nextjournal/viewers {:git/sha "c88c97c9ad008b0c214e44523488fcfa0605e6d9"} 13 | metosin/reitit-frontend {:mvn/version "0.5.15"}} 14 | 15 | :aliases 16 | {:test 17 | {:extra-paths ["test"] 18 | :extra-deps {org.clojure/test.check {:mvn/version "1.1.0"} 19 | com.cognitect/test-runner 20 | {:git/url "https://github.com/cognitect-labs/test-runner.git" 21 | :sha "209b64504cb3bd3b99ecfec7937b358a879f55c1"}} 22 | :main-opts ["-m" "cognitect.test-runner"]} 23 | 24 | :jar 25 | {:replace-deps {com.github.seancorfield/depstar {:mvn/version "2.1.245"}} 26 | :exec-fn hf.depstar/jar 27 | :exec-args {}} 28 | 29 | :release 30 | {:extra-deps {applied-science/deps-library {:mvn/version "0.4.0"}} 31 | :main-opts ["-m" "applied-science.deps-library"]}}} 32 | -------------------------------------------------------------------------------- /examples/algorithms.clj: -------------------------------------------------------------------------------- 1 | (ns examples.algorithms 2 | (:require [hiccup.core :refer [html]] 3 | [svg-clj.algorithms :as alg] 4 | [svg-clj.composites :as comp :refer [svg]] 5 | [svg-clj.elements :as el] 6 | [svg-clj.parametric :as p] 7 | [svg-clj.transforms :as tf] 8 | [svg-clj.utils :as u])) 9 | 10 | (defn inside-pt-example 11 | [] 12 | (let [deg (rand-int 361) 13 | tri (->> (p/regular-polygon-pts 100 3) 14 | (map #(u/rotate-pt % deg))) 15 | rand-pt (fn [] [(- 100 (rand-int 200)) 16 | (- 100 (rand-int 200))]) 17 | pts (repeatedly 1400 rand-pt)] 18 | (el/g 19 | (-> (el/polygon tri) 20 | (tf/style {:fill "none" :stroke "black"})) 21 | (into [:g {}] 22 | (for [pt pts] 23 | (if (u/pt-inside? tri pt) 24 | (-> (el/circle 2) 25 | (tf/translate pt) 26 | (tf/style {:fill "green"})) 27 | (-> (el/circle 2) 28 | (tf/translate pt) 29 | (tf/style {:fill "red"})))))))) 30 | 31 | (def remove-colinears-example 32 | (let [pts (-> (p/regular-polygon-pts 100 4) 33 | (p/simplify 160)) 34 | xpts (alg/remove-colinears pts)] 35 | (el/g 36 | (into [:g {}] 37 | (for [pt pts] 38 | (-> (el/circle 1.5) 39 | (tf/translate pt) 40 | (tf/style {:fill "black"})))) 41 | (into [:g {}] 42 | (for [pt xpts] 43 | (-> (el/circle 2.5) 44 | (tf/translate pt) 45 | (tf/style {:fill "green"}))))))) 46 | 47 | (defn draw-triangulation 48 | [{:keys [tris]}] 49 | (into [:g {}] 50 | (for [tri tris] 51 | (-> (el/polygon tri) 52 | (tf/style {:fill "none" :stroke "black"}))))) 53 | 54 | (def concave 55 | (let [f (p/blend (p/circle 100) 56 | (p/polygon (p/regular-polygon-pts 100 6)) 2)] 57 | (map f (range 0 1 0.01)))) 58 | 59 | (def ear-clip-example 60 | (draw-triangulation (alg/clip-ears concave))) 61 | 62 | (def examples [(inside-pt-example) 63 | (inside-pt-example) 64 | remove-colinears-example 65 | ear-clip-example]) 66 | 67 | (def doc 68 | (->> 69 | (for [elem examples] 70 | (-> elem 71 | svg 72 | (tf/style {:style {:outline "1px solid blue" 73 | :margin "10px"}}))) 74 | (partition-all 3) 75 | (interpose [:br]))) 76 | 77 | (spit 78 | "examples/algorithms.html" 79 | (html 80 | [:html 81 | [:body 82 | [:h1 "Algorithms Examples"] 83 | doc]])) 84 | -------------------------------------------------------------------------------- /examples/basics.clj: -------------------------------------------------------------------------------- 1 | (ns examples.basics 2 | "Showing the basic elements and transforms of svg-clj." 3 | (:require [hiccup.core :refer [html]] 4 | [svg-clj.composites :refer [svg]] 5 | [svg-clj.elements :as el] 6 | [svg-clj.path :as path] 7 | [svg-clj.transforms :as tf] 8 | [svg-clj.utils :as u])) 9 | 10 | (defn show-debug-geom 11 | "Add some useful debugging geometry to `elem`." 12 | [elem] 13 | (let [ctr (tf/centroid elem) 14 | bds (tf/bounds elem)] 15 | (el/g elem 16 | (el/g (-> (el/polygon bds) 17 | (tf/style {:fill "none" 18 | :stroke "red" 19 | :stroke-width "1px" 20 | :opacity 0.3})) 21 | (-> (el/circle 2) 22 | (tf/translate ctr) 23 | (tf/style {:fill "red" 24 | :opacity 0.3})))))) 25 | 26 | (def basic-group 27 | (el/g 28 | (el/rect 20 20) 29 | (-> (el/rect 20 20) (tf/translate [20 0])) 30 | (-> (el/rect 20 20) (tf/translate [0 20])) 31 | (-> (el/rect 20 20) (tf/translate [20 20])))) 32 | 33 | (def circles 34 | (-> (for [a (range 0 12)] 35 | (-> (el/circle (+ 5 (* a 4))) 36 | (tf/translate [(/ (+ 5 (* a 4)) 2) 0]) 37 | (tf/translate (u/rotate-pt [20 0] (* a -40))) 38 | (tf/style {:stroke 39 | (str "rgba(163,190,140," 40 | (/ (inc a) 10.0) ")") 41 | :stroke-width "2px" 42 | :fill "none"}))) 43 | el/g 44 | (tf/translate [100 100]))) 45 | 46 | (def basics [(path/arc [0 0] [50 0] 90) 47 | (path/circle 40) 48 | (path/bezier [0 0] [30 20] [80 40] [120 180]) 49 | (el/circle 80) 50 | (path/rect 70 120) 51 | (path/ellipse 40 80) 52 | (el/line [0 0] [100 100]) 53 | (path/line [0 0] [100 100]) 54 | (el/polygon [ [0 0] [30 0] [30 20] [15 10] [0 20] ]) 55 | (el/polyline [ [0 0] [30 0] [30 20] [15 10] [0 20] ]) 56 | (path/polygon [ [0 0] [30 0] [30 20] [15 10] [0 20] ]) 57 | (el/text "this is text") 58 | (el/image "https://www.fillmurray.com/300/200" 100 67) 59 | (path/merge-paths (path/rect 100 100) (path/rect 80 80)) 60 | basic-group 61 | circles]) 62 | 63 | (def doc 64 | (->> 65 | (for [elem basics] 66 | (-> elem 67 | (tf/translate [80 80]) 68 | (tf/rotate 20) 69 | (tf/style {:fill "pink" 70 | :stroke-width "2px" 71 | :stroke "hotpink"}) 72 | show-debug-geom 73 | svg 74 | (tf/style {:style {:outline "1px solid blue" 75 | :margin "10px"}}))) 76 | (partition-all 3) 77 | (interpose [:br]))) 78 | 79 | (spit 80 | "examples/basics.html" 81 | (html 82 | [:html 83 | [:body 84 | [:h1 "Basic Geometry Examples"] 85 | doc]])) 86 | -------------------------------------------------------------------------------- /examples/basics.html: -------------------------------------------------------------------------------- 1 |

Basic Geometry Examples




this is text

-------------------------------------------------------------------------------- /examples/bezier.clj: -------------------------------------------------------------------------------- 1 | (ns examples.bezier 2 | (:require [hiccup.core :refer [html]] 3 | [svg-clj.composites :refer [svg]] 4 | [svg-clj.elements :as el] 5 | [svg-clj.parametric :as p] 6 | [svg-clj.path :as path] 7 | [svg-clj.transforms :as tf])) 8 | 9 | (def pts [ [0 0] [100 -300] [200 -300] [300 0]]) 10 | #_(def pts [ [110 150] [25 190] [210 250] [210 30]]) 11 | 12 | (def ts [0.2 0.4 0.6 0.8]) 13 | (def curve (p/bezier pts)) 14 | (def curve2 (p/rational-bezier pts [1 2.5 0.5 1])) 15 | 16 | (def cols ["blue" "cyan" "purple" "pink" "blue" "skyblue" "slategray" "gold" "orange" "red"]) 17 | 18 | ;; runs slow due to arc-length calc 19 | (def curves 20 | (let [cpts (p/uniform-split-bezier curve 6) #_(p/multi-split-bezier curve ts)] 21 | (map-indexed #(el/g 22 | (-> (apply path/bezier %2) 23 | (tf/style {:fill "none" 24 | :stroke-width "3px" 25 | :stroke (get cols %1)})) 26 | (-> (el/circle 5) 27 | (tf/translate (last %2)) 28 | (tf/style {:fill "red"}))) 29 | cpts))) 30 | 31 | (def split-curve (p/uniform-split-bezier curve 4)) 32 | 33 | (def a (-> (apply path/bezier pts) 34 | (tf/style {:fill "none" 35 | :stroke-width "6px" 36 | :stroke "pink"}))) 37 | 38 | (def aa (-> (p/split-bezier curve 0.2) 39 | :a 40 | (#(apply path/bezier %)) 41 | (tf/style {:fill "none" 42 | :stroke-width "3px" 43 | :stroke "blue"}))) 44 | 45 | (def ab (-> (p/split-bezier curve 0.2) 46 | :b 47 | (#(apply path/bezier %)) 48 | (tf/style {:fill "none" 49 | :stroke-width "3px" 50 | :stroke "green"}))) 51 | 52 | (def b 53 | (let [cpts (map curve2 (range 0 1.01 0.01))] 54 | (el/g 55 | (map #(-> (el/circle 3) 56 | (tf/translate %) 57 | (tf/style {:fill "red"})) 58 | cpts)))) 59 | 60 | (def c (el/g a aa ab b)) 61 | 62 | (def examples [a 63 | aa 64 | ab 65 | b 66 | c]) 67 | 68 | (def doc 69 | (->> 70 | (for [elem examples] 71 | (-> elem 72 | svg 73 | (tf/style {:style {:outline "1px solid blue" 74 | :margin "10px"}}))) 75 | (partition-all 3) 76 | (interpose [:br]))) 77 | 78 | (spit 79 | "examples/bezier.html" 80 | (html 81 | [:html 82 | [:body 83 | [:h1 "Bezier Curve Examples"] 84 | doc]])) 85 | -------------------------------------------------------------------------------- /examples/bezier.html: -------------------------------------------------------------------------------- 1 |

Bezier Curve Examples


-------------------------------------------------------------------------------- /examples/blossom.clj: -------------------------------------------------------------------------------- 1 | (ns examples.blossom 2 | (:require [svg-clj.elements :as el] 3 | [svg-clj.layout :as lo] 4 | [svg-clj.parametric :as p] 5 | [svg-clj.path :as path] 6 | [svg-clj.tools :as tools] 7 | [svg-clj.transforms :as tf] 8 | [svg-clj.utils :as u])) 9 | 10 | (defn flip-y 11 | [pts] 12 | (mapv #(u/v* % [1 -1]) pts)) 13 | 14 | (defn petal 15 | [cpts] 16 | (let [beza (apply path/bezier cpts) 17 | bezb (apply path/bezier (flip-y cpts)) 18 | shape (path/merge-paths beza bezb) 19 | ctr (tf/centroid shape)] 20 | (-> shape 21 | (tf/rotate -90) 22 | (tf/translate (u/v* ctr [-1 -1]))))) 23 | 24 | (defn petal-ring 25 | [petal r n] 26 | (el/g 27 | (lo/distribute-on-curve 28 | (repeat n petal) 29 | (p/circle r)))) 30 | 31 | (def petal-01 32 | (-> (petal [[0 0] [5 -50] [50 -20] [75 0]]) 33 | (tf/style {:fill "#ff8b94" 34 | :stroke "#ffaaa5" 35 | :stroke-width "4px" 36 | :stroke-linecap "round"}))) 37 | 38 | (def petal-02 39 | (-> (petal [[0 0] [1 -20] [20 -10] [40 0]]) 40 | (tf/style {:fill "#ffaaa5" 41 | :stroke "none"}))) 42 | 43 | (def petal-03 44 | (-> (path/merge-paths petal-01 petal-02) 45 | (tf/style {:fill "#a8e6cf"}))) 46 | 47 | (def petal-ring-01 (petal-ring petal-01 120 12)) 48 | (def petal-ring-02 (petal-ring petal-02 120 12)) 49 | 50 | (def petal-ring-03 51 | (-> (petal-ring petal-03 70 6) 52 | (tf/rotate (/ 360.0 24)))) 53 | 54 | (def petal-ring-04 55 | (let [petal (-> petal-03 (tf/style {:fill "#cc5963"}))] 56 | (-> (petal-ring petal 90 6) 57 | (tf/rotate (/ 360.0 24)) 58 | (tf/rotate (/ 360.0 12))))) 59 | 60 | (def petal-ring-05 61 | (let [petal (-> petal-02 62 | (tf/rotate 180) 63 | (tf/style {:fill "none" 64 | :stroke "#f4f1d7" 65 | :stroke-width "2px"}))] 66 | (-> (petal-ring petal 70 36) 67 | (tf/rotate (/ 360.0 24))))) 68 | 69 | (def petal-ring-06 70 | (let [petal (-> petal-02 71 | (tf/style {:fill "none" 72 | :stroke "#f4f1d7" 73 | :stroke-width "2px"}))] 74 | (-> (petal-ring petal 40 20) 75 | (tf/rotate (/ 360.0 24))))) 76 | 77 | (def blossom (el/g 78 | (-> (el/circle 105) (tf/style {:fill "#69b599"})) 79 | petal-ring-01 80 | petal-ring-02 81 | petal-ring-06 82 | petal-ring-05 83 | petal-ring-04 84 | petal-ring-03)) 85 | 86 | ;; when in a Clojure context, you can compile to SVG files 87 | ;; this uses the Hiccup html compiler 88 | ;; emitted SVG data works with Reagent as well. 89 | 90 | (tools/save-svg blossom "examples/blossom.svg") 91 | -------------------------------------------------------------------------------- /examples/circles.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/layout.clj: -------------------------------------------------------------------------------- 1 | (ns examples.layout 2 | (:require [hiccup.core :refer [html]] 3 | [svg-clj.composites :as comp :refer [svg]] 4 | [svg-clj.elements :as el] 5 | [svg-clj.layout :as lo] 6 | [svg-clj.parametric :as p] 7 | [svg-clj.transforms :as tf])) 8 | 9 | (defn show-debug-geom 10 | [elem] 11 | (let [ctr (tf/centroid elem) 12 | bds (tf/bounds elem)] 13 | (el/g elem 14 | (el/g (-> (el/polygon bds) 15 | (tf/style {:fill "none" 16 | :stroke "red" 17 | :stroke-width "3px"})) 18 | (-> (el/circle 2) 19 | (tf/translate ctr) 20 | (tf/style {:fill "red"})))))) 21 | 22 | (defn rand-rect 23 | [] 24 | (let [w (+ 5 (rand-int 20)) 25 | h (+ 5 (rand-int 20)) 26 | origin [0 (/ h 2)]] 27 | (-> (el/rect w h) 28 | (tf/translate origin) 29 | (tf/style {:fill (str "rgb(" 30 | (rand-int 255) "," 31 | (rand-int 255) "," 32 | (rand-int 255) ")")})))) 33 | 34 | ;; Distribute a list of elements along X/Y axis, keeping a constant gap between the boundaries of each element. 35 | 36 | (def horizontal-dist 37 | (el/g 38 | (map show-debug-geom 39 | (drop 2 (lo/distribute-linear :x 10 (repeatedly 7 rand-rect)))))) 40 | 41 | (def vertical-dist 42 | (el/g 43 | (map show-debug-geom 44 | (drop 2 (lo/distribute-linear :y 10 (repeatedly 7 rand-rect)))))) 45 | 46 | ;; Distribute a list of elements onto a list of points. 47 | ;; Works like map, so whichever runs out first (elements or points) is the limiter. 48 | 49 | (def grid-dist 50 | (lo/distribute-on-pts 51 | (repeatedly rand-rect) 52 | (p/rect-grid 10 10 30 30))) 53 | 54 | (def grid-dist2 55 | (lo/distribute-on-pts 56 | (repeat (el/circle 1.5)) 57 | (p/rect-grid 20 30 10 10))) 58 | 59 | ;; Distribute a list of elements onto a parametric curve. 60 | (def redline 61 | (-> (el/line [0 0] [0 15]) 62 | (tf/style {:stroke "red" :stroke-width "3px"}))) 63 | 64 | (def circle-curve-dist 65 | (el/g 66 | (el/circle 150) 67 | (lo/distribute-on-curve 68 | (repeat 80 redline) 69 | (p/circle 150)))) 70 | 71 | (def circle-curve-dist2 72 | (-> (el/g 73 | (el/circle 150) 74 | (lo/distribute-on-curve 75 | (repeatedly 40 rand-rect) 76 | (p/circle 150))) 77 | (tf/translate [150 150]))) 78 | 79 | ;; Distribute on any curve available in parametric.cljc 80 | (def bez-curve (p/bezier [ [70 -20] [10 70] [200 -300] [300 0]])) 81 | 82 | (def bezier-curve-dist 83 | (lo/distribute-on-curve 84 | (repeatedly 20 rand-rect) 85 | bez-curve)) 86 | 87 | (def examples [horizontal-dist 88 | vertical-dist 89 | grid-dist 90 | grid-dist2 91 | circle-curve-dist 92 | circle-curve-dist2 93 | bezier-curve-dist]) 94 | 95 | (def doc 96 | (->> 97 | (for [elem examples] 98 | (-> elem 99 | svg 100 | (tf/style {:style {:outline "1px solid blue" 101 | :margin "10px"}}))) 102 | (partition-all 3) 103 | (interpose [:br]))) 104 | 105 | (spit 106 | "examples/layout.html" 107 | (html 108 | [:html 109 | [:body 110 | [:h1 "Layout Examples"] 111 | doc]])) 112 | -------------------------------------------------------------------------------- /examples/load-svg-test.svg: -------------------------------------------------------------------------------- 1 | 2 | 17 | 19 | 40 | 42 | 43 | 45 | image/svg+xml 46 | 48 | 49 | 50 | 51 | 52 | 56 | 63 | 70 | 75 | 79 | 83 | 90 | 94 | 100 | 106 | 107 | 108 | -------------------------------------------------------------------------------- /examples/offset.clj: -------------------------------------------------------------------------------- 1 | (ns examples.offset 2 | (:require [hiccup.core :refer [html]] 3 | [svg-clj.composites :as comp :refer [svg]] 4 | [svg-clj.elements :as el] 5 | [svg-clj.parametric :as p] 6 | [svg-clj.transforms :as tf] 7 | [svg-clj.utils :as u])) 8 | 9 | (def a (-> (p/regular-polygon-pts 120 10) 10 | (el/polygon) 11 | (tf/style {:fill "none" 12 | :stroke "red" 13 | :stroke-width "3px"}))) 14 | 15 | (def b (-> (tf/offset a 20) 16 | (tf/style {:fill "none" 17 | :stroke "limegreen" 18 | :stroke-width "3px"}))) 19 | 20 | (def c (-> (el/circle 40) 21 | (tf/style {:fill "none" 22 | :stroke "red" 23 | :stroke-width "3px"}))) 24 | 25 | (def d (-> (tf/offset c -3) 26 | (tf/style {:fill "none" 27 | :stroke "limegreen" 28 | :stroke-width "3px"}))) 29 | 30 | (def pts [ [0 0] [100 -300] [200 -300] [300 0]]) 31 | (def curve (p/bezier pts)) 32 | 33 | (def e (-> (map curve (range 0 1.05 0.05)) 34 | (el/polyline) 35 | (tf/style {:fill "none" 36 | :stroke "red" 37 | :stroke-width "3px"}))) 38 | 39 | (def f (-> (map curve (range 0 1.05 0.05)) 40 | (u/offset-pts 20) 41 | (el/polyline) 42 | (tf/style {:fill "none" 43 | :stroke "limegreen" 44 | :stroke-width "3px"}))) 45 | 46 | (def examples [a 47 | b 48 | c 49 | d 50 | (el/g a b) 51 | (el/g c d) 52 | e 53 | f 54 | (el/g e f)]) 55 | 56 | (def doc 57 | (->> 58 | (for [elem examples] 59 | (-> elem 60 | svg 61 | (tf/style {:style {:outline "1px solid blue" 62 | :margin "10px"}}))) 63 | (partition-all 3) 64 | (interpose [:br]))) 65 | 66 | (spit 67 | "examples/offset.html" 68 | (html 69 | [:html 70 | [:body 71 | [:h1 "Offset Examples"] 72 | doc]])) 73 | -------------------------------------------------------------------------------- /examples/offset.html: -------------------------------------------------------------------------------- 1 |

Offset Examples



-------------------------------------------------------------------------------- /examples/quilt.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/adam-james-v/svg-clj/8c8d90535c3d6d421993833f6af4936e36301eb5/examples/quilt.png -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | A colourful render of a quilt design 2 | 3 | # svg-clj 4 | 5 | [![Clojars Project](https://img.shields.io/clojars/v/io.github.adam-james-v/svg-clj.svg)](https://clojars.org/io.github.adam-james-v/svg-clj) 6 | 7 | svg-clj is a library for creating SVGs in Clojure/Clojurescript. This is done using functions which emit hiccup data structures. Since hiccup is quite common and well-known in the Clojure ecosystem, it is rather simple to use svg-clj alongside other libraries that emit and/or expect hiccup-style data structures. 8 | 9 | You can try things out in the browser here: 10 | [svg-clj-interactive](https://adam-james-v.github.io/svg-clj-interactive/index.html) 11 | 12 | Here is an example using most of svg-clj's features: 13 | 14 | ![An SVG Image of a stylized flower blossom.](https://github.com/adam-james-v/svg-clj/blob/main/examples/blossom.svg "Blossom") 15 | 16 | This blossom is produced with the following code: 17 | 18 | ```clojure 19 | (ns examples.blossom 20 | (:require [svg-clj.utils :as utils] 21 | [svg-clj.elements :as el] 22 | [svg-clj.transforms :as tf] 23 | [svg-clj.composites :as comp :refer [svg]] 24 | [svg-clj.path :as path] 25 | [svg-clj.parametric :as p] 26 | [svg-clj.layout :as lo] 27 | #?(:clj [svg-clj.tools :as tools]))) 28 | 29 | (defn flip-y 30 | [pts] 31 | (mapv #(utils/v* % [1 -1]) pts)) 32 | 33 | (defn petal 34 | [cpts] 35 | (let [beza (apply path/bezier cpts) 36 | bezb (apply path/bezier (flip-y cpts)) 37 | shape (tf/merge-paths beza bezb) 38 | ctr (tf/centroid shape)] 39 | (-> shape 40 | (tf/rotate -90) 41 | (tf/translate (utils/v* ctr [-1 -1]))))) 42 | 43 | (defn petal-ring 44 | [petal r n] 45 | (el/g 46 | (lo/distribute-on-curve 47 | (repeat n petal) 48 | (p/circle r)))) 49 | 50 | (def petal-01 51 | (-> (petal [[0 0] [5 -50] [50 -20] [75 0]]) 52 | (tf/style {:fill "#ff8b94" 53 | :stroke "#ffaaa5" 54 | :stroke-width "4px" 55 | :stroke-linecap "round"}))) 56 | 57 | (def petal-02 58 | (-> (petal [[0 0] [1 -20] [20 -10] [40 0]]) 59 | (tf/style {:fill "#ffaaa5" 60 | :stroke "none"}))) 61 | 62 | (def petal-03 63 | (-> (path/merge-paths petal-01 petal-02) 64 | (tf/style {:fill "#a8e6cf"}))) 65 | 66 | (def petal-ring-01 (petal-ring petal-01 120 12)) 67 | (def petal-ring-02 (petal-ring petal-02 120 12)) 68 | 69 | (def petal-ring-03 70 | (-> (petal-ring petal-03 70 6) 71 | (tf/rotate (/ 360.0 24)))) 72 | 73 | (def petal-ring-04 74 | (let [petal (-> petal-03 (tf/style {:fill "#cc5963"}))] 75 | (-> (petal-ring petal 90 6) 76 | (tf/rotate (/ 360.0 24)) 77 | (tf/rotate (/ 360.0 12))))) 78 | 79 | (def petal-ring-05 80 | (let [petal (-> petal-02 81 | (tf/rotate 180) 82 | (tf/style {:fill "none" 83 | :stroke "#f4f1d7" 84 | :stroke-width "2px"}))] 85 | (-> (petal-ring petal 70 36) 86 | (tf/rotate (/ 360.0 24))))) 87 | 88 | (def petal-ring-06 89 | (let [petal (-> petal-02 90 | (tf/style {:fill "none" 91 | :stroke "#f4f1d7" 92 | :stroke-width "2px"}))] 93 | (-> (petal-ring petal 40 20) 94 | (tf/rotate (/ 360.0 24))))) 95 | 96 | (def blossom (el/g 97 | (-> (el/circle 105) (tf/style {:fill "#69b599"})) 98 | petal-ring-01 99 | petal-ring-02 100 | petal-ring-06 101 | petal-ring-05 102 | petal-ring-04 103 | petal-ring-03)) 104 | 105 | ;; when in a Clojure context, you can compile to SVG files 106 | ;; this uses the Hiccup html compiler 107 | ;; emitted hiccup works with Reagent as well. 108 | 109 | (tools/save-svg blossom "examples/blossom.svg") 110 | ``` 111 | 112 | Other examples, also available in the examples directory of this project: 113 | 114 | - [basics](https://adam-james-v.github.io/svg-clj/examples/basics) 115 | - [layout](https://adam-james-v.github.io/svg-clj/examples/layout) 116 | - [bezier](https://adam-james-v.github.io/svg-clj/examples/bezier) 117 | - [offset](https://adam-james-v.github.io/svg-clj/examples/offset) 118 | 119 | ## Known Issues 120 | There are several features I have yet to completely fix. 121 | 122 | - scale transformation can have confusing behaviour when scaled elements are used in groups. 123 | - Bounds and Centroid calculations can give incorrect results with paths containing arcs or bezier curves 124 | - text elements have only basic support (translate, rotate, style work). Other transforms have buggy workarounds for the fact that text element dimensions are not known until rasterization 125 | - offset works for all elements except paths, which is a WIP feature 126 | - arc implementation is still buggy, particularly when rotating. 127 | 128 | ## Using svg-clj in your project 129 | 130 | If you use lein or boot, place this in your project.clj: 131 | 132 | ```clj 133 | [io.github.adam-james-v/svg-clj "0.0.1-SNAPSHOT"] 134 | ``` 135 | 136 | If you use Clojure's CLI, add this to your :deps in deps.edn: 137 | 138 | 139 | ```clj 140 | io.github.adam-james-v/svg-clj {:mvn/version "0.0.1-SNAPSHOT"} 141 | ``` 142 | 143 | NOTE: check that you're grabbing the version you want. 144 | 145 | ## Design 146 | The library uses hiccup syntax to represent the SVG diagrams being created. The user writes functional code to define various elements of the SVG and has access to transformations via utility functions. 147 | 148 | Since the library functions emit hiccup data structures, the user can extend and manipulate their data using other clojure libraries or their own functions. 149 | 150 | The library has two main categories of functions: 151 | 152 | - elements 153 | - container elements (svg, figure...) 154 | - shapes 155 | - circle 156 | - ellipse 157 | - line 158 | - path 159 | - polygon 160 | - polyline 161 | - rect 162 | - text 163 | - g 164 | - composites (custom functions using shapes.. eg. arrow) 165 | 166 | - transforms and property calcs 167 | - centroid 168 | - bounds 169 | - rotate 170 | - translate 171 | - scale 172 | - style 173 | - offset 174 | - explode paths 175 | - merge paths 176 | 177 | ### Explaining the namespaces 178 | I've annotated a ns declaration to help make sense of where you can find various functions. 179 | 180 | ```clj 181 | (ns examples.blossom 182 | (:require 183 | ;; math helpers, simple data manip helpers 184 | [svg-clj.utils :as utils] 185 | 186 | ;; all of the shape functions like rect, circle, polygon, etc. 187 | [svg-clj.elements :as el] 188 | 189 | ;; all of the transforms, including path specific fns 190 | [svg-clj.transforms :as tf] 191 | 192 | ;; shapes built from other shapes, AND the svg container fn 193 | [svg-clj.composites :as comp :refer [svg]] 194 | 195 | ;; draw elements using path instead, and has the 'commands' path DSL 196 | ;; also has arc and bezier drawing fns 197 | [svg-clj.path :as path] 198 | 199 | ;; parametric curve fns and point list generators useful for layouts 200 | [svg-clj.parametric :as p] 201 | 202 | ;; layout functions like distribute-linear and distribute-along-curve 203 | [svg-clj.layout :as lo] 204 | 205 | ;; when in CLJ context, use cider-show, show, save-svg, load-svg 206 | ;; to help with the dev. process 207 | #?(:clj [svg-clj.tools :as tools]))) 208 | ``` 209 | 210 | Every transform takes an element or list of elements, performs the appropriate actions, and returns an element or list of elements with the transform 'baked in' to the properties. 211 | 212 | For example, a circle begins as follows: 213 | 214 | ```clj 215 | (el/circle 50) 216 | ;; => [:circle {:cx 0, :cy 0, :r 50}] 217 | 218 | (tf/translate (el/circle 50) [25 25]) 219 | ;; => [:circle {:cx 25, :cy 25, :r 50, :transform "rotate(0 25 25)"}] 220 | ``` 221 | 222 | Notice how the circle's cx and cy properties have changed according to the transformation. 223 | 224 | An important thing to consider with this approach is that it is 'lossy' in some sense. The user's design intent is clear when reading the source they provide, but is lost when compiled to SVG. The call to the translate function is not explicit in the output. This may not be the behaviour everyone expects, so just be aware of this if you need to pass the output to another program or perhaps to another person. 225 | 226 | ## Opinionated Approach 227 | This is not quite a straight wrapper for SVG functionality. I have altered the default behavior of some functions. 228 | 229 | For example, a rectangle is drawn centered around the orgin by default. Plain SVG rectangles draw with the first corner located at the origin by default. 230 | 231 | All rotations are applied to shapes locally by default. This means that a circle at [10 0] rotated by 90 deg will not appear to move using svg-clj; the shape itself is being spun around it's center, but that center point is not moving. Default SVG behaviour rotates around the origin by default. So, any elements offset from the orgin will move large distances away from their starting positions. 232 | 233 | This choice was made because it feels more intuitive (to me, at least) to draw with local transformation operations in mind. 234 | 235 | ## Threading 236 | Greencoder (one of my Twitch viewers) sent several twitter DMs with some criticisms/feedback. All have been appropriately addressed, but I wanted to highlight his thoughts regarding my use of threading macros. 237 | 238 | "thread last macro should be kept for stream operations to compose better with other fns. I think that translate-element should take elem as first argument." 239 | - GreenCoder (Twitch handle) 240 | 241 | strictly speaking, translate and rotate are not operating on streams of data, but rather on objects 242 | - assoc and dissoc use thread first. That is, you do a thing to a single 'object' 243 | - map and filter use thread last, and are expected to work on all types of seq-able things lists... lazy, infinite 244 | 245 | So, to keep the mental model the same, I have designed my transform fns to always take the element being transformed as the first arg. I find threading to be a very readable and intuitive way to 'build up' transforms on some basic element. You can see this approach throughout my various examples. 246 | 247 | 248 | ## Further Reading 249 | 250 | If you would like to understand my motivations, decisions, and reasoning for the choices I've made in this library, you can read the .org file in the top level of this repo. 251 | 252 | [svg-clj.org](https://github.com/adam-james-v/svg-clj/blob/main/svg-clj.org). 253 | 254 | I use a 'freehand' literate programming style in my org files. This just means that I have a scattered approach. Please be patient if you're reading the notes; they may not always make sense or have full context. 255 | 256 | Proper documentation is, naturally, a key element in bringing this project from prototype to release. 257 | 258 | ## Other Work (That I've heard of so far) 259 | 260 | [Dali](https://github.com/stathissideris/dali) is a library by Stathis Sideris that also works with SVG. Since I have only recently heard about this library, I have not yet had time to do a detailed comparison but, at a glance, some differences I see are: 261 | 262 | | svg-clj | dali | 263 | |:--------------------------------------:|:-----------------------------------------------:| 264 | | write functions which emit hiccup data | write hiccup data directly | 265 | | very basic layout engine | layout engine is a key feature | 266 | | no built-in rasterization | rasterize SVGs using Batik | 267 | | Clojure and Clojurescript | Clojure only | 268 | | SVG primitives only (for now) | SVG primitives + 'prefabs' (eg. markers/arrows) | 269 | -------------------------------------------------------------------------------- /release.edn: -------------------------------------------------------------------------------- 1 | {:group-id "io.github.adam-james-v" 2 | :artifact-id "svg-clj" 3 | :scm-url "https://github.com/adam-james-v/svg-clj"} 4 | -------------------------------------------------------------------------------- /src/svg_clj/algorithms.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.algorithms 2 | (:require [clojure.set :as set] 3 | [svg-clj.utils :as u])) 4 | 5 | ;; todo: check if we need this fn here. 6 | (def pow 7 | "Raise the first number to the power of the second number." 8 | #?(:clj #(Math/pow %1 %2) :cljs js/Math.pow)) 9 | 10 | ;; https://gist.github.com/mutoo/5617691 11 | (defn- circumscribe-tri 12 | [[[ax ay] [bx by] [cx cy]]] 13 | (let [A (- bx ax) 14 | B (- by ay) 15 | C (- cx ax) 16 | D (- cy ay) 17 | E (+ (* A (+ ax bx)) (* B (+ ay by))) 18 | F (+ (* C (+ ax cx)) (* D (+ ay cy))) 19 | G (* 2 (- (* A (- cy by)) (* B (- cx bx))))] 20 | (when (> (Math/abs G) 0.000001) 21 | (let [cx (/ (- (* D E) (* B F)) G) 22 | cy (/ (- (* A F) (* C E)) G) 23 | dx (- cx ax) 24 | dy (- cy ay) 25 | r (+ (pow dx 2) (pow dy 2))] 26 | {:x cx :y cy :radius-squared r})))) 27 | 28 | (defn- edges 29 | [pts] 30 | (partition 2 1 (conj (vec pts) (first pts)))) 31 | 32 | (defn- contains-pt? 33 | [{:keys [x y radius-squared]} [px py]] 34 | (let [distance-squared (+ (pow (- x px) 2) (pow (- y py) 2))] 35 | (< distance-squared radius-squared))) 36 | 37 | (defn- outer-edges 38 | [tris] 39 | (let [all-edges (mapcat edges tris) 40 | matches (fn [edge] (filter #{edge (reverse edge)} all-edges)) 41 | appears-once (fn [edge] (= (count (matches edge)) 1))] 42 | (filter appears-once all-edges))) 43 | 44 | (defn- make-new-tris 45 | [containers pt] 46 | (->> containers 47 | outer-edges 48 | (map (fn [[p1 p2]] [p1 p2 pt])) 49 | set)) 50 | 51 | (defn- add-pt-to-tris 52 | [tris pt] 53 | (let [containers (set (filter #(contains-pt? (circumscribe-tri %) pt) tris)) 54 | new-tris (make-new-tris containers pt)] 55 | (set/union (set/difference tris containers) new-tris))) 56 | 57 | ;; http://paulbourke.net/papers/triangulate/ 58 | ;; todo: Test this a bunch, see if I can get it to work with any arbitrary set of pts. 59 | ;; todo: see where it fails (eg. concave pt sets?) and fix 60 | (defn delaunay 61 | "Compute a delaunay triangulation of `pts`." 62 | [pts] 63 | (let [pts (map (fn [[x y]] [(float x) (float y)]) pts) 64 | pt-indices (zipmap pts (range 0 (count pts))) 65 | [bl br tr tl] (map #(u/v* % [2 2]) (u/bounds-of-pts pts)) 66 | initial #{[tl tr bl] [bl tr br]} 67 | with-bounds (reduce add-pt-to-tris initial pts) 68 | tris (remove #(some #{tl tr bl br} %) with-bounds) 69 | tri-indices (fn [tri] (mapv #(get pt-indices %) tri))] 70 | {:pts pts 71 | :tris tris 72 | :tri-indices (map tri-indices tris) 73 | :edges (distinct (mapcat edges tris))})) 74 | 75 | (defn remove-colinears 76 | "Removes all points from `pts` which are colinear with other corners from the list of points `pts`. 77 | That is, any point that does not itself form a corner is removed." 78 | [pts] 79 | (let [indices (zipmap pts (range (count pts))) 80 | tris (partition 3 1 (concat pts (take 2 pts))) 81 | clpts (set (map second (filter #(apply u/colinear? %) tris))) 82 | xindices (vals (apply dissoc indices clpts))] 83 | (map #(get pts %) xindices))) 84 | 85 | (defn- clip-one-ear 86 | [pts] 87 | (let [pts (vec pts) 88 | indices (zipmap pts (range (count pts))) 89 | corners (->> pts 90 | (#(concat % (take 2 %))) 91 | (partition 3 1) 92 | (filter #(#{:convex} (apply u/corner-condition %)))) 93 | clear? (fn [corner] 94 | (not (seq (filter #(u/pt-inside? corner %) pts)))) 95 | tri (first (filter clear? corners))] 96 | {:pts pts 97 | :npts (mapv #(get pts %) (sort (vals (dissoc indices (second tri))))) 98 | :tri tri})) 99 | 100 | (defn clip-ears 101 | "Create a tessellation of the polygon defined by `pts`. 102 | This algorithm works acceptably, but returns 'bad' tessellations often. That is, it will return a mesh with very thin triangles, it will slow down if there are many many points." 103 | ([pts] (clip-ears {:indices (zipmap pts (range (count pts)))} pts [] [])) 104 | ([data pts tris indices] 105 | (if (< (count pts) 3) 106 | (merge data {:tris tris :tri-indices indices}) 107 | (let [{:keys [npts tri]} (clip-one-ear pts) 108 | local-indices (mapv #(get (:indices data) %) tri)] 109 | (recur data npts (conj tris tri) (conj indices local-indices)))))) 110 | 111 | (defn hull 112 | "Compute the convex hull of `pts`." 113 | ([pts] (hull [{:pt (first (sort-by first pts))}] pts)) 114 | ([acc pts] 115 | (if (or 116 | ;; stop the process if acc grows larger than the pts count 117 | (> (count acc) (count pts)) 118 | ;; *should* always end where the last added point closes the poly 119 | (and (< 1 (count acc)) 120 | (= (:pt (first acc)) (:pt (last acc))))) 121 | (map :pt (drop-last acc)) 122 | (let [prev (:pt (last acc)) 123 | dir (if (= 1 (count acc)) 124 | (u/v+ [0 1] prev) 125 | (:pt (last (drop-last acc)))) 126 | f (fn [pt] 127 | (let [a (when (= 3 (count (into #{} [dir prev pt]))) 128 | (u/angle-from-pts dir prev pt))] 129 | {:pt pt :angle a})) 130 | sorted (->> (map f pts) 131 | (remove #(nil? (:angle %))) 132 | (sort-by #(Math/abs (- (:angle %) 180))))] 133 | (recur (conj acc (first sorted)) pts))))) 134 | 135 | (defn nested-hull 136 | "Compute the nested convex hull of `pts`." 137 | ([pts] (nested-hull [] pts)) 138 | ([acc pts] 139 | (if (> 3 (count pts)) 140 | acc 141 | (let [hull (hull pts) 142 | npts (remove (set hull) pts)] 143 | (recur (conj acc hull) npts))))) 144 | -------------------------------------------------------------------------------- /src/svg_clj/composites.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.composites 2 | "Provides functions that combine transforms and primitive elements to make more complicated shapes. 3 | 4 | Additionally, the SVG container function is provided here as it relies on [[svg-clj.transforms]] to allow automatic veiwBox setup." 5 | (:require [clojure.string :as str] 6 | [svg-clj.elements :as el] 7 | [svg-clj.transforms :as tf] 8 | [svg-clj.utils :as u])) 9 | 10 | (defn svg 11 | "Wraps `content` in an SVG container element whose width, height, and viewBox properties are automatically calculated when `w`, `h`, and `sc` are omitted. 12 | The SVG container is optionally parameterized by width `w`, height `h`, and scale `sc`." 13 | ([content] 14 | (let [[w h] (u/bb-dims (tf/bounds content)) 15 | [[x y] _ _ _] (tf/bounds content)] 16 | [:svg {:width w 17 | :height h 18 | :viewBox (str/join " " [x y w h]) 19 | :xmlns "http://www.w3.org/2000/svg"} 20 | content])) 21 | 22 | ([content w h] 23 | [:svg {:width w 24 | :height h 25 | :viewBox (str "0 0 " w " " h) 26 | :xmlns "http://www.w3.org/2000/svg"} 27 | content]) 28 | 29 | ([content w h sc] 30 | (svg [:g {:transform (str "scale(" sc ")")} content] w h))) 31 | 32 | (defn arrow 33 | "Draws an arrow from point `a` to point `b`, with the tip beign a triangle drawn at `b`." 34 | ([a b] 35 | (let [tip-pts [ [0 0] [5 0] [5 5] ] 36 | tip-shape (el/polygon tip-pts)] 37 | (arrow a b tip-shape))) 38 | 39 | ([a b tip-shape] 40 | (let [[mx my] (tf/centroid tip-shape) 41 | r (u/to-deg (apply #(Math/atan2 %1 %2) (u/v- b a)))] 42 | (-> 43 | (el/g 44 | (el/line a b) 45 | (-> tip-shape 46 | (tf/translate [(- mx) (- my)]) 47 | (tf/rotate (- 315 r)) 48 | (tf/translate a) 49 | (tf/style {}) 50 | (tf/style {:fill "none" 51 | :stroke "none"})) 52 | (-> tip-shape 53 | (tf/translate [(- mx) (- my)]) 54 | (tf/rotate (- 135 r)) 55 | (tf/translate b))))))) 56 | 57 | (defn label 58 | "Draw a text element with `text` rendered with Verdana in `font-size` in pixels if passed as a number. 59 | You can pass `font-size` as a string to specify other units. Eg. \"14pt\". You can use `svg-clj.transforms/style` to override any styles." 60 | [font-size text] 61 | [:text 62 | {:x 0 :y 0 63 | :style {:font-family "Verdana" 64 | :text-anchor "middle" 65 | :dominant-baseline "middle" 66 | :font-size font-size}} text]) 67 | -------------------------------------------------------------------------------- /src/svg_clj/elements.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.elements 2 | "Provides functions to generate the renderable SVG elements. 3 | Every function in this namespace emits hiccup style data structures, and have the following shape: `[:tag {:prop \"value\"}]`, except g (group) and text which emit: `[:tag {:prop \"value\"} \"content\"]`. 4 | 5 | All functions in this namespace emit the primitive elements of an SVG image. These primitives are the basis for further manipulation using transform functions from [[svg-clj.transforms]]. 6 | 7 | One notable element which is not provided is `path`. Since path elements have a more complex property specification, the [[svg-clj.path]] namespace is dedicated to path element generation." 8 | (:require [clojure.string :as str] 9 | [svg-clj.utils :as u])) 10 | 11 | (defn circle 12 | "Emits a circle element with radius `r` centered at the origin." 13 | [r] 14 | [:circle {:cx 0 :cy 0 :r r}]) 15 | 16 | (defn ellipse 17 | "Emits an ellipse element with x-axis radius `rx` and y-axis radius `ry` centered at the origin." 18 | [rx ry] 19 | [:ellipse {:cx 0 :cy 0 :rx rx :ry ry}]) 20 | 21 | (defn line 22 | "Emits a line element starting at 2d point `pt-a` and ending at 2d point `pt-b`." 23 | [pt-a pt-b] 24 | (let [[ax ay] pt-a 25 | [bx by] pt-b] 26 | [:line {:x1 ax :y1 ay :x2 bx :y2 by}])) 27 | 28 | (defn polygon 29 | "Emits a polygon element with 2d points from vector or list `pts`. 30 | Polygon elements have a closed path." 31 | [pts] 32 | [:polygon {:points (str/join " " (map u/v->s pts))}]) 33 | 34 | (defn polyline 35 | "Emits a polyline element with 2d points from vector or list `pts`. 36 | Polyline elements have an open path." 37 | [pts] 38 | [:polyline {:points (str/join " " (map u/v->s pts))}]) 39 | 40 | (defn rect 41 | "Emits a rect element of width `w` and height `h` centered at the origin." 42 | [w h] 43 | [:rect {:width w :height h :x (/ w -2.0) :y (/ h -2.0)}]) 44 | 45 | (defn image 46 | "Emits an image element of the image specified at `url`, of width `w`, and height `h` centered at the origin." 47 | [url w h] 48 | [:image {:href url :width w :height h :x (/ w -2.0) :y (/ h -2.0)}]) 49 | 50 | (defn text 51 | "Emits a text element containing `text` of font-size 12pt. 52 | By default, text is centered at the origin by setting text-anchor='middle' and dominant-baseline='middle'. These defaults can be changed using [[svg-clj.transforms/style]] to override any preset properties." 53 | [text] 54 | [:text {:x 0 55 | :y 0 56 | :font-size 12 57 | :text-anchor "middle" 58 | :dominant-baseline "middle"} text]) 59 | 60 | (defn g 61 | "Emits a g (group) element." 62 | [& content] 63 | (if (and (= 1 (count content)) 64 | (not (keyword? (first (first content))))) 65 | ;; content is a list of a list of elements 66 | (into [:g {}] (first content)) 67 | ;; content is a single element OR a list of elements 68 | (into [:g {}] (filter (complement nil?) content)))) 69 | -------------------------------------------------------------------------------- /src/svg_clj/jvm_utils.clj: -------------------------------------------------------------------------------- 1 | (ns svg-clj.jvm-utils 2 | (:require [clojure.string :as str] 3 | [clojure.zip :as zip] 4 | [clojure.data.xml :as xml])) 5 | 6 | (defn str->number 7 | "Turns a string `s` into a number if possible, otherwise returns `s`." 8 | [s] 9 | (let [n (try (read-string s) 10 | (catch Exception _ s))] 11 | (if (number? n) n s))) 12 | 13 | (def numerical-attrs 14 | "Set of SVG attributes which have numerical values." 15 | #{;; circle, ellipse 16 | :cx :cy :r :rx :ry 17 | ;; image, rect 18 | :width :height :x :y 19 | ;; line 20 | :x1 :y1 :x2 :y2}) 21 | 22 | (defn cast-numerical-attrs 23 | "Casts certain attribute values to numbers if they are strings. 24 | Attributes to be cast are defined in `numerical-attrs` and include `:cx`, `:cy`, `:width`, etc." 25 | [attrs] 26 | (if (empty? attrs) 27 | {} 28 | (apply merge 29 | (map 30 | (fn [[k v]] 31 | (if (numerical-attrs k) 32 | {k (str->number v)} 33 | {k v})) 34 | attrs)))) 35 | 36 | (defn- fix-ns-tag 37 | [t] 38 | (let [namespace (namespace t) 39 | name (name t)] 40 | (if namespace 41 | (-> namespace 42 | (str/split #"\.") 43 | first 44 | (str ":" name) 45 | keyword) 46 | t))) 47 | 48 | (defn xml->hiccup 49 | "Convert XML to hiccup." 50 | [xml] 51 | (if-let [t (:tag xml)] 52 | (let [elem [(fix-ns-tag t)] 53 | elem (conj elem (cast-numerical-attrs (:attrs xml)))] 54 | (into elem (map xml->hiccup (remove string? (:content xml))))) 55 | xml)) 56 | 57 | (defn svg-str->hiccup 58 | "Parses an SVG string into a Hiccup data structure, keeping all nodes." 59 | [svg-str] 60 | (-> svg-str 61 | (xml/parse-str :namespace-aware false) 62 | xml->hiccup)) 63 | -------------------------------------------------------------------------------- /src/svg_clj/layout.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.layout 2 | "Provides functions for layout control of elements." 3 | (:require [svg-clj.elements :as el] 4 | [svg-clj.transforms :as tf] 5 | [svg-clj.utils :as u])) 6 | 7 | (defn distribute-linear 8 | "Distribute `elems` along the `axis` (either :x or :y) with a `gap` distance between each item." 9 | [elems axis gap] 10 | (let [getfn (axis {:x first :y second}) 11 | distances 12 | (reductions + 13 | (map #(+ (/ (getfn (u/bb-dims %1)) 2) 14 | (/ (getfn (u/bb-dims %2)) 2) gap) 15 | elems (rest elems)))] 16 | (el/g 17 | (conj 18 | (map 19 | #(tf/translate %1 (if (= axis :x) 20 | [%2 0] 21 | [0 %2])) (rest elems) distances) 22 | (first elems))))) 23 | 24 | (defn distribute-on-pts 25 | "Distribute the `elems` along the given `pts`. Each element is centered on its point." 26 | [elems pts] 27 | (el/g (map #(-> %1 (tf/translate %2)) elems pts))) 28 | 29 | (defn distribute-on-curve 30 | "Distribute the `elems` evenly along the given `curve`." 31 | [elems curve] 32 | (let [eps u/*eps* 33 | n (if (> (count elems) 1) (dec (count elems)) 1) 34 | xf (fn [elem t] 35 | (let [t (cond (<= (- 1 eps) t) (- 1 eps) 36 | (> eps t) eps 37 | :else t) 38 | n (u/normal (curve (- t eps)) (curve (+ t eps))) 39 | a (u/angle-from-pts n [0 0] [0 1]) 40 | o (map #(u/round % 4) (u/rotate-pt (tf/centroid elem) a))] 41 | (-> elem 42 | (tf/rotate a) 43 | (tf/translate (u/v- (curve t) o (tf/centroid elem))))))] 44 | (map #(xf %1 (float (/ %2 n))) elems (range 0 (inc n))))) 45 | 46 | (defn pattern-on-pts 47 | "Repeat `elem`, centering on each point of `pts`." 48 | [elem pts] 49 | (el/g (map #(-> elem (tf/translate %)) pts))) 50 | 51 | (defn pattern-on-curve 52 | "Repeat `elem` evenly along `curve` `n` times." 53 | [elem curve n] 54 | (let [step (/ 1.0 n)] 55 | (map #(-> elem (tf/translate (curve %))) (range 0 1.0 step)))) 56 | -------------------------------------------------------------------------------- /src/svg_clj/parametric.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.parametric 2 | "Provides functions that generate lists of points or return parametric curve functions." 3 | (:require [svg-clj.algorithms :as alg] 4 | [svg-clj.utils :as u])) 5 | 6 | (defn check-parametric 7 | "Utility fn to help diagnose parametric function issues." 8 | [f] 9 | (let [fdata (try (f) (catch #?(:cljs :default :clj Exception) _)) 10 | [f0 f05 f1] (map f [0 0.5 1]) 11 | t0 (if (seqable? f0) f0 [f0]) 12 | t05 (if (seqable? f05) f05 [f05]) 13 | t1 (if (seqable? f1) f1 [f1]) 14 | dim (count t05) 15 | required [:fn :input :vertex-params :length :origin] 16 | keys-pred (every? #(contains? fdata %) required) 17 | t0-pred (and t0 (= (count t0) dim) (every? number? t0)) 18 | t1-pred (and t1 (= (count t1) dim) (every? number? t1)) 19 | missing (when-not keys-pred (remove (set (keys fdata)) (set required))) 20 | result {:dimension dim 21 | :data fdata 22 | :valid-data keys-pred 23 | :valid-t0 t0-pred 24 | :valid-t1 t1-pred}] 25 | (cond-> result 26 | missing (assoc-in [:error :missing] missing) 27 | (not fdata) (assoc-in [:error :invalid-0-arity] fdata) 28 | (not t0-pred) (assoc-in [:error :invalid-t0] t0) 29 | (not t1-pred) (assoc-in [:error :invalid-t1] t1)))) 30 | 31 | (defn valid-parametric? 32 | "`True` if `f` is a properly built parametric function." 33 | [f] 34 | (nil? (:error (check-parametric f)))) 35 | 36 | (defn- remap-within 37 | "Shift the parameter range of `f` from 0 to 1 to `start` to `end`." 38 | [f [start end] x] 39 | (when (and (>= x start) (< x end)) 40 | (let [step (- end start) 41 | t (/ (- x start) step)] 42 | (f t)))) 43 | 44 | (defn arc-length 45 | "Calculate the arc length of `curve`, being exact where possible and estimating otherwise. 46 | For example, bezier curves are estimated, but circles and arcs have exact results (barring rounding)." 47 | ([curve] (arc-length curve 0 1)) 48 | ([curve t] (arc-length curve 0 t)) 49 | ([curve ta tb] 50 | (let [seg 13500 51 | start (/ (* ta seg) seg) 52 | end (/ (inc (* tb seg)) seg)] 53 | (->> (range start end (/ 1 seg)) 54 | (map curve) 55 | (partition 2 1) 56 | (map #(apply u/distance %)) 57 | (reduce +) 58 | (#(u/round % 5)))))) 59 | 60 | (defn regular-polygon-pts 61 | "Return a list of points making up a polygon with distance to the points `r` and `n` edges." 62 | [r n] 63 | (let [angle (* 2 Math/PI (/ 1 n))] 64 | (map #(vector (u/round (* r (Math/cos (* % angle))) 5) 65 | (u/round (* r (Math/sin (* % angle))) 5)) 66 | (range n)))) 67 | 68 | (defn rect-grid 69 | "Build a rectilinear grid with `nx`, `ny` points in x and y directions, with `x-spacing` and `y-spacing` between each point in the x and y directions respectively. 70 | Returned as a flat list of points from [0 0] in a 'Z' pattern to [(* nx x-spacing) (* ny y-spacing)]." 71 | [nx ny x-spacing y-spacing] 72 | (for [b (range ny) 73 | a (range nx)] 74 | [(* a x-spacing) (* b y-spacing)])) 75 | 76 | ;; todo: make this work. it's broken. 77 | (defn hex-grid 78 | "Build a hexagonal grid. Doesn't work yet." 79 | [nx ny w] 80 | (let [a-offset (/ w 2) 81 | h (/ w 0.8660254)] 82 | (concat 83 | (for [x (range 0 nx) 84 | y (range 0 (Math/floor (/ ny 2)))] 85 | [(+ a-offset (* w x)) (* 2 h y)]) 86 | (for [x (range 0 nx) 87 | y (range 1 (Math/ceil (/ ny 2)))] 88 | [(* w x) (+ h (* 2 h y))])))) 89 | 90 | (defn line 91 | "Create a parametric function representing a straight line. 92 | The returned function takes a parameter `t` between 0 and 1, where t 0 = `a` and t 1 = `b`." 93 | [a b] 94 | (fn 95 | ([] {:fn `line 96 | :input [a b] 97 | :origin (u/centroid-of-pts [a b]) 98 | :vertex-params [0 1] 99 | :length (u/distance a b)}) 100 | ([t] 101 | (cond 102 | (= (float t) 0.0) a 103 | (= (float t) 1.0) b 104 | :else 105 | (u/v+ a (u/v* (u/v- b a) (repeat t))))))) 106 | 107 | (defn fastline 108 | "Create a parametric function representing a straight line, with no checks and slightly faster implementation meant primarily for use in the bezier implementation. 109 | The returned function takes a parameter `t` between 0 and 1, where t 0 = `a` and t 1 = `b`." 110 | [[ax ay :as a] b] 111 | (let [[vx vy] (u/v- b a)] 112 | (fn [t] 113 | [(+ ax (* vx t)) 114 | (+ ay (* vy t))]))) 115 | 116 | (defn polyline 117 | "Create a parametric function representing a polyline with straight segments defined by `pts`. 118 | The returned function takes a parameter `t` between 0 and 1, where t 0 = (first `pts`) and t 1 = (last `pts`)." 119 | [pts] 120 | (let [lines (map (partial apply line) (partition 2 1 pts)) 121 | length (reduce + (map #(:length (%)) lines)) 122 | intervals (->> lines 123 | (map #(:length (%))) 124 | (reductions +) 125 | (concat [0]) 126 | (map #(/ % length)) 127 | (partition 2 1))] 128 | (fn 129 | ([] {:fn `polyline 130 | :input [pts] 131 | :origin (u/centroid-of-pts pts) 132 | :vertex-params (concat [0] (mapv second intervals)) 133 | :length length}) 134 | ([t] 135 | (cond 136 | (= (float t) 0.0) (first pts) 137 | (= (float t) 1.0) (last pts) 138 | :else 139 | (first 140 | (filter some? 141 | (map #(remap-within %1 %2 t) lines intervals)))))))) 142 | 143 | (defn polygon 144 | "Create a parametric function representing a polygon with straight segments defined by `pts`. 145 | The returned function takes a parameter `t` between 0 and 1, where t 0 and 1 = (first `pts`)." 146 | [pts] 147 | (let [pts (concat (vec pts) [(first pts)]) 148 | lines (map (partial apply line) (partition 2 1 pts)) 149 | length (reduce + (map #(:length (%)) lines)) 150 | intervals (->> lines 151 | (map #(:length (%))) 152 | (reductions +) 153 | (concat [0]) 154 | (map #(/ % length)) 155 | (partition 2 1))] 156 | (fn 157 | ([] {:fn `polygon 158 | :input [pts] 159 | :origin (u/centroid-of-pts pts) 160 | :vertex-params (concat [0] (mapv second intervals)) 161 | :length (reduce + (map #(:length (%)) lines))}) 162 | ([t] 163 | (cond 164 | (= (float t) 0.0) (first pts) 165 | (= (float t) 1.0) (last pts) 166 | :else 167 | (first 168 | (filter some? 169 | (map #(remap-within %1 %2 t) lines intervals)))))))) 170 | 171 | (defn- radius-from-pts 172 | "compute the radius of an arc defined by 3 points" 173 | [p1 p2 p3] 174 | (let [a (u/distance p3 p2) 175 | b (u/distance p3 p1) 176 | c (u/distance p2 p1) 177 | s (/ (+ a b c) 2) 178 | sa ( - s a) 179 | sb ( - s b) 180 | sc ( - s c) 181 | rt (Math/sqrt ^double (* s sa sb sc)) 182 | radius (/ (/ (* a b c) 4) rt)] 183 | radius)) 184 | 185 | (defn- center-from-pts 186 | "compute the center point of an arc through 3 points" 187 | [p1 p2 p3] 188 | (let [u1 (u/v- p2 p1) 189 | u2 (u/v- p3 p1) 190 | w1 (u/cross* (u/v- p3 p1) u1) 191 | u (u/normalize u1) 192 | w (u/normalize w1) 193 | v (u/cross* w u) 194 | [bx _] [(u/dot* u1 u) 0] 195 | [cx cy] [(u/dot* u2 u) (u/dot* u2 v)] 196 | h (/ (+ (Math/pow (- cx (/ bx 2)) 2) 197 | (Math/pow cy 2) 198 | (- (Math/pow (/ bx 2) 2))) 199 | (* 2 cy))] 200 | (u/v+ p1 201 | (u/v* (repeat (/ bx 2)) u) 202 | (u/v* (repeat h) v)))) 203 | 204 | (defn circle 205 | "Create a parametric function representing a circle with radius `r` centered at the origin, or circumscribing points `a`, `b`, and `c`, as long as the three points are not colinear. 206 | The returned function takes a parameter `t` between 0 and 1, where t 0 and 1 = [r 0] or centroid + calcuated radius." 207 | ([r] 208 | (fn 209 | ([] {:fn `circle 210 | :input [r] 211 | :origin [0 0] 212 | :vertex-params [0] 213 | :length (* Math/PI 2 r)}) 214 | ([t] 215 | (let [t (* 2 Math/PI t) 216 | x (* r (Math/cos t)) 217 | y (* r (Math/sin t))] 218 | [x y])))) 219 | 220 | ([a b c] 221 | (when-not (u/colinear? a b c) 222 | (let [[a b c] (map #(conj % 0) [a b c]) 223 | n (u/normalize (u/normal a b c)) 224 | r (radius-from-pts a b c) 225 | cp (center-from-pts a b c) 226 | u (u/normalize (u/v- a cp)) 227 | v (u/cross* n u)] 228 | (fn 229 | ([] {:fn `circle 230 | :input [a b c] 231 | :origin cp 232 | :vertex-params [0] 233 | :length (* Math/PI 2 r) 234 | :radius r}) 235 | ([t] 236 | (cond 237 | (or (< t 0.0) (> t 1.0)) nil 238 | (= (float t) 0.0) (vec (drop-last a)) 239 | (= (float t) 1.0) (vec (drop-last a)) 240 | :else 241 | (let [t (* 2 Math/PI t)] 242 | (mapv 243 | #(u/round % 5) 244 | (drop-last 245 | (u/v+ cp 246 | (u/v* (repeat (* r (Math/cos t))) u) 247 | (u/v* (repeat (* r (Math/sin t))) v)))))))))))) 248 | 249 | (defn arc 250 | "Create a parametric function representing an arc drawn from `a` through `b` and ending at `c`, as long as the three points are not colinear. 251 | The returned function takes a parameter `t` between 0 and 1, where t 0 = `a` and t 1 = `c`." 252 | [a b c] 253 | (when-not (u/colinear? a b c) 254 | (let [[a b c] (map #(conj % 0) [a b c]) 255 | f (circle a b c) 256 | cp (center-from-pts a b c) 257 | angle (u/angle-from-pts a cp c) 258 | r (radius-from-pts a b c)] 259 | (fn 260 | ([] {:fn `arc 261 | :input [a b c] 262 | :origin cp 263 | :vertex-params [0 1] 264 | :length (* Math/PI 2 r (/ angle 360)) 265 | :radius r 266 | :center cp}) 267 | ([t] 268 | (let [t (* t (/ angle 360.0))] 269 | (f t))))))) 270 | 271 | ;; https://www.mathsisfun.com/geometry/ellipse-perimeter.html 272 | ;; uses 'Infinite Series 2' exact calc. using 4 terms. 273 | (defn- ellipse-perimeter 274 | "Estimate the perimeter of an ellipse with radii `rx` and `ry`." 275 | [rx ry] 276 | (let [h (/ (Math/pow (- rx ry) 2) 277 | (Math/pow (+ rx ry) 2))] 278 | (* Math/PI (+ rx ry) 279 | (+ 1 280 | (* h (/ 1 4)) 281 | (* h h (/ 1 64)) 282 | (* h h h (/ 1 256)))))) 283 | 284 | (defn ellipse 285 | "Create a parametric function representing an ellipse with radii `rx`, `ry` centered at the origin. 286 | The returned function takes a parameter `t` between 0 and 1, where t 0 and 1 = [rx 0]." 287 | [rx ry] 288 | (fn 289 | ([] {:fn `ellipse 290 | :input [rx ry] 291 | :origin [0 0] 292 | :vertex-params [0] 293 | :length (ellipse-perimeter rx ry)}) 294 | ([t] 295 | (let [t (* 2 Math/PI t) 296 | x (* rx (Math/cos t)) 297 | y (* ry (Math/sin t))] 298 | [x y])))) 299 | 300 | (defn- quadratic-bezier 301 | [a b c] 302 | (fn [t] 303 | (let [l1 (fastline a b) 304 | l2 (fastline b c) 305 | l3 (fastline (l1 t) (l2 t))] 306 | (l3 t)))) 307 | 308 | (defn- bezier* 309 | [pts] 310 | (if (= 3 (count pts)) 311 | (apply quadratic-bezier pts) 312 | (let [lines (map #(apply fastline %) (partition 2 1 pts))] 313 | (fn 314 | [t] 315 | (let [npts (map #(% t) lines)] 316 | ((bezier* npts) t)))))) 317 | 318 | (defn bezier 319 | "Create a parametric function representing a bezier curve with control points `pts`, as long as there are at least 3 points. 320 | The returned function takes a parameter `t` between 0 and 1, where t 0 = (first `pts`) and t 1 = (last `pts`)." 321 | [pts] 322 | (when (> (count pts) 2) 323 | (let [curve (bezier* pts) 324 | length (arc-length curve)] 325 | (fn 326 | ([] {:fn `bezier 327 | :input [pts] 328 | :origin (u/centroid-of-pts pts) 329 | :vertex-params [0 1] 330 | :length length}) 331 | ([t] (curve t)))))) 332 | 333 | (defn- next-pascal 334 | [row] 335 | (vec (concat [(first row)] 336 | (mapv #(apply + %) (partition 2 1 row)) 337 | [(last row)]))) 338 | 339 | (defn- binomial 340 | [n i] 341 | (let [pascal-tri-row (last (take (inc n) (iterate next-pascal [1])))] 342 | (get pascal-tri-row i))) 343 | 344 | (defn- polynomial 345 | [n i t] 346 | (* (Math/pow (- 1 t) (- n i)) (Math/pow t i))) 347 | 348 | (defn- half-bezier 349 | [ws t] 350 | (let [n (dec (count ws)) 351 | poly (partial polynomial n) 352 | bi (partial binomial n)] 353 | (reduce + (map-indexed 354 | (fn [i w] 355 | (* (bi i) (poly i t) w)) 356 | ws)))) 357 | 358 | (defn- rational-bezier* 359 | [pts wts] 360 | (let [xs (map #(* (first %1) %2) pts wts) 361 | ys (map #(* (second %1) %2) pts wts) 362 | dn (partial half-bezier wts)] 363 | (fn [t] 364 | [(/ (half-bezier xs t) (dn t)) 365 | (/ (half-bezier ys t) (dn t))]))) 366 | 367 | ;; todo: write tests to see if this actually works properly. 368 | (defn rational-bezier 369 | "Create a parametric function representing a rational bezier curve with control points `pts` and weights `wts`, as long as there are at least 3 points and 3 wts. 370 | The returned function takes a parameter `t` between 0 and 1, where t 0 = (first `pts`) and t 1 = (last `pts`)." 371 | [pts wts] 372 | (let [curve (rational-bezier* pts wts) 373 | length (arc-length curve)] 374 | (fn 375 | ([] {:fn `rational-bezier 376 | :input [pts wts] 377 | :origin (u/centroid-of-pts pts) 378 | :vertex-params [0 1] 379 | :length length}) 380 | ([t] (curve t))))) 381 | 382 | (defn piecewise-curve 383 | "Create a parametric function representing compound curve composed of `curves`. 384 | The returned function takes a parameter `t` between 0 and 1, where t 0 = the start of the first curve and t 1 = the end of the last curve." 385 | [curves] 386 | (let [step (/ 1.0 (count curves)) 387 | intervals (partition 2 1 (range 0 (+ 1 step) step)) 388 | remapf (fn [curve [start end]] 389 | (let [vertex-params (:vertex-params (curve)) 390 | sc (- end start)] 391 | (map #(+ start (* sc %)) vertex-params))) 392 | vertex-params (vec (distinct (mapcat remapf curves intervals))) 393 | origin (u/centroid-of-pts (map #(:origin (%)) curves)) 394 | length (reduce + (map #(:length (%)) curves)) 395 | sample-curve (first curves)] 396 | (fn 397 | ([] {:fn `piecewise-curve 398 | :input [curves] 399 | :origin origin 400 | :dimension (count (sample-curve 0.5)) 401 | :vertex-params vertex-params 402 | :length length}) 403 | ([t] 404 | (cond 405 | (= (float t) 0.0) ((first curves) 0) 406 | (= (float t) 1.0) ((last curves) 1) 407 | :else 408 | (first 409 | (filter some? 410 | (map #(remap-within %1 %2 t) curves intervals)))))))) 411 | 412 | (defn split-bezier 413 | "Returns the Control Point 'de Casteljau Skeleton', used to derive split Bezier Curve Control Points." 414 | ([curve t] 415 | (let [pts (-> (curve) :input first)] 416 | (split-bezier {:a [(first pts)] 417 | :b [(last pts)]} pts t))) 418 | 419 | ([{:keys [a b]} pts t] 420 | (let [cs (map #(apply line %) (partition 2 1 pts)) 421 | npts (map #(% t) cs)] 422 | (if (= 1 (count npts)) 423 | {:a (conj a (first npts)) 424 | :b (-> b 425 | reverse 426 | (conj (first npts)) 427 | vec)} 428 | (recur {:a (conj a (first npts)) 429 | :b (conj b (last npts))} npts t))))) 430 | 431 | (defn- get-t 432 | "Estimate curve parameter `t` that corresponds to length-percentage `target-lp`." 433 | [curve target-lp] 434 | (let [eps 0.00001 435 | length (:length (curve)) 436 | target-l (* length target-lp)] 437 | (loop [t target-lp 438 | n 0] 439 | (let [next-t (+ t (/ (- target-l (arc-length curve t)) target-l))] 440 | (if (or 441 | (= (u/round t 4) (u/round next-t 4)) 442 | (< (Math/abs (- target-l (arc-length curve t))) eps) 443 | (< 300 n)) 444 | next-t 445 | (recur next-t (inc n))))))) 446 | 447 | (defn- get-t-at-distance 448 | [curve d] 449 | (let [target-lp (/ d (:length (curve)))] 450 | (get-t curve target-lp))) 451 | 452 | (defn split-bezier-between 453 | "Split the given bezier curve `curve` between parameters `ta` and `tb`, where each is between 0 and 1." 454 | [curve ta tb] 455 | (let [da (arc-length curve ta) 456 | split1 (split-bezier curve tb) 457 | curve1 (bezier (:a split1)) 458 | partial-result {:c (:b split1)} 459 | ta1 (get-t-at-distance curve1 da)] 460 | (merge (split-bezier curve1 ta1) partial-result))) 461 | 462 | (defn multi-split-bezier 463 | "Split the given bezier curve `curve` at each parameter in `ts`, where each is between 0 and 1." 464 | ([curve ts] 465 | (let [ds (map #(arc-length curve %) (sort ts))] 466 | (multi-split-bezier [] curve (reverse ds)))) 467 | ([acc curve ds] 468 | (if (< 1 (count ds)) 469 | (let [remapped-t (get-t-at-distance curve (first ds)) 470 | {:keys [a b]} (split-bezier curve remapped-t)] 471 | (recur (conj acc b) (bezier a) (rest ds))) 472 | (let [remapped-t (get-t-at-distance curve (first ds)) 473 | {:keys [a b]} (split-bezier curve remapped-t)] 474 | (-> acc 475 | (conj b) 476 | (conj a) 477 | reverse))))) 478 | 479 | (defn uniform-split-bezier 480 | "Split the given bezier curve `curve` evenly into `n` segments." 481 | [curve n-segments] 482 | (let [l (arc-length curve) 483 | step (/ l n-segments) 484 | ds (range step l step)] 485 | (if (= 2 n-segments) 486 | (split-bezier curve 0.5) 487 | (multi-split-bezier [] curve (reverse (sort ds)))))) 488 | 489 | ;; todo: test/fix all bezier splitting functions 490 | 491 | #_(def test-spline 492 | (let [degree 3 493 | pts [[0 0] [5 5] [10 -5] [15 25] [20 -5] [25 5] [30 0]] 494 | knots [1 2 3 4 5 6 7 8 9 10 11]] 495 | (partial b-spline-inner [pts degree knots] [1 pts]))) 496 | 497 | (defn sinwave 498 | "Creates a parametric function of a sinwave with amplitude `amp`, and frequency `freq`." 499 | [amp freq] 500 | (fn [t] 501 | (* amp (Math/sin (* t freq Math/PI))))) 502 | 503 | (defn blend 504 | "Buildsa a parametric function that is a blend of parametric functions `fa` `fb` by `alpha` between 0 and 1 where 0 is 100% `fa`, and 1 is 100% `fb`. 505 | Optionally pass an `easefn` to apply to the alpha." 506 | ([fa fb alpha] 507 | (fn [t] 508 | (let [line (line (fa t) (fb t))] 509 | (line alpha)))) 510 | ([fa fb easefn alpha] 511 | (fn [t] 512 | (let [line (line (fa t) (fb t))] 513 | (line (easefn alpha)))))) 514 | 515 | (defn eased-polyline 516 | "Create a parametric function which is a smoothed polyline using an easing function `easefn`." 517 | [pts easefn] 518 | (let [lines (map (partial apply line) (partition 2 1 pts)) 519 | length (reduce + (map #(:length (%)) lines)) 520 | intervals (->> lines 521 | (map #(:length (%))) 522 | (reductions +) 523 | (concat [0]) 524 | (map #(/ % length)) 525 | (partition 2 1)) 526 | easedlines (map #(fn [t] (% (easefn t))) lines)] 527 | (fn 528 | ([] {:fn `eased-polyline 529 | :input [pts easefn] 530 | :length length}) 531 | ([t] 532 | (cond 533 | (= (float t) 0.0) (first pts) 534 | (= (float t) 1.0) (last pts) 535 | :else 536 | (first 537 | (filter some? 538 | (map #(remap-within %1 %2 t) easedlines intervals)))))))) 539 | 540 | ;; todo: turn this into a proper parametric fn (add 0-arity, test, etc.) 541 | (defn multiblend 542 | "Blend multiple parametric curves `fs` together with `alpha` and an optional `easefn`." 543 | ([fs alpha] 544 | (fn [t] 545 | (let [line (polyline (map #(% t) fs))] 546 | (line alpha)))) 547 | ([fs easefn alpha] 548 | (fn [t] 549 | (let [line (eased-polyline (map #(% t) fs) easefn)] 550 | (line alpha))))) 551 | 552 | ;; todo: turn this into a proper parametric fn (add 0-arity, test, etc.) 553 | (defn fn-offset 554 | "Offset the parametric curve `curve` with an offsetting function `f`, which modfies the paramter t in some way." 555 | [curve f] 556 | (let [eps u/*eps*] 557 | (fn [t] 558 | (let [t (cond (<= (- 1 eps) t) (- 1 eps) 559 | (> eps t) eps 560 | :else t) 561 | n (u/normalize (u/normal (curve (- t eps)) (curve (+ t eps)))) 562 | tpt (curve t) 563 | l (line tpt (u/v+ tpt n))] 564 | (l (f t)))))) 565 | 566 | (defn shift-pts 567 | "Shift a list of `pts` to begin at `start`, preserving order and cycling the list. 568 | If no `start` is provided, pt with lowest x and y values is used." 569 | ([pts] 570 | (let [start (first (sort-by (juxt first second) pts))] 571 | (shift-pts pts start))) 572 | ([pts start] 573 | (let [[back front] (split-with (complement #{start}) pts)] 574 | (concat front back)))) 575 | 576 | (defn simplify 577 | "Simplifies the list of `pts` by evenly stepping `n` times along the parametric curve produced by the original list. 578 | This does not guarantee that input pts are preserved in the output." 579 | [pts n] 580 | (let [c (polygon pts)] 581 | (mapv #(c (/ % (inc n))) (range n)))) 582 | 583 | (defn stroke-pts 584 | "Return a list of points that define a constant `width` stroke with `n-segments` along the `curve`." 585 | [curve width n-segments] 586 | (let [tcurve (fn-offset curve #(* 0.5 width)) 587 | bcurve (fn-offset curve #(* -0.5 width))] 588 | (concat [(curve 0)] 589 | (map #(tcurve (/ % n-segments)) (range (inc n-segments))) 590 | [(curve 1)] 591 | (map #(bcurve (/ % n-segments)) (reverse (range (inc n-segments))))))) 592 | 593 | ;; todo: rework this implementation to remove need for 'pline' 594 | #_(defn- pline 595 | [line] 596 | (let [[_ {:keys [x1 y1 x2 y2]}] line] 597 | (line [x1 y1] [x2 y2]))) 598 | 599 | #_(defn tapered-stroke-pts 600 | "Return a list of points that define a maximum `width` stroke with `n-segments` along the `curve`, where the points are tapered from both ends up to the parameter `taper-t` on the curve. 601 | The max. `taper-t` can be is 0.5 to have the stroke taper up to maximum width at the center of the curve down again to the end of the curve." 602 | [curve width n-segments taper-t] 603 | (let [taper-n (int (* n-segments taper-t)) 604 | taper (map #(u/ease-out-sin (/ % taper-n)) (range taper-n)) 605 | dist (concat taper (repeat (- n-segments (* 2 (count taper))) 1) (reverse taper)) 606 | tlns (->> (el/line [0 0] [0 (* 0.5 width)]) 607 | (repeat (inc n-segments)) 608 | (#(lo/distribute-on-curve % curve)) 609 | (map pline)) 610 | blns (->> (el/line [0 0] [0 (* -0.5 width)]) 611 | (repeat n-segments) 612 | (#(lo/distribute-on-curve % curve)) 613 | (map pline))] 614 | (concat [(curve 0)] 615 | (map #(%1 (* 1 (- 1 %2))) tlns dist) 616 | [(curve 1)] 617 | (reverse (map #(%1 (* 1 (- 1 %2))) blns dist))))) 618 | 619 | (defn fillet-pts 620 | "Return a list of points defining an approximation of the shaped defined by `pts` with fillets of radius `r` at all of the corners." 621 | [pts r] 622 | (let [fillet (regular-polygon-pts r 50) 623 | ipts (u/offset-pts pts (- r)) 624 | f (fn [pt] (map #(u/v+ pt %) fillet)) 625 | npts (mapcat f ipts)] 626 | (alg/hull npts))) 627 | 628 | (defn chamfer-pts 629 | "Return a list of points defining a new shape derived from the shape made by `pts` with chamfers of radius `r` at all of the corners." 630 | [pts r] 631 | (let [fillet (regular-polygon-pts r 50) 632 | ipts (u/offset-pts pts (- r)) 633 | f (fn [pt] (map #(u/v+ pt %) fillet)) 634 | npts (mapcat f ipts)] 635 | (->> (alg/hull npts) 636 | (partition 2 1) 637 | (sort-by #(apply u/distance %)) 638 | reverse 639 | (take (count pts)) 640 | (apply concat) 641 | alg/hull))) 642 | 643 | (defn translate 644 | "Translate the parametric function `f` by [`x` `y`]." 645 | [f [x y]] 646 | (let [data (f)] 647 | (fn 648 | ([] (merge data 649 | {:fn `translate 650 | :origin (u/v+ (:origin data) [x y]) 651 | :input [f [x y]]})) 652 | ([t] 653 | (u/v+ (f t) [x y]))))) 654 | 655 | (defn rotate 656 | "Rotate the parametric function `f` by `deg` around its origin." 657 | [f deg] 658 | (let [data (f) 659 | ctr (:origin data)] 660 | (fn 661 | ([] {:fn `rotate 662 | :input [f deg]}) 663 | ([t] 664 | (u/rotate-pt-around-center (f t) deg ctr))))) 665 | 666 | (defn scale 667 | "Scale the parametric function `f` by [`sx` `sy`] around its origin." 668 | [f [sx sy]] 669 | (let [data (f) 670 | ctr (:origin data)] 671 | (fn 672 | ([] (merge data 673 | {:fn `scale 674 | :input [f [sx sy]]})) 675 | ([t] 676 | (u/scale-pt-from-center (f t) [sx sy] ctr))))) 677 | -------------------------------------------------------------------------------- /src/svg_clj/tools.clj: -------------------------------------------------------------------------------- 1 | (ns svg-clj.tools 2 | (:require [clojure.java.browse] 3 | [clojure.java.io] 4 | [hiccup.core :as hiccup :refer [html]] 5 | [svg-clj.composites :as comp :refer [svg]] 6 | [svg-clj.utils :as u])) 7 | 8 | (defn save-svg 9 | "Save hiccup-style `svg-data` to file `fname`." 10 | [svg-data fname] 11 | (let [data (if (= (first svg-data) :svg) 12 | svg-data 13 | (svg svg-data))] 14 | (spit fname (html data)))) 15 | 16 | (defn cider-show 17 | "Show hiccup-style `svg-data` in a CIDER REPL. Creates `_tmp.svg` in the project's root folder." 18 | [svg-data] 19 | (let [fname "_tmp.svg"] 20 | (save-svg svg-data fname) 21 | (clojure.java.io/file fname))) 22 | 23 | (defn show 24 | "Show hiccup-style `svg-data` in the browser. Creates `_tmp.svg.html` in the project's root folder." 25 | [svg-data] 26 | (let [fname "_tmp.svg.html"] 27 | (save-svg svg-data fname) 28 | (clojure.java.io/file fname))) 29 | -------------------------------------------------------------------------------- /src/svg_clj/transforms.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.transforms 2 | "Provides functions for computing and transforming properties of the SVG elements created by the `elements`, `path`, and `composites` namespaces. 3 | 4 | The most common transformations include translate, rotate, style, and scale which all work on every element. Other transformations include merge, split, and explode and these only work on path elements. 5 | 6 | This namespace also provides `bounds`, and `centroid` functions which calculate the respective property for all elements provided by this library." 7 | (:require [clojure.string :as str] 8 | [svg-clj.path :as path] 9 | [svg-clj.utils :as u] 10 | #?(:cljs 11 | [cljs.reader :refer [read-string]]))) 12 | 13 | (defn style 14 | "Merge a style map into the given element." 15 | [elem style-map] 16 | (u/style elem style-map)) 17 | 18 | (defmulti centroid 19 | "Calculates the arithmetic mean position of the given `element`." 20 | (fn [element] 21 | (if (keyword? (first element)) 22 | (first element) 23 | :list))) 24 | 25 | (defmethod centroid :list 26 | [elems] 27 | (u/centroid-of-pts (into #{} (map centroid elems)))) 28 | 29 | (defmethod centroid :circle 30 | [[_ props]] 31 | [(:cx props) (:cy props)]) 32 | 33 | (defmethod centroid :ellipse 34 | [[_ props]] 35 | [(:cx props) (:cy props)]) 36 | 37 | (defmethod centroid :line 38 | [[_ props]] 39 | (let [a (mapv #(get props %) [:x1 :y1]) 40 | b (mapv #(get props %) [:x2 :y2])] 41 | (u/centroid-of-pts [a b]))) 42 | 43 | (defmethod centroid :polygon 44 | [[_ props]] 45 | (let [pts (mapv u/s->v (str/split (:points props) #" "))] 46 | (u/centroid-of-pts pts))) 47 | 48 | (defmethod centroid :polyline 49 | [[_ props]] 50 | (let [pts (mapv u/s->v (str/split (:points props) #" "))] 51 | (u/centroid-of-pts pts))) 52 | 53 | (defmethod centroid :rect 54 | [[_ props]] 55 | [(+ (:x props) (/ (:width props) 2.0)) 56 | (+ (:y props) (/ (:height props) 2.0))]) 57 | 58 | (defmethod centroid :image 59 | [[_ props]] 60 | [(+ (:x props) (/ (:width props) 2.0)) 61 | (+ (:y props) (/ (:height props) 2.0))]) 62 | 63 | ;; this is not done yet. Text in general needs a redo. 64 | (defmethod centroid :text 65 | [[_ props _]] 66 | [(:x props) (:y props)]) 67 | 68 | (defmethod centroid :path 69 | [elem] 70 | (path/centroid elem)) 71 | 72 | (declare centroid) 73 | (defmethod centroid :g 74 | [[_ _ & content]] 75 | (u/centroid-of-pts (into #{} (map centroid content)))) 76 | 77 | (defmulti bounds 78 | "Calculates the axis-aligned-bounding-box of `element` or list of elements." 79 | (fn [element] 80 | (if (keyword? (first element)) 81 | (first element) 82 | :list))) 83 | 84 | (defmethod bounds :default 85 | [_] 86 | [[-1 -1] [1 -1] [1 1] [-1 1]]) 87 | 88 | (defmethod bounds :list 89 | [elems] 90 | (u/bounds-of-pts (mapcat bounds elems))) 91 | 92 | (defmethod bounds :circle 93 | [[_ props]] 94 | (let [c [(:cx props) (:cy props)] 95 | r (:r props) 96 | pts (mapv #(u/v+ c %) [[r 0] 97 | [0 r] 98 | [(- r) 0] 99 | [0 (- r)]])] 100 | (u/bounds-of-pts pts))) 101 | 102 | (defmethod bounds :ellipse 103 | [[_ props]] 104 | (let [xf (u/str->xf-map (get props :transform "rotate(0 0 0)")) 105 | deg (get-in xf [:rotate 0]) 106 | mx (get-in xf [:rotate 1]) 107 | my (get-in xf [:rotate 2]) 108 | c [(:cx props) (:cy props)] 109 | rx (:rx props) 110 | ry (:ry props) 111 | pts (mapv #(u/v+ c %) [[rx 0] 112 | [0 ry] 113 | [(- rx) 0] 114 | [0 (- ry)]]) 115 | bb (u/bounds-of-pts pts) 116 | obb (mapv #(u/rotate-pt-around-center % deg [mx my]) bb) 117 | xpts (mapv #(u/rotate-pt-around-center % deg [mx my]) pts) 118 | small-bb (u/bounds-of-pts xpts) 119 | large-bb (u/bounds-of-pts obb)] 120 | ;; not accurate, but good enough for now 121 | ;; take the bb to be the average between the small and large 122 | (u/bounds-of-pts (mapv #(u/centroid-of-pts [%1 %2]) small-bb large-bb)))) 123 | 124 | (defmethod bounds :line 125 | [[_ props]] 126 | (let [a (mapv #(get props %) [:x1 :y1]) 127 | b (mapv #(get props %) [:x2 :y2])] 128 | (u/bounds-of-pts [a b]))) 129 | 130 | (defmethod bounds :polygon 131 | [[_ props]] 132 | (let [pts (mapv u/s->v (str/split (:points props) #" "))] 133 | (u/bounds-of-pts pts))) 134 | 135 | (defmethod bounds :polyline 136 | [[_ props]] 137 | (let [pts (mapv u/s->v (str/split (:points props) #" "))] 138 | (u/bounds-of-pts pts))) 139 | 140 | (defmethod bounds :rect 141 | [[_ props]] 142 | (let [xf (u/str->xf-map (get props :transform "rotate(0 0 0)")) 143 | deg (get-in xf [:rotate 0]) 144 | mx (get-in xf [:rotate 1]) 145 | my (get-in xf [:rotate 2]) 146 | x (:x props) 147 | y (:y props) 148 | w (:width props) 149 | h (:height props) 150 | pts [[x y] 151 | [(+ x w) y] 152 | [(+ x w) (+ y h)] 153 | [x (+ y h)]] 154 | xpts (mapv #(u/rotate-pt-around-center % deg [mx my]) pts)] 155 | (u/bounds-of-pts xpts))) 156 | 157 | (defmethod bounds :image 158 | [[_ props]] 159 | (let [xf (u/str->xf-map (get props :transform "rotate(0 0 0)")) 160 | deg (get-in xf [:rotate 0]) 161 | mx (get-in xf [:rotate 1]) 162 | my (get-in xf [:rotate 2]) 163 | x (:x props) 164 | y (:y props) 165 | w (:width props) 166 | h (:height props) 167 | pts [[x y] 168 | [(+ x w) y] 169 | [(+ x w) (+ y h)] 170 | [x (+ y h)]] 171 | xpts (mapv #(u/rotate-pt-around-center % deg [mx my]) pts)] 172 | (u/bounds-of-pts xpts))) 173 | 174 | ;; this is not done yet. Text in general needs a redo. 175 | ;; Austin is a headless browser that may help with .getBBox??? 176 | (defmethod bounds :text 177 | [[_ {:keys [x y font-size ] :as props} text]] 178 | (let [xf (u/str->xf-map (get props :transform "rotate(0 0 0)")) 179 | deg (get-in xf [:rotate 0]) 180 | ar 0.6 181 | h (read-string (str font-size)) 182 | hh (/ h 2.0) 183 | hw (/ (* ar h (count text)) 2.0) 184 | pts [ [(- x hw) (- y hh)] 185 | [(+ x hw) (- y hh)] 186 | [(+ x hw) (+ y hh)] 187 | [(- x hw) (+ y hh)] ] 188 | xpts (mapv #(u/rotate-pt-around-center % deg [x y]) pts)] 189 | (u/bounds-of-pts xpts))) 190 | 191 | (defmethod bounds :path 192 | [elem] 193 | (path/bounds elem)) 194 | 195 | (declare bounds) 196 | (defmethod bounds :g 197 | [[_ _ & content]] 198 | (u/bounds-of-pts (mapcat bounds content))) 199 | 200 | (defn- get-props 201 | [props] 202 | (merge {:rotate [0 0 0]} (u/str->xf-map (get props :transform)))) 203 | 204 | (defmulti translate 205 | "Translates `element` by [`x` `y`]." 206 | (fn [element _] 207 | (if (keyword? (first element)) 208 | (first element) 209 | :list))) 210 | 211 | (defmethod translate :list 212 | [elems [x y]] 213 | (map #(translate % [x y]) elems)) 214 | 215 | (defmethod translate :circle 216 | [[k props] [x y]] 217 | (let [xf (get-props props) 218 | cx (:cx props) 219 | cy (:cy props) 220 | new-xf (-> xf 221 | (assoc-in [:rotate 1] (+ x cx)) 222 | (assoc-in [:rotate 2] (+ y cy))) 223 | new-props (-> props 224 | (assoc :transform (u/xf-map->str new-xf)) 225 | (update :cx + x) 226 | (update :cy + y))] 227 | [k new-props])) 228 | 229 | (defmethod translate :ellipse 230 | [[k props] [x y]] 231 | (let [xf (get-props props) 232 | cx (:cx props) 233 | cy (:cy props) 234 | new-xf (-> xf 235 | (assoc-in [:rotate 1] (+ x cx)) 236 | (assoc-in [:rotate 2] (+ y cy))) 237 | new-props (-> props 238 | (assoc :transform (u/xf-map->str new-xf)) 239 | (update :cx + x) 240 | (update :cy + y))] 241 | [k new-props])) 242 | 243 | (defmethod translate :line 244 | [[k props] [x y]] 245 | (let [new-props (-> props 246 | (update :x1 + x) 247 | (update :y1 + y) 248 | (update :x2 + x) 249 | (update :y2 + y))] 250 | [k new-props])) 251 | 252 | (defmethod translate :polygon 253 | [[k props] [x y]] 254 | (let [pts (mapv u/s->v (str/split (:points props) #" ")) 255 | xpts (->> pts 256 | (map (partial u/v+ [x y])) 257 | (map u/v->s))] 258 | [k (assoc props :points (str/join " " xpts))])) 259 | 260 | (defmethod translate :polyline 261 | [[k props] [x y]] 262 | (let [pts (mapv u/s->v (str/split (:points props) #" ")) 263 | xpts (->> pts 264 | (map (partial u/v+ [x y])) 265 | (map u/v->s))] 266 | [k (assoc props :points (str/join " " xpts))])) 267 | 268 | (defmethod translate :rect 269 | [[k props] [x y]] 270 | (let [[cx cy] (centroid [k props]) 271 | xf (get-props props) 272 | new-xf (-> xf 273 | (assoc-in [:rotate 1] (+ cx x)) 274 | (assoc-in [:rotate 2] (+ cy y))) 275 | new-props (-> props 276 | (assoc :transform (u/xf-map->str new-xf)) 277 | (update :x + x) 278 | (update :y + y))] 279 | [k new-props])) 280 | 281 | (defmethod translate :image 282 | [[k props] [x y]] 283 | (let [[cx cy] (centroid [k props]) 284 | xf (get-props props) 285 | new-xf (-> xf 286 | (assoc-in [:rotate 1] (+ cx x)) 287 | (assoc-in [:rotate 2] (+ cy y))) 288 | new-props (-> props 289 | (assoc :transform (u/xf-map->str new-xf)) 290 | (update :x + x) 291 | (update :y + y))] 292 | [k new-props])) 293 | 294 | (defmethod translate :text 295 | [[k props text] [x y]] 296 | (let [xf (get-props props) 297 | new-xf (-> xf 298 | (update-in [:rotate 1] + x) 299 | (update-in [:rotate 2] + y)) 300 | new-props (-> props 301 | (assoc :transform (u/xf-map->str new-xf)) 302 | (update :x + x) 303 | (update :y + y))] 304 | [k new-props text])) 305 | 306 | (defmethod translate :path 307 | [elem [x y]] 308 | (path/translate elem [x y])) 309 | 310 | #_(declare translate) 311 | (defmethod translate :g 312 | [[k props & content] [x y]] 313 | (->> content 314 | (map #(translate % [x y])) 315 | (filter (complement nil?)) 316 | (into [k props]))) 317 | 318 | (defn rotate-element-by-transform 319 | "Rotate an element by using the SVG transform property. 320 | This function is used to transform elements that cannot 'bake' the transform into their other geometric properties. For example, the ellipse and circle elements have only center and radius properties which cannot affect orientation." 321 | [[k props content] deg] 322 | (let [xf (get-props props) 323 | new-xf (-> xf 324 | (update-in [:rotate 0] + deg)) 325 | new-props (assoc props :transform (u/xf-map->str new-xf))] 326 | (vec (filter (complement nil?) [k new-props (when content content)])))) 327 | 328 | (defmulti rotate 329 | "Rotate `element` by `deg` degrees around its centroid." 330 | (fn [element _] 331 | (if (keyword? (first element)) 332 | (first element) 333 | :list))) 334 | 335 | (defmethod rotate :list 336 | [elems deg] 337 | (map #(rotate % deg) elems)) 338 | 339 | (defmethod rotate :circle 340 | [[k props] deg] 341 | (rotate-element-by-transform [k props] deg)) 342 | 343 | (defmethod rotate :ellipse 344 | [[k props] deg] 345 | (rotate-element-by-transform [k props] deg)) 346 | 347 | (defmethod rotate :line 348 | [[k props] deg] 349 | (let [pts [[(:x1 props) (:y1 props)] [(:x2 props) (:y2 props)]] 350 | [[x1 y1] [x2 y2]] (->> pts 351 | (map #(u/v- % (u/centroid-of-pts pts))) 352 | (map #(u/rotate-pt % deg)) 353 | (map #(u/v+ % (u/centroid-of-pts pts)))) 354 | new-props (assoc props :x1 x1 :y1 y1 :x2 x2 :y2 y2)] 355 | [k new-props])) 356 | 357 | (defmethod rotate :polygon 358 | [[k props] deg] 359 | (let [ctr (centroid [k props]) 360 | pts (mapv u/s->v (str/split (:points props) #" ")) 361 | xpts (->> pts 362 | (map #(u/v- % ctr)) 363 | (map #(u/rotate-pt % deg)) 364 | (map #(u/v+ % ctr)) 365 | (map u/v->s)) 366 | xprops (assoc props :points (str/join " " xpts))] 367 | [k xprops])) 368 | 369 | (defmethod rotate :polyline 370 | [[k props] deg] 371 | (let [ctr (centroid [k props]) 372 | pts (mapv u/s->v (str/split (:points props) #" ")) 373 | xpts (->> pts 374 | (map #(u/v- % ctr)) 375 | (map #(u/rotate-pt % deg)) 376 | (map #(u/v+ % ctr)) 377 | (map u/v->s)) 378 | xprops (assoc props :points (str/join " " xpts))] 379 | [k xprops])) 380 | 381 | (defmethod rotate :rect 382 | [[k props] deg] 383 | (let [[cx cy] (centroid [k props]) 384 | xf (get-props props) 385 | new-xf (-> xf 386 | (update-in [:rotate 0] + deg) 387 | (assoc-in [:rotate 1] cx) 388 | (assoc-in [:rotate 2] cy)) 389 | new-props (assoc props :transform (u/xf-map->str new-xf))] 390 | [k new-props])) 391 | 392 | (defmethod rotate :image 393 | [[k props] deg] 394 | (let [[cx cy] (centroid [k props]) 395 | xf (get-props props) 396 | new-xf (-> xf 397 | (update-in [:rotate 0] + deg) 398 | (assoc-in [:rotate 1] cx) 399 | (assoc-in [:rotate 2] cy)) 400 | new-props (assoc props :transform (u/xf-map->str new-xf))] 401 | [k new-props])) 402 | 403 | (defmethod rotate :text 404 | [[k props text] deg] 405 | (rotate-element-by-transform [k props text] deg)) 406 | 407 | (defmethod rotate :path 408 | [elem deg] 409 | (path/rotate elem deg)) 410 | 411 | (defmethod rotate :g 412 | [[k props & content :as elem] deg] 413 | (let [[gcx gcy] [0 0] #_(u/centroid-of-pts (bounds elem)) 414 | xfcontent (for [child content] 415 | (let [ch (translate child [(- gcx) (- gcy)]) 416 | ctr (if (= :g (first ch)) 417 | (u/centroid-of-pts (bounds ch)) 418 | (centroid ch)) 419 | xfm (-> ctr 420 | (u/rotate-pt deg) 421 | (u/v+ [gcx gcy]))] 422 | (-> ch 423 | (translate (u/v* [-1 -1] ctr)) 424 | (rotate deg) 425 | (translate xfm))))] 426 | (into [k props] (filter (complement nil?) xfcontent)))) 427 | 428 | (defn scale-by-transform 429 | "Scale an element by using the SVG transform property. 430 | This function is used to transform elements that cannot 'bake' the transform into their other geometric properties." 431 | [[k props & content] [sx sy]] 432 | (let [xf (u/str->xf-map (:transform props)) 433 | new-xf (-> xf 434 | (update :scale (fnil #(map * [sx sy] %) [1 1]))) 435 | new-props (assoc props :transform (u/xf-map->str new-xf))] 436 | [k new-props] content)) 437 | 438 | (defmulti scale 439 | "Scale `element` by [`sx` `sy`] around its centroid." 440 | (fn [element _] 441 | (if (keyword? (first element)) 442 | (first element) 443 | :list))) 444 | 445 | (defmethod scale :list 446 | [elems [sx sy]] 447 | (map #(scale [sx sy] %) elems)) 448 | 449 | ;; transforms are applied directly to the properties of shapes. 450 | ;; I have scale working the same way. One issue is that scaling a circle 451 | ;; turns it into an ellipse. This impl WILL change the shape to ellipse if non-uniform scaling is applied. 452 | 453 | (defmethod scale :circle 454 | [[_ props] [sx sy]] 455 | (let [[sx sy] (map #(Math/abs %) [sx sy]) 456 | circle? (= sx sy) 457 | r (:r props) 458 | new-props (if circle? 459 | (assoc props :r (* r sx)) 460 | (-> props 461 | (dissoc :r) 462 | (assoc :rx (* sx r)) 463 | (assoc :ry (* sy r)))) 464 | k (if circle? :circle :ellipse)] 465 | [k new-props])) 466 | 467 | (defmethod scale :ellipse 468 | [[k props] [sx sy]] 469 | (let [[sx sy] (map #(Math/abs %) [sx sy]) 470 | new-props (-> props 471 | (update :rx #(* sx %)) 472 | (update :ry #(* sy %)))] 473 | [k new-props])) 474 | 475 | ;; find bounding box center 476 | ;; translate bb-center to 0 0 477 | ;; scale all x y values by * [sx sy] 478 | ;; translate back to original bb-center 479 | 480 | (defmethod scale :line 481 | [[k props :as elem] [sx sy]] 482 | (let [[cx cy] (centroid elem) 483 | new-props (-> props 484 | (update :x1 #(+ (* (- % cx) sx) cx)) 485 | (update :y1 #(+ (* (- % cy) sy) cy)) 486 | (update :x2 #(+ (* (- % cx) sx) cx)) 487 | (update :y2 #(+ (* (- % cy) sy) cy)))] 488 | [k new-props])) 489 | 490 | (defmethod scale :polygon 491 | [[k props :as elem] [sx sy]] 492 | (let [pts (map vec (partition 2 (u/s->v (:points props)))) 493 | ctr (centroid elem) 494 | xpts (->> pts 495 | (map #(u/scale-pt-from-center % [sx sy] ctr)) 496 | (map u/v->s))] 497 | [k (assoc props :points (str/join " " xpts))])) 498 | 499 | (defmethod scale :polyline 500 | [[k props :as elem] [sx sy]] 501 | (let [pts (map vec (partition 2 (u/s->v (:points props)))) 502 | ctr (centroid elem) 503 | xpts (->> pts 504 | (map #(u/scale-pt-from-center % [sx sy] ctr)) 505 | (map u/v->s))] 506 | [k (assoc props :points (str/join " " xpts))])) 507 | 508 | (defmethod scale :rect 509 | [[k props] [sx sy]] 510 | (let [cx (+ (:x props) (/ (:width props) 2.0)) 511 | cy (+ (:y props) (/ (:height props) 2.0)) 512 | w (* sx (:width props)) 513 | h (* sy (:height props)) 514 | new-props (-> props 515 | (assoc :width w) 516 | (assoc :height h) 517 | (update :x #(+ (* (- % cx) sx) cx)) 518 | (update :y #(+ (* (- % cy) sy) cy)))] 519 | [k new-props])) 520 | 521 | (defmethod scale :image 522 | [[k props] [sx sy]] 523 | (let [cx (+ (:x props) (/ (:width props) 2.0)) 524 | cy (+ (:y props) (/ (:height props) 2.0)) 525 | w (* sx (:width props)) 526 | h (* sy (:height props)) 527 | new-props (-> props 528 | (assoc :width w) 529 | (assoc :height h) 530 | (update :x #(+ (* (- % cx) sx) cx)) 531 | (update :y #(+ (* (- % cy) sy) cy)))] 532 | [k new-props])) 533 | 534 | (defmethod scale :text 535 | [[k props text] [sx sy]] 536 | (let [xf (get-props props) 537 | cx (get-in xf [:rotate 1]) 538 | cy (get-in xf [:rotate 2]) 539 | x (+ (* (- (:x props) cx) sx) cx) 540 | y (+ (* (- (:y props) cy) sy) cy) 541 | new-xf (-> xf 542 | (assoc-in [:rotate 1] (- x)) 543 | (assoc-in [:rotate 2] (- y))) 544 | new-props (-> props 545 | (assoc :transform (u/xf-map->str new-xf)) 546 | (assoc :x x) 547 | (assoc :y y) 548 | (update-in [:style :font-size] #(* % sx)))] 549 | [k new-props text])) 550 | 551 | (defmethod scale :path 552 | [elem [sx sy]] 553 | (path/scale elem [sx sy])) 554 | 555 | #_(defmethod scale :g 556 | [[k props & content] [sx sy]] 557 | (let [xf (u/str->xf-map (:transform props)) 558 | new-xf (-> xf 559 | (update :scale (fnil #(map * [sx sy] %) [1 1]))) 560 | new-props (assoc props :transform (u/xf-map->str new-xf))] 561 | (into [k new-props] content))) 562 | 563 | (defmethod scale :g 564 | [[k props & content :as elem] [sx sy]] 565 | (let [g-ctr (u/centroid-of-pts (bounds elem)) 566 | xfcontent (for [child content] 567 | (let [elem-ctr (if (= :g (first child)) 568 | (u/centroid-of-pts (bounds child)) 569 | (centroid child)) 570 | ch (-> child 571 | (translate (u/v* [-1 -1] elem-ctr)) 572 | (scale [sx sy])) 573 | elem-v (u/v- elem-ctr g-ctr)] 574 | (-> ch (translate (u/v+ (u/v* [sx sy] elem-v) g-ctr)))))] 575 | (into [k props] (filter (complement nil?) xfcontent)))) 576 | 577 | (defmulti offset 578 | "Offset the boundary of `element` by distance `d`. 579 | The offset direction is always normal to the boundary, pointing outward if the path is wound in a CCW direction around the element's centroid." 580 | (fn [element _] 581 | (if (keyword? (first element)) 582 | (first element) 583 | :list))) 584 | 585 | (defmethod offset :default 586 | [[k _ :as elem]] 587 | (println (str "Offset not implemented for " k ".")) 588 | elem) 589 | 590 | (defmethod offset :list 591 | [elems d] 592 | (map #(offset % d) elems)) 593 | 594 | (defmethod offset :circle 595 | [[k props] d] 596 | (let [new-props (update props :r + d)] 597 | [k new-props])) 598 | 599 | (defmethod offset :ellipse 600 | [[k props] d] 601 | (let [new-props (-> props 602 | (update :rx + d) 603 | (update :ry + d))] 604 | [k new-props])) 605 | 606 | (defmethod offset :rect 607 | [[k props] d] 608 | (let [new-props (-> props 609 | (update :x - d) 610 | (update :y - d) 611 | (update :width + (* d 2)) 612 | (update :height + (* d 2)))] 613 | [k new-props])) 614 | 615 | (defmethod offset :line 616 | [[k {:keys [x1 y1 x2 y2] :as props}] d] 617 | (let [[[nx1 ny1] [nx2 ny2]] (u/offset-edge [[x1 y1] [x2 y2]] d) 618 | new-props (-> props 619 | (assoc :x1 nx1) 620 | (assoc :y1 ny1) 621 | (assoc :x2 nx2) 622 | (assoc :y2 ny2))] 623 | [k new-props])) 624 | 625 | (defmethod offset :polygon 626 | [[k {:keys [points] :as props}] d] 627 | (let [pts (map vec (partition 2 (u/s->v points))) 628 | opts (u/offset-pts pts d) 629 | npoints (str/join " " (map u/v->s opts)) 630 | new-props (assoc props :points npoints)] 631 | [k new-props])) 632 | 633 | (defmethod offset :polyline 634 | [[k {:keys [points] :as props}] d] 635 | (let [pts (map vec (partition 2 (u/s->v points))) 636 | opts (u/offset-pts pts d) 637 | npoints (str/join " " (map u/v->s opts)) 638 | new-props (assoc props :points npoints)] 639 | [k new-props])) 640 | 641 | (defmulti ^:private offset-path-command 642 | "Offset the path command `cmd`." 643 | (fn [cmd _] 644 | (:command cmd))) 645 | 646 | (defmethod offset-path-command "M" 647 | [{:keys [:input] :as m} [x y]] 648 | (assoc m :input (u/v+ [x y] input))) 649 | 650 | (defmethod offset-path-command "L" 651 | [{:keys [:input] :as m} [x y]] 652 | (assoc m :input (u/v+ [x y] input))) 653 | 654 | (defmethod offset-path-command "H" 655 | [{:keys [:input] :as m} [x _]] 656 | (assoc m :input (u/v+ [x] input))) 657 | 658 | (defmethod offset-path-command "V" 659 | [{:keys [:input] :as m} [_ y]] 660 | (assoc m :input (u/v+ [y] input))) 661 | 662 | ;; x y x y x y because input will have the form: 663 | ;; [x1 y1 x2 y2 x y] (first two pairs are control points) 664 | (defmethod offset-path-command "C" 665 | [{:keys [:input] :as m} [x y]] 666 | (assoc m :input (u/v+ [x y x y x y] input))) 667 | 668 | ;; similar approach to above, but one control point is implicit 669 | (defmethod offset-path-command "S" 670 | [{:keys [:input] :as m} [x y]] 671 | (assoc m :input (u/v+ [x y x y] input))) 672 | 673 | (defmethod offset-path-command "Q" 674 | [{:keys [:input] :as m} [x y]] 675 | (assoc m :input (u/v+ [x y x y] input))) 676 | 677 | (defmethod offset-path-command "T" 678 | [{:keys [:input] :as m} [x y]] 679 | (assoc m :input (u/v+ [x y] input))) 680 | 681 | ;; [rx ry xrot laf swf x y] 682 | ;; rx, ry do not change 683 | ;; xrot also no change 684 | ;; large arc flag and swf again no change 685 | (defmethod offset-path-command "A" 686 | [{:keys [:input] :as m} [x y]] 687 | (let [[rx ry xrot laf swf ox oy] input] 688 | (assoc m :input [rx ry xrot laf swf (+ x ox) (+ y oy)]))) 689 | 690 | (defmethod offset-path-command "Z" 691 | [cmd _] 692 | cmd) 693 | 694 | (defmethod offset-path-command :default 695 | [cmd a] 696 | [cmd a]) 697 | 698 | ;; todo: TDD this offset implementation 699 | (defmethod offset :path 700 | [[k props] d] 701 | (let [cmds (path/path-str->cmds (:d props)) 702 | xcmds (map #(offset-path-command % d) cmds)] 703 | [k (assoc props :d (path/cmds->path-string xcmds))])) 704 | -------------------------------------------------------------------------------- /src/svg_clj/utils.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.utils 2 | (:require [clojure.string :as str] 3 | #?(:cljs [cljs.reader :refer [read-string]]))) 4 | 5 | #_(defn abs 6 | [x] 7 | (Math/abs x)) 8 | 9 | (def ^:dynamic *eps* 10 | "Epsilon Value where any floating point value less than `*eps*` will be considered zero." 11 | 0.00001) 12 | 13 | (defn zeroish? 14 | "`True` if the absolute value of number `x` is less than `*eps*`, which is 0.00001 by default." 15 | [x] 16 | (< (abs x) *eps*)) 17 | 18 | (def ^:dynamic *rounding-decimal-places* 19 | "The number of decimal places the `round` funciton will round to." 20 | 5) 21 | 22 | (def pow 23 | "Implementation for clj/cljs `pow` function." 24 | #?(:clj #(Math/pow %1 %2) 25 | :cljs js/Math.pow)) 26 | 27 | (defn round 28 | "Rounds a non-integer number `num` to `places` decimal places." 29 | ([num] 30 | (round num *rounding-decimal-places*)) 31 | ([num places] 32 | (if places 33 | (let [d #?(:clj (bigdec (Math/pow 10 places)) 34 | :cljs (Math/pow 10 places))] 35 | (double (/ (Math/round (* (double num) d)) d))) 36 | num))) 37 | 38 | ;; vector arithmetic helpers 39 | (def v+ "Add vectors element-wise." (partial mapv +)) 40 | (def v- "Subtract vectors element-wise." (partial mapv -)) 41 | (def v* "Multiply vectors element-wise." (partial mapv *)) 42 | 43 | ;; simple calcs 44 | (defn to-deg 45 | "Convert `rad` radians to degrees." 46 | [rad] 47 | (round (* rad (/ 180 Math/PI)))) 48 | 49 | (defn to-rad 50 | "Convert `deg` degrees to radians." 51 | [deg] 52 | (round (* deg (/ Math/PI 180)))) 53 | 54 | (defn average 55 | "Compute the average of `numbers`." 56 | [& numbers] 57 | (let [n (count numbers)] 58 | (round (/ (apply + numbers) n)))) 59 | 60 | ;; some string transformation tools 61 | (defn v->s 62 | "Turns the vector `v` into a string with commas separating the values." 63 | [v] 64 | (str/join "," v)) 65 | 66 | (defn s->v 67 | "Turns a string of comma or space separated numbers into a vector." 68 | [s] 69 | (-> s 70 | (str/trim) 71 | (str/split #"[, ]") 72 | (#(filter (complement empty?) %)) 73 | (#(mapv read-string %)))) 74 | 75 | (defn- xf-kv->str 76 | "Formats a key value pair [`k` `v`] from a transform map into an inline-able string. 77 | Example: 78 | 79 | [:rotate [0 90 0]] -> \"rotate(0 90 0)\"" 80 | [[k v]] 81 | (str (symbol k) (apply list v))) 82 | 83 | (defn- str->xf-kv 84 | "Formats an SVG transform string `s` into a key value pair. The opposite of `xf-kv->str`. 85 | Example: 86 | 87 | \"rotate(0 90 0)\" -> [:rotate [0 90 0]]" 88 | [s] 89 | (let [split (str/split s #"\(") 90 | key (keyword (first split)) 91 | val (vec (read-string (str "(" (second split))))] 92 | [key val])) 93 | 94 | (defn xf-map->str 95 | "Turn transform maps from an element's properties into a string properly formatted for use inline in an svg element tag. Consider this an internal tool." 96 | [m] 97 | (str/join "\n" (map xf-kv->str m))) 98 | 99 | (defn str->xf-map 100 | "Turn inline SVG transform strings from an element's properties into a map in a form which the transforms namespace expects. Consider this an internal tool." 101 | [s] 102 | (if-let [s s] 103 | (into {} 104 | (->> s 105 | (#(str/replace % #"\)" ")\n")) 106 | str/split-lines 107 | (map str/trim) 108 | (map str->xf-kv))) 109 | {})) 110 | 111 | (defn rotate-pt 112 | "Rotates 2d point `pt` around the origin by `deg` in the counter-clockwise direction." 113 | [pt deg] 114 | (let [[x y] pt 115 | c (Math/cos (to-rad deg)) 116 | s (Math/sin (to-rad deg))] 117 | [(round (- (* x c) (* y s))) 118 | (round (+ (* x s) (* y c)))])) 119 | 120 | (defn rotate-pt-around-center 121 | "Rotates point `pt` around `center` by `deg` in the counter-clockwise direction." 122 | [pt deg center] 123 | (-> pt 124 | (v+ (map - center)) 125 | (rotate-pt deg) 126 | (v+ center))) 127 | 128 | (defn distance 129 | "Computes the distance between two points `a` and `b`." 130 | [a b] 131 | (let [v (v- b a) 132 | v2 (reduce + (v* v v))] 133 | (round (Math/sqrt ^double v2)))) 134 | 135 | (defn distance-squared 136 | "Computes the squared distance between two points `a` and `b`. Avoids a square-root calculation, so this can be used in some cases for optimization." 137 | [a b] 138 | (let [v (v- b a)] 139 | (reduce + (v* v v)))) 140 | 141 | (defn determinant 142 | "Computes the determinant between two 2D points `a` and `b`." 143 | [[a b] [c d]] 144 | (- (* a d) 145 | (* b c))) 146 | 147 | (defn perpendicular 148 | "Returns a vector perpendicular to the vector [`x` `y`]." 149 | [[x y]] 150 | [(- y) x]) 151 | 152 | (defn dot* 153 | "Calculates the dot product of two vectors." 154 | [a b] 155 | (reduce + (map * a b))) 156 | 157 | (defn cross* 158 | "Calculates cross product of two 3d-vectors. If `a` and `b` are 2D, z is assumed to be 0." 159 | [a b] 160 | (let [[a1 a2 a3] a 161 | [b1 b2 b3] b 162 | a3 (if a3 a3 0) 163 | b3 (if b3 b3 0) 164 | i (- (* a2 b3) (* a3 b2)) 165 | j (- (* a3 b1) (* a1 b3)) 166 | k (- (* a1 b2) (* a2 b1))] 167 | [i j k])) 168 | 169 | (defn cross*-k 170 | "Calculates the k component of the cross product of two 2D vectors, assuming Z=0 as the 3rd component." 171 | [[ax ay] [bx by]] 172 | (- (* ax by) (* ay bx))) 173 | 174 | (defn normal 175 | "Calculates the normal vector of plane given 3 points or calculates the normal vector of a line given two (2D) points." 176 | ([a b] 177 | (let [[x1 y1] a 178 | [x2 y2] b 179 | dx (- x2 x1) 180 | dy (- y2 y1)] 181 | [(- dy) dx])) 182 | ([a b c] 183 | (let [ab (v- a b) 184 | ac (v- a c) 185 | [x y z] (cross* ab ac)] 186 | (when (and (> x *eps*) (> y *eps*) (> z *eps*)) 187 | [x y z])))) 188 | 189 | (defn normalize 190 | "find the unit vector of a given vector" 191 | [v] 192 | (when v 193 | (let [m (Math/sqrt ^double (reduce + (v* v v)))] 194 | (mapv / v (repeat m))))) 195 | 196 | ;; https://math.stackexchange.com/questions/361412/finding-the-angle-between-three-points 197 | (defn- check-quadrants 198 | "Using `p2` as the 'origin', return a string indicating positive, negative, or axis-aligned for p1 p2." 199 | [p1 p2 p3] 200 | (let [v1 (v- p1 p2) 201 | v2 (v- p3 p2) 202 | qf (fn [[x y]] 203 | (cond (and (pos? x) (pos? y)) "pp" 204 | (and (pos? x) (neg? y)) "pn" 205 | (and (neg? x) (neg? y)) "nn" 206 | (and (neg? x) (pos? y)) "np" 207 | (pos? x) "p_" 208 | (neg? x) "n_" 209 | (pos? y) "_p" 210 | (neg? y) "_n"))] 211 | (apply str (map qf [v1 v2])))) 212 | 213 | (defn angle-from-pts 214 | "Calculates the angle starting at line p3p2 going to line p1p2. 215 | Put another way, the angle is measured following the 'right hand rule' around p2." 216 | [p1 p2 p3] 217 | (let [v1 (v- p1 p2) 218 | v2 (v- p3 p2) 219 | [v1nx _] (normalize v1) 220 | [v2nx _] (normalize v2) 221 | l1 (distance p1 p2) 222 | l2 (distance p3 p2) 223 | n (dot* v1 v2) 224 | d (* l1 l2)] 225 | (when-not (zeroish? (float d)) 226 | (let [a (to-deg (Math/acos (/ n d))) 227 | quadrants (check-quadrants p1 p2 p3)] 228 | (cond 229 | ;; same quadrant, checking if V2 is before or after V1 230 | (and (= "pppp" quadrants) (> v2nx v1nx)) a 231 | (and (= "npnp" quadrants) (> v2nx v1nx)) a 232 | (and (= "nnnn" quadrants) (< v2nx v1nx)) a 233 | (and (= "pnpn" quadrants) (< v2nx v1nx)) a 234 | ;; within same quadrant 235 | (#{"p_p_" "ppp_" "_ppp" "p_pn"} quadrants) a 236 | (#{"_p_p" "np_p" "n_np"} quadrants) a 237 | (#{"n_n_" "nnn_" "_nnn"} quadrants) a 238 | (#{"_n_n" "pn_n" "pnp_"} quadrants) a 239 | ;; one quadrant away 240 | (#{"npp_" "nn_p" "pnn_" "pp_n"} quadrants) a 241 | (#{"n_pp" "_nnp" "p_nn" "_ppn"} quadrants) a 242 | (#{"nppp" "nnnp" "pnnn" "pppn"} quadrants) a 243 | ;; 90 degrees away on axes 244 | (#{"_pp_" "n__p" "_nn_" "p__n"} quadrants) a 245 | ;; two quadrants away 246 | (and (= "ppnn" quadrants) (> (abs v1nx) (abs v2nx))) a 247 | (and (= "nnpp" quadrants) (> (abs v1nx) (abs v2nx))) a 248 | (and (= "pnnp" quadrants) (< (abs v1nx) (abs v2nx))) a 249 | (and (= "nppn" quadrants) (< (abs v1nx) (abs v2nx))) a 250 | ;; 180 degrees away on axes 251 | (#{"p_n_" "_p_n" "n_p_" "_n_p"} quadrants) a 252 | :else (- 360 a)))))) 253 | 254 | (defn line-intersection 255 | "Returns the intersection point between two 2D lines or `nil` if the lines are (close to) parallel. Assumes lines are infinite, so the intersection may lie beyond the line segments specified." 256 | [[pt-a pt-b] [pt-c pt-d]] 257 | (let [[ax ay] pt-a 258 | [bx by] pt-b 259 | [cx cy] pt-c 260 | [dx dy] pt-d 261 | xdiff [(- ax bx) (- cx dx)] 262 | ydiff [(- ay by) (- cy dy)] 263 | div (determinant xdiff ydiff)] 264 | (when-not (zeroish? (abs div)) 265 | (let [dets [(determinant pt-a pt-b) (determinant pt-c pt-d)] 266 | x (/ (determinant dets xdiff) div) 267 | y (/ (determinant dets ydiff) div)] 268 | [x y])))) 269 | 270 | (defn colinear? 271 | "`True` if points `a`, `b`, and `c` are along the same line." 272 | [a b c] 273 | (let [ba (v- a b) 274 | bc (v- c b)] 275 | (if (every? #(= (count %) 3) [a b c]) 276 | (every? #(> *eps*(abs %)) (cross* ba bc)) 277 | (> *eps* (abs (cross*-k ba bc)))))) 278 | 279 | (defn corner-condition 280 | "Returns the type of corner at point `b`, given `a` and `c` endpoints. 281 | `:colinear` -> a b c form a line 282 | `:reflex` -> CCW angle from ab to bc is > 180 and < 360 283 | `:convex` -> CCW angle from ab to bc is < 180 and > 0" 284 | [a b c] 285 | (let [ba (v- a b) 286 | bc (v- c b) 287 | k (cross*-k ba bc)] 288 | (cond 289 | (> *eps* (abs k)) :colinear 290 | (< *eps* k) :reflex 291 | (> (- *eps*) k) :convex))) 292 | 293 | ;; https://youtu.be/hTJFcHutls8?t=1473 294 | ;; use k component from cross product to quickly check if vector 295 | ;; is on right or left of another vector 296 | ;; check each triangle edge vector against corner to pt vectors 297 | (defn pt-inside? 298 | "`True` if point `pt` is inside the triangle formed by points `a`, `b`, and `c`." 299 | [[a b c] pt] 300 | (when-not (colinear? a b c) 301 | (let [ab (v- b a) 302 | bc (v- c b) 303 | ca (v- a c) 304 | apt (v- pt a) 305 | bpt (v- pt b) 306 | cpt (v- pt c)] 307 | (not 308 | (or (<= (cross*-k ab apt) 0) 309 | (<= (cross*-k bc bpt) 0) 310 | (<= (cross*-k ca cpt) 0)))))) 311 | 312 | (defn style 313 | "Merge a style map into the given element." 314 | [[k props & content] style-map] 315 | (into [k (merge props style-map)] content)) 316 | 317 | (defn centroid-of-pts 318 | "Calculates the arithmetic mean position of the given `pts`." 319 | [pts] 320 | (let [ndim (count (first (sort-by count pts))) 321 | splits (for [axis (range 0 ndim)] 322 | (map #(nth % axis) pts))] 323 | (mapv #(apply average %) splits))) 324 | 325 | (defn bounds-of-pts 326 | "Calculates the axis-aligned-bounding-box of `pts`." 327 | [pts] 328 | (when (seq pts) 329 | (let [xmax (apply max (map first pts)) 330 | ymax (apply max (map second pts)) 331 | xmin (apply min (map first pts)) 332 | ymin (apply min (map second pts))] 333 | (vector [xmin ymin] 334 | [xmax ymin] 335 | [xmax ymax] 336 | [xmin ymax])))) 337 | 338 | (defn bb-dims 339 | "Returns the dimensions of the bounding box defined by `pts`." 340 | [pts] 341 | (when-let [bounds (bounds-of-pts pts)] 342 | (let [[[xmin ymin] _ [xmax ymax] _] bounds] 343 | [(- xmax xmin) (- ymax ymin)]))) 344 | 345 | (defn offset-edge 346 | "Offset an edge defined by points `a` and `b` by distance `d` along the vector perpendicular to the edge." 347 | [[a b] d] 348 | (let [p (perpendicular (v- b a)) 349 | pd (v* (normalize p) (repeat (- d))) 350 | xa (v+ a pd) 351 | xb (v+ b pd)] 352 | [xa xb])) 353 | 354 | (defn- cycle-pairs 355 | "Creates pairs of points for line segments, including a segment from the last to the first point." 356 | [pts] 357 | (let [n (count pts)] 358 | (vec (take n (partition 2 1 (cycle pts)))))) 359 | 360 | (defn- wrap-list-once 361 | "Shifts a list by one to the right. 362 | [1 2 3] -> [3 1 2]" 363 | [s] 364 | (conj (drop-last s) (last s))) 365 | 366 | (defn- every-other 367 | "Returns every even indexed element of the vector `v`." 368 | [v] 369 | (let [n (count v)] 370 | (map #(get v %) (filter even? (range n))))) 371 | 372 | (defn offset-pts 373 | "Offset a polygon or polyline defined by points `pts` a distance of `d`. CCW point winding will result in an outward offset." 374 | [pts d] 375 | (let [edges (cycle-pairs pts) 376 | opts (mapcat #(offset-edge % d) edges) 377 | oedges (every-other (cycle-pairs opts)) 378 | edge-pairs (cycle-pairs oedges)] 379 | (wrap-list-once (map #(apply line-intersection %) edge-pairs)))) 380 | 381 | (defn scale-pt-from-center 382 | "Scales a point [`x` `y`] by [`sx` `sy`] as if it were centered at [`cx` `cy`]." 383 | [[x y] [sx sy] [cx cy]] 384 | [(+ (* (- x cx) sx) cx) 385 | (+ (* (- y cy) sy) cy)]) 386 | 387 | ;; easing functions are easier to understand with visuals: 388 | ;; https://easings.net/ 389 | 390 | (defn ease-in-sin 391 | "Remaps value `t`, which is assumed to be between 0 and 1.0, to a sin curve, affecting values closer to 1." 392 | [t] 393 | (- 1 (Math/cos (/ (* Math/PI t) 2)))) 394 | 395 | (defn ease-out-sin 396 | "Remaps value `t`, which is assumed to be between 0 and 1.0, to a sin curve, affecting values closer to 0." 397 | [t] 398 | (Math/sin (/ (* Math/PI t) 2))) 399 | 400 | (defn ease-in-out-sin 401 | "Remaps value `t`, which is assumed to be between 0 and 1.0, to a sin curve." 402 | [t] 403 | (/ (- (Math/cos (* Math/PI t)) 1) -2)) 404 | -------------------------------------------------------------------------------- /src/svg_clj/viewers.cljs: -------------------------------------------------------------------------------- 1 | (ns svg-clj.viewers 2 | (:require [nextjournal.clerk.sci-viewer :as sv] 3 | [sci.core :as sci] 4 | [reagent.core :as r] 5 | [svg-clj.utils :as utils] 6 | [svg-clj.elements :as el] 7 | [svg-clj.transforms :as tf] 8 | [svg-clj.composites :as comp :refer [svg]] 9 | [svg-clj.path :as path] 10 | [svg-clj.parametric :as p] 11 | [svg-clj.layout :as lo])) 12 | 13 | ;; Here is the existing context: 14 | ;; https://github.com/nextjournal/clerk/blob/d08c26043efe19a92fe33dd9eb4499e304e4cff7/src/nextjournal/clerk/sci_viewer.cljs#L1013-L1023 15 | 16 | (sci.impl.cljs/require-cljs-analyzer-api) 17 | 18 | (defn- get-parent-svg 19 | [node] 20 | (let [parent (.-parentElement node) 21 | tag (.-tagName parent)] 22 | (when (not (#{"div" "span" "body" "html"} tag)) 23 | (if (= tag "svg") 24 | parent 25 | (recur parent))))) 26 | 27 | (defn- element-offset 28 | [el] 29 | {:x (-> el .getBoundingClientRect .-left int) 30 | :y (-> el .getBoundingClientRect .-top int) 31 | #_#_:a (-> js/window .-scrollY)}) 32 | 33 | ;; https://cljdoc.org/d/reagent/reagent/1.1.1/doc/tutorials/creating-reagent-components 34 | (defn mouse-pos 35 | ([] (mouse-pos js/document)) 36 | ([el] 37 | (r/with-let [pointer (r/atom nil) 38 | handler #(reset! pointer 39 | (merge-with - 40 | {:x (.-clientX %) 41 | :y (.-clientY %)} 42 | (when (not= el js/document) 43 | (element-offset el)))) 44 | _ (.addEventListener el "mousemove" handler)] 45 | @pointer 46 | (finally 47 | (.removeEventListener el "mousemove" handler))))) 48 | 49 | (defn number-input 50 | ([state-target] 51 | (number-input state-target nil)) 52 | ([state-target on-change-fn] 53 | (let [number-input-class 54 | (apply str 55 | (interpose " " ["dark:bg-[#1f2937]" "dark:text-[#cbd5e1]" "form-control" "w-16" "px-1" "py-1" "text-gray-500" "bg-clip-padding" "border-gray-300" "rounded" "transition" "ease-in-out" "focus:text-gray-700" "focus:bg-white" "focus:border-gray-600" "focus:outline-none"]))] 56 | [:input (merge 57 | {:class (str "inspected-value " number-input-class) 58 | :style {:margin 6 59 | :text-align "center"} 60 | :type :number 61 | :placeholder @state-target 62 | :value @state-target 63 | :on-input #(reset! state-target (.. % -target -value))} 64 | {:on-change on-change-fn})]))) 65 | 66 | (defn movable-pt-1 67 | [w h] 68 | (r/with-let [down-pt (r/atom {:x 0 :y 0}) 69 | old-local-pt (r/atom {:x 10 :y 10}) 70 | local-pt (r/atom {:x 10 :y 10}) 71 | move! (r/atom false) 72 | refa (r/atom nil)] 73 | [:<> 74 | [:span "Mouse Pos: " (str @(r/track mouse-pos))] [:br] 75 | [:span "Local Mouse Pos: " (when @refa (str @(r/track mouse-pos @refa)))] [:br] 76 | [:span "Down Pt: " (str @down-pt)] [:br] 77 | [:span "Local Pt: " (str @local-pt)] [:br] 78 | 79 | [:svg {:width w 80 | :height h 81 | :style {:background "honeydew"} 82 | :ref (fn [el] (reset! refa el)) 83 | :on-mouse-move #(when @move! 84 | (reset! local-pt (merge-with + @old-local-pt 85 | (merge-with - @(r/track mouse-pos @refa) 86 | @down-pt)))) 87 | :on-mouse-up #(reset! move! false)} 88 | (let [pt (r/atom (vec (vals @local-pt)))] 89 | (-> (el/circle 5) 90 | (tf/translate @pt) 91 | (tf/style {:on-mouse-down #(do (reset! down-pt @(r/track mouse-pos @refa)) 92 | (reset! old-local-pt {:x (first @pt) 93 | :y (second @pt)}) 94 | (reset! move! true))})))]])) 95 | 96 | (defn movable-pt-2 97 | [parent-el r] 98 | (r/with-let [down-pt (r/atom {:x 0 :y 0}) 99 | old-local-pt (r/atom {:x 10 :y 10}) 100 | local-pt (r/atom {:x 10 :y 10}) 101 | move! (r/atom false) 102 | el-pt (r/track mouse-pos parent-el)] 103 | (let [pt (r/atom (vec (vals @local-pt))) 104 | handler1 #(when @move! 105 | (reset! local-pt (merge-with + @old-local-pt (merge-with - @el-pt @down-pt)))) 106 | handler2 #(reset! move! false) 107 | handler3 #(do (reset! down-pt @el-pt) 108 | (reset! old-local-pt {:x (first @pt) 109 | :y (second @pt)}) 110 | (reset! move! true))] 111 | (.addEventListener parent-el "mousemove" handler1) 112 | (.addEventListener parent-el "mouseup" handler2) 113 | (el/g 114 | (-> (el/text (str @el-pt)) 115 | (tf/style {:display "none"})) 116 | (-> (el/circle r) 117 | (tf/translate @pt) 118 | (tf/style {:on-mouse-down handler3})))))) 119 | 120 | (defn movable-pt-3 121 | [r] 122 | (let [parent-el! (r/atom nil)] 123 | (r/create-class 124 | {:display-name "movable-pt" 125 | :component-did-mount (fn [this] (let [node (reagent.dom/dom-node this) 126 | parent (get-parent-svg node)] 127 | (js/console.log (.-tagName parent)) 128 | (reset! parent-el! parent))) 129 | :reagent-render 130 | (fn [r] 131 | (el/g 132 | (when @parent-el! 133 | (r/with-let [parent-el @parent-el! 134 | down-pt (r/atom {:x 0 :y 0}) 135 | old-local-pt (r/atom {:x 10 :y 10}) 136 | local-pt (r/atom {:x 10 :y 10}) 137 | move! (r/atom false) 138 | el-pt (r/track mouse-pos parent-el)] 139 | (let [pt (r/atom (vec (vals @local-pt))) 140 | handler1 #(when @move! 141 | (reset! local-pt (merge-with + @old-local-pt (merge-with - @el-pt @down-pt)))) 142 | handler2 #(reset! move! false) 143 | handler3 #(do (reset! down-pt @el-pt) 144 | (reset! old-local-pt {:x (first @pt) 145 | :y (second @pt)}) 146 | (reset! move! true))] 147 | (.addEventListener parent-el "mousemove" handler1) 148 | (.addEventListener parent-el "mouseup" handler2) 149 | [:<> 150 | (-> (el/text (str @el-pt)) 151 | (tf/style {:display "none"})) 152 | (-> (el/circle r) 153 | (tf/translate @pt) 154 | (tf/style {:on-mouse-down handler3}))])))))}))) 155 | 156 | (defn movable-pt 157 | [pt! r] 158 | (let [parent-el! (r/atom nil)] 159 | (r/create-class 160 | {:display-name "movable-pt" 161 | :component-did-mount (fn [this] (let [node (reagent.dom/dom-node this) 162 | parent (get-parent-svg node)] 163 | (reset! parent-el! parent))) 164 | :reagent-render 165 | (fn [pt! r] 166 | (el/g 167 | (when @parent-el! 168 | (r/with-let [parent-el @parent-el! 169 | [x y] @pt! 170 | down-pt (r/atom {:x 0 :y 0}) 171 | old-local-pt (r/atom {:x 0 :y 0}) 172 | local-pt (r/atom {:x x :y y}) 173 | move! (r/atom false) 174 | el-pt (r/track mouse-pos parent-el)] 175 | (let [pt (r/atom (vec (vals @local-pt))) 176 | handler1 #(when @move! 177 | (do (reset! local-pt (merge-with + @old-local-pt (merge-with - @el-pt @down-pt))) 178 | (reset! pt! @pt))) 179 | handler2 #(reset! move! false) 180 | handler3 #(do (reset! down-pt @el-pt) 181 | (reset! old-local-pt {:x (first @pt) 182 | :y (second @pt)}) 183 | (reset! move! true))] 184 | (.addEventListener parent-el "mousemove" handler1) 185 | (.addEventListener parent-el "mouseup" handler2) 186 | [:<> 187 | (-> (el/text (str @el-pt)) 188 | (tf/style {:display "none"})) 189 | (-> (el/circle r) 190 | (tf/translate @pt) 191 | (tf/style {:on-mouse-down handler3}))])))))}))) 192 | 193 | (defn moveable 194 | [pt! el] 195 | (let [parent-el! (r/atom nil)] 196 | (r/create-class 197 | {:display-name "movable-pt" 198 | :component-did-mount (fn [this] (let [node (reagent.dom/dom-node this) 199 | parent (get-parent-svg node)] 200 | (reset! parent-el! parent))) 201 | :reagent-render 202 | (fn [pt! r] 203 | (el/g 204 | (when @parent-el! 205 | (r/with-let [parent-el @parent-el! 206 | [x y] @pt! 207 | down-pt (r/atom {:x 0 :y 0}) 208 | old-local-pt (r/atom {:x 0 :y 0}) 209 | local-pt (r/atom {:x x :y y}) 210 | move! (r/atom false) 211 | el-pt (r/track mouse-pos parent-el)] 212 | (let [pt (r/atom (vec (vals @local-pt))) 213 | handler1 #(when @move! 214 | (do (reset! local-pt (merge-with + @old-local-pt (merge-with - @el-pt @down-pt))) 215 | (reset! pt! @pt))) 216 | handler2 #(reset! move! false) 217 | handler3 #(do (reset! down-pt @el-pt) 218 | (reset! old-local-pt {:x (first @pt) 219 | :y (second @pt)}) 220 | (reset! move! true))] 221 | (.addEventListener parent-el "mousemove" handler1) 222 | (.addEventListener parent-el "mouseup" handler2) 223 | [:<> 224 | (-> (el/text (str @el-pt)) 225 | (tf/style {:display "none"})) 226 | (-> el 227 | (tf/translate @pt) 228 | (tf/style {:on-mouse-down handler3}))])))))}))) 229 | 230 | ;; example usage 231 | #_(svg 232 | (r/with-let [pts (r/atom (vec (p/regular-polygon-pts 40 8))) 233 | el (-> (el/circle 6) (tf/style {:fill "red"}))] 234 | (el/g 235 | (-> (el/rect 400 400) (tf/style {:fill "honeydew"})) 236 | (-> (el/polygon @pts) 237 | (tf/style {:stroke "green" :fill "none" :stroke-width 2})) 238 | (into [:<>] 239 | (map (fn [idx] 240 | (let [pt! (r/cursor pts [idx])] [movable pt! el])) (range (count @pts))))))) 241 | 242 | (def slider-render-fn 243 | (let [base-style {:margin-right 8 244 | :display "inline-block" 245 | :text-align "end" 246 | :min-width 20}] 247 | (fn [global-state k sync-fn] 248 | (r/with-let [state (r/cursor global-state [k]) 249 | tmp (r/atom 1) 250 | minv (r/atom 1) 251 | maxv (r/atom 100) 252 | refa (r/atom nil)] 253 | [:<> 254 | ;; var name 255 | [:span {:class "inspected-value" 256 | :style (merge base-style {:text-align "end"})} (str (name k) " ")] 257 | ;; var value 258 | [:span {:class "inspected-value" 259 | :style base-style} @state] 260 | ;; minimum input 261 | [number-input minv] 262 | ;; slider input 263 | [:input {:style {:height "0.5em"} 264 | :type :range 265 | #_#_:value @state 266 | :min @minv 267 | :max @maxv 268 | :on-change #(reset! state (js/parseInt (.. % -target -value))) 269 | :on-touch-end sync-fn 270 | :on-mouse-up sync-fn}] 271 | ;; maximum input 272 | [number-input maxv] 273 | ;; var value input 274 | [number-input tmp sync-fn]])))) 275 | 276 | (def moveable-pt-render-fn 277 | (let [base-style {:margin-right 8 278 | :display "inline-block" 279 | :text-align "end" 280 | :min-width 20}] 281 | (fn [global-state k sync-fn] 282 | (r/with-let [state (r/cursor global-state [k]) 283 | elem (-> (el/circle 6) (tf/style {:fill "red" 284 | :on-mouse-up sync-fn}))] 285 | [:<> 286 | ;; var name 287 | [:span {:class "inspected-value" 288 | :style (merge base-style {:text-align "end"})} (str (name k) " ")] 289 | ;; var value 290 | [:span {:class "inspected-value" 291 | :style base-style} (str @state)] 292 | ;; moveable-pt input 293 | (svg 294 | (el/g 295 | (-> (el/rect 200 200) (tf/style {:stroke "black" :fill "none"})) 296 | (-> (el/line [0 -100] [0 100]) (tf/style {:stroke "red" :fill "none"})) 297 | (-> (el/line [-100 0] [100 0]) (tf/style {:stroke "green" :fill "none"})) 298 | (-> (el/line [0 (second @state)] @state) (tf/style {:stroke "gray" :fill "none"})) 299 | (-> (el/line [(first @state) 0] @state) (tf/style {:stroke "gray" :fill "none"})) 300 | [:<> [moveable state elem]]))])))) 301 | 302 | (def moveable-pts-render-fn 303 | (let [base-style {:margin-right 8 304 | :display "inline-block" 305 | :text-align "end" 306 | :min-width 20}] 307 | (fn [global-state k sync-fn] 308 | (r/with-let [state (r/cursor global-state [k]) 309 | elem (-> (el/circle 6) (tf/style {:fill "red" 310 | :on-mouse-up sync-fn}))] 311 | [:<> 312 | ;; var name 313 | [:span {:class "inspected-value" 314 | :style (merge base-style {:text-align "end"})} (str (name k) " ")] 315 | ;; var value 316 | [:span {:class "inspected-value" 317 | :style base-style} (str @state)] 318 | ;; moveable-pt input 319 | (svg 320 | (el/g 321 | (-> (el/rect 200 200) (tf/style {:stroke "black" :fill "none"})) 322 | (-> (el/line [0 -100] [0 100]) (tf/style {:stroke "red" :fill "none"})) 323 | (-> (el/line [-100 0] [100 0]) (tf/style {:stroke "green" :fill "none"})) 324 | (-> (el/polygon @state) (tf/style {:stroke "blue" :fill "none"})) 325 | (into [:<>] 326 | (map (fn [idx] 327 | (let [pt! (r/cursor state [idx])] [moveable pt! elem])) (range (count @state))))))])))) 328 | 329 | (swap! sv/!sci-ctx 330 | sci/merge-opts 331 | {:namespaces 332 | {'svg-clj.viewers {'slider-render-fn slider-render-fn 333 | 'moveable-pt-render-fn moveable-pt-render-fn 334 | 'moveable-pts-render-fn moveable-pts-render-fn} 335 | 'svg-clj.utils (sci/copy-ns svg-clj.utils (sci/create-ns 'svg-clj.utils)) 336 | 'svg-clj.elements (sci/copy-ns svg-clj.elements (sci/create-ns 'svg-clj.elements)) 337 | 'svg-clj.transforms (sci/copy-ns svg-clj.transforms (sci/create-ns 'svg-clj.transforms)) 338 | 'svg-clj.composites (sci/copy-ns svg-clj.composites (sci/create-ns 'svg-clj.composites)) 339 | 'svg-clj.path (sci/copy-ns svg-clj.path (sci/create-ns 'svg-clj.path)) 340 | 'svg-clj.parametric (sci/copy-ns svg-clj.parametric (sci/create-ns 'svg-clj.parametric)) 341 | 'svg-clj.layout (sci/copy-ns svg-clj.layout (sci/create-ns 'svg-clj.layout))} 342 | 343 | :aliases {'sv 'svg-clj.viewers 344 | 'utils 'svg-clj.utils 345 | 'el 'svg-clj.elements 346 | 'tf 'svg-clj.transforms 347 | 'c 'svg-clj.composites 348 | 'path 'svg-clj.path 349 | 'p 'svg-clj.parametric 350 | 'lo 'svg-clj.layout}}) 351 | -------------------------------------------------------------------------------- /test/svg_clj/elements_test.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.elements-test 2 | (:require [svg-clj.utils :as u] 3 | [svg-clj.elements :as el] 4 | [svg-clj.transforms :as tf] 5 | [clojure.test :refer [deftest is]])) 6 | 7 | (def test-circle (el/circle 5)) 8 | (def test-ellipse (el/ellipse 5 10)) 9 | (def test-line (el/line [0 0] [10 20])) 10 | (def test-polygon (el/polygon [ [0 0] [10 20] [40 50] [20 10] ])) 11 | (def test-polyline (el/polyline [ [0 0] [10 20] [40 50] [20 10] ])) 12 | (def test-rect (el/rect 60 30)) 13 | (def test-image (el/image "https://www.fillmurray.com/g/200/300" 200 300)) 14 | (def test-g (el/g test-circle 15 | test-ellipse 16 | test-line 17 | test-polygon 18 | test-polyline 19 | test-rect 20 | test-image)) 21 | 22 | (def test-shapes [test-circle 23 | test-ellipse 24 | test-line 25 | test-polygon 26 | test-polyline 27 | test-rect 28 | test-image]) 29 | 30 | (deftest basic-shapes-test 31 | (is (= test-circle [:circle {:cx 0 :cy 0 :r 5}])) 32 | (is (= test-ellipse [:ellipse {:cx 0 :cy 0 :rx 5 :ry 10}])) 33 | (is (= test-line [:line {:x1 0 :y1 0 :x2 10 :y2 20}])) 34 | (is (= test-polygon [:polygon {:points "0,0 10,20 40,50 20,10"}])) 35 | (is (= test-polyline [:polyline {:points "0,0 10,20 40,50 20,10"}])) 36 | (is (= test-rect [:rect {:x -30.0 :y -15.0 :width 60 :height 30}])) 37 | (is (= test-image [:image 38 | {:href "https://www.fillmurray.com/g/200/300" 39 | :x -100.0 :y -150.0 40 | :width 200 :height 300}]))) 41 | 42 | (deftest basic-translate-test 43 | (is (= (-> test-circle (tf/translate [10 10])) 44 | [:circle {:r 5 :cx 10 :cy 10 :transform "rotate(0 10 10)"}])) 45 | (is (= (-> test-ellipse (tf/translate [10 10])) 46 | [:ellipse {:rx 5 :ry 10 :cx 10 :cy 10 :transform "rotate(0 10 10)"}])) 47 | (is (= (-> test-line (tf/translate [10 10])) 48 | [:line {:x1 10 :y1 10 :x2 20 :y2 30}])) 49 | (is (= (-> test-polygon (tf/translate [10 10])) 50 | [:polygon {:points "10,10 20,30 50,60 30,20"}])) 51 | (is (= (-> test-polyline (tf/translate [10 10])) 52 | [:polyline {:points "10,10 20,30 50,60 30,20"}])) 53 | (is (= (-> test-rect (tf/translate [10 10])) 54 | [:rect {:x -20.0 :y -5.0 :width 60 :height 30 :transform "rotate(0 10.0 10.0)"}])) 55 | (is (= (-> test-image (tf/translate [10 10])) 56 | [:image {:href "https://www.fillmurray.com/g/200/300" 57 | :x -90.0 :y -140.0 58 | :width 200 :height 300 59 | :transform "rotate(0 10.0 10.0)"}]))) 60 | 61 | (deftest translate-group-test 62 | (is (= (drop 2 (tf/translate test-g [5 10])) 63 | (map #(tf/translate % [5 10]) (drop 2 test-g))))) 64 | 65 | (deftest translate-list-test 66 | (let [a (repeat 10 (el/rect 10 20))] 67 | (is (= (tf/translate a [5 10]) 68 | (map #(tf/translate % [5 10]) a))))) 69 | 70 | (deftest basic-rotate-test 71 | (is (= (-> test-circle (tf/rotate 45)) 72 | [:circle {:r 5 :cx 0 :cy 0 :transform "rotate(45 0 0)"}])) 73 | (is (= (-> test-ellipse (tf/rotate 45)) 74 | [:ellipse {:rx 5 :ry 10 :cx 0 :cy 0 :transform "rotate(45 0 0)"}])) 75 | (is (= (-> test-line (tf/rotate 90)) 76 | [:line {:x1 15.0 :y1 4.999999999999999 :x2 -5.0 :y2 15.0}])) 77 | (is (= (-> test-polygon (tf/rotate 90)) 78 | [:polygon {:points "37.5,2.5 17.5,12.5 -12.5,42.5 27.5,22.5"}])) 79 | (is (= (-> test-polyline (tf/rotate 90)) 80 | [:polyline {:points "37.5,2.5 17.5,12.5 -12.5,42.5 27.5,22.5"}])) 81 | (is (= (-> test-rect (tf/rotate 45)) 82 | [:rect {:x -30.0 :y -15.0 :width 60 :height 30 :transform "rotate(45 0.0 0.0)"}])) 83 | (is (= (-> test-image (tf/rotate 45)) 84 | [:image {:href "https://www.fillmurray.com/g/200/300" 85 | :x -100.0 :y -150.0 86 | :width 200 :height 300 87 | :transform "rotate(45 0.0 0.0)"}]))) 88 | 89 | (def rotated-test-g-data-structure 90 | [:g 91 | {} 92 | [:circle {:cx 0.0 :cy 0.0 :r 5 :transform "rotate(90 0.0 0.0)"}] 93 | [:ellipse {:cx 0.0 :cy 0.0 :rx 5 :ry 10 :transform "rotate(90 0.0 0.0)"}] 94 | [:line {:x1 0.0 :y1 0.0 :x2 -20.0 :y2 10.000000000000002}] 95 | [:polygon {:points "0.0,0.0 -20.0,10.0 -50.0,40.0 -10.0,20.0"}] 96 | [:polyline {:points "0.0,0.0 -20.0,10.0 -50.0,40.0 -10.0,20.0"}] 97 | [:rect 98 | {:width 60 :height 30 :x -30.0 :y -15.0 :transform "rotate(90 0.0 0.0)"}] 99 | [:image 100 | {:href "https://www.fillmurray.com/g/200/300" 101 | :width 200 102 | :height 300 103 | :x -100.0 104 | :y -150.0 105 | :transform "rotate(90 0.0 0.0)"}]]) 106 | 107 | (deftest rotate-group-test 108 | (is (not= (drop 2 (tf/rotate test-g 45)) 109 | (map #(tf/rotate % 45) (drop 2 test-g)))) 110 | (is (= (tf/rotate test-g 90) 111 | rotated-test-g-data-structure))) 112 | 113 | (deftest rotate-list-test 114 | (let [a (repeat 10 (el/rect 10 20))] 115 | (is (= (tf/rotate a 45) 116 | (map #(tf/rotate % 45) a))))) 117 | -------------------------------------------------------------------------------- /test/svg_clj/path_test.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.path-test 2 | (:require 3 | [svg-clj.elements :as el] 4 | [svg-clj.path :as path] 5 | [svg-clj.transforms :as tf] 6 | [clojure.test :as test :refer [deftest is]])) 7 | 8 | (def test-circle (path/circle 5)) 9 | (def test-ellipse (path/ellipse 5 10)) 10 | (def test-line (path/line [0 0] [10 20])) 11 | (def test-polygon (path/polygon [ [0 0] [10 20] [40 50] [20 10] ])) 12 | (def test-polyline (path/polyline [ [0 0] [10 20] [40 50] [20 10] ])) 13 | (def test-rect (path/rect 60 30)) 14 | (def test-g (el/g test-circle 15 | test-ellipse 16 | test-line 17 | test-polygon 18 | test-polyline 19 | test-rect)) 20 | 21 | (def test-shapes [test-circle 22 | test-ellipse 23 | test-line 24 | test-polygon 25 | test-polyline 26 | test-rect]) 27 | 28 | (deftest basic-shapes-test 29 | (is (= test-circle [:path {:d "M5 0 A5 5 0 1 0 0 5 A5 5 0 1 0 -5 0 A5 5 0 1 0 0 -5 A5 5 0 1 0 5 0 Z", :fill-rule "evenodd"}])) 30 | (is (= test-ellipse [:path {:d "M5 0 A5 10 0 1 0 0 10 A5 10 0 1 0 -5 0 A5 10 0 1 0 0 -10 A5 10 0 1 0 5 0 Z", :fill-rule "evenodd"}])) 31 | (is (= test-line [:path {:d "M0 0 L10 20", :fill-rule "evenodd"}])) 32 | (is (= test-polygon [:path {:d "M0 0 L10 20 L40 50 L20 10 Z", :fill-rule "evenodd"}])) 33 | (is (= test-polyline [:path {:d "M0 0 L10 20 L40 50 L20 10", :fill-rule "evenodd"}])) 34 | (is (= test-rect [:path {:d "M-30.0 -15.0 L30.0 -15.0 L30.0 15.0 L-30.0 15.0 Z", :fill-rule "evenodd"}]))) 35 | 36 | (def a-str "M453 83l15 -9q-13 -81 -96 -81q-34 0 -51 22.5t-20 53.5q-20 -23 -30.5 -33t-39.5 -27.5t-58 -17.5q-50 0 -86 28t-36 89q0 27 11.5 47t32 32.5t41.5 20.5t49 11.5t46.5 4.5t41 1.5t24.5 0.5q3 0 3 74q0 95 -87 95q-30 0 -48 -13t-22 -31q29 0 29 -44q0 -27 -18 -38.5\nt-35 -11.5q-19 0 -34 17.5t-15 38.5q0 37 47 72q38 29 105 29q63 0 112 -39t49 -106q0 -33 -2 -92t-2 -85q0 -67 31 -66q18 0 27 13t16 44zM297 94v118q-35 -3 -64.5 -6.5t-50.5 -11t-33 -25.5t-12 -50q0 -43 21.5 -63t54.5 -20q52 0 84 58z") 37 | 38 | (def a-cmds (path/path-str->cmds a-str)) 39 | 40 | (deftest basic-cmds-test 41 | (is (= #{:abs} (set (map :coordsys a-cmds)))) 42 | (is (nil? (#{"V" "H" "S" "T"} (set (map :command a-cmds)))))) 43 | 44 | (deftest basic-translate-test 45 | (is (= (-> test-circle (tf/translate [10 10])) 46 | [:path {:d "M15 10 A5 5 0 1 0 10 15 A5 5 0 1 0 5 10 A5 5 0 1 0 10 5 A5 5 0 1 0 15 10 Z", :fill-rule "evenodd"}])) 47 | (is (= (-> test-ellipse (tf/translate [10 10])) 48 | [:path {:d "M15 10 A5 10 0 1 0 10 20 A5 10 0 1 0 5 10 A5 10 0 1 0 10 0 A5 10 0 1 0 15 10 Z", :fill-rule "evenodd"}])) 49 | (is (= (-> test-line (tf/translate [10 10])) 50 | [:path {:d "M10 10 L20 30", :fill-rule "evenodd"}])) 51 | (is (= (-> test-polygon (tf/translate [10 10])) 52 | [:path {:d "M10 10 L20 30 L50 60 L30 20 Z", :fill-rule "evenodd"}])) 53 | (is (= (-> test-polyline (tf/translate [10 10])) 54 | [:path {:d "M10 10 L20 30 L50 60 L30 20", :fill-rule "evenodd"}])) 55 | (is (= (-> test-rect (tf/translate [10 10])) 56 | [:path {:d "M-20.0 -5.0 L40.0 -5.0 L40.0 25.0 L-20.0 25.0 Z", :fill-rule "evenodd"}]))) 57 | 58 | (deftest translate-group-test 59 | (is (= (drop 2 (tf/translate test-g [5 10])) 60 | (map #(tf/translate % [5 10]) (drop 2 test-g))))) 61 | 62 | (deftest translate-list-test 63 | (let [a (repeat 10 (el/rect 10 20))] 64 | (is (= (tf/translate a [5 10]) 65 | (map #(tf/translate % [5 10]) a))))) 66 | 67 | (deftest basic-rotate-test 68 | (is (= (-> test-circle (tf/rotate 45)) 69 | [:path {:d "M3.5355339059327378 3.5355339059327373 A5 5 45 1 0 -3.5355339059327373 3.5355339059327378 A5 5 45 1 0 -3.5355339059327378 -3.5355339059327373 A5 5 45 1 0 3.5355339059327373 -3.5355339059327378 A5 5 45 1 0 3.5355339059327378 3.5355339059327373 Z" :fill-rule "evenodd"}])) 70 | (is (= (-> test-ellipse (tf/rotate 45)) 71 | [:path {:d "M3.5355339059327378 3.5355339059327373 A5 10 45 1 0 -7.071067811865475 7.0710678118654755 A5 10 45 1 0 -3.5355339059327378 -3.5355339059327373 A5 10 45 1 0 7.071067811865475 -7.0710678118654755 A5 10 45 1 0 3.5355339059327378 3.5355339059327373 Z" :fill-rule "evenodd"}])) 72 | (is (= (-> test-line (tf/rotate 90)) 73 | [:path {:d "M15.0 4.999999999999999 L-5.0 15.0", :fill-rule "evenodd"}])) 74 | (is (= (-> test-polygon (tf/rotate 90)) 75 | [:path {:d "M37.5 2.5 L17.5 12.5 L-12.5 42.5 L27.5 22.5 Z", :fill-rule "evenodd"}])) 76 | (is (= (-> test-polyline (tf/rotate 90)) 77 | [:path {:d "M37.5 2.5 L17.5 12.5 L-12.5 42.5 L27.5 22.5", :fill-rule "evenodd"}])) 78 | (is (= (-> test-rect (tf/rotate 45)) 79 | [:path {:d "M-10.606601717798215 -31.819805153394636 L31.81980515339464 10.60660171779821 L10.606601717798215 31.819805153394636 L-31.81980515339464 -10.60660171779821 Z", 80 | :fill-rule "evenodd"}]))) 81 | 82 | (def rotated-test-g-data-structure 83 | [:g {} 84 | [:path {:d "M22.5 17.5 A5 5 90 1 0 17.5 12.5 A5 5 90 1 0 22.5 7.5 A5 5 90 1 0 27.5 12.5 A5 5 90 1 0 22.5 17.5 Z", :fill-rule "evenodd"}] 85 | [:path {:d "M22.5 17.5 A5 10 90 1 0 12.5 12.5 A5 10 90 1 0 22.5 7.5 A5 10 90 1 0 32.5 12.5 A5 10 90 1 0 22.5 17.5 Z", :fill-rule "evenodd"}] 86 | [:path {:d "M22.5 12.5 L2.5 22.5", :fill-rule "evenodd"}] 87 | [:path {:d "M22.5 12.5 L2.5000000000000004 22.5 L-27.5 52.5 L12.5 32.5 Z", :fill-rule "evenodd"}] 88 | [:path {:d "M22.5 12.5 L2.5000000000000004 22.5 L-27.5 52.5 L12.5 32.5", :fill-rule "evenodd"}] 89 | [:path {:d "M37.5 -17.5 L37.5 42.5 L7.500000000000002 42.5 L7.499999999999998 -17.5 Z", :fill-rule "evenodd"}]]) 90 | 91 | (deftest rotate-group-test 92 | (is (not= (drop 2 (tf/rotate test-g 45)) 93 | (map #(tf/rotate % 45) (drop 2 test-g)))) 94 | (is (= (tf/rotate test-g 90) 95 | rotated-test-g-data-structure))) 96 | 97 | (deftest rotate-list-test 98 | (let [a (repeat 10 (el/rect 10 20))] 99 | (is (= (tf/rotate a 45) 100 | (map #(tf/rotate % 45) a))))) 101 | -------------------------------------------------------------------------------- /test/svg_clj/tools_test.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.tools-test 2 | (:require [clojure.string :as str] 3 | [svg-clj.utils :as u] 4 | [svg-clj.path :as path] 5 | [svg-clj.transforms :as tf] 6 | [svg-clj.elements :as el] 7 | [svg-clj.composites :refer [svg]] 8 | [svg-clj.tools :as tools] 9 | [clojure.test :as test :refer [deftest is]])) 10 | 11 | (def loaded-sk (tools/load-svg "examples/load-svg-test.svg")) 12 | (def sk-elems (tools/load-svg-elems "examples/load-svg-test.svg")) 13 | (def circle-elems (tools/load-svg-elems "examples/load-svg-test.svg" #{:circle})) 14 | 15 | (deftest basic-loading-test 16 | (is (= :svg (first loaded-sk))) 17 | (is (= :g (first (first sk-elems)))) 18 | (is (= 10 (count sk-elems))) 19 | (is (= 2 (count circle-elems))) 20 | (is (= #{:circle} (set (map first circle-elems))))) 21 | -------------------------------------------------------------------------------- /test/svg_clj/utils_test.cljc: -------------------------------------------------------------------------------- 1 | (ns svg-clj.utils-test 2 | (:require [svg-clj.utils :as u] 3 | [svg-clj.parametric :as p] 4 | [svg-clj.transforms :as tf] 5 | [clojure.test :as test :refer [deftest testing is]])) 6 | 7 | (deftest zeroish-test 8 | (testing "Zero is zerosih." 9 | (is (= true (u/zeroish? 0))) 10 | (is (= true (u/zeroish? 0.0)))) 11 | (testing "0.1 is not zerosih." 12 | (is (= false (u/zeroish? 0.1))) 13 | (is (= false (u/zeroish? -0.1)))) 14 | (testing "Really small is zerosih." 15 | (is (= true (u/zeroish? 0.000001))) 16 | (is (= true (u/zeroish? 1e-10))))) 17 | 18 | (deftest rounding-test 19 | (testing "Default rounding is 5 decimal places." 20 | (is (= 5.0 (u/round 4.999999999))) 21 | (is (= 5.0 (u/round 4.999995))) 22 | (is (= 4.99999 (u/round 4.999991))) 23 | (is (= 4.99999 (u/round 4.999994))))) 24 | 25 | (deftest angle-from-pts 26 | (let [angles (map 27 | #(u/angle-from-pts [10 0] [0 0] %) 28 | (p/regular-polygon-pts 10 20)) 29 | sorted-angles (reverse (sort angles))] 30 | (is (= (rest (map #(Math/round %) angles)) ;; first angle is 0, rest are in decreasing order 31 | (drop-last (map #(Math/round %) sorted-angles)))))) 32 | 33 | (deftest angle-first-quadrant 34 | (let [eps 0.00001 35 | a (u/angle-from-pts [0 10] [0 0] [10 0])] 36 | (is (< (Math/abs (- 90.0 a)) eps)))) 37 | 38 | (deftest cast-numerical-attrs-test 39 | (let [attrs {:cx "10" :cy "20" :width "200" :height "200px"} 40 | {:keys [cx cy width height] :as res} (u/cast-numerical-attrs attrs)] 41 | (is (= cx 10)) 42 | (is (= cy 20)) 43 | (is (= width 200)) 44 | (is (= height "200px")))) 45 | 46 | (deftest basic-string-to-elements 47 | (let [s "" 48 | res (u/svg-str->elems s) 49 | [k props] (first res)] 50 | (is (= 1 (count res))) 51 | (is (= k :rect)) 52 | (is (= (set (keys props)) #{:width :height :x :y})))) 53 | --------------------------------------------------------------------------------