Browse Source

fix ansistring trim, add textblock::testblock

master
Julian Noble 8 months ago
parent
commit
f85343ebc3
  1. 114
      src/modules/punk/ansi-999999.0a1.0.tm
  2. 46
      src/modules/textblock-999999.0a1.0.tm
  3. 28
      src/vendormodules/overtype-1.6.0.tm

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

@ -386,6 +386,7 @@ namespace eval punk::ansi {
#standard string append #standard string append
$s1 append $ansi2 $s1 append $ansi2
# -- # --
$s2 destroy
#$s1 append \033\[31mX ;#redX #$s1 append \033\[31mX ;#redX
return $s1 return $s1
@ -402,7 +403,7 @@ namespace eval punk::ansi {
#ansistring object append #ansistring object append
$s1 appendobj $s2 $s1 appendobj $s2
# -- # --
$s2 destroy
#$s1 append \033\[31mX ;#redX #$s1 append \033\[31mX ;#redX
return $s1 return $s1
} }
@ -2441,6 +2442,9 @@ namespace eval punk::ansi::class {
} }
set o_cursor_row $row set o_cursor_row $row
} }
#consider scroll area
#we need to render to something with a concept of viewport, offscreen above,below,left,right?
method rendernext {} { method rendernext {} {
upvar ${o_ns_from}::o_ansisplits from_ansisplits upvar ${o_ns_from}::o_ansisplits from_ansisplits
upvar ${o_ns_from}::o_elements from_elements upvar ${o_ns_from}::o_elements from_elements
@ -2477,7 +2481,7 @@ namespace eval punk::ansi::class {
#as a counterpoint however - we don't currently retrieve grapheme width during split (performance impact at wrong time?) - and width may depend on the rendering method anyway #as a counterpoint however - we don't currently retrieve grapheme width during split (performance impact at wrong time?) - and width may depend on the rendering method anyway
#e.g c0 controls are normally zero printing width - but are (often) 1-wide glyphs in a cp437 rendering operation. #e.g c0 controls are normally zero printing width - but are (often) 1-wide glyphs in a cp437 rendering operation.
#we want to render all the elements in this splitindex - for pt this may be multiple, for code it will be a single element #we want to render all the elements in this splitindex - for pt this may be multiple, for code it will be a single element(?)
set newtext "" set newtext ""
set rendercount 0 set rendercount 0
@ -2495,6 +2499,7 @@ namespace eval punk::ansi::class {
lassign $elementinfo _type item lassign $elementinfo _type item
} }
} else { } else {
#while not g ? render however many ansi sequences are in a row?
set newtext $item set newtext $item
lappend o_rendereditems $elementinfo lappend o_rendereditems $elementinfo
incr rendercount incr rendercount
@ -3692,6 +3697,70 @@ namespace eval punk::ansi::ansistring {
string length [stripansi $string] string length [stripansi $string]
} }
proc _splits_trimleft {sclist} {
set intext 0
set outlist [list]
foreach {pt ansiblock} $sclist {
if {$ansiblock ne ""} {
if {!$intext} {
if {$pt eq "" || [regexp {^\s+$} $pt]} {
lappend outlist "" $ansiblock
} else {
lappend outlist [string trimleft $pt] $ansiblock
set intext 1
}
} else {
lappend outlist $pt $ansiblock
}
} else {
if {!$intext} {
if {$pt eq "" || [regexp {^\s+$} $pt]} {
lappend outlist ""
} else {
lappend outlist [string trimleft $pt]
set intext 1
}
} else {
lappend outlist $pt
}
}
}
return $outlist
}
proc _splits_trimright {sclist} {
set intext 0
set outlist [list]
foreach {pt ansiblock} [lreverse $sclist] {
if {$ansiblock ne ""} {
if {!$intext} {
if {$pt eq "" || [regexp {^\s+$} $pt]} {
lappend outlist "" $ansiblock
} else {
lappend outlist [string trimright $pt] $ansiblock
set intext 1
}
} else {
lappend outlist $pt $ansiblock
}
} else {
if {!$intext} {
if {$pt eq "" || [regexp {^\s+$} $pt]} {
lappend outlist ""
} else {
lappend outlist [string trimright $pt]
set intext 1
}
} else {
lappend outlist $pt
}
}
}
return [lreverse $outlist]
}
proc _splits_trim {sclist} {
return [_splits_trimright [_splits_trimleft $sclist]]
}
proc trimleft {string args} { proc trimleft {string args} {
set intext 0 set intext 0
@ -3712,8 +3781,10 @@ namespace eval punk::ansi::ansistring {
return $out return $out
} }
proc trimright {string} { proc trimright {string} {
#broken!
if {$string eq ""} {return ""} ;#excludes the case where split_codes would return nothing if {$string eq ""} {return ""} ;#excludes the case where split_codes would return nothing
set rtrimmed_list [lreverse [_splits_trimleft [lreverse [split_codes $string]]]] #jmn
set rtrimmed_list [lreverse [_splits_trimright [lreverse [split_codes $string]]]]
return [join $rtrimmed_list ""] return [join $rtrimmed_list ""]
} }
proc trim {string} { proc trim {string} {
@ -4079,43 +4150,6 @@ namespace eval punk::ansi::ansistring {
} }
} }
proc _splits_trimleft {sclist} {
set intext 0
set outlist [list]
foreach {pt ansiblock} $sclist {
if {!$intext} {
if {$pt eq "" || [regexp {^\s+$} $pt]} {
lappend outlist "" $ansiblock
} else {
lappend outlist [string trimleft $pt] $ansiblock
set intext 1
}
} else {
lappend outlist $pt $ansiblock
}
}
return $outlist
}
proc _splits_trimright {sclist} {
set intext 0
set outlist [list]
foreach {pt ansiblock} [lreverse $sclist] {
if {!$intext} {
if {$pt eq "" || [regexp {^\s+$} $pt]} {
lappend outlist "" $ansiblock
} else {
lappend outlist [string trimright $pt] $ansiblock
set intext 1
}
} else {
lappend outlist $pt $ansiblock
}
}
return [lreverse $outlist]
}
proc _splits_trim {sclist} {
return [_splits_trimright [_splits_trimleft $sclist]]
}
#*** !doctools #*** !doctools
#[list_end] [comment {--- end definitions namespace punk::ansi::ta ---}] #[list_end] [comment {--- end definitions namespace punk::ansi::ta ---}]

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

@ -72,6 +72,52 @@ namespace eval textblock {
return [::join $mtrx \n] return [::join $mtrx \n]
} }
} }
proc testblock {size {colour ""}} {
if {$size <1 || $size > 15} {
error "textblock::testblock only sizes between 1 and 15 inclusive supported"
}
set rainbow_list [list]
lappend rainbow_list {30 47} ;#black White
lappend rainbow_list {31 46} ;#red Cyan
lappend rainbow_list {32 45} ;#green Purple
lappend rainbow_list {33 44} ;#yellow Blue
lappend rainbow_list {34 43} ;#blue Yellow
lappend rainbow_list {35 42} ;#purple Green
lappend rainbow_list {36 41} ;#cyan Red
lappend rainbow_list {37 40} ;#white Black
lappend rainbow_list {black Yellow}
lappend rainbow_list red
lappend rainbow_list green
lappend rainbow_list yellow
lappend rainbow_list blue
lappend rainbow_list purple
lappend rainbow_list cyan
lappend rainbow_list {white Red}
set chars [concat [punk::range 1 9] A B C D E F]
set charsubset [lrange $chars 0 $size-1]
set c [::join $charsubset \n]
set RST [a]
if {"rainbow" in $colour} {
set clist [list]
for {set i 0} {$i <$size} {incr i} {
set colour2 [string map [list rainbow [lindex $rainbow_list $i]] $colour]
set ansi [a+ {*}$colour2]
set ansicode [punk::ansi::codetype::sgr_merge_list "" $ansi]
lappend clist ${ansicode}$c$RST
}
} else {
set cc $c
if {$colour ne ""} {
set cc [a+ {*}$colour]$c$RST
}
set clist [lrepeat $size $cc]
}
textblock::join {*}$clist
}
interp alias {} testblock {} textblock::testblock
#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 #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} { proc width {textblock} {

