#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)
#leave map unindented - used both as a dict and for direct display
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
set settings_applied [string trim $SGR_setting_map \n]
try {
package require overtype ;# circular dependency - many components require overtype. Here we only need it for nice layout in the a? query proc - so we'll do a soft-dependency by only loading when needed and also wrapping in a try
package require textblock
append out [textblock::join $indent [string map $strmap $settings_applied]] \n
append out [textblock::join $indent [string trim $SGR_colour_map \n]] \n
append out [textblock::join $indent "Example: \[a+ bold red White underline\]text\[a] -> [a+ bold red White underline]text[a]"] \n \n
set bgname "White"
set map1 [colourmap1 $bgname]
set map1 [overtype::centre -transparent 1 $map1 "[a black $bgname]Standard colours[a]"]
set map2 [colourmap2 $bgname]
set map2 [overtype::centre -transparent 1 $map2 "[a black $bgname]High-intensity colours[a]"]
append out [textblock::join $map1 " " $map2] \n
#append out $map1[a] \n
#append out $map2[a] \n
append out [colourblock_216]
append out [textblock::join $indent [textblock::join $map1 $map2]] \n
append out "[a+ web-white]216 colours of 256 terminal colours (To see names, use: a? term)[a]" \n
append out [textblock::join $indent [colourblock_216]] \n
append out "[a+ web-white]24 Greyscale colours[a]" \n
append out [textblock::join $indent [colourblock_24]] \n
append out [textblock::join $indent "To see all names use: a? web"] \n
append out [textblock::join $indent "To see specific colour groups use: a? web groupname1 groupname2..."] \n
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
#intended for single grapheme - but will work for multiple
#cannot contain ansi or newlines
#(a cache of ansifreestring_width calls - as these are quite regex heavy)
proc grapheme_width_cached {ch} {
#review - effective memory leak on longrunning programs if never cleared
#tradeoff in fragmenting cache and reducing efficiency vs ability to clear in a scoped manner
proc grapheme_width_cached {ch {key ""}} {
variable grapheme_widths
if {[dict exists $grapheme_widths $ch]} {
return [dict get $grapheme_widths $ch]
#if key eq "*" - we won't be able to clear that cache individually. Perhaps that's ok
if {[dict exists $grapheme_widths $key $ch]} {
return [dict get $grapheme_widths $key $ch]
}
set width [punk::char::ansifreestring_width $ch] ;#review - can we provide faster version if we know it's a single grapheme rather than a string? (grapheme is still a string as it may have combiners/diacritics)
dict set grapheme_widths $ch $width
dict set grapheme_widths $key $ch $width
return $width
}
proc grapheme_width_cache_clear {key} {
variable grapheme_widths
if {$key eq "*} {
set grapheme_widths [dict create]
} else {
dict unset grapheme_widths $key
}
return
}
#no char_width - use grapheme_width terminology to be clearer
proc grapheme_width {char} {
error "grapheme_width unimplemented - use ansifreestring_width"
interp alias {} lpop {} ::punk::lib::compat::lmaptcl
}
#lmap came in Tcl 8.6 - so probably not much need for a tcl forward compatibility version - but here it is anyway
proc lmaptcl {varnames list script} {
set result [list]
set varlist [list]
foreach varname $varnames {
upvar 1 $varname var_$varname ;#ensure no collisions with vars in this proc
lappend varlist var_$varname
}
foreach $varlist $list {
lappend result [uplevel 1 $script]
}
return $result
}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::lib::compat ---}]
@ -196,6 +244,99 @@ namespace eval punk::lib {
#[para] Core API functions for punk::lib
#[list_begin definitions]
#The closure-like behaviour is *very* slow especially when called from a context such as the global namespace with lots of vars and large arrays such as ::env
proc lmapflat_closure {varnames list script} {
set result [list]
set values [list]
foreach v $varnames {
lappend values "\$$v"
}
# -- --- ---
#capture - use uplevel 1 or namespace eval depending on context
set capture [uplevel 1 {
apply { varnames {
set capturevars [dict create]
set capturearrs [dict create]
foreach fullv $varnames {
set v [namespace tail $fullv]
upvar 1 $v var
if {[info exists var]} {
if {(![array exists var])} {
dict set capturevars $v $var
} else {
dict set capturearrs capturedarray_$v [array get var]
}
} else {
#A variable can show in the results for 'info vars' but still not 'exist'. e.g a 'variable x' declaration in the namespace where the variable has never been set
}
}
return [dict create vars $capturevars arrs $capturearrs]
} } [info vars]
} ]
# -- --- ---
set cvars [dict get $capture vars]
set carrs [dict get $capture arrs]
set apply_script ""
foreach arrayalias [dict keys $carrs] {
set realname [string range $arrayalias [string first _ $arrayalias]+1 end]
#This will still be wrong for example with diacritics on terminals that don't collapse the space following a diacritic, and don't correctly report cursor position
#(i.e as at 2024 - lots of them) wezterm on windows at least does the right thing.
#unicode box drawing only provides enough characters for seamless joining of unicode boxes light and heavy.
#e.g with characters such as \u2539 Box Drawings Right Light and Left Up Heavy.
#the double glyphs in box drawing can do a limited set of joins to light lines - but not enough for seamless table layouts.
#the arc set can't even join to itself e.g with curved equivalents of T-like shapes
variable framedef_cache
set cache_key [concat $f $args]
if {[dict exists $framedef_cache $cache_key]} {
return [dict get $framedef_cache $cache_key]
}
set defaults [dict create\
-joins ""\
-boxonly 0\
]
dict for {k v} $args {
switch -- $k {
-joins - -boxonly {}
default {
error "framedef unknown option '$k'. Known options [dict keys $args]"
}
}
}
set opts [dict merge $defaults $args]
set joins [dict get $opts -joins]
set boxonly [dict get $opts -boxonly]
#sorted order down left right up
#1 x choose 4
@ -4297,7 +4356,16 @@ namespace eval textblock {
set vlrj $vlr
}
}
return [dict create\
if {$boxonly} {
set result [dict create\
tlc $tlc hlt $hlt trc $trc\
vll $vll vlr $vlr\
blc $blc hlb $hlb brc $brc\
]
dict set framedef_cache $cache_key $result
return $result
} else {
set result [dict create\
tlc $tlc hlt $hlt trc $trc\
vll $vll vlr $vlr\
blc $blc hlb $hlb brc $brc\
@ -4306,7 +4374,31 @@ namespace eval textblock {
vllj $vllj\
vlrj $vlrj\
]
dict set framedef_cache $cache_key $result
return $result
}
}
variable frame_cache
set frame_cache [dict create]
proc frame_cache {{action ""}} {
if {$action ni [list clear ""]} {
error "frame_cache action '$action' not understood. Valid actions: clear"
}
variable frame_cache
set out ""
dict for {k v} $frame_cache {
lassign $v _f frame _used used
append out [textblock::join $k " " $frame " " $used]\n
}
if {$action eq "clear"} {
set frame_cache [dict create]
append out \nCLEARED
}
return $out
}
#options before content argument - which is allowed to be absent
#frame performance (noticeable with complex tables even of modest size) is improved significantly by frame_cache - but is still (2024) a fairly expensive operation.
proc frame {args} {
variable frametypes
set expect_optval 0
@ -4356,11 +4448,14 @@ namespace eval textblock {
-ansibase ""\
-align "left"\
-ellipsis 1\
-usecache 1\
-buildcache 1\
]
#use -buildcache 1 with -usecache 0 for debugging cache issues so we can inspect using textblock::frame_cache
