Browse Source

punk::ansi a? improvements, punk::ansi::sgr_cache

master
Julian Noble 7 months ago
parent
commit
e9644754a3
  1. 795
      src/modules/punk/ansi-999999.0a1.0.tm
  2. 22
      src/modules/punk/console-999999.0a1.0.tm
  3. 6
      src/modules/punk/repl-0.1.tm
  4. 61
      src/modules/textblock-999999.0a1.0.tm

795
src/modules/punk/ansi-999999.0a1.0.tm

@ -1001,12 +1001,15 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
]
#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_diff ;#maintain the difference as a separate dict so we can display in a? x11
dict set X11_colour_map_diff gray 190-190-190 ;# #BEBEBE
dict set X11_colour_map_diff green 0-255-0 ;# #00FF00
dict set X11_colour_map_diff maroon 176-48-96 ;# #B03060
dict set X11_colour_map_diff purple 160-32-240 ;# #A020F0
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
set X11_colour_map [dict merge $WEB_colour_map $X11_colour_map_diff]
#Xterm colour names (256 colours)
#lists on web have duplicate names
@ -1189,7 +1192,7 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
darkseagreen1\
paleturquoise1\
red3\
deppink3\
deeppink3\
deeppink3\
magenta3\
magenta3\
@ -1407,6 +1410,35 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
}
return $out[a]
}
proc colourtable_16_names {} {
variable TERM_colour_map_reverse
set rows [list]
set row [list]
set fg "web-white"
set t [textblock::class::table new]
$t configure -show_seps 0 -show_edge 0
for {set i 0} {$i <=15} {incr i} {
set cname [dict get $TERM_colour_map_reverse $i] ;#use term-$i etc instead of term-$name?
if {[llength $row]== 8} {
lappend rows $row
set row [list]
}
if {$i > 6} {
set fg "web-black"
}
#lappend row "[a+ {*}$fg Term-$cname][format %3s $i] $cname "
lappend row "[a+ {*}$fg Term-$i][format %3s $i] $cname "
}
lappend rows $row
foreach r $rows {
$t add_row $r
}
append out [$t print]
$t destroy
append out [a]
return [string trimleft $out \n]
}
#216 colours of 256
proc colourblock_216 {} {
set out ""
@ -1437,22 +1469,21 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
set t [textblock::class::table new]
$t configure -show_seps 0 -show_edge 0
for {set i 16} {$i <=231} {incr i} {
if {$i % 9 == 7} {
set cname [dict get $TERM_colour_map_reverse $i] ;#use term-cname etc instead of term$i - may as well let a+ cache the call by name as the preferred? option
if {[llength $row]== 8} {
lappend rows $row
set row [list]
}
if {$i % 18 == 16} {
if {$fg eq "web-black"} {
set fg "web-white"
} else {
set fg "web-black"
}
if {[llength $row]} {
lappend row "[a+ {*}$fg Term$i][format %3s $i] [dict get $TERM_colour_map_reverse $i]"
lappend rows $row
set row [list]
}
} else {
lappend row "[a+ {*}$fg Term$i][format %3s $i] [dict get $TERM_colour_map_reverse $i]"
}
#append out "$br[a+ {*}$fg Term$i][format %3s $i] "
lappend row "[a+ {*}$fg Term-$cname][format %3s $i] $cname "
}
lappend rows $row
foreach r $rows {
$t add_row $r
}
@ -1473,6 +1504,34 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
}
return $out[a]
}
proc colourtable_24_names {} {
variable TERM_colour_map_reverse
set rows [list]
set row [list]
set fg "web-white"
set t [textblock::class::table new]
$t configure -show_hseps 0 -show_edge 0
for {set i 232} {$i <=255} {incr i} {
set cname [dict get $TERM_colour_map_reverse $i] ;#use term-cname etc instead of term$i - may as well let a+ cache the call by name as the preferred? option
if {[llength $row]== 8} {
lappend rows $row
set row [list]
}
if {$i > 243} {
set fg "web-black"
}
lappend row "[a+ {*}$fg Term-$cname][format %3s $i] $cname "
}
lappend rows $row
foreach r $rows {
$t add_row $r
}
append out [$t print]
$t destroy
append out [a]
return [string trimleft $out \n]
}
#set WEB_colour_map [dict merge\
# $WEB_colour_map_basic\
@ -1530,11 +1589,12 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} else {
set fg "web-black"
}
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ Rgb-$cdec $fg]
#$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ $fg Rgb-$cdec]
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ $fg Web-$cname]
}
$t configure_column 0 -headers [list "[string totitle $g] colours"]
$t configure_column 0 -header_colspans [list all]
$t configure -ansibase_header [a+ Web-white web-black]
$t configure -ansibase_header [a+ web-black Web-white]
lappend grouptables [$t print]
$t destroy
}
@ -1546,6 +1606,53 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
$displaytable destroy
return $result
}
proc colourtable_x11diff {} {
variable X11_colour_map_diff
variable WEB_colour_map
set comparetables [list] ;# 2 side by side x11 and web
# -- --- ---
set t [textblock::class::table new]
$t configure -show_edge 0 -show_seps 0 -show_header 1
dict for {cname cdec} [set X11_colour_map_diff] {
$t add_row [list "$cname " "[colour_dec2hex $cdec] " $cdec]
set fg "web-white"
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ $fg X11-$cname]
}
$t configure_column 0 -headers [list "X11"]
$t configure_column 0 -header_colspans [list all]
$t configure -ansibase_header [a+ web-black Web-white]
lappend comparetables [$t print]
$t destroy
# -- --- ---
set WEB_map_subset [dict create]
dict for {k v} $X11_colour_map_diff {
dict set WEB_map_subset $k [dict get $WEB_colour_map $k]
}
# -- --- ---
set t [textblock::class::table new]
$t configure -show_edge 0 -show_seps 0 -show_header 1
dict for {cname cdec} [set WEB_map_subset] {
$t add_row [list "$cname " "[colour_dec2hex $cdec] " $cdec]
set fg "web-white"
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ $fg Web-$cname]
}
$t configure_column 0 -headers [list "Web"]
$t configure_column 0 -header_colspans [list all]
$t configure -ansibase_header [a+ web-black Web-white]
lappend comparetables [$t print]
$t destroy
# -- --- ---
set displaytable [textblock::list_as_table 2 $comparetables -return object]
$displaytable configure -show_header 0 -show_vseps 0
set result [$displaytable print]
$displaytable destroy
return $result
}
proc a? {args} {
#*** !doctools
#[call [fun a?] [opt {ansicode...}]]
@ -1565,14 +1672,14 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
bold - dim - italic - doubleunderline - blink - fastblink - strike - overline - framecircle {
lappend strmap " $k " " [a+ $k]$k$RST "
}
noreverse - nounderline {
#prefixed version will match before unprefixed - will not be subject to further replacement scanning
lappend strmap "$k" "[a+ $k]$k$RST" ;#could replace with self - but may as well put in punk::ansi::sgr_cache (can make cache a little neater to display)
}
underline - reverse - frame {
#1st coloumn - no leading space
lappend strmap "$k " "[a+ $k]$k$RST "
}
noreverse {
#undo mapping of 'reverse' within this string
lappend strmap "$k" "noreverse"
}
}
}
set settings_applied [string trim $SGR_setting_map \n]
@ -1609,6 +1716,9 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
append out [textblock::join $indent "Valid group names (can be listed in any order): basic pink red orange yellow brown purple blue cyan green white grey"] \n
append out \n
append out [textblock::join $indent "Example: \[a+ Web-springgreen web-crimson\]text\[a] -> [a+ Web-springgreen web-coral]text[a]"] \n
append out \n
append out "[a+ web-white]X11 colours[a] - mostly match Web colours" \n
append out [textblock::join $indent "To see differences: a? x11"] \n
} on error {result options} {
@ -1620,13 +1730,22 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
} else {
switch -- [lindex $args 0] {
term {
return [colourtable_216_names]
set out "16 basic colours\n"
append out [colourtable_16_names] \n
append out "216 colours\n"
append out [colourtable_216_names] \n
append out "24 greyscale colours\n"
append out [colourtable_24_names]
return $out
}
web {
return [colourtable_web [lrange $args 1 end]]
}
x11 {
return "Display not implemented. Mostly same as web"
set out ""
append out "Mostly same as web - known differences displayed" \n
append out [colourtable_x11diff]
return $out
}
}
set result [list]
@ -1646,6 +1765,38 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
return $result
}
}
#REVIEW! note that OSC 4 can change the 256 color pallette
#e.g \x1b\]4\;1\;#HHHHHH\x1b\\
# (or with colour name instead of rgb #HHHHHH on for example wezterm)
#Q: If we can't detect OSC 4 - how do we know when to invalidate/clear at least the 256 color portion of the cache?
#A: The cache values should still be valid - and the terminal should display the newly assigned colour.
# If in line mode - perhaps readline or something else is somehow storing the rgb values and replaying invalid colours?
# On wezterm - we can get cells changing colour as we scroll after a pallette change - so something appears to be caching colours
variable sgr_cache
set sgr_cache [dict create]
#sgr_cache clear called by punk::console::ansi when set to off
proc sgr_cache {{action ""}} {
variable sgr_cache
if {$action ni {"" clear}} {
error "sgr_cache action '$action' not understood. Valid actions: clear"
}
if {$action eq "clear"} {
set sgr_cache [dict create]
return "sgr_cache cleared"
}
set out ""
set RST [a]
#todo - terminal width? table?
dict for {key ansi} $sgr_cache {
append out "$ansi$key$RST "
}
return $out\n
}
proc a+ {args} {
#*** !doctools
#[call [fun a+] [opt {ansicode...}]]
@ -1656,124 +1807,225 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
#[para]punk::ansi::a Red
#[para]see [cmd punk::ansi::a?] to display a list of codes
variable sgr_cache
if {[dict exists $sgr_cache $args]} {
return [dict get $sgr_cache $args]
}
#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]} {
lappend t $i
} elseif {[string first ";" $i] >=0} {
#literal with params
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-<int> or 256fg-<int> or 256f<int>
# rgbf-<r>-<g>-<b> or rgbfg-<r>-<g>-<b> or rgbf<r>-<g>-<b>
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"
set f4 [string range $i 0 3]
switch -- $f4 {
web- {
#variable WEB_colour_map
#upvar ::punk::ansi::WEB_colour_map WEB_colour_map
#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 { - ;} $rgbdash]
lappend t "38;2;$rgb"
} else {
puts stderr "ansi web colour unmatched: '$i'"
}
}
Web- - WEB- {
#variable WEB_colour_map
#upvar ::punk::ansi::WEB_colour_map WEB_colour_map
#background web colour
set cname [string tolower [string range $i 4 end]]
if {[dict exists $WEB_colour_map $cname]} {
lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]"
} else {
puts stderr "ansi Web colour unmatched: '$i'"
}
}
rese {lappend t 0 ;#reset}
bold {lappend t 1}
dim {lappend t 2}
blin {
#blink
lappend t 5
}
}
}
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"
fast {
#fastblink
lappend t 6
}
}
}
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"
}
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"
}
"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"
}
"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"
}
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"
}
}
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"
}
nobl {
#noblink
lappend t 25
}
hide {lappend t 8}
norm {lappend t 22 ;#normal}
unde {lappend t 4 ;#underline}
doub {lappend t 21 ;#doubleunderline}
noun {lappend t 24 ;#nounderline}
stri {lappend t 9 ;#strike}
nost {lappend t 29 ;#nostrike}
ital {lappend t 3 ;#italic}
noit {lappend t 23 ;#noitalic}
reve {lappend t 7 ;#reverse}
nore {lappend t 27 ;#noreverse}
defa {
if {$i eq "defaultfg"} {
lappend t 39
} else {
#defaultbg
lappend t 49
}
}
nohi {lappend t 28 ;#nohide}
over {lappend t 53 ;#overline}
noov {lappend t 55 ;#nooverline}
fram {
if {$i eq "frame"} {
lappend t 51 ;#frame
} else {
lappend t 52 ;#framecircle
}
}
nofr {lappend t 54 ;#noframe}
blac {lappend t 30 ;#black}
red {lappend t 31}
gree {lappend t 32 ;#green}
yell {lappend t 33 ;#yellow}
blue {lappend t 34}
purp {lappend t 35 ;#purple}
cyan {lappend t 36}
whit {lappend t 37 ;#white}
Blac {lappend t 40 ;#Black}
Red {lappend t 41}
Gree {lappend t 42 ;#Green}
Yell {lappend t 43 ;#Yellow}
Blue {lappend t 44}
Purp {lappend t 45 ;#Purple}
Cyan {lappend t 46}
Whit {lappend t 47 ;#White}
brig {
switch -- $i {
brightblack {lappend t 90}
brightred {lappend t 91}
brightgreen {lappend t 92}
brightyellow {lappend t 93}
brightblue {lappend t 94}
brightpurple {lappend t 95}
brightcyan {lappend t 96}
brightwhite {lappend t 97}
}
}
Brig {
switch -- $i {
Brightblack {lappend t 100}
Brightred {lappend t 101}
Brightgreen {lappend t 101}
Brightyellow {lappend t 103}
Brightblue {lappend t 104}
Brightpurple {lappend t 105}
Brightcyan {lappend t 106}
Brightwhite {lappend t 107}
}
}
term {
#variable TERM_colour_map
#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] & $cc < 256} {
lappend t "38;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend t "38;5;[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi term colour unmatched: '$i'"
}
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"
}
}
}
Term - TERM {
#variable TERM_colour_map
#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] && $cc < 256} {
lappend t "48;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend t "48;5;[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi Term colour unmatched: '$i'"
}
}
}
rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 {
#decimal rgb foreground
#allow variants rgb-xxx-xxx-xxx and rgbxxx-xxx-xxx
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "38;2;$rgb"
}
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"
}
"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"
}
"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"
}
x11- {
variable X11_colour_map
#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"
} else {
puts stderr "ansi x11 colour unmatched: '$i'"
}
}
X11- {
variable X11_colour_map
#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"
} else {
puts stderr "ansi X11 colour unmatched: '$i'"
}
}
default {
if {[string is integer -strict $i] || [string first ";" $i] > 0} {
lappend t $i
} else {
puts stderr "ansi name unmatched: '$i' Perhaps missing prefix? e.g web- x11- term- rgb# 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))
set result "" ;# a+ nonexistent should return nothing rather than a reset ( \033\[\;m is a reset even without explicit zero(s))
} else {
set result "\x1b\[[join $t {;}]m"
}
return "\x1b\[[join $t {;}]m"
dict set sgr_cache $args $result
return $result
}
proc a {args} {
@ -1787,111 +2039,224 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu
#[para]punk::ansi::a Red
#[para]see [cmd punk::ansi::a?] to display a list of codes
#variable SGR_setting_map {
# bold 1 dim 2 blink 5 fastblink 6 noblink 25 hide 8 normal 22
# underline 4 doubleunderline 21 nounderline 24 strike 9 nostrike 29 italic 3 noitalic 23
# reverse 7 noreverse 27 defaultfg 39 defaultbg 49 nohide 28
# overline 53 nooverline 55 frame 51 framecircle 52 noframe 54
#}
#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
# BLACK 100 RED 101 GREEN 102 YELLOW 103 BLUE 104 PURPLE 105 CYAN 106 WHITE 107
#}
variable sgr_cache
if {[dict exists $sgr_cache $args]} {
return [dict get $sgr_cache $args]
}
#don't disable ansi here.
#we want this to be available to call even if ansi is off
#variable SGR_map
set t [list]
variable WEB_colour_map
variable TERM_colour_map
set t [list]
foreach i $args {
switch -- $i {
bold {lappend t 1}
dim {lappend t 2}
blink {lappend t 5}
fastblink {lappend t 6}
noblink {lappend t 25}
hide {lappend t 8}
normal {lappend t 22}
underline {lappend t 4}
doubleunderline {lappend t 21}
nounderline {lappend t 24}
strike {lappend t 9}
nostrike {lappend t 29}
italic {lappend t 3}
noitalic {lappend t 23}
reverse {lappend t 7}
noreverse {lappend t 27}
defaultfb {lappend t 39}
defaultbg {lappedn t 49}
nohide {lappend t 28}
overline {lappend t 53}
nooverline {lappend t 55}
frame {lappend t 51}
framecircle {lappend t 52}
noframe {lappend t 54}
black {lappend t 30}
red {lappend t 31}
green {lappend t 32}
yellow {lappend t 33}
blue {lappend t 34}
purple {lappend t 35}
cyan {lappend t 36}
white {lappend t 37}
Black {lappend t 40}
Red {lappend t 41}
Green {lappend t 42}
Yellow {lappend t 43}
Blue {lappend t 44}
Purple {lappend t 45}
Cyan {lappend t 46}
White {lappend t 47}
BLACK {lappend t 100}
RED {lappend t 101}
GREEN {lappend t 101}
YELLOW {lappend t 103}
BLUE {lappend t 104}
PURPLE {lappend t 105}
CYAN {lappend t 106}
WHITE {lappend t 107}
set f4 [string range $i 0 3]
switch -- $f4 {
web- {
#variable WEB_colour_map
#upvar ::punk::ansi::WEB_colour_map WEB_colour_map
#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 { - ;} $rgbdash]
lappend t "38;2;$rgb"
} else {
puts stderr "ansi web colour unmatched: '$i'"
}
}
Web- - WEB- {
#variable WEB_colour_map
#upvar ::punk::ansi::WEB_colour_map WEB_colour_map
#background web colour
set cname [string tolower [string range $i 4 end]]
if {[dict exists $WEB_colour_map $cname]} {
lappend t "48;2;[string map {- ;} [dict get $WEB_colour_map $cname]]"
} else {
puts stderr "ansi Web colour unmatched: '$i'"
}
}
rese {lappend t 0 ;#reset}
bold {lappend t 1}
dim {lappend t 2}
blin {
#blink
lappend t 5
}
fast {
#fastblink
lappend t 6
}
nobl {
#noblink
lappend t 25
}
hide {lappend t 8}
norm {lappend t 22 ;#normal}
unde {lappend t 4 ;#underline}
doub {lappend t 21 ;#doubleunderline}
noun {lappend t 24 ;#nounderline}
stri {lappend t 9 ;#strike}
nost {lappend t 29 ;#nostrike}
ital {lappend t 3 ;#italic}
noit {lappend t 23 ;#noitalic}
reve {lappend t 7 ;#reverse}
nore {lappend t 27 ;#noreverse}
defa {
if {$i eq "defaultfg"} {
lappend t 39
} else {
#defaultbg
lappend t 49
}
}
nohi {lappend t 28 ;#nohide}
over {lappend t 53 ;#overline}
noov {lappend t 55 ;#nooverline}
fram {
if {$i eq "frame"} {
lappend t 51 ;#frame
} else {
lappend t 52 ;#framecircle
}
}
nofr {lappend t 54 ;#noframe}
blac {lappend t 30 ;#black}
red {lappend t 31}
gree {lappend t 32 ;#green}
yell {lappend t 33 ;#yellow}
blue {lappend t 34}
purp {lappend t 35 ;#purple}
cyan {lappend t 36}
whit {lappend t 37 ;#white}
Blac {lappend t 40 ;#Black}
Red {lappend t 41}
Gree {lappend t 42 ;#Green}
Yell {lappend t 43 ;#Yellow}
Blue {lappend t 44}
Purp {lappend t 45 ;#Purple}
Cyan {lappend t 46}
Whit {lappend t 47 ;#White}
brig {
switch -- $i {
brightblack {lappend t 90}
brightred {lappend t 91}
brightgreen {lappend t 92}
brightyellow {lappend t 93}
brightblue {lappend t 94}
brightpurple {lappend t 95}
brightcyan {lappend t 96}
brightwhite {lappend t 97}
}
}
Brig {
switch -- $i {
Brightblack {lappend t 100}
Brightred {lappend t 101}
Brightgreen {lappend t 101}
Brightyellow {lappend t 103}
Brightblue {lappend t 104}
Brightpurple {lappend t 105}
Brightcyan {lappend t 106}
Brightwhite {lappend t 107}
}
}
term {
#variable TERM_colour_map
#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] & $cc < 256} {
lappend t "38;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend t "38;5;[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi term colour unmatched: '$i'"
}
}
}
Term - TERM {
#variable TERM_colour_map
#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] && $cc < 256} {
lappend t "48;5;$cc"
} else {
if {[dict exists $TERM_colour_map $cc]} {
lappend t "48;5;[dict get $TERM_colour_map $cc]"
} else {
puts stderr "ansi Term colour unmatched: '$i'"
}
}
}
rgb- - rgb0 - rgb1 - rgb2 - rgb3 - rgb4 - rgb5 - rgb6 - rgb7 - rgb8 - rgb9 {
#decimal rgb foreground
#allow variants rgb-xxx-xxx-xxx and rgbxxx-xxx-xxx
set rgbspec [string trim [string range $i 3 end] -]
set rgb [string map [list - {;} , {;}] $rgbspec]
lappend t "38;2;$rgb"
}
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"
}
"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"
}
"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"
}
x11- {
variable X11_colour_map
#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"
} else {
puts stderr "ansi x11 colour unmatched: '$i'"
}
}
X11- {
variable X11_colour_map
#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"
} else {
puts stderr "ansi X11 colour unmatched: '$i'"
}
}
default {
if {[string is integer -strict $i]} {
lappend t $i
} elseif {[string first ";" $i] >=0} {
#literal with params
if {[string is integer -strict $i] || [string first ";" $i] > 0} {
lappend t $i
} else {
#accept examples for foreground
# 256f-# or 256fg-# or 256f#
# rgbf-<r>-<g>-<b> or rgbfg-<r>-<g>-<b> or rgbf<r>-<g>-<b>
switch -nocase -glob -- $i {
"256f*" {
set cc [string trim [string range $i 4 end] -gG]
lappend t "38;5;$cc"
}
"256b*" {
set cc [string trim [string range $i 4 end] -gG]
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"
}
"rgbb*" {
set rgb [string trim [string range $i 4 end] -gG]
lassign [split $rgb -] r g b
lappend t "48;2;$r;$g;$b"
}
}
puts stderr "ansi name unmatched: '$i' Perhaps missing prefix? e.g web- x11- term- rgb# rgb-"
}
}
}
}
# \033 - octal. equivalently \x1b in hex which is more common in documentation
# empty list [a=] should do reset - same for [a= nonexistant]
# 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]
return "\x1b\[[join $t {;}]m"
set t [linsert $t[unset t] 0 0]
set result "\x1b\[[join $t {;}]m"
dict set sgr_cache $args $result
return $result
}
proc ansiwrap {codes text} {

22
src/modules/punk/console-999999.0a1.0.tm

@ -804,30 +804,33 @@ namespace eval punk::console {
}
}
proc code_a {args} {
proc code_a+ {args} {
variable colour_disabled
variable ansi_wanted
if {$colour_disabled || $ansi_wanted <= 0} {
return
}
tailcall punk::ansi::a {*}$args
#a and a+ are called a *lot* - avoid even slight overhead of tailcall as it doesn't give us anything useful here
#tailcall punk::ansi::a+ {*}$args
::punk::ansi::a+ {*}$args
}
proc code_a? {args} {
proc code_a {args} {
variable colour_disabled
variable ansi_wanted
if {$colour_disabled || $ansi_wanted <= 0} {
return [punk::ansi::stripansi [::punk::ansi::a? {*}$args]]
} else {
tailcall ::punk::ansi::a? {*}$args
return
}
#tailcall punk::ansi::a {*}$args
::punk::ansi::a {*}$args
}
proc code_a+ {args} {
proc code_a? {args} {
variable colour_disabled
variable ansi_wanted
if {$colour_disabled || $ansi_wanted <= 0} {
return
return [punk::ansi::stripansi [::punk::ansi::a? {*}$args]]
} else {
tailcall ::punk::ansi::a? {*}$args
}
tailcall punk::ansi::a+ {*}$args
}
proc ansi {{onoff {}}} {
@ -846,6 +849,7 @@ namespace eval punk::console {
false -
no {
set ansi_wanted 0
punk::ansi::sgr_cache clear
}
default {
set ansi_wanted 2

6
src/modules/punk/repl-0.1.tm

@ -2458,12 +2458,12 @@ proc repl::repl_process_data {inputchan type chunk stdinlines prompt_config} {
doprompt "p% "
}
} else {
#doprompt "P% " "green nobold"
#doprompt "P% " "green normal"
if {$linenum == 0} {
doprompt "P% " "green nobold"
doprompt "P% " "green normal"
screen_last_char_add " " empty empty
} else {
doprompt "\nP% " "green nobold"
doprompt "\nP% " "green normal"
screen_last_char_add "\n" empty empty ;#add \n to indicate noclearance required
}
}

61
src/modules/textblock-999999.0a1.0.tm

@ -28,6 +28,9 @@ package require term::ansi::code::macros ;#required for frame if old ansi g0 use
package require textutil
namespace eval textblock {
#review - what about ansi off in punk::console?
namespace import ::punk::ansi::a ::punk::ansi::a+
namespace eval class {
variable opts_table_defaults
set opts_table_defaults [dict create\
@ -890,7 +893,10 @@ namespace eval textblock {
#*** !doctools
#[call class::table [method add_row] [arg args]]
if {[dict size $o_columndefs] > 0 && ([llength $valuelist] && [llength $valuelist] != [dict size $o_columndefs])} {
error "add_row - invalid number of values in row - Must match existing column count: [dict size $o_columndefs]"
set msg ""
append msg "add_row - invalid number ([llength $valuelist]) of values in row - Must match existing column count: [dict size $o_columndefs]" \n
append msg "rowdata: $valuelist"
error $msg
}
if {[dict size $o_columndefs] == 0 && ![llength $valuelist]} {
error "add_row - no values supplied, and no columns defined, so cannot use default column values"
@ -1279,7 +1285,7 @@ namespace eval textblock {
set ansiborder_final $ansibase_header$ansiborder_header
}
set cidx [lindex [dict keys $o_columndefs] $index_expression]
set RST [a]
set RST [punk::ansi::a]
set colwidth [my column_width $cidx]
set hcell_line_blank [string repeat " " $colwidth]
@ -2674,8 +2680,10 @@ namespace eval textblock {
}
return [tcl::mathfunc::max {*}[lmap v $block {::punk::char::string_width [stripansi $v]}]]
}
pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- <input/0,indent/1|
pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1|
#we shouldn't make textblock depend on the punk pipeline system
#pipealias ::textblock::padleft .= {list $input [string repeat " " $indent]} |/0,padding/1> punk:lib::lines_as_list -- |> .= {lmap v $data {overtype::right $padding $v}} |> punk::lib::list_as_lines -- <input/0,indent/1|
#pipealias ::textblock::padright .= {list $input [string repeat " " $colsize]} |/0,padding/1> punk::lib::lines_as_list -- |> .= {lmap v $data {overtype::left $padding $v}} |> punk::lib::list_as_lines -- <input/0,colsize/1|
proc ::textblock::pad {block args} {
set defaults [dict create\
@ -2986,22 +2994,23 @@ namespace eval textblock {
#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 -- {|
data2
>} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
>} punk::lib::list_as_lines -- <lhs/0,w1/1,rhs/2,w2/3|
pipealias ::textblock::joinpair .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
/2,col1/1,col2/3
>} .=> punk::lib::lines_as_list -- {|
data2
>} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
>} punk::lib::list_as_lines -- <lhs/0,rhs/1|
# pipealias ::textblock::join_width .= {list $lhs [string repeat " " $w1] $rhs [string repeat " " $w2]} {|
# /2,col1/1,col2/3
# >} punk::lib::lines_as_list -- {|
# data2
# >} .=lhs> punk::lib::lines_as_list -- {|
# >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
# >} punk::lib::list_as_lines -- <lhs/0,w1/1,rhs/2,w2/3|
#
# pipealias ::textblock::joinpair .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
# /2,col1/1,col2/3
# >} .=> punk::lib::lines_as_list -- {|
# data2
# >} .=lhs> punk::lib::lines_as_list -- {|
# >} .= {lmap v $data w $data2 {val "[overtype::left $col1 $v][overtype::left $col2 $w]"}} {|
# >} punk::lib::list_as_lines -- <lhs/0,rhs/1|
proc ::textblock::join1 {args} {
@ -3081,13 +3090,13 @@ namespace eval textblock {
set trimlines ""
}
pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
/2,col1/1,col2/3
>} .=> punk::lib::lines_as_list -- {|
data2
>} .=lhs> punk::lib::lines_as_list -- {|
>} .= {lmap v $data w $data2 {val "[overtype::right $col1 $v][overtype::right $col2 $w]"}} {|
>} punk::lib::list_as_lines <lhs/0,rhs/1|
#pipealias ::textblock::join_right .= {list $lhs [string repeat " " [width $lhs]] $rhs [string repeat " " [width $rhs]]} {|
# /2,col1/1,col2/3
# >} .=> punk::lib::lines_as_list -- {|
# data2
# >} .=lhs> punk::lib::lines_as_list -- {|
# >} .= {lmap v $data w $data2 {val "[overtype::right $col1 $v][overtype::right $col2 $w]"}} {|
# >} punk::lib::list_as_lines <lhs/0,rhs/1|
proc example {} {
set pleft [>punk . rhs]

Loading…
Cancel
Save