28
src/vendormodules/overtype-1.6.0.tm

@ -302,8 +302,9 @@ proc overtype::left {args} {
# -experimental dev flag to set flags etc # -experimental dev flag to set flags etc
# ---------------------------- # ----------------------------
set data_mode 0 set data_mode 0
set test_mode 0 set test_mode 1
set info_mode 0 set info_mode 0
set edit_mode 0
set opt_experimental [dict get $opts -experimental] set opt_experimental [dict get $opts -experimental]
foreach o $opt_experimental { foreach o $opt_experimental {
switch -- $o { switch -- $o {
@ -311,12 +312,19 @@ proc overtype::left {args} {
set test_mode 1 set test_mode 1
set info_mode 1 set info_mode 1
} }
old_mode {
set test_mode 0
set info_mode 1
}
data_mode { data_mode {
set data_mode 1 set data_mode 1
} }
info_mode { info_mode {
set info_mode 1 set info_mode 1
} }
edit_mode {
set edit_mode 1
}
} }
} }
# ---------------------------- # ----------------------------
@ -355,20 +363,6 @@ proc overtype::left {args} {
#(in cases where there are interline moves or cursor jumps anyway) #(in cases where there are interline moves or cursor jumps anyway)
#This works - but doesn't seem efficient. #This works - but doesn't seem efficient.
#On the other hand.. maybe it depends on the data. For simpler files it's more efficient than splitting first #On the other hand.. maybe it depends on the data. For simpler files it's more efficient than splitting first
if 0 {
set inputchunks [split $overblock \n]
if {$test_mode} {
set lflines [list]
foreach ln $inputchunks {
append ln \n
lappend lflines $ln
}
if {[llength $lflines]} {
lset lflines end [string range [lindex $lflines end] 0 end-1]
}
set inputchunks $lflines[unset lflines]
}
}
if {!$test_mode} { if {!$test_mode} {
set inputchunks [split $overblock \n] set inputchunks [split $overblock \n]
@ -376,6 +370,7 @@ proc overtype::left {args} {
set scheme 3 set scheme 3
switch -- $scheme { switch -- $scheme {
0 { 0 {
#one big chunk
set inputchunks [list $overblock] set inputchunks [list $overblock]
} }
1 { 1 {
@ -399,6 +394,7 @@ proc overtype::left {args} {
} }
} }
3 { 3 {
#it turns out line based chunks are faster than the above.. probably because some of those end up doing the regex splitting twice
set lflines [list] set lflines [list]
set inputchunks [split $overblock \n] set inputchunks [split $overblock \n]
foreach ln $inputchunks { foreach ln $inputchunks {
@ -2487,7 +2483,7 @@ proc overtype::renderline {args} {
#$re_decstbm #$re_decstbm
#https://www.vt100.net/docs/vt510-rm/DECSTBM.html #https://www.vt100.net/docs/vt510-rm/DECSTBM.html
#This control function sets the top and bottom margins for the current page. You cannot perform scrolling outside the margins #This control function sets the top and bottom margins for the current page. You cannot perform scrolling outside the margins
lassign [split $param {;} margin_top margin_bottom] lassign [split $param {;}] margin_top margin_bottom
#todo - return these for the caller to process.. #todo - return these for the caller to process..
puts stderr "overtype::renderline DECSTBM set top and bottom margin not implemented" puts stderr "overtype::renderline DECSTBM set top and bottom margin not implemented"

Loading…
Cancel
Save