Posted to tcl by dbohdan at Thu Sep 12 17:06:53 GMT 2019view raw

  1. #! /usr/bin/env tclsh
  2. # https://wiki.tcl-lang.org/page/Sparkline, one-$ version
  3.  
  4. proc $ var-name {
  5. upvar 1 ${var-name} var
  6. return $var
  7. }
  8.  
  9. namespace eval sparklines {
  10. namespace export create
  11.  
  12. variable version 0.0.5
  13. variable ticks [list  ‚ ƒ „ … † ‡ ˆ]
  14. variable tick-max [expr {
  15. [llength [$ ticks]] - 1
  16. }]
  17.  
  18. proc create data {
  19. variable ticks
  20. variable tick-max
  21.  
  22. set sorted [lsort -real [$ data]]
  23. set min [lindex [$ sorted] 0]
  24. set max [lindex [$ sorted] end]
  25.  
  26. if {[$ min] == [$ max]} {
  27. # All data points are the same.
  28. return [string repeat \
  29. [lindex [$ ticks] [expr {int([$ tick-max] / 2)}]] \
  30. [llength [$ data]]]
  31. } else {
  32. set result {}
  33. foreach x [$ data] {
  34. set x-normalized [expr {
  35. int([$ tick-max] * ([$ x] - [$ min]) /
  36. ([$ max] - [$ min]))
  37. }]
  38. append result [lindex [$ ticks] [$ x-normalized]]
  39. }
  40. return [$ result]
  41. }
  42. }
  43. }
  44.  
  45. # The following code allows you to use this script from the command line much
  46. # like the Bash version mentioned above.
  47. proc main-script? {} {
  48. # From https://wiki.tcl-lang.org/40097.
  49. global argv0
  50.  
  51. if {[info exists argv0]
  52. && [file exists [info script]]
  53. && [file exists [$ argv0]]} {
  54.  
  55. file stat [$ argv0] argv0-info-arr
  56. file stat [info script] script-info-arr
  57.  
  58. set argv0-info [array get argv0-info-arr]
  59. set script-info [array get script-info-arr]
  60.  
  61. expr {
  62. [dict get [$ argv0-info] dev] == [dict get [$ script-info] dev]
  63. && [dict get [$ argv0-info] ino] == [dict get [$ script-info] ino]
  64. }
  65. } else {
  66. return 0
  67. }
  68. }
  69.  
  70. if {[main-script?]} {
  71. if {[$ argv] eq ""} {
  72. puts "usage: [$ argv0] value ?value...?"
  73. puts " [$ argv0] \"value ?value...?\""
  74. } elseif {[$ argv] eq "test"} {
  75. proc assert {v1 v2} {
  76. if {[$ v1] eq [$ v2]} {
  77. puts [$ v1]
  78. } else {
  79. error "assertion failed: \"[$ v1]\" ne \"[$ v2]\""
  80. }
  81. }
  82.  
  83. assert [sparklines::create {1 5 22 13 53}] {ƒ‚ˆ}
  84. assert [sparklines::create {0 30 55 80 33 150}] {‚ƒ„‚ˆ}
  85. assert [sparklines::create {9 13 5 17 1}] {„†‚ˆ}
  86. assert [sparklines::create {1 1 1 1}] {„„„„}
  87.  
  88. puts ok
  89. } else {
  90. if {[llength [$ argv]] == 1} {
  91. set argv [lindex [$ argv] 0]
  92. }
  93.  
  94. puts [sparklines::create [$ argv]]
  95. }
  96. }
  97.  

Comments

Posted by avl at Tue Sep 17 07:09:39 GMT 2019 [text] [code]

interp alias {} $ {} set