Posted to tcl by mjanssen at Tue Jun 23 07:45:15 GMT 2020view raw

  1. # Copyright (c) 2020, M.P.C. Janssen
  2. # This code is released under
  3. # the terms of the MIT license. See the file LICENSE for details.
  4.  
  5. package require tls
  6. package require http
  7. package require base64
  8. ::http::register https 443 [list ::tls::socket -autoservername 1]
  9.  
  10. namespace eval ::tclssg::pipeline::10-register-template-command {
  11. namespace path ::tclssg
  12.  
  13.  
  14. proc plantumlurl {raw} {
  15. return https://plantuml.mpcjanssen.nl/svg/[string map [list \n {}] [string trim [base64toplantuml [base64::encode [zlib deflate $raw]]]]]
  16. }
  17.  
  18. variable base64map
  19. foreach x {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 + /}\
  20. y {0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z - _} {
  21. lappend base64map $x $y
  22. }
  23. interp alias {} [namespace current]::base64toplantuml {} string map $base64map
  24.  
  25. proc plantumlsvg {uml} {
  26. set tok [http::geturl [plantumlurl $uml]]
  27. set data [base64::encode [http::data $tok]]
  28. http::cleanup $tok
  29. return "<img src='data:image/svg+xml;base64,$data'/>"
  30. }
  31.  
  32. proc transform {} {
  33. set me [namespace tail [namespace current]]
  34. log::info [list running demo plugin $me]
  35. log::debug $::tclssg::interpreter::aliases
  36.  
  37. dict set ::tclssg::interpreter::aliases \
  38. [namespace current]::plantumlsvg \
  39. plantumlsvg
  40. }
  41. }
  42.