diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index c5f6f21..a2fd354 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -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- or 256fg- or 256f # rgbf--- or rgbfg--- or rgbf-- - 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--- or rgbfg--- or rgbf-- - 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 "" # => "" diff --git a/src/bootsupport/modules/textblock-0.1.1.tm b/src/bootsupport/modules/textblock-0.1.1.tm index 215f3dc..6f267db 100644 --- a/src/bootsupport/modules/textblock-0.1.1.tm +++ b/src/bootsupport/modules/textblock-0.1.1.tm @@ -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 -- punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- ? ?-which right|left|centre? -width " + #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 |? ?-which right|left|centre? ?-width auto|? ?-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 -- 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- or 256fg- or 256f # rgbf--- or rgbfg--- or rgbf-- - 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--- or rgbfg--- or rgbf-- - 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 "" # => "" diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 17bc244..590aa67 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -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 -- punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- ? ?-which right|left|centre? -width " + #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 |? ?-which right|left|centre? ?-width auto|? ?-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 --