You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
697 lines
29 KiB
697 lines
29 KiB
# -*- tcl -*- |
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
|
# |
|
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
|
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# (C) 2023 |
|
# |
|
# @@ Meta Begin |
|
# Application textblock 999999.0a1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Requirements |
|
##e.g package require frobz |
|
#package require punk |
|
package require punk::args |
|
package require punk::char |
|
package require punk::lib |
|
catch {package require patternpunk} |
|
package require overtype |
|
package require term::ansi::code::macros ;#required for frame if old ansi g0 used - review - make package optional? |
|
package require textutil |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# |
|
#Note: A textblock does not necessarily have lines the same length - either in number of characters or print-width |
|
# |
|
namespace eval textblock { |
|
namespace export block width |
|
namespace eval cd { |
|
#todo - save and restore existing namespace export in case macros::cd has default exports in future |
|
namespace eval ::term::ansi::code::macros::cd {namespace export *} |
|
namespace import ::term::ansi::code::macros::cd::* |
|
namespace eval ::term::ansi::code::macros::cd {namespace export -clear} |
|
} |
|
|
|
#return a homogenous block of characters - ie lines all same length, all same character |
|
#printing-width in terminal columns is not necessarily same as blockwidth even if a single char is passed (could be full-width unicode character) |
|
proc block {blockwidth blockheight {char " "}} { |
|
if {$blockwidth < 0} { |
|
error "textblock::block blockwidth must be an integer greater than or equal to zero" |
|
} |
|
if {$blockheight <= 0} { |
|
error "textblock::block blockheight must be a positive integer" |
|
} |
|
if {$char eq ""} {return ""} |
|
if {[string length $char] == 1} { |
|
set row [string repeat $char $blockwidth] |
|
set mtrx [lrepeat $blockheight $row] |
|
return [::join $mtrx \n] |
|
} else { |
|
set charblock [string map [list \r\n \n] $char] |
|
if {[string first \n $charblock] >= 0} { |
|
if {$blockwidth > 1} { |
|
set row [.= val $charblock {*}[lrepeat [expr {$blockwidth -1}] |> piper_blockjoin $charblock]] |
|
} else { |
|
set row $charblock |
|
} |
|
} else { |
|
set row [string repeat $char $blockwidth] |
|
} |
|
set mtrx [lrepeat $blockheight $row] |
|
return [::join $mtrx \n] |
|
} |
|
} |
|
|
|
#todo - consider 'elastic tabstops' for textblocks where tab acts as a column separator and adjacent lines with the same number of tabs form a sort of table |
|
proc width {textblock} { |
|
#backspaces, vertical tabs,carriage returns |
|
|
|
if {$textblock eq ""} { |
|
return 0 |
|
} |
|
|
|
#textutil::tabify is a reasonable hack when there are no ansi SGR codes - but probably not always what we want even then - review |
|
set textblock [textutil::tabify::untabify2 $textblock] |
|
|
|
if {[string first \n $textblock] >= 0} { |
|
return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::ansifreestring_width [stripansi $v]}]] |
|
} |
|
return [punk::char::ansifreestring_width [stripansi $textblock]] |
|
} |
|
proc width_naive {textblock} { |
|
# doesn't deal with backspaces, vertical tabs,carriage returns, ansi movements |
|
|
|
if {$textblock eq ""} { |
|
return 0 |
|
} |
|
|
|
set textblock [textutil::tabify::untabify2 $textblock] ;#a reasonable hack - but probably not always what we want - review |
|
|
|
if {[string first \n $textblock] >= 0} { |
|
return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::string_width [stripansi $v]}]] |
|
} |
|
return [punk::char::string_width [stripansi $textblock]] |
|
} |
|
proc height {textblock} { |
|
#This is the height as it will/would-be rendered - not the number of input lines purely in terms of le |
|
#empty string still has height 1 (at least for left-right/right-left languages) |
|
|
|
#vertical tab on a proper terminal should move directly down. |
|
#Whether or not the terminal in use actually does this - we need to calculate as if it does. (there might not even be a terminal) |
|
|
|
set num_le [expr {[string length $textblock]-[string length [string map [list \n {} \v {}] $textblock]]}] ;#faster than splitting into single-char list |
|
return [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le |
|
} |
|
#MAINTENANCE - same as overtype::blocksize? |
|
proc size {textblock} { |
|
if {$textblock eq ""} { |
|
return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings |
|
} |
|
set textblock [textutil::tabify::untabify2 $textblock] |
|
#stripansi on entire block in one go rather than line by line - result should be the same - review - make tests |
|
set textblock [punk::ansi::stripansi $textblock] |
|
if {[string first \n $textblock] >= 0} { |
|
set width [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $textblock] {::punk::char::ansifreestring_width $v}]] |
|
} else { |
|
set width [punk::char::ansifreestring_width $textblock] |
|
} |
|
set num_le [expr {[string length $textblock]-[string length [string map [list \n {} \v {}] $textblock]]}] ;#faster than splitting into single-char list |
|
#our concept of block-height is likely to be different to other line-counting mechanisms |
|
set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le |
|
|
|
return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize <data>]] width height |
|
} |
|
#must be able to handle block as string with or without newlines |
|
#if no newlines - attempt to treat as a list |
|
#must handle whitespace-only string,list elements, and/or lines. |
|
#reviewing 2024 - this seems like too much magic! |
|
proc width1 {block} { |
|
if {$block eq ""} { |
|
return 0 |
|
} |
|
set block [textutil::tabify::untabify2 $block] |
|
if {[string first \n $block] >= 0} { |
|
return [tcl::mathfunc::max {*}[lmap v [punk::lib::lines_as_list -- $block] {::punk::char::string_width [stripansi $v]}]] |
|
} |
|
if {[catch {llength $block}]} { |
|
return [::punk::char::string_width [stripansi $block]] |
|
} |
|
if {[llength $block] == 0} { |
|
#could be just a whitespace string |
|
return [string length $block] |
|
} |
|
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| |
|
proc ::textblock::pad {block args} { |
|
set defaults [dict set\ |
|
-padchar " "\ |
|
-which "right"\ |
|
-width ""\ |
|
-overflow 0\ |
|
] |
|
set usage "pad ?-padchar <character>? ?-which right|left|centre? -width <int>" |
|
foreach {k v} $args { |
|
if {$k ni [dict keys $defaults]} { |
|
error "textblock::pad unrecognised option '$k'. Usage: $usage" |
|
} |
|
} |
|
set opts [dict merge $defaults $args] |
|
# -- --- --- --- --- --- --- --- --- --- |
|
set padchar [dict get $opts -padchar] |
|
# -- --- --- --- --- --- --- --- --- --- |
|
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 width [dict get $opts -width] |
|
# -- --- --- --- --- --- --- --- --- --- |
|
|
|
if {$width = ""} { |
|
|
|
} |
|
|
|
|
|
} |
|
|
|
|
|
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} { |
|
lassign [punk::args::opts_values { |
|
-ansiresets -default 1 -type integer |
|
blocks -type string -multiple 1 |
|
} $args] _o opts _v values |
|
set blocks [dict get $values blocks] |
|
|
|
set idx 0 |
|
set fordata [list] |
|
foreach b $blocks { |
|
set c($idx) [string repeat " " [width $b]] |
|
lappend fordata "v($idx)" [punk::lib::lines_as_list {*}$opts -- $b] |
|
incr idx |
|
} |
|
set outlines [list] |
|
foreach {*}$fordata { |
|
set row "" |
|
foreach colidx [lsort -integer -increasing [array names c]] { |
|
append row [overtype::left $c($colidx) $v($colidx)] |
|
} |
|
lappend outlines $row |
|
} |
|
return [punk::lib::list_as_lines -- $outlines] |
|
} |
|
proc ::textblock::join {args} { |
|
lassign [punk::args::opts_values { |
|
blocks -type string -multiple 1 |
|
} $args] _o opts _v values |
|
set blocks [dict get $values blocks] |
|
|
|
set idx 0 |
|
set fordata [list] |
|
foreach b $blocks { |
|
set c($idx) [string repeat " " [width $b]] |
|
#lappend fordata "v($idx)" [punk::lib::lines_as_list -- $b] |
|
lappend fordata "v($idx)" [punk::lib::lines_as_list -ansiresets 1 -- $b] |
|
incr idx |
|
} |
|
set outlines [list] |
|
set colindices [lsort -integer -increasing [array names c]] |
|
foreach {*}$fordata { |
|
set row "" |
|
foreach colidx $colindices { |
|
append row [overtype::left $c($colidx) $v($colidx)] |
|
} |
|
lappend outlines $row |
|
} |
|
return [::join $outlines \n] |
|
} |
|
|
|
proc ::textblock::trim {block} { |
|
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| |
|
|
|
proc example {} { |
|
set pleft [>punk . rhs] |
|
set pright [>punk . lhs] |
|
set prightair [>punk . lhs_air] |
|
set red [a+ red]; set redb [a+ red bold] |
|
set green [a+ green]; set greenb [a+ green bold] |
|
set cyan [a+ cyan];set cyanb [a+ cyan bold] |
|
set blue [a+ blue];set blueb [a+ blue bold] |
|
set RST [a] |
|
set gr0 [punk::ansi::g0 abcdefghijklm\nnopqrstuvwxyz] |
|
set punks [textblock::join $pleft $pright] |
|
set pleft_greenb $greenb$pleft$RST |
|
set pright_redb $redb$pright$RST |
|
set prightair_cyanb $cyanb$prightair$RST |
|
set cpunks [textblock::join $pleft_greenb $pright_redb] |
|
set out "" |
|
append out $punks \n |
|
append out $cpunks \n |
|
append out [textblock::join $punks $cpunks] \n |
|
set 2frames_a [textblock::join [textblock::frame $cpunks] [textblock::frame $punks]] |
|
append out $2frames_a \n |
|
set 2frames_b [textblock::join [textblock::frame -ansiborder $cyanb -title "plainpunks" $punks] [textblock::frame -ansiborder $greenb -title "fancypunks" $cpunks]] |
|
append out [textblock::frame -title "punks" $2frames_b\n$RST$2frames_a] \n |
|
append out [overtype::right [overtype::left [textblock::frame -ansiborder [a+ green bold] -type unicode_box_heavy -title ${redb}PATTERN$RST -subtitle ${redb}PUNK$RST $prightair_cyanb] "$blueb\n\n\P\nU\nN\nK$RST"] "$blueb\n\nL\nI\nF\nE"] \n |
|
return $out |
|
} |
|
|
|
proc example3 {{text "test\netc\nmore text"}} { |
|
package require patternpunk |
|
.= textblock::join [punk::lib::list_as_lines -- [list 1 2 3 4 5 6 7]] [>punk . lhs] |> .=>1 textblock::join " " |> .=>1 textblock::join $text |> .=>1 textblock::join [>punk . rhs] |> .=>1 textblock::join [punk::lib::list_as_lines -- [lrepeat 7 " | "]] |
|
} |
|
proc example2 {{text "test\netc\nmore text"}} { |
|
package require patternpunk |
|
.= textblock::join\ |
|
[punk::lib::list_as_lines -- [list 1 2 3 4 5 6 7 8]]\ |
|
[>punk . lhs]\ |
|
" "\ |
|
$text\ |
|
[>punk . rhs]\ |
|
[punk::lib::list_as_lines -- [lrepeat 8 " | "]] |
|
} |
|
|
|
proc frame {args} { |
|
package require punk::char |
|
|
|
set contents [lindex $args end] |
|
set arglist [lrange $args 0 end-1] |
|
if {[llength $arglist] % 2 != 0} { |
|
error "Usage frame ?-type unicode|altg|ascii|<dict hl (c) vl (c) tlc (c) trc (c) blc (c) brc (c)>? ?-title <ansitext>? ?-subtitle <ansitext>? ?-width <columns>? ?-ansiborder <ansi_sgr>? <contents>" |
|
} |
|
#todo args -justify left|centre|right (center) |
|
|
|
set defaults [dict create\ |
|
-type unicode_box\ |
|
-title ""\ |
|
-subtitle ""\ |
|
-width ""\ |
|
-ansiborder ""\ |
|
-align "left"\ |
|
] |
|
set opts [dict merge $defaults $arglist] |
|
foreach {k v} $opts { |
|
if {$k ni [dict keys $defaults]} { |
|
error "frame option '$k' not understood. Valid options are [dict keys $defaults]" |
|
} |
|
} |
|
# -- --- --- --- --- --- |
|
set opt_type [dict get $opts -type] |
|
set known_types [list unicode_box unicode_box_heavy unicode_arc unicode_double ascii altg] |
|
set default_custom [dict create hl " " vl " " tlc " " trc " " blc " " brc " "] |
|
set custom_keys [list hl hlt hlb vl vll vlr tlc trc blc brc] |
|
if {$opt_type ni $known_types} { |
|
set is_custom_dict_ok 1 |
|
if {[llength $opt_type] %2 == 0} { |
|
#custom dict may leave out keys - but cannot have unknown keys |
|
dict for {k v} $opt_type { |
|
if {$k ni $custom_keys} { |
|
set is_custom_dict_ok 0 |
|
break |
|
} |
|
} |
|
} else { |
|
set is_custom_dict_ok 0 |
|
} |
|
if {!$is_custom_dict_ok} { |
|
error "frame option -type must be one of known types: $known_types or a dictionary with any of keys hl,hlt,hlb,vl,vll,vlr,tlc,trc,blc,brc" |
|
} |
|
set custom_frame [dict merge $default_custom $opt_type] |
|
} |
|
# -- --- --- --- --- --- |
|
set opt_title [dict get $opts -title] |
|
set opt_subtitle [dict get $opts -subtitle] |
|
set opt_width [dict get $opts -width] |
|
# -- --- --- --- --- --- |
|
set opt_align [dict get $opts -align] |
|
set opt_align [string tolower $opt_align] |
|
if {$opt_align ni [list left right centre center]} { |
|
#these are all valid commands for overtype::<cmd> |
|
error "frame option -align must be left|right|centre|center - received: $$opt_align" |
|
} |
|
# -- --- --- --- --- --- |
|
set opt_ansiborder [dict get $opts -ansiborder] |
|
# -- --- --- --- --- --- |
|
|
|
set contents [textutil::tabify::untabify2 $contents] |
|
set contents [string map [list \r\n \n] $contents] |
|
|
|
set actual_contentwidth [width $contents] |
|
if {$opt_title ne ""} { |
|
set titlewidth [punk::ansi::printing_length $opt_title] |
|
set content_or_title_width [expr {max($actual_contentwidth,$titlewidth)}] |
|
} else { |
|
set titlewith 0 |
|
set content_or_title_width $actual_contentwidth |
|
} |
|
|
|
if {[$opt_width eq ""]} { |
|
set contentwidth $content_or_title_width |
|
} else { |
|
set contentwidth [expr {$opt_width -2}] ;#default |
|
} |
|
|
|
#todo - render it with vertical overflow so we can process ansi moves? |
|
set linecount [textblock::height $contents] |
|
set rst [a] |
|
set column [string repeat " " $contentwidth] ;#default - may need to override for custom frame |
|
if {$opt_type eq "altg"} { |
|
#old style ansi escape sequences with alternate graphics page G0 |
|
set hl [cd::hl] |
|
set hlt $hl |
|
set hlb $hl |
|
set vl [cd::vl] |
|
set vll $vl |
|
set vlr $vl |
|
set tlc [cd::tlc] |
|
set trc [cd::trc] |
|
set blc [cd::blc] |
|
set brc [cd::brc] |
|
set tbar [string repeat $hl $contentwidth] |
|
set tbar [cd::groptim $tbar] |
|
set bbar $tbar |
|
} elseif {$opt_type eq "ascii"} { |
|
set hl - |
|
set hlt - |
|
set hlb - |
|
set vl | |
|
set vll | |
|
set vlr | |
|
set tlc + |
|
set trc + |
|
set blc + |
|
set brc + |
|
set tbar [string repeat - $contentwidth] |
|
set bbar $tbar |
|
} elseif {$opt_type eq "unicode_box"} { |
|
#unicode box drawing set |
|
set hl [punk::char::charshort boxd_lhz] ;# light horizontal |
|
set hlt $hl |
|
set hlb $hl |
|
set vl [punk::char::charshort boxd_lv] ;#light vertical |
|
set vll $vl |
|
set vlr $vl |
|
set tlc [punk::char::charshort boxd_ldr] |
|
set trc [punk::char::charshort boxd_ldl] |
|
set blc [punk::char::charshort boxd_lur] |
|
set brc [punk::char::charshort boxd_lul] |
|
set tbar [string repeat $hl $contentwidth] |
|
set bbar $tbar |
|
} elseif {$opt_type eq "unicode_box_heavy"} { |
|
#unicode box drawing set |
|
set hl [punk::char::charshort boxd_hhz] ;# light horizontal |
|
set hlt $hl |
|
set hlb $hl |
|
set vl [punk::char::charshort boxd_hv] ;#light vertical |
|
set vll $vl |
|
set vlr $vl |
|
set tlc [punk::char::charshort boxd_hdr] |
|
set trc [punk::char::charshort boxd_hdl] |
|
set blc [punk::char::charshort boxd_hur] |
|
set brc [punk::char::charshort boxd_hul] |
|
set tbar [string repeat $hl $contentwidth] |
|
set bbar $tbar |
|
} elseif {$opt_type eq "unicode_double"} { |
|
#unicode box drawing set |
|
set hl [punk::char::charshort boxd_dhz] ;# double horizontal \U2550 |
|
set hlt $hl |
|
set hlb $hl |
|
set vl [punk::char::charshort boxd_dv] ;#double vertical \U2551 |
|
set vll $vl |
|
set vlr $vl |
|
set tlc [punk::char::charshort boxd_ddr] ;#double down and right \U2554 |
|
set trc [punk::char::charshort boxd_ddl] ;#double down and left \U2557 |
|
set blc [punk::char::charshort boxd_dur] ;#double up and right \U255A |
|
set brc [punk::char::charshort boxd_dul] ;#double up and left \U255D |
|
set tbar [string repeat $hl $contentwidth] |
|
set bbar $tbar |
|
} elseif {$opt_type eq "unicode_arc"} { |
|
#unicode box drawing set |
|
set hl [punk::char::charshort boxd_lhz] ;# light horizontal |
|
set hlt $hl |
|
set hlb $hl |
|
set vl [punk::char::charshort boxd_lv] ;#light vertical |
|
set vll $vl |
|
set vlr $vl |
|
set tlc [punk::char::charshort boxd_ladr] ;#light arc down and right \U256D |
|
set trc [punk::char::charshort boxd_ladl] ;#light arc down and left \U256E |
|
set blc [punk::char::charshort boxd_laur] ;#light arc up and right \U2570 |
|
set brc [punk::char::charshort boxd_laul] ;#light arc up and left \U256F |
|
set tbar [string repeat $hl $contentwidth] |
|
set bbar $tbar |
|
} else { |
|
dict with custom_frame {} ;#extract keys as vars |
|
if {[dict exists $custom_frame hlt]} { |
|
set hlt [dict get $custom_frame hlt] |
|
} else { |
|
set hlt $hl |
|
} |
|
set hlt_width [punk::ansi::printing_length $hlt] |
|
if {[dict exists $custom_frame hlb]} { |
|
set hlb [dict get $custom_frame hlb] |
|
} else { |
|
set hlb $hl |
|
} |
|
set hlb_width [punk::ansi::printing_length $hlb] |
|
|
|
if {[dict exists $custom_frame vll]} { |
|
set vll [dict get $custom_frame vll] |
|
} else { |
|
set vll $vl |
|
} |
|
set vll_width [punk::ansi::printing_length $vll] |
|
if {[dict exists $custom_frame vlr]} { |
|
set vlr [dict get $custom_frame vlr] |
|
} else { |
|
set vlr $vl |
|
} |
|
set vlr_width [punk::ansi::printing_length $vlr] |
|
|
|
set tlc_width [punk::ansi::printing_length $tlc] |
|
set trc_width [punk::ansi::printing_length $trc] |
|
set blc_width [punk::ansi::printing_length $blc] |
|
set brc_width [punk::ansi::printing_length $brc] |
|
|
|
|
|
set framewidth [expr {$contentwidth + 2}] ;#reverse default assumption |
|
if {$opt_width eq ""} { |
|
#width wasn't specified - so user is expecting frame to adapt to title/contents |
|
#content shouldn't truncate because of extra wide frame |
|
set contentwidth $content_or_title_width |
|
set tbarwidth [expr {$content_or_title_width + 2 - $tlc_width - $trc_width - 2 + $vll_width + $vlr_width}] ;#+/2's for difference between border element widths and standard element single-width |
|
set bbarwidth [expr {$content_or_title_width + 2 - $blc_width - $brc_width - 2 + $vll_width + $vlr_width}] |
|
} else { |
|
set contentwidth [expr $opt_width - $vll_width - $vlr_width] ;#content may be truncated |
|
set tbarwidth [expr {$opt_width - $tlc_width - $trc_width}] |
|
set bbarwidth [expr {$opt_width - $blc_width - $brc_width}] |
|
} |
|
set column [string repeat " " $contentwidth] |
|
|
|
if {$hlt_width == 1} { |
|
set tbar [string repeat $hlt $tbarwidth] |
|
} else { |
|
#possibly mixed width chars that make up hlt - string range won't get width right |
|
set blank [string repeat " " $tbarwidth] |
|
set count [expr {($tbarwidth / $hlt_width) + 1}] |
|
set tbar [string repeat $hlt $count] |
|
#set tbar [string range $tbar 0 $tbarwidth-1] |
|
set tbar [overtype::left -overflow 0 -exposed1 " " -exposed2 " " $blank $tbar];#spaces for exposed halves of 2w chars instead of default replacement character |
|
} |
|
if {$hlb_width == 1} { |
|
set bbar [string repeat $hlb $bbarwidth] |
|
} else { |
|
set blank [string repeat " " $bbarwidth] |
|
set count [expr {($bbarwidth / $hlb_width) + 1}] |
|
set bbar [string repeat $hlb $count] |
|
#set bbar [string range $bbar 0 $bbarwidth-1] |
|
set bbar [overtype::left -overflow 0 -exposed1 " " -exposed2 " " $blank $bbar] |
|
} |
|
} |
|
#keep lhs/rhs separate? can we do vertical text on sidebars? |
|
set lhs [string repeat $vll\n $linecount] |
|
set lhs [string range $lhs 0 end-1] |
|
set rhs [string repeat $vlr\n $linecount] |
|
set rhs [string range $rhs 0 end-1] |
|
if {$opt_ansiborder ne ""} { |
|
set tbar $opt_ansiborder$tbar$rst |
|
set bbar $opt_ansiborder$bbar$rst |
|
set tlc $opt_ansiborder$tlc$rst |
|
set trc $opt_ansiborder$trc$rst |
|
set blc $opt_ansiborder$blc$rst |
|
set brc $opt_ansiborder$brc$rst |
|
set lhs $opt_ansiborder$lhs$rst ;#wrap the whole block and let textblock::join figure it out |
|
set rhs $opt_ansiborder$rhs$rst |
|
} |
|
|
|
if {$opt_title ne ""} { |
|
set topbar [overtype::centre -overflow 0 -exposed1 " " -exposed2 " " -ellipsis 1 -bias left $tbar $opt_title] ;#overtype supports gx0 on/off |
|
} else { |
|
set topbar $tbar |
|
} |
|
if {$opt_subtitle ne ""} { |
|
set bottombar [overtype::centre -overflow 0 -exposed1 " " -exposed2 " " -ellipsis 1 -bias left $bbar $opt_subtitle] ;#overtype supports gx0 on/off |
|
} else { |
|
set bottombar $bbar |
|
} |
|
append fs $tlc$topbar$trc\n |
|
set inner [overtype::$opt_align -ellipsis 1 $column $contents] |
|
set body [textblock::join -- $lhs $inner $rhs] |
|
append fs $body |
|
append fs \n $blc$bottombar$brc |
|
|
|
return $fs |
|
|
|
} |
|
proc gcross {{size 1} args} { |
|
if {$size == 0} { |
|
return "" |
|
} |
|
|
|
set defaults [list\ |
|
-max_cross_size 0 |
|
] |
|
set opts [dict merge $defaults $args] |
|
set opt_max_cross_size [dict get $opts -max_cross_size] |
|
|
|
#set fit_size [punk::lib::greatestOddFactor $size] |
|
set fit_size $size |
|
if {$opt_max_cross_size == 0} { |
|
set max_cross_size $fit_size |
|
} else { |
|
#todo - only allow divisors |
|
#set testsize [expr {min($fit_size,$opt_max_cross_size)}] |
|
|
|
set factors [punk::lib::factors $size] |
|
#pick odd size in list that is smaller or equal to test_size |
|
set max_cross_size [lindex $factors end] |
|
set last_ok [lindex $factors 0] |
|
for {set i 0} {$i < [llength $factors]} {incr i} { |
|
set s [lindex $factors $i] |
|
if {$s > $opt_max_cross_size} { |
|
break |
|
} |
|
set last_ok $s |
|
} |
|
set max_cross_size $last_ok |
|
} |
|
set crosscount [expr {$size / $max_cross_size}] |
|
|
|
package require punk::char |
|
set x [punk::char::charshort boxd_ldc] |
|
set bs [punk::char::charshort boxd_ldgullr] |
|
set fs [punk::char::charshort boxd_ldgurll] |
|
|
|
set onecross "" |
|
set crossrows [list] |
|
set armsize [expr {int(floor($max_cross_size /2))}] |
|
set row [lrepeat $max_cross_size " "] |
|
#toparm |
|
for {set i 0} {$i < $armsize} {incr i} { |
|
set r $row |
|
lset r $i $bs |
|
lset r end-$i $fs |
|
#append onecross [::join $r ""] \n |
|
lappend crossrows [::join $r ""] |
|
} |
|
|
|
if {$max_cross_size % 2 != 0} { |
|
#only put centre cross in for odd sized crosses |
|
set r $row |
|
lset r $armsize $x |
|
#append onecross [::join $r ""] \n |
|
lappend crossrows [::join $r ""] |
|
} |
|
|
|
for {set i [expr {$armsize -1}]} {$i >= 0} {incr i -1} { |
|
set r $row |
|
lset r $i $fs |
|
lset r end-$i $bs |
|
#append onecross [::join $r ""] \n |
|
lappend crossrows [::join $r ""] |
|
} |
|
#set onecross [string trimright $onecross \n] |
|
set onecross [::join $crossrows \n] |
|
|
|
#fastest to do row first then columns - because textblock::join must do line by line |
|
|
|
if {$crosscount > 1} { |
|
package require textblock |
|
set row [textblock::join {*}[lrepeat $crosscount $onecross]] |
|
set rows [lrepeat $crosscount $row] |
|
set out [::join $rows \n] |
|
} else { |
|
set out $onecross |
|
} |
|
|
|
return $out |
|
} |
|
|
|
#Test we can join two coloured blocks |
|
proc test_colour {} { |
|
set b1 [a= red]1\n2\n3[a=] |
|
set b2 [a= green]a\nb\nc[a=] |
|
set result [textblock::join $b1 $b2] |
|
puts $result |
|
#return [list $b1 $b2 $result] |
|
return [ansistring VIEW $result] |
|
} |
|
namespace import ::punk::ansi::stripansi |
|
} |
|
|
|
|
|
namespace eval ::textblock::piper { |
|
namespace export * |
|
proc join {rhs pipelinedata} { |
|
tailcall ::textblock::join -- $pipelinedata $rhs |
|
} |
|
} |
|
interp alias {} piper_blockjoin {} ::textblock::piper::join |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Ready |
|
package provide textblock [namespace eval textblock { |
|
variable version |
|
set version 999999.0a1.0 |
|
}] |
|
return |