jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

ansi web,x11,term colour names, textblock::table fixes, textblock::example update to show coloured periodic table

master
Julian Noble 7 months ago
parent
d9d771100b
commit
5b62995e06
4 changed files with 2382 additions and 276 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 774
      src/bootsupport/modules/punk/ansi-0.1.1.tm
  2. 555
      src/bootsupport/modules/textblock-0.1.1.tm
  3. 774
      src/modules/punk/ansi-999999.0a1.0.tm
  4. 555
      src/modules/textblock-999999.0a1.0.tm

774
src/bootsupport/modules/punk/ansi-0.1.1.tm
Unescape View File

@ -325,7 +325,7 @@ namespace eval punk::ansi {
dict set map_special_graphics "\}" \u00a3 ;#pound sign
dict set map_special_graphics ~ \u00b7 ;#middle dot
#see also ansicolor page on wiki https://wiki.tcl-lang.org/page/ANSI+color+control
#see also ansicolour page on wiki https://wiki.tcl-lang.org/page/ANSI+color+control
variable test "blah\033\[1;33mETC\033\[0;mOK"
@ -768,15 +768,535 @@ namespace eval punk::ansi {
normal 22 defaultfg 39 defaultbg 49 overline 53 nooverline 55
frame 51 framecircle 52 noframe 54 underlinedefault 59
}
#unprefixed colours are (close to) the ansi-specified colour names (lower-cased and whitespace collapsed, with capitalisation of 1st letter given fg/bg meaning here)
variable SGR_colour_map {
black 30 red 31 green 32 yellow 33 blue 34 purple 35 cyan 36 white 37
Black 40 Red 41 Green 42 Yellow 43 Blue 44 Purple 45 Cyan 46 White 47
xblack 90 xred 91 xgreen 92 xyellow 93 xblue 94 xpurple 95 xcyan 96 xwhite 97
BLACK 100 RED 101 GREEN 102 YELLOW 103 BLUE 104 PURPLE 105 CYAN 106 WHITE 107
brightblack 90 brightred 91 brightgreen 92 brightyellow 93 brightblue 94 brightpurple 95 brightcyan 96 brightwhite 97
Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblue 104 Brightpurple 105 Brightcyan 106 Brightwhite 107
}
variable SGR_map ;#public - part of interface - review
set SGR_map [dict merge $SGR_colour_map $SGR_setting_map]
#we use prefixes e.g web-white and/or x11-white
#Only a leading capital letter will indicate the colour target is background vs lowercase for foreground
#In the map key-lookup context the colour names will be canonically lower case
#We should be case insensitive in the non-prefix part ie after determining fg/bg target from first letter of the prefix
#e.g Web-Lime or Web-lime are ok and are targeting background
#foreground target examples: web-Lime web-LIME web-DarkSalmon web-Darksalmon
#specified in decimal - but we should also accept hex format directly in a+ function e.g #00FFFF for aqua
variable WEB_colour_map
#use the totitle format as the canonical lookup key
#don't use leading zeros - keep compatible with earlier tcl and avoid octal issue
# -- --- ---
#css 1-2.0 HTML 3.2-4 Basic colours eg web-silver for fg Web-silver for bg
#
dict set WEB_colour_map white 255-255-255 ;# #FFFFFF
dict set WEB_colour_map silver 192-192-192 ;# #C0C0C0
dict set WEB_colour_map gray 128-128-128 ;# #808080
dict set WEB_colour_map black 0-0-0 ;# #000000
dict set WEB_colour_map red 255-0-0 ;# #FF0000
dict set WEB_colour_map maroon 128-0-0 ;# #800000
dict set WEB_colour_map yellow 255-255-0 ;# #FFFF00
dict set WEB_colour_map olive 128-128-0 ;# #808000
dict set WEB_colour_map lime 0-255-0 ;# #00FF00
dict set WEB_colour_map green 0-128-0 ;# #008000
dict set WEB_colour_map aqua 0-255-255 ;# #00FFFF
dict set WEB_colour_map teal 0-128-128 ;# #008080
dict set WEB_colour_map blue 0-0-255 ;# #0000FF
dict set WEB_colour_map navy 0-0-128 ;# #000080
dict set WEB_colour_map fuchsia 255-0-255 ;# #FF00FF
dict set WEB_colour_map purple 128-0-128 ;# #800080
# -- --- ---
#Pink colours
dict set WEB_colour_map mediumvioletred 199-21-133 ;# #C71585
dict set WEB_colour_map deeppink 255-20-147 ;# #FF1493
dict set WEB_colour_map palevioletred 219-112-147 ;# #DB7093
dict set WEB_colour_map hotpink 255-105-180 ;# #FF69B4
dict set WEB_colour_map lightpink 255-182-193 ;# #FFB6C1
dict set WEB_colour_map pink 255-192-203 ;# #FFCOCB
# -- --- ---
#Red colours
dict set WEB_colour_map darkred 139-0-0 ;# #8B0000
#red - as above
dict set WEB_colour_map firebrick 178-34-34 ;# #B22222
dict set WEB_colour_map crimson 220-20-60 ;# #DC143C
dict set WEB_colour_map indianred 205-92-92 ;# #CD5C5C
dict set WEB_colour_map lightcoral 240-128-128 ;# #F08080
dict set WEB_colour_map salmon 250-128-114 ;# #FA8072
dict set WEB_colour_map darksalmon 233-150-122 ;# #E9967A
dict set WEB_colour_map lightsalmon 255-160-122 ;# #FFA07A
# -- --- ---
#Orange colours
dict set WEB_colour_map orangered 255-69-0 ;# #FF4500
dict set WEB_colour_map tomato 255-99-71 ;# #FF6347
dict set WEB_colour_map darkorange 255-140-0 ;# #FF8C00
dict set WEB_colour_map coral 255-127-80 ;# #FF7F50
dict set WEB_colour_map orange 255-165-0 ;# #FFA500
# -- --- ---
#Yellow colours
dict set WEB_colour_map darkkhaki 189-183-107 ;# #BDB76B
dict set WEB_colour_map gold 255-215-0 ;# #FFD700
dict set WEB_colour_map khaki 240-230-140 ;# #F0E68C
dict set WEB_colour_map peachpuff 255-218-185 ;# #FFDAB9
#yellow - as above
dict set WEB_colour_map palegoldenrod 238-232-170 ;# #EEE8AA
dict set WEB_colour_map moccasin 255-228-181 ;# #FFE4B5
dict set WEB_colour_map papayawhip 255-239-213 ;# #FFEFD5
dict set WEB_colour_map lightgoldenrodyeallow 250-250-210 ;# #FAFAD2
dict set WEB_colour_map lemonchiffon 255-250-205 ;# #FFFACD
dict set WEB_colour_map lightyellow 255-255-224 ;# #FFFFE0
# -- --- ---
#Brown colours
#maroon as above
dict set WEB_colour_map brown 165-42-42 ;# #A52A2A
dict set WEB_colour_map saddlebrown 139-69-19 ;# #8B4513
dict set WEB_colour_map sienna 160-82-45 ;# #A0522D
dict set WEB_colour_map chocolate 210-105-30 ;# #D2691E
dict set WEB_colour_map darkgoldenrod 184-134-11 ;# #B8860B
dict set WEB_colour_map peru 205-133-63 ;# #CD853F
dict set WEB_colour_map rosybrown 188-143-143 ;# #BC8F8F
dict set WEB_colour_map goldenrod 218-165-32 ;# #DAA520
dict set WEB_colour_map sandybrown 244-164-96 ;# #F4A460
dict set WEB_colour_map tan 210-180-140 ;# #D2B48C
dict set WEB_colour_map burlywood 222-184-135 ;# #DEB887
dict set WEB_colour_map wheat 245-222-179 ;# #F5DEB3
dict set WEB_colour_map navajowhite 255-222-173 ;# #FFDEAD
dict set WEB_colour_map bisque 255-228-196 ;# #FFEfC4
dict set WEB_colour_map blanchedalmond 255-228-196 ;# #FFEfC4
dict set WEB_colour_map cornsilk 255-248-220 ;# #FFF8DC
# -- --- ---
#Purple, violet, and magenta colours
dict set WEB_colour_map indigo 75-0-130 ;# #4B0082
#purple as above
dict set WEB_colour_map darkmagenta 139-0-139 ;# #8B008B
dict set WEB_colour_map darkviolet 148-0-211 ;# #9400D3
dict set WEB_colour_map darkslateblue 72-61-139 ;# #9400D3
dict set WEB_colour_map blueviolet 138-43-226 ;# #8A2BE2
dict set WEB_colour_map darkorchid 153-50-204 ;# #9932CC
#fuchsia as above
dict set WEB_colour_map magenta 255-0-255 ;# #FF00FF - same as fuchsia
dict set WEB_colour_map slateblue 106-90-205 ;# #6A5ACD
dict set WEB_colour_map mediumslateblue 123-104-238 ;# #7B68EE
dict set WEB_colour_map mediumorchid 186-85-211 ;# #BA5503
dict set WEB_colour_map mediumpurple 147-112-219 ;# #9370DB
dict set WEB_colour_map orchid 218-112-214 ;# #DA70D6
dict set WEB_colour_map violet 238-130-238 ;# #EE82EE
dict set WEB_colour_map plum 221-160-221 ;# #DDA0DD
dict set WEB_colour_map thistle 216-191-216 ;# #D88FD8
dict set WEB_colour_map lavender 230-230-150 ;# #E6E6FA
# -- --- ---
#Blue colours
dict set WEB_colour_map midnightblue 25-25-112 ;# #191970
#navy as above
dict set WEB_colour_map darkblue 0-0-139 ;# #00008B
dict set WEB_colour_map mediumblue 0-0-205 ;# #0000CD
#blue as above
dict set WEB_colour_map royalblue 65-105-225 ;# #4169E1
dict set WEB_colour_map steelblue 70-130-180 ;# #4682B4
dict set WEB_colour_map dodgerblue 30-144-255 ;# #1E90FF
dict set WEB_colour_map deepskyblue 0-191-255 ;# #00BFFF
dict set WEB_colour_map cornflowerblue 100-149-237 ;# #6495ED
dict set WEB_colour_map skyblue 135-206-235 ;# #87CEEB
dict set WEB_colour_map lightskyblue 135-206-250 ;# #87CEFA
dict set WEB_colour_map lightsteelblue 176-196-222 ;# #B0C4DE
dict set WEB_colour_map lightblue 173-216-230 ;# #ADD8E6
dict set WEB_colour_map powderblue 176-224-230 ;# #B0E0E6
# -- --- ---
#Cyan colours
#teal as above
dict set WEB_colour_map darkcyan 0-139-139 ;# #008B8B
dict set WEB_colour_map lightseagreen 32-178-170 ;# #20B2AA
dict set WEB_colour_map cadetblue 95-158-160 ;# #5F9EA0
dict set WEB_colour_map darkturquoise 0-206-209 ;# #00CED1
dict set WEB_colour_map mediumturquoise 72-209-204 ;# #48D1CC
dict set WEB_colour_map turquoise 64-224-208 ;# #40E0D0
#aqua as above
dict set WEB_colour_map cyan 0-255-255 ;# #00FFFF - same as aqua
dict set WEB_colour_map aquamarine 127-255-212 ;# #7FFFD4
dict set WEB_colour_map paleturquoise 175-238-238 ;# #AFEEEE
dict set WEB_colour_map lightcyan 224-255-255 ;# #E0FFFF
# -- --- ---
#Green colours
dict set WEB_colour_map darkgreen 0-100-0 ;# #006400
#green as above
dict set WEB_colour_map darkolivegreen 85-107-47 ;# #55682F
dict set WEB_colour_map forestgreen 34-139-34 ;# #228B22
dict set WEB_colour_map seagrean 46-139-87 ;# #2E8B57
#olive as above
dict set WEB_colour_map olivedrab 107-142-35 ;# #6B8E23
dict set WEB_colour_map mediumseagreen 60-179-113 ;# #3CB371
dict set WEB_colour_map limegreen 50-205-50 ;# #32CD32
#lime as above
dict set WEB_colour_map springgreen 0-255-127 ;# #00FF7F
dict set WEB_colour_map mediumspringgreen 0-250-154 ;# #00FA9A
dict set WEB_colour_map darkseagreen 143-188-143 ;# #8FBC8F
dict set WEB_colour_map mediumaquamarine 102-205-170 ;# #66CDAA
dict set WEB_colour_map yellowgreen 154-205-50 ;# #9ACD32
dict set WEB_colour_map lawngreen 124-252-0 ;# #7CFC00
dict set WEB_colour_map chartreuse 127-255-0 ;# #7FFF00
dict set WEB_colour_map lightgreen 144-238-144 ;# #90EE90
dict set WEB_colour_map greenyellow 173-255-47 ;# #ADFF2F
dict set WEB_colour_map palegreen 152-251-152 ;# #98FB98
# -- --- ---
#White colours
dict set WEB_colour_map mistyrose 255-228-225 ;# #FFE4E1
dict set WEB_colour_map antiquewhite 250-235-215 ;# #FAEBD7
dict set WEB_colour_map linen 250-240-230 ;# #FAF0E6
dict set WEB_colour_map beige 245-245-220 ;# #F5F5DC
dict set WEB_colour_map whitesmoke 245-245-245 ;# #F5F5F5
dict set WEB_colour_map lavenderblush 255-240-245 ;# #FFF0F5
dict set WEB_colour_map oldlace 253-245-230 ;# #FDF5E6
dict set WEB_colour_map aliceblue 240-248-255 ;# #F0F8FF
dict set WEB_colour_map seashell 255-245-238 ;# #FFF5EE
dict set WEB_colour_map ghostwhite 248-248-255 ;# #F8F8FF
dict set WEB_colour_map honeydew 240-255-240 ;# #F0FFF0
dict set WEB_colour_map floralwhite 255-250-240 ;# #FFFAF0
dict set WEB_colour_map azure 240-255-255 ;# #F0FFFF
dict set WEB_colour_map mintcream 245-255-250 ;# #F5FFFA
dict set WEB_colour_map snow 255-250-250 ;# #FFFAFA
dict set WEB_colour_map ivory 255-255-240 ;# #FFFFF0
#white as above
# -- --- ---
#Gray and black colours
#black as above
dict set WEB_colour_map darkslategray 47-79-79 ;# #2F4F4F
dict set WEB_colour_map dimgray 105-105-105 ;# #696969
dict set WEB_colour_map slategray 112-128-144 ;# #708090
#gray as above
dict set WEB_colour_map lightslategray 119-136-153 ;# #778899
dict set WEB_colour_map darkgray 169-169-169 ;# #A9A9A9
dict set WEB_colour_map silver 192-192-192 ;# #C0C0C0
dict set WEB_colour_map lightgray 211-211-211 ;# #D3D3D3
dict set WEB_colour_map gainsboro 220-220-220 ;# #DCDCDC
#we should be able to use WEB_colour_map as a base and override only the conflicts for X11 colours ? Review - check if this is true
variable X11_colour_map
set X11_colour_map $WEB_colour_map
dict set X11_colour_map gray 190-190-190 ;# #BEBEBE
dict set X11_colour_map green 0-255-0 ;# #00FF00
dict set X11_colour_map maroon 176-48-96 ;# #B03060
dict set X11_colour_map purple 160-32-240 ;# #A020F0
#Xterm colour names (256 colours)
#lists on web have duplicate names
#these have been renamed here in a systematic way:
#They are suffixed with a dash and a letter e.g second deepskyblue4 -> deepskyblue4-b, third deepskyblue4 -> deepskyblue4-c
#presumably the xterm colour names are not widely used or are used for reverse lookup from rgb to get an approximate name in the case of dupes?
#Review!
#keep duplicate names in the list and map them when building the dict.
#This is an in depth analysis of the xterm colour set which gives names(*) to all of the 256 colours and describes possible indexing by Hue,Luminance,Saturation
#https://www.wowsignal.io/articles/xterm256
#*The names are wildly-imaginative, often unintuitively so, and multiple (5?) given for each colour - so they are unlikely to be of practical use or any sort of standard.
#e.g who is to know that 'Rabbit Paws', 'Forbidden Thrill' and 'Tarsier' refer to a particular shade of pinky-red? (code 95)
#Perhaps it's an indication that colour naming once we get to 256 colours or more is a fool's errand anyway.
#The xterm names are boringly unimaginative - and also have some oddities such as:
# DarkSlateGray1 which looks much more like cyan..
# The greyxx names are spelt with an e - but the darkslategrayX variants use an a. Perhaps that's because they are more cyan than grey and the a is a hint?
# there is no gold or gold2 - but there is gold1 and gold3
#but in general the names bear some resemblance to the colours and are at least somewhat intuitive.
set xterm_names [list\
black\
maroon\
green\
olive\
navy\
purple\
teal\
silver\
grey\
red\
lime\
yellow\
blue\
fuchsia\
aqua\
white\
grey0\
navyblue\
darkblue\
blue3\
blue3\
blue1\
darkgreen\
deepskyblue4\
deepskyblue4\
deepskyblue4\
dodgerblue3\
dodgerblue2\
green4\
springgreen4\
turquise4\
deepskyblue3\
deepskyblue3\
dodgerblue1\
green3\
springgreen3\
darkcyan\
lightseagreen\
deepskyblue2\
deepskyblue1\
green3\
springgreen3\
springgreen2\
cyan3\
darkturquoise\
turquoise2\
green1\
springgreen2\
springgreen1\
mediumspringgreen\
cyan2\
cyan1\
darkred\
deeppink4\
purple4\
purple4\
purple3\
blueviolet\
orange4\
grey37\
mediumpurple4\
slateblue3\
slateblue3\
royalblue1\
chartreuse4\
darkseagreen4\
paleturquoise4\
steelblue\
steelblue3\
cornflowerblue\
chartreuse3\
darkseagreen4\
cadetblue\
cadetblue\
skyblue3\
steelblue1\
chartreuse3\
palegreen3\
seagreen3\
aquamarine3\
mediumturquoise\
steelblue1\
chartreuse2\
seagreen2\
seagreen1\
seagreen1\
aquamarine1\
darkslategray2\
darkred\
deeppink4\
darkmagenta\
darkmagenta\
darkviolet\
purple\
orange4\
lightpink4\
plum4\
mediumpurple3\
mediumpurple3\
slateblue1\
yellow4\
wheat4\
grey53\
lightslategrey\
mediumpurple\
lightslateblue\
yellow4\
darkolivegreen3\
darkseagreen\
lightskyblue3\
lightskyblue3\
skyblue2\
chartreuse2\
darkolivegreen3\
palegreen3\
darkseagreen3\
darkslategray3\
skyblue1\
chartreuse1\
lightgreen\
lightgreen\
palegreen1\
aquamarine1\
darkslategray1\
red3\
deeppink4\
mediumvioletred\
magenta3\
darkviolet\
purple\
darkorange3\
indianred\
hotpink3\
mediumorchid3\
mediumorchid\
mediumpurple2\
darkgoldenrod\
lightsalmon3\
rosybrown\
grey63\
mediumpurple2\
mediumpurple1\
gold3\
darkkhaki\
navajowhite\
grey69\
lightsteelblue3\
lightsteelblue\
yellow3\
darkolivegreen3\
darkseagreen3\
darkseagreen2\
lightcyan3\
lightskyblue1\
greenyellow\
darkolivegreen2\
palegreen1\
darkseagreen2\
darkseagreen1\
paleturquoise1\
red3\
deppink3\
deeppink3\
magenta3\
magenta3\
magenta2\
darkorange3\
indianred\
hotpink3\
hotpink2\
orchid\
mediumorchid1\
orange3\
lightsalmon3\
lightpink3\
pink3\
plum3\
violet\
gold3\
lightgoldenrod3\
tan\
mistyrose3\
thistle3\
plum2\
yellow3\
khaki3\
lightgoldenrod2\
lightyellow3\
grey84\
lightsteelblue1\
yellow2\
darkolivegreen1\
darkolivegreen1\
darkseagreen1\
honeydew2\
lightcyan1\
red1\
deeppink2\
deeppink1\
deeppink1\
magenta2\
magenta1\
orangered1\
indianred1\
indianred1\
hotpink\
hotpink\
mediumorchid1\
darkorange\
salmon1\
lightcoral\
palevioletred1\
orchid2\
orchid1\
orange1\
sandybrown\
lightsalmon1\
lightpink1\
pink1\
plum1\
gold1\
lightgoldenrod2\
lightgoldenrod2\
navajowhite1\
mistyrose1\
thistle1\
yellow1\
lightgoldenrod1\
khaki1\
wheat1\
cornsilk1\
grey100\
grey3\
grey7\
grey11\
grey11\
grey15\
grey19\
grey23\
grey27\
grey30\
grey35\
grey39\
grey42\
grey46\
grey50\
grey54\
grey58\
grey62\
grey66\
grey70\
grey74\
grey78\
grey82\
grey85\
grey89\
grey93\
]
variable TERM_colour_map
set TERM_colour_map [dict create]
set cidx 0
foreach cname $xterm_names {
if {![dict exists $TERM_colour_map $cname]} {
dict set TERM_colour_map $cname $cidx
} else {
set did_rename 0
#start suffixes at '-b'. The base name could be considered the '-a' version - but we don't create it.
foreach {suffix} {b c} {
if {![dict exists $TERM_colour_map $cname-$suffix]} {
dict set TERM_colour_map $cname-$suffix $cidx
set did_rename 1
break
}
}
if {!$did_rename} {
error "Not enough suffixes for duplicate names in xterm colour list. Add more suffixes or review list"
}
}
incr cidx
}
#colour_hex2dec
#conversion of hex to format directly pluggable to ansi rgb format (colon separated e.g for foreground we need "38;2;$r;$g;$b" so we return $r;$g;$b)
#we want to support arbitrary rgb values specified in hex - so a table of 16M+ is probably not a great idea
#hex zero-padded - canonically upper case but mixed or lower accepted
#dict for {k v} $WEB_colour_map {
# set dectriple [split $v -]
# set webhex [::join [format %02X%02X%02X {*}$dectriple] ;# e.g 808080, FFFFFF, 000000
# dict set HEX_colour_map $webhex [join $dectriple {;}]
#}
proc colour_hex2dec {hex6} {
return [join [::scan $hex6 %2X%2X%2X] {;}]
}
proc get_sgr_map {} {
variable SGR_map
return $SGR_map
@ -786,23 +1306,62 @@ namespace eval punk::ansi {
package require textblock
set bg [textblock::block 33 3 "[a+ $bgname] [a]"]
set colormap ""
set colourmap ""
for {set i 0} {$i <= 7} {incr i} {
append colormap "_[a+ white bold 48\;5\;$i] $i [a]"
append colourmap "_[a+ white bold 48\;5\;$i] $i [a]"
}
set map1 [overtype::left -transparent _ $bg "\n$colormap"]
set map1 [overtype::left -transparent _ $bg "\n$colourmap"]
return $map1
}
proc colourmap2 {{bgname White}} {
package require textblock
set bg [textblock::block 39 3 "[a+ $bgname] [a]"]
set colormap ""
set colourmap ""
for {set i 8} {$i <= 15} {incr i} {
append colormap "_[a+ black normal 48\;5\;$i] $i [a]" ;#black normal is blacker than black bold - which often displays as a grey
append colourmap "_[a+ black normal 48\;5\;$i] $i [a]" ;#black normal is blacker than black bold - which often displays as a grey
}
set map2 [overtype::left -transparent _ $bg "\n$colormap"]
set map2 [overtype::left -transparent _ $bg "\n$colourmap"]
return $map2
}
proc colourtable_216 {} {
package require textblock
set clist [list]
set fg black
for {set i 16} {$i <=231} {incr i} {
if {$i % 18 == 16} {
if {$fg eq "black"} {
set fg "bold white"
} else {
set fg "black"
}
}
lappend clist "[a+ {*}$fg Term$i][format %3s $i]"
}
set t [textblock::list_as_table 36 $clist -return object]
$t configure -show_hseps 0
#return [$t print]
return $t
}
proc colourblock_216 {} {
set out ""
set fg black
for {set i 16} {$i <=231} {incr i} {
if {$i % 18 == 16} {
if {$fg eq "black"} {
set fg "bold white"
} else {
set fg "black"
}
set br "\n"
} else {
set br ""
}
append out "$br[a+ {*}$fg Term$i][format %3s $i] "
}
return $out
}
proc a? {args} {
#*** !doctools
#[call [fun a?] [opt {ansicode...}]]
@ -825,17 +1384,18 @@ namespace eval punk::ansi {
append out [textblock::join $map1 " " $map2] \n
#append out $map1[a] \n
#append out $map2[a] \n
append out [colourblock_216]
} on error {result options} {
puts stderr "Failed to draw colormap"
puts stderr "Failed to draw colourmap"
puts stderr "$result"
} finally {
return $out
}
} else {
set result [list]
set map [dict merge $SGR_setting_map $SGR_colour_map]
set rmap [lreverse $map]
foreach i $args {
if {[string is integer -strict $i]} {
@ -864,6 +1424,10 @@ namespace eval punk::ansi {
#don't disable ansi here.
#we want this to be available to call even if ansi is off
variable SGR_map
variable WEB_colour_map
variable TERM_colour_map
variable X11_colour_map
set t [list]
foreach i $args {
if {[string is integer -strict $i]} {
@ -873,98 +1437,110 @@ namespace eval punk::ansi {
lappend t $i
} else {
if {[dict exists $SGR_map $i]} {
#SGR case must match exactly those in the map
lappend t [dict get $SGR_map $i]
} else {
#accept examples for foreground
# 256f-# or 256fg-# or 256f#
# 256f-<int> or 256fg-<int> or 256f<int>
# rgbf-<r>-<g>-<b> or rgbfg-<r>-<g>-<b> or rgbf<r>-<g>-<b>
switch -nocase -glob -- $i {
"256f*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "38;5;$cc"
switch -- [string range $i 0 3] {
term {
#256 colour foreground by Xterm name or by integer
#name is xterm name or colour index from 0 - 255
set cc [string trim [string tolower [string range $i 4 end]] -]
if {[string is integer -strict $cc]} {
lappend t "38;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
set cc [dict get $TERM_colour_map $cc]
lappend t "38;5;$cc"
}
}
}
"256b*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "48;5;$cc"
Term - TERM {
#256 colour background by Xterm name or by integer
set cc [string trim [string tolower [string range $i 4 end]] -]
if {[string is integer -strict $cc]} {
lappend t "48;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
set cc [dict get $TERM_colour_map $cc]
lappend t "48;5;$cc"
}
}
}
"rgbf*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "38;2;$r;$g;$b"
rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 {
#decimal rgb foreground
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "38;2;$rgb"
}
"rgbb*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "48;2;$r;$g;$b"
Rgb- - RGB- - Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 - RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 {
#decimal rgb background
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "48;2;$rgb"
}
}
}
}
}
# \033 - octal. equivalently \x1b in hex which is more common in documentation
if {![llength $t]} {
return "" ;# a+ nonexistent should return nothing rather than a reset ( \033\[\;m is a reset even without explicit zero(s))
}
return "\x1b\[[join $t {;}]m"
}
proc a2 {args} {
#*** !doctools
#[call [fun a] [opt {ansicode...}]]
#[para]Returns the ansi code to reset any current settings and apply those from the supplied list
#[para] by calling punk::ansi::a with no arguments - the result is a reset to plain text
#[para] e.g to set foreground red and bold
#[para]punk::ansi::a red bold
#[para]to set background red
#[para]punk::ansi::a Red
#[para]see [cmd punk::ansi::a?] to display a list of codes
#don't disable ansi here.
#we want this to be available to call even if ansi is off
variable SGR_map
set t [list]
foreach i $args {
if {[dict exists $SGR_map $i]} {
lappend t [dict get $SGR_map $i]
} else {
if {[string is integer -strict $i]} {
lappend t $i
} elseif {[string first ";" $i] >=0} {
#literal with params
lappend t $i
} else {
#accept examples for foreground
# 256f-# or 256fg-# or 256f#
# rgbf-<r>-<g>-<b> or rgbfg-<r>-<g>-<b> or rgbf<r>-<g>-<b>
switch -nocase -glob -- $i {
"256f*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "38;5;$cc"
"rgb#" {
#hex rgb foreground
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "38;2;$rgb"
}
"256b*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "48;5;$cc"
"Rgb#" - "RGB#" {
#hex rgb background
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "48;2;$rgb"
}
"rgbf*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "38;2;$r;$g;$b"
web- {
#foreground web colour
set cname [string tolower [string range $i 4 end]]
if {[dict exists $WEB_colour_map $cname]} {
set rgbdash [dict get $WEB_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "38;2;$rgb"
}
}
"rgbb*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "48;2;$r;$g;$b"
Web- - WEB- {
#background web colour
set cname [string tolower [string range $i 4 end]]
if {[dict exists $WEB_colour_map $cname]} {
set rgbdash [dict get $WEB_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "48;2;$rgb"
}
}
x11- {
#foreground X11 names
set cname [string tolower [string range $i 4 end]]
if {[dict exists $X11_colour_map $cname]} {
set rgbdash [dict get $X11_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "38;2;$rgb"
}
}
X11- {
#background X11 names
set cname [string tolower [string range $i 4 end]]
if {[dict exists $X11_colour_map $cname]} {
set rgbdash [dict get $X11_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "48;2;$rgb"
}
}
}
}
}
}
# \033 - octal. equivalently \x1b in hex which is more common in documentation
# empty list [a=] should do reset - same for [a= nonexistant]
# explicit reset at beginning of parameter list for a= (as opposed to a+)
set t [linsert $t 0 0]
if {![llength $t]} {
return "" ;# a+ nonexistent should return nothing rather than a reset ( \033\[\;m is a reset even without explicit zero(s))
}
return "\x1b\[[join $t {;}]m"
}
proc a {args} {
#*** !doctools
#[call [fun a] [opt {ansicode...}]]
@ -1668,7 +2244,7 @@ namespace eval punk::ansi {
#However - detecting zero or empty parameter in other positions requires knowing all other codes that may allow zero or empty params.
#We only look at the initial parameter within the trailing SGR code as this is the well-formed normal case.
#Review - consider normalizing sgr codes to remove other redundancies such as setting fg or bg color twice in same code
#Review - consider normalizing sgr codes to remove other redundancies such as setting fg or bg colour twice in same code
proc has_sgr_leadingreset {code} {
#*** !doctools
#[call [fun has_sgr_leadingreset] [arg code]]
@ -1736,7 +2312,7 @@ namespace eval punk::ansi {
dict set codestate_empty ideogram_clear ""
dict set codestate_empty overline "" ;#53 on 55 off - probably not supported - pass through.
dict set codestate_empty underlinecolour "" ;#58 - same arguments as 256color and rgb (nonstandard - in Kitty ,VTE,mintty and iTerm2)
dict set codestate_empty underlinecolour "" ;#58 - same arguments as 256colour and rgb (nonstandard - in Kitty ,VTE,mintty and iTerm2)
# -- mintty?
dict set codestate_empty superscript "" ;#73
@ -1758,11 +2334,19 @@ namespace eval punk::ansi {
}
sgr_merge $args
}
proc sgr_merge {codelist args} {
set allparts [list]
foreach c $codelist {
set cparts [punk::ansi::ta::split_codes_single $c]
lappend allparts {*}[lsearch -all -inline -not $cparts ""]
}
sgr_merge_singles $allparts {*}$args
}
#codes *must* already have been split so that one esc per element in codelist
#e.g codelist [a+ Yellow Red underline] [a+ blue] [a+ red] is ok
#but codelist "[a+ Yellow Red underline][a+ blue]" [a+ red] is not
#(use punk::ansi::ta::split_codes_single)
proc sgr_merge {codelist args} {
proc sgr_merge_singles {codelist args} {
variable codestate_empty
set othercodes [list]
@ -1807,7 +2391,7 @@ namespace eval punk::ansi {
#set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m
set params [string range $cnorm 4 end-1] ;#string leading XCSI and trailing m
#some systems use colon for 256 colors or RGB or nonstandard subparameters
#some systems use colon for 256 colours or RGB or nonstandard subparameters
#- it is therefore probably not ok to map to semicolon within SGR codes and treat the same.
# - will break mintty? set params [string map [list : {;}] $params]
set plist [split $params {;}]
@ -1939,7 +2523,7 @@ namespace eval punk::ansi {
dict set codestate fg $p ;#foreground colour
}
38 {
#256 color or rgb
#256 colour or rgb
#check if subparams supplied as colon separated
if {[string first : $p] < 0} {
switch -- [lindex $plist $i+1] {
@ -1955,7 +2539,7 @@ namespace eval punk::ansi {
}
}
} else {
#apparently subparameters can be left empty - and there are other subparams like transparency and color-space
#apparently subparameters can be left empty - and there are other subparams like transparency and colour-space
#we should only need to pass it all through for the terminal to understand
#review
dict set codestate fg $p
@ -1968,7 +2552,7 @@ namespace eval punk::ansi {
dict set codestate bg $p ;#background colour
}
48 {
#256 color or rgb
#256 colour or rgb
if {[string first : $p] < 0} {
switch -- [lindex $plist $i+1] {
5 {
@ -2006,7 +2590,7 @@ namespace eval punk::ansi {
}
58 {
#nonstandard
#256 color or rgb
#256 colour or rgb
if {[string first : $p] < 0} {
switch -- [lindex $plist $i+1] {
5 {
@ -2162,7 +2746,7 @@ namespace eval punk::ansi {
# -- --- --- --- --- --- --- --- --- --- ---
#todo - implement colour resets like the perl module:
#https://metacpan.org/pod/Text::ANSI::Util
#(saves up all ansi color codes since previous color reset and replays the saved codes after our highlighting is done)
#(saves up all ansi colour codes since previous colour reset and replays the saved codes after our highlighting is done)
}
@ -2322,8 +2906,8 @@ namespace eval punk::ansi::ta {
}
# -- --- --- --- --- ---
#Split $text to a list containing alternating ANSI color codes and text.
#ANSI color codes are always on the second element, fourth, and so on.
#Split $text to a list containing alternating ANSI colour codes and text.
#ANSI colour codes are always on the second element, fourth, and so on.
#(ie plaintext on odd list-indices ansi on even indices)
# Example:
#ta_split_codes "" # => ""

555
src/bootsupport/modules/textblock-0.1.1.tm
Unescape View File

@ -417,7 +417,7 @@ namespace eval textblock {
lappend ansi_codes $code
}
}
set ansival [punk::ansi::codetype::sgr_merge $ansi_codes]
set ansival [punk::ansi::codetype::sgr_merge_singles $ansi_codes]
lappend checked_opts $k $ansival
}
-frametype - -frametype_header - -frametype_body {
@ -756,7 +756,7 @@ namespace eval textblock {
lappend col_ansibase_items $code
}
}
set col_ansibase [punk::ansi::codetype::sgr_merge $col_ansibase_items]
set col_ansibase [punk::ansi::codetype::sgr_merge_singles $col_ansibase_items]
lappend checked_opts $k $col_ansibase
}
-ansireset {
@ -945,6 +945,7 @@ namespace eval textblock {
if {$auto_columns} {
set o_columndata [dict create]
set o_columndefs [dict create]
set o_columnstate [dict create]
}
error "add_row failed to configure with supplied options $opts. Err:\n$errMsg"
}
@ -1005,7 +1006,7 @@ namespace eval textblock {
lappend row_ansibase_items $code
}
}
set row_ansibase [punk::ansi::codetype::sgr_merge $row_ansibase_items]
set row_ansibase [punk::ansi::codetype::sgr_merge_singles $row_ansibase_items]
lappend checked_opts $k $row_ansibase
}
-ansireset {
@ -1050,7 +1051,7 @@ namespace eval textblock {
#The data values are stored by column regardless of whether added row by row
dict for {cidx records} $o_columndata {
dict set o_columndata $cidx [list]
dict set o_columnstates $cidx [dict create maxbodywidthseen 0 maxheaderwidthseen 0]
dict set o_columnstates $cidx [dict create maxwidthbodyseen 0 maxwidthheaderseen 0]
}
}
method clear {} {
@ -1269,10 +1270,10 @@ namespace eval textblock {
set return_headerwidth 0
if {$do_show_header} {
#puts "boxlimitsinfo header $opt_posn: -- boxlimits $header_boxlimits -- boxmap $hdrmap"
set ansibase_header [dict get $o_opts_table -ansibase_header]
set ansibase_header [dict get $o_opts_table -ansibase_header] ;#merged to single during configure
set ansiborder_header [dict get $o_opts_table -ansiborder_header]
if {[dict get $o_opts_table -frametype_header] eq "block"} {
set extrabg [punk::ansi::codetype::sgr_merge [list $ansibase_header] -filter_fg 1]
set extrabg [punk::ansi::codetype::sgr_merge_singles [list $ansibase_header] -filter_fg 1]
set ansiborder_final $ansibase_header$ansiborder_header$extrabg
} else {
set ansiborder_final $ansibase_header$ansiborder_header
@ -1295,7 +1296,7 @@ namespace eval textblock {
]
set framedef_leftbox [textblock::framedef $ftype_header left]
set column_body_width_cache [dict create]
set column_width_cache [dict create]
foreach header $header_list {
@ -1425,26 +1426,28 @@ namespace eval textblock {
set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$next_posn] ]
}
if {![dict exists $column_body_width_cache $spancol]} {
if {![dict exists $column_width_cache $spancol]} {
#puts "-----> get_column_by_index $spancol -position $next_posn"
set spancolinfo [my get_column_by_index $spancol -position $next_posn -return dict]
set cwidth [dict get $spancolinfo bodywidth]
dict set column_body_width_cache $spancol $cwidth
set bwidth [dict get $spancolinfo bodywidth]
set hwidth [dict get $spancolinfo headerwidth]
dict set column_width_cache $spancol bodywidth $bwidth
dict set column_width_cache $spancol headerwidth $hwidth
} else {
set cwidth [dict get $column_body_width_cache $spancol]
set bwidth [dict get $column_width_cache $spancol bodywidth]
}
if {$next_posn eq "right"} {
#This is an unintuitive edge case - review
#spans at tail end are too long when edges are shown if we use cwidth+1 (vlr extends right beyond table)
#spans at tail end are too short if edges are hidden and we use cwidth (short lower horizontal bar)
#spans at tail end are too long when edges are shown if we use bwidth+1 (vlr extends right beyond table)
#spans at tail end are too short if edges are hidden and we use bwidth (short lower horizontal bar)
if {![dict get $o_opts_table -show_edge]} {
set spanwidth [expr {$cwidth+1}]
set spanwidth [expr {$bwidth+1}]
} else {
set spanwidth $cwidth
set spanwidth $bwidth
}
} else {
set spanwidth [expr {$cwidth+1}]
set spanwidth [expr {$bwidth+1}]
}
set header_cell [textblock::frame -width $spanwidth -type [dict get $ftypes header]\
@ -1474,6 +1477,7 @@ namespace eval textblock {
set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$opt_posn] ]
}
set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "]
#set spacemap [list hl "\uFFFF" vl "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
set hblock [textblock::frame -type $spacemap -boxlimits $hlims -ansibase $ansibase_header $hval]
set spanned_frame [overtype::left -experimental test_mode -transparent 1 $spanned_frame $hblock]
}
@ -1482,14 +1486,50 @@ namespace eval textblock {
append part_header $spanned_frame
append part_header \n
} else {
#zero span header
#JMN
if 0 {
#old version - sort of works
set h_lines [lrepeat $rowh ""]
set hcell_blank [join $h_lines \n]
set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "]
set spacemap [list hl "\uFFFF" vl "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
set header_frame [textblock::frame -width 0 -type [dict get $ftypes header]\
-ansibase $ansibase_header \
-boxlimits $hlims -boxmap $spacemap $hcell_blank\
]
append part_header $header_frame\n
} else {
#test version
set hw1 [dict get $o_columnstates $cidx maxwidthheaderseen] ;#headers may be masked by spans, or empty - width may depend more on spans than headers in current column
set hw2 [textblock::width $part_header] ;#widest so far
set hw3 [expr {max($hw1,$hw2)}]
set bw [dict get $o_columnstates $cidx maxwidthbodyseen]
set padwidth [expr {max($hw3,$bw)}]
if {[dict exists $column_width_cache $cidx]} {
set hwidth [dict get $column_width_cache $cidx headerwidth]
set padwidth [expr {max($padwidth,$hwidth)}]
}
#test hack - wider helps stop the breaks - but leaves junk spaces and ansiresets beyond the rhs border of table
#print function overflow 0 fixes?
set padwidth 20
#set bline [string repeat \uFFFF $colwidth]
set bline [string repeat \uFFFF $padwidth]
set h_lines [lrepeat $rowh $bline]
set hcell_blank [::join $h_lines \n]
set spacemap [list hl "\uFFFF" vll "\uFFFF" vlr "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
set header_frame [textblock::frame -width [expr {$padwidth+2}] -type [dict get $ftypes header]\
-ansibase $ansibase_header \
-boxlimits $hlims -boxmap $spacemap $hcell_blank\
]
append part_header $header_frame\n
}
}
incr h
}
@ -1543,30 +1583,56 @@ namespace eval textblock {
set opt_col_ansibase [dict get $o_columndefs $colidx -ansibase] ;#ordinary merge of codes already done in configure_column
set body_ansibase [dict get $o_opts_table -ansibase_body]
set ansibase $body_ansibase$opt_col_ansibase ;#allow col to override body
#set ansibase [punk::ansi::codetype::sgr_merge_singles [list $body_ansibase $opt_col_ansibase]] ;#allow col to override body
set ansibase $body_ansibase$opt_col_ansibase
set body_ansiborder [dict get $o_opts_table -ansiborder_body]
if {[dict get $o_opts_table -frametype] eq "block"} {
#block is the only style where bg colour can fill the frame content area exactly if the L-shaped border elements are styled
#we need to only accept background ansi codes from the columndef ansibase for this
set col_bg [punk::ansi::codetype::sgr_merge [list $opt_col_ansibase] -filter_fg 1] ;#special merge for block borders - don't override fg colours
set col_bg [punk::ansi::codetype::sgr_merge_singles [list $opt_col_ansibase] -filter_fg 1] ;#special merge for block borders - don't override fg colours
set border_ansi $body_ansibase$body_ansiborder$col_bg
} else {
set border_ansi $body_ansibase$body_ansiborder
}
set r 0
foreach c $cells {
set row_ansibase [dict get $o_rowdefs $r -ansibase]
#todo - joinleft,joinright,joindown based on opts in args
#append output [textblock::frame -boxlimits {vll blc hlb} $c]\n
if {[dict get $o_opts_table -frametype] eq "block"} {
set row_ansibase [dict get $o_rowdefs $r -ansibase]
set row_bg ""
if {$row_ansibase ne ""} {
set row_bg [punk::ansi::codetype::sgr_merge [list $row_ansibase] -filter_fg 1]
set row_bg [punk::ansi::codetype::sgr_merge_singles [list $row_ansibase] -filter_fg 1]
}
set ansiborder_body_col_row $border_ansi$row_bg
set ansiborder_final $ansiborder_body_col_row
if 1 {
#$c will always have ansi resets due to overtype::left behaviour
#todo - review overtype
if {[punk::ansi::ta::detect $c]} {
#use only the last ansi sequence in the cell value
#Filter out foreground and use background for ansiborder override
set parts [punk::ansi::ta::split_codes_single $c]
#we have detected ansi - so there will always be at least 3 parts beginning and ending with pt pt,ansi,pt,ansi...,pt
set codes [list]
foreach {pt cd} $parts {
lappend codes $cd
}
#set takebg [lindex $parts end-1]
#set cell_bg [punk::ansi::codetype::sgr_merge_singles [list $takebg] -filter_fg 1]
set cell_bg [punk::ansi::codetype::sgr_merge_singles $codes -filter_fg 1]
#puts "-->>> [ansistring VIEW $cell_bg] <<<--"
set ansiborder_final $ansiborder_body_col_row$cell_bg
#JMN
}
}
set border_ansi_final $border_ansi$row_bg
} else {
set border_ansi_final $border_ansi
set ansiborder_body_col_row $border_ansi
set ansiborder_final $ansiborder_body_col_row
}
set ansibase_final $ansibase$row_ansibase
if {$r == 0} {
if {$r == $rmax} {
@ -1591,7 +1657,7 @@ namespace eval textblock {
set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts top$opt_posn] ]
}
}
set rowframe [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]
set rowframe [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase_final -ansiborder $ansiborder_final -boxlimits $blims -boxmap $bmap -joins $joins $c]
set return_bodywidth [textblock::width $rowframe]
append part_body $rowframe \n
} else {
@ -1609,7 +1675,7 @@ namespace eval textblock {
set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts middle$opt_posn] ]
}
}
append part_body [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n
append part_body [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase_final -ansiborder $ansiborder_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n
}
incr r
}
@ -1695,7 +1761,7 @@ namespace eval textblock {
dict set output headers [list]
for {set i 0} {$i < $num_headers} {incr i} {
set hdr [lindex $headerlist $i]
set header_maxdataheight [my header_height $i]
set header_maxdataheight [my header_height $i] ;#from cached headerstates
set header_colspans [dict get $all_colspans $i]
set this_span [lindex $header_colspans $cidx]
set hdrwidth 0
@ -1772,14 +1838,23 @@ namespace eval textblock {
}
}
}
set cval $cell_ansibase$cval ;#no reset
#set cval $cell_ansibase$cval ;#no reset
set cell_lines [lrepeat $rowh $cell_line_blank]
set cell_blank [join $cell_lines \n]
set cval_lines [split $cval \n]
set cval_lines [concat $cval_lines $cell_lines]
set cval_lines [lrange $cval_lines 0 $rowh-1]
set cval_block [join $cval_lines \n]
#TODO! fix overtype library
set cell [overtype::left -experimental test_mode $cell_ansibase$cell_blank$RST $cval_block]
#set cell [overtype::left -experimental test_mode $cell_ansibase$cell_blank$RST $cval_block]
#set cell [overtype::left -experimental test_mode $cell_blank $cval_block]
set cell [textblock::pad $cval_block -width $colwidth -padchar " " -within_ansi 0 -which right]
#set cell [textblock::pad $cval_block -width $colwidth -padchar " " -within_ansi 0 -which left]
dict lappend output cells $cell
incr r
@ -2130,8 +2205,12 @@ namespace eval textblock {
set table $nextcol
set height [textblock::height $table] ;#only need to get height once at start
} else {
set nextcol [textblock::join [textblock::block $padwidth $height " "] $nextcol]
set table [overtype::left -overflow 1 -experimental test_mode -transparent 1 $table $nextcol]
set nextcol [textblock::join [textblock::block $padwidth $height "\uFFFF"] $nextcol]
set table [overtype::left -overflow 1 -experimental test_mode -transparent \uFFFF $table $nextcol]
#JMN
#set nextcol [textblock::join [textblock::block $padwidth $height "\uFFFF"] $nextcol]
#set table [overtype::left -overflow 1 -experimental test_mode -transparent \uFFFF $table $nextcol]
}
incr padwidth $bodywidth
incr colposn
@ -2144,6 +2223,10 @@ namespace eval textblock {
return "No columns matched"
}
}
method print_bodymatrix {} {
set m [my as_matrix]
$m format 2string
}
#*** !doctools
#[list_end]
@ -2175,6 +2258,150 @@ namespace eval textblock {
$t configure -show_header 1 -ansiborder_header [a+ cyan]
return $t
}
proc periodic {args} {
#For an impressive interactive terminal app (javascript)
# see: https://github.com/spirometaxas/periodic-table-cli
set defaults [dict create\
-return "string"\
-compact 1\
]
dict for {k v} $args {
switch -- $k {
-return - -compact {}
default {
"textblock::periodic unknown option '$k'. Known options: [dict keys $defaults]"
}
}
}
set opts [dict merge $defaults $args]
set opt_return [dict get $opts -return]
#examples ptable.com
set elements [list\
1 H "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" He\
2 Li Be "" "" "" "" "" "" "" "" "" "" B C N O F Ne\
3 Na Mg "" "" "" "" "" "" "" "" "" "" Al Si P S Cl Ar\
4 K Ca Sc Ti V Cr Mn Fe Co Ni Cu Zn Ga Ge As Se Br Kr\
5 Rb Sr Y Zr Nb Mo Tc Ru Rh Pd Ag Cd In Sn Sb Te I Xe\
6 Cs Ba "" Hf Ta W Re Os Ir Pt Au Hg Tl Pb Bi Po At Rn\
7 Fr Ra "" Rf Db Sg Bh Hs Mt Ds Rg Cn Nh Fl Mc Lv Ts Og\
" " " " " " " " " " " " " " " " " " " " " " " " "" "" "" "" "" "" ""\
"" "" "" 6 La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu\
"" "" "" 7 Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md No Lr\
]
set type_colours [list]
set ecat [dict create]
set cat_alkaline_earth [list Be Mg Ca Sr Ba Ra]
set ansi [a+ Web-gold web-black]
foreach e $cat_alkaline_earth {
dict set ecat $e [list ansi $ansi cat alkaline_earth]
}
set cat_reactive_nonmetal [list H C N O F P S Cl Se Br I]
set ansi [a+ Web-lightgreen web-black]
foreach e $cat_reactive_nonmetal {
dict set ecat $e [list ansi $ansi cat reactive_nonmetal]
}
set cat [list Li Na K Rb Cs Fr]
set ansi [a+ Web-Khaki web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat alkali_metals]
}
set cat [list Sc Ti V Cr Mn Fe Co Ni Cu Zn Y Zr Nb Mo Tc Ru Rh Pd Ag Cd Hf Ta W Re Os Ir Pt Au Hg Rf Db Sg Bh Hs]
set ansi [a+ Web-lightsalmon web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat transition_metals]
}
set cat [list Al Ga In Sn Tl Pb Bi Po]
set ansi [a+ Web-lightskyblue web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat post_transition_metals]
}
set cat [list B Si Ge As Sb Te At]
set ansi [a+ Web-turquoise web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat metalloids]
}
set cat [list He Ne Ar Kr Xe Rn]
set ansi [a+ Web-orchid web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat noble_gases]
}
set cat [list Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md No Lr]
set ansi [a+ Web-plum web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat actinoids]
}
set cat [list La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu]
set ansi [a+ Web-tan web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat lanthanoids]
}
set cat [list Mt Ds Rg Cn Nh Fl Mc Lv Ts Og]
set ansi [a+ Web-whitesmoke web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat other]
}
set elements1 [list]
foreach e $elements {
if {[dict exists $ecat $e]} {
set ansi [dict get $ecat $e ansi]
lappend elements1 [textblock::pad $ansi$e -width 2 -which right]
} else {
lappend elements1 $e
}
}
set t [list_as_table 19 $elements1 -return obj]
#todo - keep simple table with symbols as base - map symbols to descriptions etc for more verbose table options
set header_0 [list "" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18]
set c 0
foreach h $header_0 {
$t configure_column $c -headers [list $h] -minwidth 2
incr c
}
for {set c 0} {$c < [$t column_count]} {incr c} {
$t configure_column $c -minwidth 3
}
if {[dict get $opts -compact]} {
$t configure -show_hseps 0
$t configure -show_header 0
$t configure -show_edge 0
} else {
$t configure -show_header 1
}
if {$opt_return eq "string"} {
$t configure -frametype_header light
$t configure -ansiborder_header [a+ web-white]
$t configure -ansibase_header [a+ Web-black]
$t configure -ansibase_body [a+ Web-black]
$t configure -ansiborder_body [a+ web-black]
$t configure -frametype block
set output [textblock::frame -ansiborder [a+ Web-black web-cornflowerblue] -type heavy -title "[a+ Web-black] Periodic Table " [$t print]]
return $output
}
return $t
}
proc list_as_table {table_or_colcount datalist args} {
set defaults [dict create\
-return string\
@ -2447,43 +2674,282 @@ namespace eval textblock {
}
pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- <input/0,indent/1|
pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1|
proc ::textblock::pad {block args} {
set defaults [dict set\
set defaults [dict create\
-padchar " "\
-which "right"\
-width ""\
-overflow 0\
-within_ansi 0\
]
set usage "pad ?-padchar <character>? ?-which right|left|centre? -width <int>"
#review!?
#-within_ansi means after a leading ansi code when doing left pad on all but last line
#-within_ansi means before a trailing ansi code when doing right pad on all but last line
set usage "pad ?-padchar <sp>|<character>? ?-which right|left|centre? ?-width auto|<int>? ?-within_ansi 1|0?"
foreach {k v} $args {
if {$k ni [dict keys $defaults]} {
error "textblock::pad unrecognised option '$k'. Usage: $usage"
switch -- $k {
-padchar - -which - -width - -overflow - -within_ansi {}
default {
error "textblock::pad unrecognised option '$k'. Usage: $usage"
}
}
}
set opts [dict merge $defaults $args]
# -- --- --- --- --- --- --- --- --- ---
set padchar [dict get $opts -padchar]
#if padchar width (screen width) > 1 - length calculations will not be correct
#we will allow tokens longer than 1 - as the caller may want to post-process on the token whilst preserving previous leading/trailing spaces, e.g with a string map
#The caller may also use ansi within the padchar - although it's unlikely to be efficient.
# -- --- --- --- --- --- --- --- --- ---
set known_whiches [list l left r right c center centre]
set which [string tolower [dict get $opts -which]]
if {$which in [list centre center]} {set which "c"}
if {$which in [list left]} {set which "l"}
if {$which in [list right]} {set which "r"}
if {$which ni $known_whiches} {
error "textblock::pad unrecognised value for -which option. Known values $known_whiches"
set opt_which [string tolower [dict get $opts -which]]
switch -- $opt_which {
center - centre - c {
set which c
}
left - l {
set which l
}
right - r {
set which r
}
default {
error "textblock::pad unrecognised value for -which option. Known values $known_whiches"
}
}
# -- --- --- --- --- --- --- --- --- ---
set width [dict get $opts -width]
set opt_width [dict get $opts -width]
switch -- $opt_width {
"" - auto {
set width auto
}
default {
if {![string is integer -strict $opt_width] || $opt_width < 0} {
error "textblock::pad -width must be an integer >=0"
}
set width $opt_width
}
}
# -- --- --- --- --- --- --- --- --- ---
set opt_withinansi [dict get $opts -within_ansi]
switch -- $opt_withinansi {
0 - 1 {}
default {
set opt_withinansi 2
}
}
# -- --- --- --- --- --- --- --- --- ---
if {$width = ""} {
set datawidth [textblock::width $block]
if {$width eq "auto"} {
set width $datawidth
}
set lines [list]
set lnum 0
set parts [punk::ansi::ta::split_codes $block]
set line_chunks [list]
set line_len 0
foreach {pt ansi} $parts {
if {$pt ne ""} {
set has_nl [expr {[string last \n $pt]>=0}]
if {$has_nl} {
set pt [string map [list \r\n \n] $pt]
set partlines [split $pt \n]
} else {
set partlines [list $pt]
}
set last [expr {[llength $partlines]-1}]
set p 0
foreach pl $partlines {
lappend line_chunks $pl
incr line_len [punk::char::ansifreestring_width $pl]
if {$p != $last} {
#do padding
set missing [expr {$width - $line_len}]
if {$missing > 0} {
set pad [string repeat $padchar $missing]
switch -- $which-$opt_withinansi {
r-0 {
lappend line_chunks $pad
}
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
} else {
lappend line_chunks $pad
}
}
r-2 {
lappend line_chunks $pad
}
l-0 {
set line_chunks [linsert $line_chunks 0 $pad]
}
l-1 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
} else {
set line_chunks [linsert $line_chunks 0 $pad]
}
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
}
}
}
lappend lines [::join $line_chunks ""]
set line_chunks [list]
set line_len 0
}
incr p
}
} else {
#we need to store empties in order to insert text in the correct position relative to leading/trailing ansi codes
lappend line_chunks ""
}
#don't let trailing empty ansi affect the line_chunks length
if {$ansi ne ""} {
lappend line_chunks $ansi ;#don't update line_len - review - ansi codes with visible content?
}
}
#pad last line
set missing [expr {$width - $line_len}]
if {$missing > 0} {
set pad [string repeat $padchar $missing]
switch -- $which-$opt_withinansi {
r-0 {
lappend line_chunks $pad
}
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
} else {
lappend line_chunks $pad
}
}
r-2 {
lappend line_chunks $pad
}
l-0 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
} else {
set line_chunks [linsert $line_chunks 0 $pad]
}
}
l-1 {
#set line_chunks [linsert $line_chunks 0 $pad]
set line_chunks [_insert_before_text_or_last_ansi $pad $line_chunks]
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
}
}
}
lappend lines [::join $line_chunks ""]
return [::join $lines \n]
}
#left insertion into a list resulting from punk::ansi::ta::split_codes or split_codes_single
#resulting list is no longer a valid ansisplit list
proc _insert_before_text_or_last_ansi {str ansisplits} {
if {[llength $ansisplits] == 1} {
#ansisplits was a split on plaintext only
return [list $str [lindex $ansisplits 0]]
} elseif {[llength $ansisplits] == 0} {
return [list $str]
}
if {[llength $ansisplits] %2 != 1} {
error "_insert_before_text_or_last_ansi ansisplits list is not a valid resultlist from an ansi split - must be odd number of elements pt,ansi,pt,ansi...pt"
}
set out [list]
set i 0
set i_last_code [expr {[llength $ansisplits]-3}] ;#would normally be -2 - but our i is jumping to each pt - not every element
foreach {pt code} $ansisplits {
if {$pt ne ""} {
return [lappend out $str {*}[lrange $ansisplits $i end]]
}
if {$i == $i_last_code} {
return [lappend out $str {*}[lrange $ansisplits $i end]]
}
#code being empty can only occur when we have reached last pt
#we have returned by then.
lappend out $code
incr i 2
}
error "_insert_before_text_or_last_ansi failed on input str:[ansistring VIEW $str] ansisplits:[ansistring VIEW $ansisplits]"
}
proc pad_test {block} {
set width [textblock::width $block]
set padtowidth [expr {$width + 10}]
set left0 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 0]
set left1 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 1]
set left2 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 2]
set right0 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 0]
set right1 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 1]
set right2 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 2]
set testlist [list "within_ansi 0" $left0 $right0 "within_ansi 1" $left1 $right1 "within_ansi 2" $left2 $right2]
set t [textblock::list_as_table 3 $testlist -return object]
$t configure_column 0 -headers [list "ansi"]
$t configure_column 1 -headers [list "Left"]
$t configure_column 2 -headers [list "Right"]
$t configure -show_header 1
puts stdout [$t print]
return $t
}
proc pad_test2 {blocklist} {
set b 0
set blockinfo [dict create]
foreach block $blocklist {
set width [textblock::width $block]
set padtowidth [expr {$width + 10}]
dict set blockinfo $b left0 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 0]
dict set blockinfo $b left1 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 1]
dict set blockinfo $b left2 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 2]
dict set blockinfo $b right0 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 0]
dict set blockinfo $b right1 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 1]
dict set blockinfo $b right2 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 2]
incr b
}
set r0 [list "0"]
set r1 [list "1"]
set r2 [list "2"]
dict for {b bdict} $blockinfo {
lappend r0 [dict get $blockinfo $b left0] [dict get $blockinfo $b right0]
lappend r1 [dict get $blockinfo $b left1] [dict get $blockinfo $b right1]
lappend r2 [dict get $blockinfo $b left2] [dict get $blockinfo $b right2]
}
set rows [concat $r0 $r1 $r2]
set t [textblock::list_as_table [expr {1 + (2 * [dict size $blockinfo])}] $rows -return object]
$t configure_column 0 -headers [list "" "within_ansi"]
set col 1
dict for {b bdict} $blockinfo {
$t configure_column $col -headers [list "Block $b" "Left"]
$t configure_column $col -header_colspans 2
incr col
$t configure_column $col -headers [list "-" "Right"]
incr col
}
$t configure -show_header 1
puts stdout [$t print]
return $t
}
proc pad_example {} {
set b1 "[a+ green bold][textblock::block 4 4 x]\n[a]"
set b2 "[a+ green bold][textblock::block 4 4 x]\n[a+ Green]"
set b3 "[textblock::testblock 4 rainbow]\n[a]"
set b4 "[textblock::testblock 4 rainbow]\n[a+ Green]"
set t [textblock::pad_test2 [list $b1 $b2 $b3 $b4]]
}
#playing with syntax
pipealias ::textblock::join_width .= {list $lhs [string repeat " " $w1] $rhs [string repeat " " $w2]} {|
/2,col1/1,col2/3
>} punk::lib::lines_as_list -- {|
@ -2501,6 +2967,7 @@ namespace eval textblock {
>} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
>} punk::lib::list_as_lines -- <lhs/0,rhs/1|
proc ::textblock::join1 {args} {
lassign [punk::args::opts_values {
-ansiresets -default 1 -type integer
@ -2573,7 +3040,8 @@ namespace eval textblock {
}
proc ::textblock::trim {block} {
set trimlines []
error "textblock::trim unimplemented"
set trimlines ""
}
pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
@ -2607,10 +3075,11 @@ namespace eval textblock {
append out $2frames_a \n
set 2frames_b [textblock::join [textblock::frame -ansiborder $cyanb -title "plainpunks" $punks] [textblock::frame -ansiborder $greenb -title "fancypunks" $cpunks]]
append out [textblock::frame -title "punks" $2frames_b\n$RST$2frames_a] \n
set fancy [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"]]
set fancy [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"]
set spantable [[spantest] print]
append out [textblock::join $fancy $spantable] \n
append out [textblock::join $fancy " " $spantable] \n
#append out [textblock::frame -title gr $gr0]
append out [textblock::periodic]
return $out
}

774
src/modules/punk/ansi-999999.0a1.0.tm
Unescape View File

@ -325,7 +325,7 @@ namespace eval punk::ansi {
dict set map_special_graphics "\}" \u00a3 ;#pound sign
dict set map_special_graphics ~ \u00b7 ;#middle dot
#see also ansicolor page on wiki https://wiki.tcl-lang.org/page/ANSI+color+control
#see also ansicolour page on wiki https://wiki.tcl-lang.org/page/ANSI+color+control
variable test "blah\033\[1;33mETC\033\[0;mOK"
@ -768,15 +768,535 @@ namespace eval punk::ansi {
normal 22 defaultfg 39 defaultbg 49 overline 53 nooverline 55
frame 51 framecircle 52 noframe 54 underlinedefault 59
}
#unprefixed colours are (close to) the ansi-specified colour names (lower-cased and whitespace collapsed, with capitalisation of 1st letter given fg/bg meaning here)
variable SGR_colour_map {
black 30 red 31 green 32 yellow 33 blue 34 purple 35 cyan 36 white 37
Black 40 Red 41 Green 42 Yellow 43 Blue 44 Purple 45 Cyan 46 White 47
xblack 90 xred 91 xgreen 92 xyellow 93 xblue 94 xpurple 95 xcyan 96 xwhite 97
BLACK 100 RED 101 GREEN 102 YELLOW 103 BLUE 104 PURPLE 105 CYAN 106 WHITE 107
brightblack 90 brightred 91 brightgreen 92 brightyellow 93 brightblue 94 brightpurple 95 brightcyan 96 brightwhite 97
Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblue 104 Brightpurple 105 Brightcyan 106 Brightwhite 107
}
variable SGR_map ;#public - part of interface - review
set SGR_map [dict merge $SGR_colour_map $SGR_setting_map]
#we use prefixes e.g web-white and/or x11-white
#Only a leading capital letter will indicate the colour target is background vs lowercase for foreground
#In the map key-lookup context the colour names will be canonically lower case
#We should be case insensitive in the non-prefix part ie after determining fg/bg target from first letter of the prefix
#e.g Web-Lime or Web-lime are ok and are targeting background
#foreground target examples: web-Lime web-LIME web-DarkSalmon web-Darksalmon
#specified in decimal - but we should also accept hex format directly in a+ function e.g #00FFFF for aqua
variable WEB_colour_map
#use the totitle format as the canonical lookup key
#don't use leading zeros - keep compatible with earlier tcl and avoid octal issue
# -- --- ---
#css 1-2.0 HTML 3.2-4 Basic colours eg web-silver for fg Web-silver for bg
#
dict set WEB_colour_map white 255-255-255 ;# #FFFFFF
dict set WEB_colour_map silver 192-192-192 ;# #C0C0C0
dict set WEB_colour_map gray 128-128-128 ;# #808080
dict set WEB_colour_map black 0-0-0 ;# #000000
dict set WEB_colour_map red 255-0-0 ;# #FF0000
dict set WEB_colour_map maroon 128-0-0 ;# #800000
dict set WEB_colour_map yellow 255-255-0 ;# #FFFF00
dict set WEB_colour_map olive 128-128-0 ;# #808000
dict set WEB_colour_map lime 0-255-0 ;# #00FF00
dict set WEB_colour_map green 0-128-0 ;# #008000
dict set WEB_colour_map aqua 0-255-255 ;# #00FFFF
dict set WEB_colour_map teal 0-128-128 ;# #008080
dict set WEB_colour_map blue 0-0-255 ;# #0000FF
dict set WEB_colour_map navy 0-0-128 ;# #000080
dict set WEB_colour_map fuchsia 255-0-255 ;# #FF00FF
dict set WEB_colour_map purple 128-0-128 ;# #800080
# -- --- ---
#Pink colours
dict set WEB_colour_map mediumvioletred 199-21-133 ;# #C71585
dict set WEB_colour_map deeppink 255-20-147 ;# #FF1493
dict set WEB_colour_map palevioletred 219-112-147 ;# #DB7093
dict set WEB_colour_map hotpink 255-105-180 ;# #FF69B4
dict set WEB_colour_map lightpink 255-182-193 ;# #FFB6C1
dict set WEB_colour_map pink 255-192-203 ;# #FFCOCB
# -- --- ---
#Red colours
dict set WEB_colour_map darkred 139-0-0 ;# #8B0000
#red - as above
dict set WEB_colour_map firebrick 178-34-34 ;# #B22222
dict set WEB_colour_map crimson 220-20-60 ;# #DC143C
dict set WEB_colour_map indianred 205-92-92 ;# #CD5C5C
dict set WEB_colour_map lightcoral 240-128-128 ;# #F08080
dict set WEB_colour_map salmon 250-128-114 ;# #FA8072
dict set WEB_colour_map darksalmon 233-150-122 ;# #E9967A
dict set WEB_colour_map lightsalmon 255-160-122 ;# #FFA07A
# -- --- ---
#Orange colours
dict set WEB_colour_map orangered 255-69-0 ;# #FF4500
dict set WEB_colour_map tomato 255-99-71 ;# #FF6347
dict set WEB_colour_map darkorange 255-140-0 ;# #FF8C00
dict set WEB_colour_map coral 255-127-80 ;# #FF7F50
dict set WEB_colour_map orange 255-165-0 ;# #FFA500
# -- --- ---
#Yellow colours
dict set WEB_colour_map darkkhaki 189-183-107 ;# #BDB76B
dict set WEB_colour_map gold 255-215-0 ;# #FFD700
dict set WEB_colour_map khaki 240-230-140 ;# #F0E68C
dict set WEB_colour_map peachpuff 255-218-185 ;# #FFDAB9
#yellow - as above
dict set WEB_colour_map palegoldenrod 238-232-170 ;# #EEE8AA
dict set WEB_colour_map moccasin 255-228-181 ;# #FFE4B5
dict set WEB_colour_map papayawhip 255-239-213 ;# #FFEFD5
dict set WEB_colour_map lightgoldenrodyeallow 250-250-210 ;# #FAFAD2
dict set WEB_colour_map lemonchiffon 255-250-205 ;# #FFFACD
dict set WEB_colour_map lightyellow 255-255-224 ;# #FFFFE0
# -- --- ---
#Brown colours
#maroon as above
dict set WEB_colour_map brown 165-42-42 ;# #A52A2A
dict set WEB_colour_map saddlebrown 139-69-19 ;# #8B4513
dict set WEB_colour_map sienna 160-82-45 ;# #A0522D
dict set WEB_colour_map chocolate 210-105-30 ;# #D2691E
dict set WEB_colour_map darkgoldenrod 184-134-11 ;# #B8860B
dict set WEB_colour_map peru 205-133-63 ;# #CD853F
dict set WEB_colour_map rosybrown 188-143-143 ;# #BC8F8F
dict set WEB_colour_map goldenrod 218-165-32 ;# #DAA520
dict set WEB_colour_map sandybrown 244-164-96 ;# #F4A460
dict set WEB_colour_map tan 210-180-140 ;# #D2B48C
dict set WEB_colour_map burlywood 222-184-135 ;# #DEB887
dict set WEB_colour_map wheat 245-222-179 ;# #F5DEB3
dict set WEB_colour_map navajowhite 255-222-173 ;# #FFDEAD
dict set WEB_colour_map bisque 255-228-196 ;# #FFEfC4
dict set WEB_colour_map blanchedalmond 255-228-196 ;# #FFEfC4
dict set WEB_colour_map cornsilk 255-248-220 ;# #FFF8DC
# -- --- ---
#Purple, violet, and magenta colours
dict set WEB_colour_map indigo 75-0-130 ;# #4B0082
#purple as above
dict set WEB_colour_map darkmagenta 139-0-139 ;# #8B008B
dict set WEB_colour_map darkviolet 148-0-211 ;# #9400D3
dict set WEB_colour_map darkslateblue 72-61-139 ;# #9400D3
dict set WEB_colour_map blueviolet 138-43-226 ;# #8A2BE2
dict set WEB_colour_map darkorchid 153-50-204 ;# #9932CC
#fuchsia as above
dict set WEB_colour_map magenta 255-0-255 ;# #FF00FF - same as fuchsia
dict set WEB_colour_map slateblue 106-90-205 ;# #6A5ACD
dict set WEB_colour_map mediumslateblue 123-104-238 ;# #7B68EE
dict set WEB_colour_map mediumorchid 186-85-211 ;# #BA5503
dict set WEB_colour_map mediumpurple 147-112-219 ;# #9370DB
dict set WEB_colour_map orchid 218-112-214 ;# #DA70D6
dict set WEB_colour_map violet 238-130-238 ;# #EE82EE
dict set WEB_colour_map plum 221-160-221 ;# #DDA0DD
dict set WEB_colour_map thistle 216-191-216 ;# #D88FD8
dict set WEB_colour_map lavender 230-230-150 ;# #E6E6FA
# -- --- ---
#Blue colours
dict set WEB_colour_map midnightblue 25-25-112 ;# #191970
#navy as above
dict set WEB_colour_map darkblue 0-0-139 ;# #00008B
dict set WEB_colour_map mediumblue 0-0-205 ;# #0000CD
#blue as above
dict set WEB_colour_map royalblue 65-105-225 ;# #4169E1
dict set WEB_colour_map steelblue 70-130-180 ;# #4682B4
dict set WEB_colour_map dodgerblue 30-144-255 ;# #1E90FF
dict set WEB_colour_map deepskyblue 0-191-255 ;# #00BFFF
dict set WEB_colour_map cornflowerblue 100-149-237 ;# #6495ED
dict set WEB_colour_map skyblue 135-206-235 ;# #87CEEB
dict set WEB_colour_map lightskyblue 135-206-250 ;# #87CEFA
dict set WEB_colour_map lightsteelblue 176-196-222 ;# #B0C4DE
dict set WEB_colour_map lightblue 173-216-230 ;# #ADD8E6
dict set WEB_colour_map powderblue 176-224-230 ;# #B0E0E6
# -- --- ---
#Cyan colours
#teal as above
dict set WEB_colour_map darkcyan 0-139-139 ;# #008B8B
dict set WEB_colour_map lightseagreen 32-178-170 ;# #20B2AA
dict set WEB_colour_map cadetblue 95-158-160 ;# #5F9EA0
dict set WEB_colour_map darkturquoise 0-206-209 ;# #00CED1
dict set WEB_colour_map mediumturquoise 72-209-204 ;# #48D1CC
dict set WEB_colour_map turquoise 64-224-208 ;# #40E0D0
#aqua as above
dict set WEB_colour_map cyan 0-255-255 ;# #00FFFF - same as aqua
dict set WEB_colour_map aquamarine 127-255-212 ;# #7FFFD4
dict set WEB_colour_map paleturquoise 175-238-238 ;# #AFEEEE
dict set WEB_colour_map lightcyan 224-255-255 ;# #E0FFFF
# -- --- ---
#Green colours
dict set WEB_colour_map darkgreen 0-100-0 ;# #006400
#green as above
dict set WEB_colour_map darkolivegreen 85-107-47 ;# #55682F
dict set WEB_colour_map forestgreen 34-139-34 ;# #228B22
dict set WEB_colour_map seagrean 46-139-87 ;# #2E8B57
#olive as above
dict set WEB_colour_map olivedrab 107-142-35 ;# #6B8E23
dict set WEB_colour_map mediumseagreen 60-179-113 ;# #3CB371
dict set WEB_colour_map limegreen 50-205-50 ;# #32CD32
#lime as above
dict set WEB_colour_map springgreen 0-255-127 ;# #00FF7F
dict set WEB_colour_map mediumspringgreen 0-250-154 ;# #00FA9A
dict set WEB_colour_map darkseagreen 143-188-143 ;# #8FBC8F
dict set WEB_colour_map mediumaquamarine 102-205-170 ;# #66CDAA
dict set WEB_colour_map yellowgreen 154-205-50 ;# #9ACD32
dict set WEB_colour_map lawngreen 124-252-0 ;# #7CFC00
dict set WEB_colour_map chartreuse 127-255-0 ;# #7FFF00
dict set WEB_colour_map lightgreen 144-238-144 ;# #90EE90
dict set WEB_colour_map greenyellow 173-255-47 ;# #ADFF2F
dict set WEB_colour_map palegreen 152-251-152 ;# #98FB98
# -- --- ---
#White colours
dict set WEB_colour_map mistyrose 255-228-225 ;# #FFE4E1
dict set WEB_colour_map antiquewhite 250-235-215 ;# #FAEBD7
dict set WEB_colour_map linen 250-240-230 ;# #FAF0E6
dict set WEB_colour_map beige 245-245-220 ;# #F5F5DC
dict set WEB_colour_map whitesmoke 245-245-245 ;# #F5F5F5
dict set WEB_colour_map lavenderblush 255-240-245 ;# #FFF0F5
dict set WEB_colour_map oldlace 253-245-230 ;# #FDF5E6
dict set WEB_colour_map aliceblue 240-248-255 ;# #F0F8FF
dict set WEB_colour_map seashell 255-245-238 ;# #FFF5EE
dict set WEB_colour_map ghostwhite 248-248-255 ;# #F8F8FF
dict set WEB_colour_map honeydew 240-255-240 ;# #F0FFF0
dict set WEB_colour_map floralwhite 255-250-240 ;# #FFFAF0
dict set WEB_colour_map azure 240-255-255 ;# #F0FFFF
dict set WEB_colour_map mintcream 245-255-250 ;# #F5FFFA
dict set WEB_colour_map snow 255-250-250 ;# #FFFAFA
dict set WEB_colour_map ivory 255-255-240 ;# #FFFFF0
#white as above
# -- --- ---
#Gray and black colours
#black as above
dict set WEB_colour_map darkslategray 47-79-79 ;# #2F4F4F
dict set WEB_colour_map dimgray 105-105-105 ;# #696969
dict set WEB_colour_map slategray 112-128-144 ;# #708090
#gray as above
dict set WEB_colour_map lightslategray 119-136-153 ;# #778899
dict set WEB_colour_map darkgray 169-169-169 ;# #A9A9A9
dict set WEB_colour_map silver 192-192-192 ;# #C0C0C0
dict set WEB_colour_map lightgray 211-211-211 ;# #D3D3D3
dict set WEB_colour_map gainsboro 220-220-220 ;# #DCDCDC
#we should be able to use WEB_colour_map as a base and override only the conflicts for X11 colours ? Review - check if this is true
variable X11_colour_map
set X11_colour_map $WEB_colour_map
dict set X11_colour_map gray 190-190-190 ;# #BEBEBE
dict set X11_colour_map green 0-255-0 ;# #00FF00
dict set X11_colour_map maroon 176-48-96 ;# #B03060
dict set X11_colour_map purple 160-32-240 ;# #A020F0
#Xterm colour names (256 colours)
#lists on web have duplicate names
#these have been renamed here in a systematic way:
#They are suffixed with a dash and a letter e.g second deepskyblue4 -> deepskyblue4-b, third deepskyblue4 -> deepskyblue4-c
#presumably the xterm colour names are not widely used or are used for reverse lookup from rgb to get an approximate name in the case of dupes?
#Review!
#keep duplicate names in the list and map them when building the dict.
#This is an in depth analysis of the xterm colour set which gives names(*) to all of the 256 colours and describes possible indexing by Hue,Luminance,Saturation
#https://www.wowsignal.io/articles/xterm256
#*The names are wildly-imaginative, often unintuitively so, and multiple (5?) given for each colour - so they are unlikely to be of practical use or any sort of standard.
#e.g who is to know that 'Rabbit Paws', 'Forbidden Thrill' and 'Tarsier' refer to a particular shade of pinky-red? (code 95)
#Perhaps it's an indication that colour naming once we get to 256 colours or more is a fool's errand anyway.
#The xterm names are boringly unimaginative - and also have some oddities such as:
# DarkSlateGray1 which looks much more like cyan..
# The greyxx names are spelt with an e - but the darkslategrayX variants use an a. Perhaps that's because they are more cyan than grey and the a is a hint?
# there is no gold or gold2 - but there is gold1 and gold3
#but in general the names bear some resemblance to the colours and are at least somewhat intuitive.
set xterm_names [list\
black\
maroon\
green\
olive\
navy\
purple\
teal\
silver\
grey\
red\
lime\
yellow\
blue\
fuchsia\
aqua\
white\
grey0\
navyblue\
darkblue\
blue3\
blue3\
blue1\
darkgreen\
deepskyblue4\
deepskyblue4\
deepskyblue4\
dodgerblue3\
dodgerblue2\
green4\
springgreen4\
turquise4\
deepskyblue3\
deepskyblue3\
dodgerblue1\
green3\
springgreen3\
darkcyan\
lightseagreen\
deepskyblue2\
deepskyblue1\
green3\
springgreen3\
springgreen2\
cyan3\
darkturquoise\
turquoise2\
green1\
springgreen2\
springgreen1\
mediumspringgreen\
cyan2\
cyan1\
darkred\
deeppink4\
purple4\
purple4\
purple3\
blueviolet\
orange4\
grey37\
mediumpurple4\
slateblue3\
slateblue3\
royalblue1\
chartreuse4\
darkseagreen4\
paleturquoise4\
steelblue\
steelblue3\
cornflowerblue\
chartreuse3\
darkseagreen4\
cadetblue\
cadetblue\
skyblue3\
steelblue1\
chartreuse3\
palegreen3\
seagreen3\
aquamarine3\
mediumturquoise\
steelblue1\
chartreuse2\
seagreen2\
seagreen1\
seagreen1\
aquamarine1\
darkslategray2\
darkred\
deeppink4\
darkmagenta\
darkmagenta\
darkviolet\
purple\
orange4\
lightpink4\
plum4\
mediumpurple3\
mediumpurple3\
slateblue1\
yellow4\
wheat4\
grey53\
lightslategrey\
mediumpurple\
lightslateblue\
yellow4\
darkolivegreen3\
darkseagreen\
lightskyblue3\
lightskyblue3\
skyblue2\
chartreuse2\
darkolivegreen3\
palegreen3\
darkseagreen3\
darkslategray3\
skyblue1\
chartreuse1\
lightgreen\
lightgreen\
palegreen1\
aquamarine1\
darkslategray1\
red3\
deeppink4\
mediumvioletred\
magenta3\
darkviolet\
purple\
darkorange3\
indianred\
hotpink3\
mediumorchid3\
mediumorchid\
mediumpurple2\
darkgoldenrod\
lightsalmon3\
rosybrown\
grey63\
mediumpurple2\
mediumpurple1\
gold3\
darkkhaki\
navajowhite\
grey69\
lightsteelblue3\
lightsteelblue\
yellow3\
darkolivegreen3\
darkseagreen3\
darkseagreen2\
lightcyan3\
lightskyblue1\
greenyellow\
darkolivegreen2\
palegreen1\
darkseagreen2\
darkseagreen1\
paleturquoise1\
red3\
deppink3\
deeppink3\
magenta3\
magenta3\
magenta2\
darkorange3\
indianred\
hotpink3\
hotpink2\
orchid\
mediumorchid1\
orange3\
lightsalmon3\
lightpink3\
pink3\
plum3\
violet\
gold3\
lightgoldenrod3\
tan\
mistyrose3\
thistle3\
plum2\
yellow3\
khaki3\
lightgoldenrod2\
lightyellow3\
grey84\
lightsteelblue1\
yellow2\
darkolivegreen1\
darkolivegreen1\
darkseagreen1\
honeydew2\
lightcyan1\
red1\
deeppink2\
deeppink1\
deeppink1\
magenta2\
magenta1\
orangered1\
indianred1\
indianred1\
hotpink\
hotpink\
mediumorchid1\
darkorange\
salmon1\
lightcoral\
palevioletred1\
orchid2\
orchid1\
orange1\
sandybrown\
lightsalmon1\
lightpink1\
pink1\
plum1\
gold1\
lightgoldenrod2\
lightgoldenrod2\
navajowhite1\
mistyrose1\
thistle1\
yellow1\
lightgoldenrod1\
khaki1\
wheat1\
cornsilk1\
grey100\
grey3\
grey7\
grey11\
grey11\
grey15\
grey19\
grey23\
grey27\
grey30\
grey35\
grey39\
grey42\
grey46\
grey50\
grey54\
grey58\
grey62\
grey66\
grey70\
grey74\
grey78\
grey82\
grey85\
grey89\
grey93\
]
variable TERM_colour_map
set TERM_colour_map [dict create]
set cidx 0
foreach cname $xterm_names {
if {![dict exists $TERM_colour_map $cname]} {
dict set TERM_colour_map $cname $cidx
} else {
set did_rename 0
#start suffixes at '-b'. The base name could be considered the '-a' version - but we don't create it.
foreach {suffix} {b c} {
if {![dict exists $TERM_colour_map $cname-$suffix]} {
dict set TERM_colour_map $cname-$suffix $cidx
set did_rename 1
break
}
}
if {!$did_rename} {
error "Not enough suffixes for duplicate names in xterm colour list. Add more suffixes or review list"
}
}
incr cidx
}
#colour_hex2dec
#conversion of hex to format directly pluggable to ansi rgb format (colon separated e.g for foreground we need "38;2;$r;$g;$b" so we return $r;$g;$b)
#we want to support arbitrary rgb values specified in hex - so a table of 16M+ is probably not a great idea
#hex zero-padded - canonically upper case but mixed or lower accepted
#dict for {k v} $WEB_colour_map {
# set dectriple [split $v -]
# set webhex [::join [format %02X%02X%02X {*}$dectriple] ;# e.g 808080, FFFFFF, 000000
# dict set HEX_colour_map $webhex [join $dectriple {;}]
#}
proc colour_hex2dec {hex6} {
return [join [::scan $hex6 %2X%2X%2X] {;}]
}
proc get_sgr_map {} {
variable SGR_map
return $SGR_map
@ -786,23 +1306,62 @@ namespace eval punk::ansi {
package require textblock
set bg [textblock::block 33 3 "[a+ $bgname] [a]"]
set colormap ""
set colourmap ""
for {set i 0} {$i <= 7} {incr i} {
append colormap "_[a+ white bold 48\;5\;$i] $i [a]"
append colourmap "_[a+ white bold 48\;5\;$i] $i [a]"
}
set map1 [overtype::left -transparent _ $bg "\n$colormap"]
set map1 [overtype::left -transparent _ $bg "\n$colourmap"]
return $map1
}
proc colourmap2 {{bgname White}} {
package require textblock
set bg [textblock::block 39 3 "[a+ $bgname] [a]"]
set colormap ""
set colourmap ""
for {set i 8} {$i <= 15} {incr i} {
append colormap "_[a+ black normal 48\;5\;$i] $i [a]" ;#black normal is blacker than black bold - which often displays as a grey
append colourmap "_[a+ black normal 48\;5\;$i] $i [a]" ;#black normal is blacker than black bold - which often displays as a grey
}
set map2 [overtype::left -transparent _ $bg "\n$colormap"]
set map2 [overtype::left -transparent _ $bg "\n$colourmap"]
return $map2
}
proc colourtable_216 {} {
package require textblock
set clist [list]
set fg black
for {set i 16} {$i <=231} {incr i} {
if {$i % 18 == 16} {
if {$fg eq "black"} {
set fg "bold white"
} else {
set fg "black"
}
}
lappend clist "[a+ {*}$fg Term$i][format %3s $i]"
}
set t [textblock::list_as_table 36 $clist -return object]
$t configure -show_hseps 0
#return [$t print]
return $t
}
proc colourblock_216 {} {
set out ""
set fg black
for {set i 16} {$i <=231} {incr i} {
if {$i % 18 == 16} {
if {$fg eq "black"} {
set fg "bold white"
} else {
set fg "black"
}
set br "\n"
} else {
set br ""
}
append out "$br[a+ {*}$fg Term$i][format %3s $i] "
}
return $out
}
proc a? {args} {
#*** !doctools
#[call [fun a?] [opt {ansicode...}]]
@ -825,17 +1384,18 @@ namespace eval punk::ansi {
append out [textblock::join $map1 " " $map2] \n
#append out $map1[a] \n
#append out $map2[a] \n
append out [colourblock_216]
} on error {result options} {
puts stderr "Failed to draw colormap"
puts stderr "Failed to draw colourmap"
puts stderr "$result"
} finally {
return $out
}
} else {
set result [list]
set map [dict merge $SGR_setting_map $SGR_colour_map]
set rmap [lreverse $map]
foreach i $args {
if {[string is integer -strict $i]} {
@ -864,6 +1424,10 @@ namespace eval punk::ansi {
#don't disable ansi here.
#we want this to be available to call even if ansi is off
variable SGR_map
variable WEB_colour_map
variable TERM_colour_map
variable X11_colour_map
set t [list]
foreach i $args {
if {[string is integer -strict $i]} {
@ -873,98 +1437,110 @@ namespace eval punk::ansi {
lappend t $i
} else {
if {[dict exists $SGR_map $i]} {
#SGR case must match exactly those in the map
lappend t [dict get $SGR_map $i]
} else {
#accept examples for foreground
# 256f-# or 256fg-# or 256f#
# 256f-<int> or 256fg-<int> or 256f<int>
# rgbf-<r>-<g>-<b> or rgbfg-<r>-<g>-<b> or rgbf<r>-<g>-<b>
switch -nocase -glob -- $i {
"256f*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "38;5;$cc"
switch -- [string range $i 0 3] {
term {
#256 colour foreground by Xterm name or by integer
#name is xterm name or colour index from 0 - 255
set cc [string trim [string tolower [string range $i 4 end]] -]
if {[string is integer -strict $cc]} {
lappend t "38;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
set cc [dict get $TERM_colour_map $cc]
lappend t "38;5;$cc"
}
}
}
"256b*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "48;5;$cc"
Term - TERM {
#256 colour background by Xterm name or by integer
set cc [string trim [string tolower [string range $i 4 end]] -]
if {[string is integer -strict $cc]} {
lappend t "48;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
set cc [dict get $TERM_colour_map $cc]
lappend t "48;5;$cc"
}
}
}
"rgbf*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "38;2;$r;$g;$b"
rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 {
#decimal rgb foreground
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "38;2;$rgb"
}
"rgbb*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "48;2;$r;$g;$b"
Rgb- - RGB- - Rgb0 - Rgb1 - Rgb2 - Rgb3 - Rgb4 - Rgb5 - Rgb6 - Rgb7 - Rgb8 - Rgb9 - RGB0 - RGB1 - RGB2 - RGB3 - RGB4 - RGB5 - RGB6 - RGB7 - RGB8 - RGB9 {
#decimal rgb background
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "48;2;$rgb"
}
}
}
}
}
# \033 - octal. equivalently \x1b in hex which is more common in documentation
if {![llength $t]} {
return "" ;# a+ nonexistent should return nothing rather than a reset ( \033\[\;m is a reset even without explicit zero(s))
}
return "\x1b\[[join $t {;}]m"
}
proc a2 {args} {
#*** !doctools
#[call [fun a] [opt {ansicode...}]]
#[para]Returns the ansi code to reset any current settings and apply those from the supplied list
#[para] by calling punk::ansi::a with no arguments - the result is a reset to plain text
#[para] e.g to set foreground red and bold
#[para]punk::ansi::a red bold
#[para]to set background red
#[para]punk::ansi::a Red
#[para]see [cmd punk::ansi::a?] to display a list of codes
#don't disable ansi here.
#we want this to be available to call even if ansi is off
variable SGR_map
set t [list]
foreach i $args {
if {[dict exists $SGR_map $i]} {
lappend t [dict get $SGR_map $i]
} else {
if {[string is integer -strict $i]} {
lappend t $i
} elseif {[string first ";" $i] >=0} {
#literal with params
lappend t $i
} else {
#accept examples for foreground
# 256f-# or 256fg-# or 256f#
# rgbf-<r>-<g>-<b> or rgbfg-<r>-<g>-<b> or rgbf<r>-<g>-<b>
switch -nocase -glob -- $i {
"256f*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "38;5;$cc"
"rgb#" {
#hex rgb foreground
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "38;2;$rgb"
}
"256b*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "48;5;$cc"
"Rgb#" - "RGB#" {
#hex rgb background
set hex6 [string trim [string range $i 4 end] -]
set rgb [join [::scan $hex6 %2X%2X%2X] {;}]
lappend t "48;2;$rgb"
}
"rgbf*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "38;2;$r;$g;$b"
web- {
#foreground web colour
set cname [string tolower [string range $i 4 end]]
if {[dict exists $WEB_colour_map $cname]} {
set rgbdash [dict get $WEB_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "38;2;$rgb"
}
}
"rgbb*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "48;2;$r;$g;$b"
Web- - WEB- {
#background web colour
set cname [string tolower [string range $i 4 end]]
if {[dict exists $WEB_colour_map $cname]} {
set rgbdash [dict get $WEB_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "48;2;$rgb"
}
}
x11- {
#foreground X11 names
set cname [string tolower [string range $i 4 end]]
if {[dict exists $X11_colour_map $cname]} {
set rgbdash [dict get $X11_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "38;2;$rgb"
}
}
X11- {
#background X11 names
set cname [string tolower [string range $i 4 end]]
if {[dict exists $X11_colour_map $cname]} {
set rgbdash [dict get $X11_colour_map $cname]
set rgb [string map [list - {;}] $rgbdash]
lappend t "48;2;$rgb"
}
}
}
}
}
}
# \033 - octal. equivalently \x1b in hex which is more common in documentation
# empty list [a=] should do reset - same for [a= nonexistant]
# explicit reset at beginning of parameter list for a= (as opposed to a+)
set t [linsert $t 0 0]
if {![llength $t]} {
return "" ;# a+ nonexistent should return nothing rather than a reset ( \033\[\;m is a reset even without explicit zero(s))
}
return "\x1b\[[join $t {;}]m"
}
proc a {args} {
#*** !doctools
#[call [fun a] [opt {ansicode...}]]
@ -1668,7 +2244,7 @@ namespace eval punk::ansi {
#However - detecting zero or empty parameter in other positions requires knowing all other codes that may allow zero or empty params.
#We only look at the initial parameter within the trailing SGR code as this is the well-formed normal case.
#Review - consider normalizing sgr codes to remove other redundancies such as setting fg or bg color twice in same code
#Review - consider normalizing sgr codes to remove other redundancies such as setting fg or bg colour twice in same code
proc has_sgr_leadingreset {code} {
#*** !doctools
#[call [fun has_sgr_leadingreset] [arg code]]
@ -1736,7 +2312,7 @@ namespace eval punk::ansi {
dict set codestate_empty ideogram_clear ""
dict set codestate_empty overline "" ;#53 on 55 off - probably not supported - pass through.
dict set codestate_empty underlinecolour "" ;#58 - same arguments as 256color and rgb (nonstandard - in Kitty ,VTE,mintty and iTerm2)
dict set codestate_empty underlinecolour "" ;#58 - same arguments as 256colour and rgb (nonstandard - in Kitty ,VTE,mintty and iTerm2)
# -- mintty?
dict set codestate_empty superscript "" ;#73
@ -1758,11 +2334,19 @@ namespace eval punk::ansi {
}
sgr_merge $args
}
proc sgr_merge {codelist args} {
set allparts [list]
foreach c $codelist {
set cparts [punk::ansi::ta::split_codes_single $c]
lappend allparts {*}[lsearch -all -inline -not $cparts ""]
}
sgr_merge_singles $allparts {*}$args
}
#codes *must* already have been split so that one esc per element in codelist
#e.g codelist [a+ Yellow Red underline] [a+ blue] [a+ red] is ok
#but codelist "[a+ Yellow Red underline][a+ blue]" [a+ red] is not
#(use punk::ansi::ta::split_codes_single)
proc sgr_merge {codelist args} {
proc sgr_merge_singles {codelist args} {
variable codestate_empty
set othercodes [list]
@ -1807,7 +2391,7 @@ namespace eval punk::ansi {
#set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m
set params [string range $cnorm 4 end-1] ;#string leading XCSI and trailing m
#some systems use colon for 256 colors or RGB or nonstandard subparameters
#some systems use colon for 256 colours or RGB or nonstandard subparameters
#- it is therefore probably not ok to map to semicolon within SGR codes and treat the same.
# - will break mintty? set params [string map [list : {;}] $params]
set plist [split $params {;}]
@ -1939,7 +2523,7 @@ namespace eval punk::ansi {
dict set codestate fg $p ;#foreground colour
}
38 {
#256 color or rgb
#256 colour or rgb
#check if subparams supplied as colon separated
if {[string first : $p] < 0} {
switch -- [lindex $plist $i+1] {
@ -1955,7 +2539,7 @@ namespace eval punk::ansi {
}
}
} else {
#apparently subparameters can be left empty - and there are other subparams like transparency and color-space
#apparently subparameters can be left empty - and there are other subparams like transparency and colour-space
#we should only need to pass it all through for the terminal to understand
#review
dict set codestate fg $p
@ -1968,7 +2552,7 @@ namespace eval punk::ansi {
dict set codestate bg $p ;#background colour
}
48 {
#256 color or rgb
#256 colour or rgb
if {[string first : $p] < 0} {
switch -- [lindex $plist $i+1] {
5 {
@ -2006,7 +2590,7 @@ namespace eval punk::ansi {
}
58 {
#nonstandard
#256 color or rgb
#256 colour or rgb
if {[string first : $p] < 0} {
switch -- [lindex $plist $i+1] {
5 {
@ -2162,7 +2746,7 @@ namespace eval punk::ansi {
# -- --- --- --- --- --- --- --- --- --- ---
#todo - implement colour resets like the perl module:
#https://metacpan.org/pod/Text::ANSI::Util
#(saves up all ansi color codes since previous color reset and replays the saved codes after our highlighting is done)
#(saves up all ansi colour codes since previous colour reset and replays the saved codes after our highlighting is done)
}
@ -2322,8 +2906,8 @@ namespace eval punk::ansi::ta {
}
# -- --- --- --- --- ---
#Split $text to a list containing alternating ANSI color codes and text.
#ANSI color codes are always on the second element, fourth, and so on.
#Split $text to a list containing alternating ANSI colour codes and text.
#ANSI colour codes are always on the second element, fourth, and so on.
#(ie plaintext on odd list-indices ansi on even indices)
# Example:
#ta_split_codes "" # => ""

555
src/modules/textblock-999999.0a1.0.tm
Unescape View File

@ -417,7 +417,7 @@ namespace eval textblock {
lappend ansi_codes $code
}
}
set ansival [punk::ansi::codetype::sgr_merge $ansi_codes]
set ansival [punk::ansi::codetype::sgr_merge_singles $ansi_codes]
lappend checked_opts $k $ansival
}
-frametype - -frametype_header - -frametype_body {
@ -756,7 +756,7 @@ namespace eval textblock {
lappend col_ansibase_items $code
}
}
set col_ansibase [punk::ansi::codetype::sgr_merge $col_ansibase_items]
set col_ansibase [punk::ansi::codetype::sgr_merge_singles $col_ansibase_items]
lappend checked_opts $k $col_ansibase
}
-ansireset {
@ -945,6 +945,7 @@ namespace eval textblock {
if {$auto_columns} {
set o_columndata [dict create]
set o_columndefs [dict create]
set o_columnstate [dict create]
}
error "add_row failed to configure with supplied options $opts. Err:\n$errMsg"
}
@ -1005,7 +1006,7 @@ namespace eval textblock {
lappend row_ansibase_items $code
}
}
set row_ansibase [punk::ansi::codetype::sgr_merge $row_ansibase_items]
set row_ansibase [punk::ansi::codetype::sgr_merge_singles $row_ansibase_items]
lappend checked_opts $k $row_ansibase
}
-ansireset {
@ -1050,7 +1051,7 @@ namespace eval textblock {
#The data values are stored by column regardless of whether added row by row
dict for {cidx records} $o_columndata {
dict set o_columndata $cidx [list]
dict set o_columnstates $cidx [dict create maxbodywidthseen 0 maxheaderwidthseen 0]
dict set o_columnstates $cidx [dict create maxwidthbodyseen 0 maxwidthheaderseen 0]
}
}
method clear {} {
@ -1269,10 +1270,10 @@ namespace eval textblock {
set return_headerwidth 0
if {$do_show_header} {
#puts "boxlimitsinfo header $opt_posn: -- boxlimits $header_boxlimits -- boxmap $hdrmap"
set ansibase_header [dict get $o_opts_table -ansibase_header]
set ansibase_header [dict get $o_opts_table -ansibase_header] ;#merged to single during configure
set ansiborder_header [dict get $o_opts_table -ansiborder_header]
if {[dict get $o_opts_table -frametype_header] eq "block"} {
set extrabg [punk::ansi::codetype::sgr_merge [list $ansibase_header] -filter_fg 1]
set extrabg [punk::ansi::codetype::sgr_merge_singles [list $ansibase_header] -filter_fg 1]
set ansiborder_final $ansibase_header$ansiborder_header$extrabg
} else {
set ansiborder_final $ansibase_header$ansiborder_header
@ -1295,7 +1296,7 @@ namespace eval textblock {
]
set framedef_leftbox [textblock::framedef $ftype_header left]
set column_body_width_cache [dict create]
set column_width_cache [dict create]
foreach header $header_list {
@ -1425,26 +1426,28 @@ namespace eval textblock {
set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$next_posn] ]
}
if {![dict exists $column_body_width_cache $spancol]} {
if {![dict exists $column_width_cache $spancol]} {
#puts "-----> get_column_by_index $spancol -position $next_posn"
set spancolinfo [my get_column_by_index $spancol -position $next_posn -return dict]
set cwidth [dict get $spancolinfo bodywidth]
dict set column_body_width_cache $spancol $cwidth
set bwidth [dict get $spancolinfo bodywidth]
set hwidth [dict get $spancolinfo headerwidth]
dict set column_width_cache $spancol bodywidth $bwidth
dict set column_width_cache $spancol headerwidth $hwidth
} else {
set cwidth [dict get $column_body_width_cache $spancol]
set bwidth [dict get $column_width_cache $spancol bodywidth]
}
if {$next_posn eq "right"} {
#This is an unintuitive edge case - review
#spans at tail end are too long when edges are shown if we use cwidth+1 (vlr extends right beyond table)
#spans at tail end are too short if edges are hidden and we use cwidth (short lower horizontal bar)
#spans at tail end are too long when edges are shown if we use bwidth+1 (vlr extends right beyond table)
#spans at tail end are too short if edges are hidden and we use bwidth (short lower horizontal bar)
if {![dict get $o_opts_table -show_edge]} {
set spanwidth [expr {$cwidth+1}]
set spanwidth [expr {$bwidth+1}]
} else {
set spanwidth $cwidth
set spanwidth $bwidth
}
} else {
set spanwidth [expr {$cwidth+1}]
set spanwidth [expr {$bwidth+1}]
}
set header_cell [textblock::frame -width $spanwidth -type [dict get $ftypes header]\
@ -1474,6 +1477,7 @@ namespace eval textblock {
set hlims [struct::set difference $hlims [dict get $::textblock::class::header_edge_parts $rowpos$opt_posn] ]
}
set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "]
#set spacemap [list hl "\uFFFF" vl "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
set hblock [textblock::frame -type $spacemap -boxlimits $hlims -ansibase $ansibase_header $hval]
set spanned_frame [overtype::left -experimental test_mode -transparent 1 $spanned_frame $hblock]
}
@ -1482,14 +1486,50 @@ namespace eval textblock {
append part_header $spanned_frame
append part_header \n
} else {
#zero span header
#JMN
if 0 {
#old version - sort of works
set h_lines [lrepeat $rowh ""]
set hcell_blank [join $h_lines \n]
set spacemap [list hl " " vl " " tlc " " blc " " trc " " brc " "]
set spacemap [list hl "\uFFFF" vl "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
set header_frame [textblock::frame -width 0 -type [dict get $ftypes header]\
-ansibase $ansibase_header \
-boxlimits $hlims -boxmap $spacemap $hcell_blank\
]
append part_header $header_frame\n
} else {
#test version
set hw1 [dict get $o_columnstates $cidx maxwidthheaderseen] ;#headers may be masked by spans, or empty - width may depend more on spans than headers in current column
set hw2 [textblock::width $part_header] ;#widest so far
set hw3 [expr {max($hw1,$hw2)}]
set bw [dict get $o_columnstates $cidx maxwidthbodyseen]
set padwidth [expr {max($hw3,$bw)}]
if {[dict exists $column_width_cache $cidx]} {
set hwidth [dict get $column_width_cache $cidx headerwidth]
set padwidth [expr {max($padwidth,$hwidth)}]
}
#test hack - wider helps stop the breaks - but leaves junk spaces and ansiresets beyond the rhs border of table
#print function overflow 0 fixes?
set padwidth 20
#set bline [string repeat \uFFFF $colwidth]
set bline [string repeat \uFFFF $padwidth]
set h_lines [lrepeat $rowh $bline]
set hcell_blank [::join $h_lines \n]
set spacemap [list hl "\uFFFF" vll "\uFFFF" vlr "\uFFFF" tlc "\uFFFF" blc "\uFFFF" trc "\uFFFF " brc "\uFFFF"] ;# a debug test
set header_frame [textblock::frame -width [expr {$padwidth+2}] -type [dict get $ftypes header]\
-ansibase $ansibase_header \
-boxlimits $hlims -boxmap $spacemap $hcell_blank\
]
append part_header $header_frame\n
}
}
incr h
}
@ -1543,30 +1583,56 @@ namespace eval textblock {
set opt_col_ansibase [dict get $o_columndefs $colidx -ansibase] ;#ordinary merge of codes already done in configure_column
set body_ansibase [dict get $o_opts_table -ansibase_body]
set ansibase $body_ansibase$opt_col_ansibase ;#allow col to override body
#set ansibase [punk::ansi::codetype::sgr_merge_singles [list $body_ansibase $opt_col_ansibase]] ;#allow col to override body
set ansibase $body_ansibase$opt_col_ansibase
set body_ansiborder [dict get $o_opts_table -ansiborder_body]
if {[dict get $o_opts_table -frametype] eq "block"} {
#block is the only style where bg colour can fill the frame content area exactly if the L-shaped border elements are styled
#we need to only accept background ansi codes from the columndef ansibase for this
set col_bg [punk::ansi::codetype::sgr_merge [list $opt_col_ansibase] -filter_fg 1] ;#special merge for block borders - don't override fg colours
set col_bg [punk::ansi::codetype::sgr_merge_singles [list $opt_col_ansibase] -filter_fg 1] ;#special merge for block borders - don't override fg colours
set border_ansi $body_ansibase$body_ansiborder$col_bg
} else {
set border_ansi $body_ansibase$body_ansiborder
}
set r 0
foreach c $cells {
set row_ansibase [dict get $o_rowdefs $r -ansibase]
#todo - joinleft,joinright,joindown based on opts in args
#append output [textblock::frame -boxlimits {vll blc hlb} $c]\n
if {[dict get $o_opts_table -frametype] eq "block"} {
set row_ansibase [dict get $o_rowdefs $r -ansibase]
set row_bg ""
if {$row_ansibase ne ""} {
set row_bg [punk::ansi::codetype::sgr_merge [list $row_ansibase] -filter_fg 1]
set row_bg [punk::ansi::codetype::sgr_merge_singles [list $row_ansibase] -filter_fg 1]
}
set ansiborder_body_col_row $border_ansi$row_bg
set ansiborder_final $ansiborder_body_col_row
if 1 {
#$c will always have ansi resets due to overtype::left behaviour
#todo - review overtype
if {[punk::ansi::ta::detect $c]} {
#use only the last ansi sequence in the cell value
#Filter out foreground and use background for ansiborder override
set parts [punk::ansi::ta::split_codes_single $c]
#we have detected ansi - so there will always be at least 3 parts beginning and ending with pt pt,ansi,pt,ansi...,pt
set codes [list]
foreach {pt cd} $parts {
lappend codes $cd
}
#set takebg [lindex $parts end-1]
#set cell_bg [punk::ansi::codetype::sgr_merge_singles [list $takebg] -filter_fg 1]
set cell_bg [punk::ansi::codetype::sgr_merge_singles $codes -filter_fg 1]
#puts "-->>> [ansistring VIEW $cell_bg] <<<--"
set ansiborder_final $ansiborder_body_col_row$cell_bg
#JMN
}
}
set border_ansi_final $border_ansi$row_bg
} else {
set border_ansi_final $border_ansi
set ansiborder_body_col_row $border_ansi
set ansiborder_final $ansiborder_body_col_row
}
set ansibase_final $ansibase$row_ansibase
if {$r == 0} {
if {$r == $rmax} {
@ -1591,7 +1657,7 @@ namespace eval textblock {
set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts top$opt_posn] ]
}
}
set rowframe [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]
set rowframe [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase_final -ansiborder $ansiborder_final -boxlimits $blims -boxmap $bmap -joins $joins $c]
set return_bodywidth [textblock::width $rowframe]
append part_body $rowframe \n
} else {
@ -1609,7 +1675,7 @@ namespace eval textblock {
set blims [struct::set difference $blims [dict get $::textblock::class::table_edge_parts middle$opt_posn] ]
}
}
append part_body [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase -ansiborder $border_ansi_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n
append part_body [textblock::frame -type [dict get $ftypes body] -ansibase $ansibase_final -ansiborder $ansiborder_final -boxlimits $blims -boxmap $bmap -joins $joins $c]\n
}
incr r
}
@ -1695,7 +1761,7 @@ namespace eval textblock {
dict set output headers [list]
for {set i 0} {$i < $num_headers} {incr i} {
set hdr [lindex $headerlist $i]
set header_maxdataheight [my header_height $i]
set header_maxdataheight [my header_height $i] ;#from cached headerstates
set header_colspans [dict get $all_colspans $i]
set this_span [lindex $header_colspans $cidx]
set hdrwidth 0
@ -1772,14 +1838,23 @@ namespace eval textblock {
}
}
}
set cval $cell_ansibase$cval ;#no reset
#set cval $cell_ansibase$cval ;#no reset
set cell_lines [lrepeat $rowh $cell_line_blank]
set cell_blank [join $cell_lines \n]
set cval_lines [split $cval \n]
set cval_lines [concat $cval_lines $cell_lines]
set cval_lines [lrange $cval_lines 0 $rowh-1]
set cval_block [join $cval_lines \n]
#TODO! fix overtype library
set cell [overtype::left -experimental test_mode $cell_ansibase$cell_blank$RST $cval_block]
#set cell [overtype::left -experimental test_mode $cell_ansibase$cell_blank$RST $cval_block]
#set cell [overtype::left -experimental test_mode $cell_blank $cval_block]
set cell [textblock::pad $cval_block -width $colwidth -padchar " " -within_ansi 0 -which right]
#set cell [textblock::pad $cval_block -width $colwidth -padchar " " -within_ansi 0 -which left]
dict lappend output cells $cell
incr r
@ -2130,8 +2205,12 @@ namespace eval textblock {
set table $nextcol
set height [textblock::height $table] ;#only need to get height once at start
} else {
set nextcol [textblock::join [textblock::block $padwidth $height " "] $nextcol]
set table [overtype::left -overflow 1 -experimental test_mode -transparent 1 $table $nextcol]
set nextcol [textblock::join [textblock::block $padwidth $height "\uFFFF"] $nextcol]
set table [overtype::left -overflow 1 -experimental test_mode -transparent \uFFFF $table $nextcol]
#JMN
#set nextcol [textblock::join [textblock::block $padwidth $height "\uFFFF"] $nextcol]
#set table [overtype::left -overflow 1 -experimental test_mode -transparent \uFFFF $table $nextcol]
}
incr padwidth $bodywidth
incr colposn
@ -2144,6 +2223,10 @@ namespace eval textblock {
return "No columns matched"
}
}
method print_bodymatrix {} {
set m [my as_matrix]
$m format 2string
}
#*** !doctools
#[list_end]
@ -2175,6 +2258,150 @@ namespace eval textblock {
$t configure -show_header 1 -ansiborder_header [a+ cyan]
return $t
}
proc periodic {args} {
#For an impressive interactive terminal app (javascript)
# see: https://github.com/spirometaxas/periodic-table-cli
set defaults [dict create\
-return "string"\
-compact 1\
]
dict for {k v} $args {
switch -- $k {
-return - -compact {}
default {
"textblock::periodic unknown option '$k'. Known options: [dict keys $defaults]"
}
}
}
set opts [dict merge $defaults $args]
set opt_return [dict get $opts -return]
#examples ptable.com
set elements [list\
1 H "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" He\
2 Li Be "" "" "" "" "" "" "" "" "" "" B C N O F Ne\
3 Na Mg "" "" "" "" "" "" "" "" "" "" Al Si P S Cl Ar\
4 K Ca Sc Ti V Cr Mn Fe Co Ni Cu Zn Ga Ge As Se Br Kr\
5 Rb Sr Y Zr Nb Mo Tc Ru Rh Pd Ag Cd In Sn Sb Te I Xe\
6 Cs Ba "" Hf Ta W Re Os Ir Pt Au Hg Tl Pb Bi Po At Rn\
7 Fr Ra "" Rf Db Sg Bh Hs Mt Ds Rg Cn Nh Fl Mc Lv Ts Og\
" " " " " " " " " " " " " " " " " " " " " " " " "" "" "" "" "" "" ""\
"" "" "" 6 La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu\
"" "" "" 7 Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md No Lr\
]
set type_colours [list]
set ecat [dict create]
set cat_alkaline_earth [list Be Mg Ca Sr Ba Ra]
set ansi [a+ Web-gold web-black]
foreach e $cat_alkaline_earth {
dict set ecat $e [list ansi $ansi cat alkaline_earth]
}
set cat_reactive_nonmetal [list H C N O F P S Cl Se Br I]
set ansi [a+ Web-lightgreen web-black]
foreach e $cat_reactive_nonmetal {
dict set ecat $e [list ansi $ansi cat reactive_nonmetal]
}
set cat [list Li Na K Rb Cs Fr]
set ansi [a+ Web-Khaki web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat alkali_metals]
}
set cat [list Sc Ti V Cr Mn Fe Co Ni Cu Zn Y Zr Nb Mo Tc Ru Rh Pd Ag Cd Hf Ta W Re Os Ir Pt Au Hg Rf Db Sg Bh Hs]
set ansi [a+ Web-lightsalmon web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat transition_metals]
}
set cat [list Al Ga In Sn Tl Pb Bi Po]
set ansi [a+ Web-lightskyblue web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat post_transition_metals]
}
set cat [list B Si Ge As Sb Te At]
set ansi [a+ Web-turquoise web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat metalloids]
}
set cat [list He Ne Ar Kr Xe Rn]
set ansi [a+ Web-orchid web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat noble_gases]
}
set cat [list Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md No Lr]
set ansi [a+ Web-plum web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat actinoids]
}
set cat [list La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu]
set ansi [a+ Web-tan web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat lanthanoids]
}
set cat [list Mt Ds Rg Cn Nh Fl Mc Lv Ts Og]
set ansi [a+ Web-whitesmoke web-black]
foreach e $cat {
dict set ecat $e [list ansi $ansi cat other]
}
set elements1 [list]
foreach e $elements {
if {[dict exists $ecat $e]} {
set ansi [dict get $ecat $e ansi]
lappend elements1 [textblock::pad $ansi$e -width 2 -which right]
} else {
lappend elements1 $e
}
}
set t [list_as_table 19 $elements1 -return obj]
#todo - keep simple table with symbols as base - map symbols to descriptions etc for more verbose table options
set header_0 [list "" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18]
set c 0
foreach h $header_0 {
$t configure_column $c -headers [list $h] -minwidth 2
incr c
}
for {set c 0} {$c < [$t column_count]} {incr c} {
$t configure_column $c -minwidth 3
}
if {[dict get $opts -compact]} {
$t configure -show_hseps 0
$t configure -show_header 0
$t configure -show_edge 0
} else {
$t configure -show_header 1
}
if {$opt_return eq "string"} {
$t configure -frametype_header light
$t configure -ansiborder_header [a+ web-white]
$t configure -ansibase_header [a+ Web-black]
$t configure -ansibase_body [a+ Web-black]
$t configure -ansiborder_body [a+ web-black]
$t configure -frametype block
set output [textblock::frame -ansiborder [a+ Web-black web-cornflowerblue] -type heavy -title "[a+ Web-black] Periodic Table " [$t print]]
return $output
}
return $t
}
proc list_as_table {table_or_colcount datalist args} {
set defaults [dict create\
-return string\
@ -2447,43 +2674,282 @@ namespace eval textblock {
}
pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- <input/0,indent/1|
pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1|
proc ::textblock::pad {block args} {
set defaults [dict set\
set defaults [dict create\
-padchar " "\
-which "right"\
-width ""\
-overflow 0\
-within_ansi 0\
]
set usage "pad ?-padchar <character>? ?-which right|left|centre? -width <int>"
#review!?
#-within_ansi means after a leading ansi code when doing left pad on all but last line
#-within_ansi means before a trailing ansi code when doing right pad on all but last line
set usage "pad ?-padchar <sp>|<character>? ?-which right|left|centre? ?-width auto|<int>? ?-within_ansi 1|0?"
foreach {k v} $args {
if {$k ni [dict keys $defaults]} {
error "textblock::pad unrecognised option '$k'. Usage: $usage"
switch -- $k {
-padchar - -which - -width - -overflow - -within_ansi {}
default {
error "textblock::pad unrecognised option '$k'. Usage: $usage"
}
}
}
set opts [dict merge $defaults $args]
# -- --- --- --- --- --- --- --- --- ---
set padchar [dict get $opts -padchar]
#if padchar width (screen width) > 1 - length calculations will not be correct
#we will allow tokens longer than 1 - as the caller may want to post-process on the token whilst preserving previous leading/trailing spaces, e.g with a string map
#The caller may also use ansi within the padchar - although it's unlikely to be efficient.
# -- --- --- --- --- --- --- --- --- ---
set known_whiches [list l left r right c center centre]
set which [string tolower [dict get $opts -which]]
if {$which in [list centre center]} {set which "c"}
if {$which in [list left]} {set which "l"}
if {$which in [list right]} {set which "r"}
if {$which ni $known_whiches} {
error "textblock::pad unrecognised value for -which option. Known values $known_whiches"
set opt_which [string tolower [dict get $opts -which]]
switch -- $opt_which {
center - centre - c {
set which c
}
left - l {
set which l
}
right - r {
set which r
}
default {
error "textblock::pad unrecognised value for -which option. Known values $known_whiches"
}
}
# -- --- --- --- --- --- --- --- --- ---
set width [dict get $opts -width]
set opt_width [dict get $opts -width]
switch -- $opt_width {
"" - auto {
set width auto
}
default {
if {![string is integer -strict $opt_width] || $opt_width < 0} {
error "textblock::pad -width must be an integer >=0"
}
set width $opt_width
}
}
# -- --- --- --- --- --- --- --- --- ---
set opt_withinansi [dict get $opts -within_ansi]
switch -- $opt_withinansi {
0 - 1 {}
default {
set opt_withinansi 2
}
}
# -- --- --- --- --- --- --- --- --- ---
if {$width = ""} {
set datawidth [textblock::width $block]
if {$width eq "auto"} {
set width $datawidth
}
set lines [list]
set lnum 0
set parts [punk::ansi::ta::split_codes $block]
set line_chunks [list]
set line_len 0
foreach {pt ansi} $parts {
if {$pt ne ""} {
set has_nl [expr {[string last \n $pt]>=0}]
if {$has_nl} {
set pt [string map [list \r\n \n] $pt]
set partlines [split $pt \n]
} else {
set partlines [list $pt]
}
set last [expr {[llength $partlines]-1}]
set p 0
foreach pl $partlines {
lappend line_chunks $pl
incr line_len [punk::char::ansifreestring_width $pl]
if {$p != $last} {
#do padding
set missing [expr {$width - $line_len}]
if {$missing > 0} {
set pad [string repeat $padchar $missing]
switch -- $which-$opt_withinansi {
r-0 {
lappend line_chunks $pad
}
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
} else {
lappend line_chunks $pad
}
}
r-2 {
lappend line_chunks $pad
}
l-0 {
set line_chunks [linsert $line_chunks 0 $pad]
}
l-1 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
} else {
set line_chunks [linsert $line_chunks 0 $pad]
}
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
}
}
}
lappend lines [::join $line_chunks ""]
set line_chunks [list]
set line_len 0
}
incr p
}
} else {
#we need to store empties in order to insert text in the correct position relative to leading/trailing ansi codes
lappend line_chunks ""
}
#don't let trailing empty ansi affect the line_chunks length
if {$ansi ne ""} {
lappend line_chunks $ansi ;#don't update line_len - review - ansi codes with visible content?
}
}
#pad last line
set missing [expr {$width - $line_len}]
if {$missing > 0} {
set pad [string repeat $padchar $missing]
switch -- $which-$opt_withinansi {
r-0 {
lappend line_chunks $pad
}
r-1 {
if {[lindex $line_chunks end] eq ""} {
set line_chunks [linsert $line_chunks end-2 $pad]
} else {
lappend line_chunks $pad
}
}
r-2 {
lappend line_chunks $pad
}
l-0 {
if {[lindex $line_chunks 0] eq ""} {
set line_chunks [linsert $line_chunks 2 $pad]
} else {
set line_chunks [linsert $line_chunks 0 $pad]
}
}
l-1 {
#set line_chunks [linsert $line_chunks 0 $pad]
set line_chunks [_insert_before_text_or_last_ansi $pad $line_chunks]
}
l-2 {
set line_chunks [linsert $line_chunks 0 $pad]
}
}
}
lappend lines [::join $line_chunks ""]
return [::join $lines \n]
}
#left insertion into a list resulting from punk::ansi::ta::split_codes or split_codes_single
#resulting list is no longer a valid ansisplit list
proc _insert_before_text_or_last_ansi {str ansisplits} {
if {[llength $ansisplits] == 1} {
#ansisplits was a split on plaintext only
return [list $str [lindex $ansisplits 0]]
} elseif {[llength $ansisplits] == 0} {
return [list $str]
}
if {[llength $ansisplits] %2 != 1} {
error "_insert_before_text_or_last_ansi ansisplits list is not a valid resultlist from an ansi split - must be odd number of elements pt,ansi,pt,ansi...pt"
}
set out [list]
set i 0
set i_last_code [expr {[llength $ansisplits]-3}] ;#would normally be -2 - but our i is jumping to each pt - not every element
foreach {pt code} $ansisplits {
if {$pt ne ""} {
return [lappend out $str {*}[lrange $ansisplits $i end]]
}
if {$i == $i_last_code} {
return [lappend out $str {*}[lrange $ansisplits $i end]]
}
#code being empty can only occur when we have reached last pt
#we have returned by then.
lappend out $code
incr i 2
}
error "_insert_before_text_or_last_ansi failed on input str:[ansistring VIEW $str] ansisplits:[ansistring VIEW $ansisplits]"
}
proc pad_test {block} {
set width [textblock::width $block]
set padtowidth [expr {$width + 10}]
set left0 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 0]
set left1 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 1]
set left2 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 2]
set right0 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 0]
set right1 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 1]
set right2 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 2]
set testlist [list "within_ansi 0" $left0 $right0 "within_ansi 1" $left1 $right1 "within_ansi 2" $left2 $right2]
set t [textblock::list_as_table 3 $testlist -return object]
$t configure_column 0 -headers [list "ansi"]
$t configure_column 1 -headers [list "Left"]
$t configure_column 2 -headers [list "Right"]
$t configure -show_header 1
puts stdout [$t print]
return $t
}
proc pad_test2 {blocklist} {
set b 0
set blockinfo [dict create]
foreach block $blocklist {
set width [textblock::width $block]
set padtowidth [expr {$width + 10}]
dict set blockinfo $b left0 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 0]
dict set blockinfo $b left1 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 1]
dict set blockinfo $b left2 [textblock::pad $block -width $padtowidth -padchar . -which left -within_ansi 2]
dict set blockinfo $b right0 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 0]
dict set blockinfo $b right1 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 1]
dict set blockinfo $b right2 [textblock::pad $block -width $padtowidth -padchar . -which right -within_ansi 2]
incr b
}
set r0 [list "0"]
set r1 [list "1"]
set r2 [list "2"]
dict for {b bdict} $blockinfo {
lappend r0 [dict get $blockinfo $b left0] [dict get $blockinfo $b right0]
lappend r1 [dict get $blockinfo $b left1] [dict get $blockinfo $b right1]
lappend r2 [dict get $blockinfo $b left2] [dict get $blockinfo $b right2]
}
set rows [concat $r0 $r1 $r2]
set t [textblock::list_as_table [expr {1 + (2 * [dict size $blockinfo])}] $rows -return object]
$t configure_column 0 -headers [list "" "within_ansi"]
set col 1
dict for {b bdict} $blockinfo {
$t configure_column $col -headers [list "Block $b" "Left"]
$t configure_column $col -header_colspans 2
incr col
$t configure_column $col -headers [list "-" "Right"]
incr col
}
$t configure -show_header 1
puts stdout [$t print]
return $t
}
proc pad_example {} {
set b1 "[a+ green bold][textblock::block 4 4 x]\n[a]"
set b2 "[a+ green bold][textblock::block 4 4 x]\n[a+ Green]"
set b3 "[textblock::testblock 4 rainbow]\n[a]"
set b4 "[textblock::testblock 4 rainbow]\n[a+ Green]"
set t [textblock::pad_test2 [list $b1 $b2 $b3 $b4]]
}
#playing with syntax
pipealias ::textblock::join_width .= {list $lhs [string repeat " " $w1] $rhs [string repeat " " $w2]} {|
/2,col1/1,col2/3
>} punk::lib::lines_as_list -- {|
@ -2501,6 +2967,7 @@ namespace eval textblock {
>} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
>} punk::lib::list_as_lines -- <lhs/0,rhs/1|
proc ::textblock::join1 {args} {
lassign [punk::args::opts_values {
-ansiresets -default 1 -type integer
@ -2573,7 +3040,8 @@ namespace eval textblock {
}
proc ::textblock::trim {block} {
set trimlines []
error "textblock::trim unimplemented"
set trimlines ""
}
pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
@ -2607,10 +3075,11 @@ namespace eval textblock {
append out $2frames_a \n
set 2frames_b [textblock::join [textblock::frame -ansiborder $cyanb -title "plainpunks" $punks] [textblock::frame -ansiborder $greenb -title "fancypunks" $cpunks]]
append out [textblock::frame -title "punks" $2frames_b\n$RST$2frames_a] \n
set fancy [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"]]
set fancy [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"]
set spantable [[spantest] print]
append out [textblock::join $fancy $spantable] \n
append out [textblock::join $fancy " " $spantable] \n
#append out [textblock::frame -title gr $gr0]
append out [textblock::periodic]
return $out
}

Write Preview
Loading…
Cancel
Save