Browse Source

more ANSI fixes

master
Julian Noble 9 months ago
parent
commit
b275c03969
  1. 308
      src/modules/punk/ansi-999999.0a1.0.tm
  2. 1
      src/modules/punk/lib-999999.0a1.0.tm
  3. 188
      src/vendormodules/overtype-1.6.0.tm

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

@ -70,7 +70,7 @@ package require punk::char
namespace eval punk::ansi::class { namespace eval punk::ansi::class {
if {![llength [info commands class_ansi]]} { if {![llength [info commands class_ansi]]} {
oo::class create class_ansi { oo::class create class_ansi {
variable o_raw variable o_ansistringobj
variable o_render_dimensions ;#last dimensions at which we rendered variable o_render_dimensions ;#last dimensions at which we rendered
variable o_rendered variable o_rendered
@ -79,12 +79,16 @@ namespace eval punk::ansi::class {
if {![regexp {^([0-9]+)[xX]([0-9]+)$} $dimensions _m w h]} { if {![regexp {^([0-9]+)[xX]([0-9]+)$} $dimensions _m w h]} {
error "class_ansi::render dimensions must be of the form <width>x<height>" error "class_ansi::render dimensions must be of the form <width>x<height>"
} }
#a straight string compare may be faster.. but a checksum is much smaller in memory, so we'll use that by default.
set o_rendered_what "" set o_rendered_what ""
#There may also be advantages to renering to a class_ansistring class object
set o_render_dimensions $dimensions set o_render_dimensions $dimensions
set o_raw $ansitext set o_ansistringobj [ansistring NEW $ansitext]
} }
method rawdata {} { method rawdata {} {
return $o_raw return [$o_ansistringobj get]
} }
method render {{dimensions ""}} { method render {{dimensions ""}} {
if {$dimensions eq ""} { if {$dimensions eq ""} {
@ -93,33 +97,51 @@ namespace eval punk::ansi::class {
if {![regexp {^([0-9]+)[xX]([0-9]+)$} $dimensions _m w h]} { if {![regexp {^([0-9]+)[xX]([0-9]+)$} $dimensions _m w h]} {
error "class_ansi::render dimensions must be of the form <width>x<height>" error "class_ansi::render dimensions must be of the form <width>x<height>"
} }
if {$o_rendered_what ne $o_raw || $dimensions ne $o_render_dimensions} { set cksum "not-done"
if {$dimensions ne $o_render_dimensions || $o_rendered_what ne [set cksum [$o_ansistringobj checksum]]} {
set b [textblock::block $w $h " "] set b [textblock::block $w $h " "]
#some ansi layout/art relies on wrapping at the width-dimension to display properly #some ansi layout/art relies on wrapping at the width-dimension to display properly
#this includes cursor movements ie right arrow can move cursor to columns in lines below #this includes cursor movements ie right arrow can move cursor to columns in lines below
#overflow is a different concept - perhaps not particularly congruent with the idea of the textblock as a mini terminal emulator. #overflow is a different concept - perhaps not particularly congruent with the idea of the textblock as a mini terminal emulator.
#overflow effectively auto-expands the block(terminal?) width #overflow effectively auto-expands the block(terminal?) width
#overflow and wrap both being true won't make sense unless we implement a max_overflow concept #overflow and wrap both being true won't make sense unless we implement a max_overflow concept
#set o_rendered [overtype::left -overflow 0 -wrap 1 -appendlines 1 $b $o_raw] #set o_rendered [overtype::left -overflow 0 -wrap 1 -appendlines 1 $b [$o_ansistringobj get]]
set o_rendered [overtype::left -overflow 0 -wrap 1 -width 80 -appendlines 1 "" $o_raw] set o_rendered [overtype::left -overflow 0 -wrap 1 -width 80 -appendlines 1 "" [$o_ansistringobj get]]
#set o_rendered_what $o_raw if {$cksum eq "not-done"} {
#if dimensions changed - the checksum won't have been done
set o_rendered_what [$o_ansistringobj checksum]
} else {
set o_rendered_what $cksum
}
set o_render_dimensions $dimensions set o_render_dimensions $dimensions
} }
#todo - store rendered and allow partial rendering of new data lines? #todo - store rendered and allow partial rendering of new data lines?
return $o_rendered return $o_rendered
} }
method checksum {} {
return [$o_ansistringobj checksum]
}
method checksum_last_rendered_input {} {
return $o_rendered_what
}
#todo - fix class_ansistring so the ansistring methods can be called directly
method viewlines {} { method viewlines {} {
return [ansistring VIEW $o_raw] return [ansistring VIEW [$o_ansistringobj get]]
} }
method viewcodes {} { method viewcodes {} {
return [ansistring VIEWCODES $o_raw] return [ansistring VIEWCODES [$o_ansistringobj get]]
} }
method viewchars {} { method viewchars {} {
return [punk::ansi::stripansiraw $o_raw] return [punk::ansi::stripansiraw [$o_ansistringobj get]]
} }
method viewstyle {} { method viewstyle {} {
return [ansistring VIEWSTYLE $o_raw] return [ansistring VIEWSTYLE [$o_ansistringobj get]]
}
method append {ansistring} {
$o_ansistringobj append $ansistring
#don't return the raw data - it may be big and probably won't play nicely with default terminal dimensions etc.
return
} }
} }
@ -1249,6 +1271,33 @@ namespace eval punk::ansi {
return [punk::char::ansifreestring_width [join $outchars ""]] return [punk::char::ansifreestring_width [join $outchars ""]]
} }
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#with thanks to Helmut Giese and other Authors of tcllib textutil
#this version is adjusted to handle ANSI SGR strings
proc untabifyLine { line num } {
variable Spaces
set currPos 0
while { 1 } {
set currPos [string first \t $line $currPos]
if { $currPos == -1 } {
# no more tabs
break
}
# how far is the next tab position ?
set dist [expr {$num - ($currPos % $num)}]
# replace '\t' at $currPos with $dist spaces
set line [string replace $line $currPos $currPos $Spaces($dist)]
# set up for next round (not absolutely necessary but maybe a trifle
# more efficient)
incr currPos $dist
}
return $line
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
}
#*** !doctools #*** !doctools
#[list_end] [comment {--- end definitions namespace punk::ansi ---}] #[list_end] [comment {--- end definitions namespace punk::ansi ---}]
@ -1997,7 +2046,206 @@ namespace eval punk::ansi::ta {
#[list_end] [comment {--- end definitions namespace punk::ansi::ta ---}] #[list_end] [comment {--- end definitions namespace punk::ansi::ta ---}]
} }
# -- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- ---
namespace eval punk::ansi::class {
#As this is intended for column-based terminals - it has a different notion of string length, string index etc than for a plain string.
oo::class create class_ansistring {
variable o_cksum_command
variable o_string
variable o_count
#this is the main state we keep of the split apart string
#we use the punk::ansi::ta::split_codes_single function which produces a list with zero, or an odd number elements always beginning and ending with plaintext
variable o_ptlist ;#plaintext as list of elements from ansisplits - will include empty elements from between adjacent ansi-codes
variable o_ansisplits ;#store our plaintext/ansi-code splits so we don't keep re-running the regexp to split
constructor {string} {
set o_string $string
#we choose not to generate an internal split-state for the initial string - which may potentially be large.
#there are a few methods such as get, has_ansi, show_state,checksum that can run efficiently on the initial string without generating it.
#The length method can use ansi::ta::detect to work quickly without updating it if it can, and other methods also update it as necessary
set o_count "" ;#o_count first updated when string appended or a method causes MakeSplit to run (or by count method if constructor argument was empty string)
set o_ansisplits [list] ;#we get empty pt(plaintext) between each ansi code. Codes include cursor movements, resets,alt graphics modes, terminal mode settings etc.
set o_ptlist [list]
#o_ansisplits and o_ptlist should only remain empty if an empty string was passed to the contructor, or no methods have yet triggered the initial string to have it's internal state built.
set o_cksum_command [list sha1::sha1 -hex]
}
method checksum {} {
if {[catch {
package require sha1
} errM]} {
error "sha1 package unavailable"
}
return [{*}$o_cksum_command $o_string]
}
#todo - allow setting checksum algorithm and/or command
method show_state {{verbose 0}} {
#show some state info - without updating anything
#only use 'my' methods that don't update the state e.g has_ansi
set result ""
if {![llength $o_ansisplits]} {
append result "No internal splits. "
append result \n "has ansi : [my has_ansi]"
append result \n "Tcl string length raw string: [string length $o_string]"
} else {
append result \n "has ansi : [my has_ansi]"
append result \n "ansisplit list len: [llength $o_ansisplits]"
append result \n "plaintext list len: [llength $o_ptlist]"
append result \n "cached count : $o_count"
append result \n "Tcl string length raw string : [string length $o_string]"
append result \n "Tcl string length plaintext parts: [string length [join $o_ptlist ""]]"
if {[llength $o_ansisplits] %2 == 0} {
append result \n --------------------------------------------------
append result \n Warning - ansisplits appears to be invalid length
append result \n Use show_state 1 to view
append result \n --------------------------------------------------
}
}
if {$verbose} {
append result \n "ansisplits listing"
#we will use a foreach with a single var rather than foreach {pt code} - so that if something goes wrong it's clearer.
#(using foreach {pt code} on an odd element list will give a spurious empty code at the end)
set i 0
foreach item $o_ansisplits {
if {$i % 2 == 0} {
set type "pt "
} else {
set type code
}
append result \n "$type: [ansistring VIEW $item]"
incr i
}
append result \n "Last element of ansisplits should be of type pt"
}
return $result
}
method MakeSplit {} {
#The split with each code as it's own element is more generally useful.
set o_ansisplits [punk::ansi::ta::split_codes_single $o_string];
set o_ptlist [list]
foreach {pt _code} $o_ansisplits {
lappend o_ptlist $pt
}
}
method convert_altg {} {
#do we need a method to retrieve without converting in the object?
puts "unimplemented"
}
method strippedlength {} {
if {![llength $o_ansisplits]} {my MakeSplit}
}
#returns the ansiless string - doesn't affect the stored state other than initialising it's internal state if it wasn't already
method stripped {} {
if {![llength $o_ansisplits]} {my MakeSplit}
return [join $o_ptlist ""]
}
#does not affect object state
method DoCount {plaintext} {
#- combiners/diacritics just map them away here - but for consistency we need to combine unicode grapheme clusters too.
#todo - joiners 200d? zwnbsp
set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+}
#we want length to return number of glyphs + normal controls such as newline.. not screen width. Has to be consistent with index function
return [string length [regsub -all $re_diacritics $plaintext ""]]
}
#This is the count of visible graphems + non-ansi control chars. Not equal to column width or to the Tcl string length of the ansistripped string!!!
method count {} {
if {$o_count eq ""} {
#only initial string present
if {$o_string eq ""} {
set o_count 0
return 0
}
my MakeSplit
set o_count [my DoCount [join $o_ptlist ""]]
}
return $o_count
}
#this is the equivalent of Tcl string length on the ansistripped string
method length {} {
if {![llength $o_ansisplits]} {
if {[punk::ansi::ta::detect $o_string]} {
my MakeSplit
} else {
return [string length $o_string]
}
} elseif {[llength $o_ansisplits] == 1} {
#single split always means no ansi
return string length $o_string
}
return [string length [join $o_ptlist ""]]
}
method get {} {
return $o_string
}
method has_ansi {} {
if {![llength $o_ansisplits]} {
#initial string - for large strings,it's faster to run detect than update the internal split-state.
return [punk::ansi::ta::detect $o_string]
} else {
#string will continue to have a single o_ansisplits element if only non-ansi appended
return [expr {[llength $o_ansisplits] != 1}]
}
}
method append {args} {
set catstr [join $args ""]
if {$catstr eq ""} {
return $o_string
}
if {![punk::ansi::ta::detect $catstr]} {
#ansi-free additions
#if no initial internal-split - generate it without first appending our additions - as we can more efficiently append them to the internal state
if {![llength $o_ansisplits]} {
#initialise o_count because we need to add to it.
#The count method will do this by calling Makesplit only if it needs to. (which will create ansisplits for anything except empty string)
my count
}
append o_string $catstr;# only append after updating using my count above
if {![llength $o_ptlist]} {
#If the object was initialised with empty string - we can still have empty lists for o_ptlist and o_ansisplits
#even though we can use lset to add to a list - we can't for empty
lappend o_ptlist $catstr
#assert - if o_ptlist is empty so is o_ansisplits
lappend o_ansisplits $catstr
} else {
lset o_ptlist end [string cat [lindex $o_ptlist end] $catstr]
lset o_ansisplits end [string cat [lindex $o_ansisplits end] $catstr]
}
incr o_count [my DoCount $catstr]
} else {
if {![llength $o_ansisplits]} {
#if we have an initial string - but no internal split-state because this is our first append and no methods have caused its generation - we can run more efficiently by combining it with the first append
append o_string $catstr ;#append before split and count on whole lot
my MakeSplit
set combined_plaintext [join $o_ptlist ""]
set o_count [my DoCount $combined_plaintext]
return $o_string
} else {
#update each element of internal state incrementally without reprocessing what is already there.
append o_string $catstr
set newsplits [punk::ansi::ta::split_codes_single $catstr]
set ptnew ""
foreach {pt code} $newsplits {
lappend o_ptlist $pt
append ptnew $pt
}
lset o_ansisplits end [string cat [lindex $o_ansisplits end] [lindex $newsplits 0]]
lappend o_ansisplits {*}[lrange $newsplits 1 end]
incr o_count [my DoCount $ptnew]
}
}
return $o_string
}
}
}
namespace eval punk::ansi::ansistring { namespace eval punk::ansi::ansistring {
#*** !doctools #*** !doctools
#[subsection {Namespace punk::ansi::ansistring}] #[subsection {Namespace punk::ansi::ansistring}]
@ -2008,7 +2256,7 @@ namespace eval punk::ansi::ansistring {
namespace path [list ::punk::ansi ::punk::ansi::ta] namespace path [list ::punk::ansi ::punk::ansi::ta]
namespace ensemble create namespace ensemble create
namespace export length length1 trim trimleft trimright index VIEW VIEWCODES VIEWSTYLE INDEXABSOLUTE INDEXCOLUMNS COLUMNINDEX namespace export length trim trimleft trimright index COUNT VIEW VIEWCODES VIEWSTYLE INDEXABSOLUTE INDEXCOLUMNS COLUMNINDEX NEW
#todo - expose _splits_ methods so caller can work efficiently with the splits themselves #todo - expose _splits_ methods so caller can work efficiently with the splits themselves
#we need to consider whether these can be agnostic towards splits from split_codes vs split_codes_single #we need to consider whether these can be agnostic towards splits from split_codes vs split_codes_single
@ -2296,6 +2544,10 @@ namespace eval punk::ansi::ansistring {
set debug_visuals [dict merge $visuals_c0 $visuals_c1 $hack] set debug_visuals [dict merge $visuals_c0 $visuals_c1 $hack]
#for repeated interaction with the same ANSI string - a mechanism to store state is more efficient
proc NEW {string} {
punk::ansi::class::class_ansistring new $string
}
proc VIEW {args} { proc VIEW {args} {
#*** !doctools #*** !doctools
#[call [fun VIEW] [arg string]] #[call [fun VIEW] [arg string]]
@ -2371,7 +2623,10 @@ namespace eval punk::ansi::ansistring {
#test of ISO2047 - 7bit - limited set, limited support, somewhat obscure glyphs #test of ISO2047 - 7bit - limited set, limited support, somewhat obscure glyphs
#return [string map [list \033 \U2296 \007 \U237E] $string] #return [string map [list \033 \U2296 \007 \U237E] $string]
} }
proc VIEWCODES {string} { proc VIEWCODES {args} {
set string [lindex $args end]
set arglist [lrange $args 0 end-1]
if {$string eq ""} { if {$string eq ""} {
return "" return ""
} }
@ -2407,7 +2662,7 @@ namespace eval punk::ansi::ansistring {
set output "" set output ""
set splits [punk::ansi::ta::split_codes_single $string] set splits [punk::ansi::ta::split_codes_single $string]
foreach {pt code} $splits { foreach {pt code} $splits {
append output "$pt" append output [ansistring VIEW {*}$arglist $pt]
if {[punk::ansi::codetype::is_sgr_reset $code]} { if {[punk::ansi::codetype::is_sgr_reset $code]} {
set displaycode [ansistring VIEW $code] set displaycode [ansistring VIEW $code]
append output ${whiteb}$displaycode$RST append output ${whiteb}$displaycode$RST
@ -2506,15 +2761,23 @@ namespace eval punk::ansi::ansistring {
return $output return $output
} }
proc length {string} {
#todo - change to COUNT to emphasize the difference between this and doing a Tcl string length on the ansistriped string!
#review. Tabs/elastic tabstops. Do we want to count a tab as one element? Probably so if we are doing so for \n etc and not counting 2W unicode.
#Consider leaving tab manipualation for a width function which determines columns occupied for all such things.
proc COUNT {string} {
#*** !doctools #*** !doctools
#[call [fun length] [arg string]] #[call [fun COUNT] [arg string]]
#[para]Returns the length of the string without ansi codes #[para]Returns the count of visible graphemes and non-ansi control characters
#[para]Incomplete! grapheme clustering support not yet implemented - only diacritics are currently clustered to count as one grapheme.
#[para]This will not count strings hidden inside a 'privacy message' or other ansi codes which may have content between their opening escape and their termination sequence. #[para]This will not count strings hidden inside a 'privacy message' or other ansi codes which may have content between their opening escape and their termination sequence.
#[para]This is equivalent to calling string length on the result of stripansi $string #[para]This is not quite equivalent to calling string length on the result of stripansi $string due to diacritics and/or grapheme combinations
#[para]Note that this returns the number of characters in the payload (after applying combiners), and is not always the same as the width of the string as rendered on a terminal. #[para]Note that this returns the number of characters in the payload (after applying combiners)
#It is not always the same as the width of the string as rendered on a terminal due to 2wide Unicode characters and the usual invisible control characters such as \r and \n
#[para]To get the width, use punk::ansi::printing_length instead, which is also ansi aware. #[para]To get the width, use punk::ansi::printing_length instead, which is also ansi aware.
#stripping diacritics only makes sense if we are counting them as combiners and also treating unicode grapheme combinations as single entities.
#as Our ansistring index function returns the character with diacritics, and will ultimately return grapheme clusters as a single element - we strip theme here as not counted.
#todo - combiners/diacritics? just map them away here? #todo - combiners/diacritics? just map them away here?
set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+}
set string [regsub -all $re_diacritics $string ""] set string [regsub -all $re_diacritics $string ""]
@ -2522,9 +2785,14 @@ namespace eval punk::ansi::ansistring {
#we want length to return number of glyphs.. not screen width. Has to be consistent with index function #we want length to return number of glyphs.. not screen width. Has to be consistent with index function
string length [stripansi $string] string length [stripansi $string]
} }
proc length {string} {
string length [stripansi $string]
}
#included as a test/verification - slightly slower. #included as a test/verification - slightly slower.
#grapheme split version may end up being used once it supports unicode grapheme clusters #grapheme split version may end up being used once it supports unicode grapheme clusters
proc length2 {string} { proc count2 {string} {
#we want length to return number of glyphs.. not screen width. Has to be consistent with index function #we want length to return number of glyphs.. not screen width. Has to be consistent with index function
return [llength [punk::char::grapheme_split [stripansi $string]]] return [llength [punk::char::grapheme_split [stripansi $string]]]
} }

1
src/modules/punk/lib-999999.0a1.0.tm

@ -599,7 +599,6 @@ namespace eval punk::lib {
} }
return $prefix return $prefix
} }
#test example of the technique - not necessarily particularly useful as a function, except maybe for brevity/clarity. todo - test if inlined version gives any perf advantage compared to a temp var #test example of the technique - not necessarily particularly useful as a function, except maybe for brevity/clarity. todo - test if inlined version gives any perf advantage compared to a temp var
proc swapnumvars {namea nameb} { proc swapnumvars {namea nameb} {
upvar $namea a $nameb b upvar $namea a $nameb b

188
src/vendormodules/overtype-1.6.0.tm

@ -200,7 +200,31 @@ proc overtype::string_columns {text} {
#These have similar algorithms/requirements - and should be refactored to be argument-wrappers over a function called something like overtype::renderblock #These have similar algorithms/requirements - and should be refactored to be argument-wrappers over a function called something like overtype::renderblock
#overtype::renderblock could render the input to a defined (possibly overflowing in x or y) rectangle overlapping the underlay. #overtype::renderblock could render the input to a defined (possibly overflowing in x or y) rectangle overlapping the underlay.
#(i.e not even necessariy having it's top left within the underlay) #(i.e not even necessariy having it's top left within the underlay)
namespace eval overtype::priv {
}
#could return larger than colwidth
proc _get_row_append_column {row} {
upvar outputlines outputlines
set idx [expr {$row -1}]
if {$row <= 1 || $row > [llength $outputlines]} {
return 1
} else {
upvar opt_overflow opt_overflow
upvar colwidth colwidth
set existinglen [punk::ansi::printing_length [lindex $outputlines $idx]]
set endpos [expr {$existinglen +1}]
if {$opt_overflow} {
return $endpos
} else {
if {$endpos > $colwidth} {
return $colwidth + 1
} else {
return $endpos
}
}
}
}
#string range should generally be avoided for both undertext and overtext which contain ansi escapes and other cursor affecting chars such as \b and \r #string range should generally be avoided for both undertext and overtext which contain ansi escapes and other cursor affecting chars such as \b and \r
#render onto an already-rendered (ansi already processed) 'underlay' string, a possibly ansi-laden 'overlay' string. #render onto an already-rendered (ansi already processed) 'underlay' string, a possibly ansi-laden 'overlay' string.
#The underlay and overlay can be multiline blocks of text of varying line lengths. #The underlay and overlay can be multiline blocks of text of varying line lengths.
@ -233,12 +257,13 @@ proc overtype::left {args} {
-transparent 0\ -transparent 0\
-exposed1 \uFFFD\ -exposed1 \uFFFD\
-exposed2 \uFFFD\ -exposed2 \uFFFD\
-experimental 0\
] ]
#-ellipsis args not used if -wrap is true #-ellipsis args not used if -wrap is true
set argsflags [lrange $args 0 end-2] set argsflags [lrange $args 0 end-2]
dict for {k v} $argsflags { dict for {k v} $argsflags {
switch -- $k { switch -- $k {
-width - -bias - -wrap - -ellipsis - -ellipsistext - -ellipsiswhitespace - -overflow - -appendlines - -transparent - -exposed1 - -exposed2 {} -width - -bias - -wrap - -ellipsis - -ellipsistext - -ellipsiswhitespace - -overflow - -appendlines - -transparent - -exposed1 - -exposed2 - -experimental {}
default { default {
set known_opts [dict keys $defaults] set known_opts [dict keys $defaults]
error "overtype::left unknown option '$k'. Known options: $known_opts" error "overtype::left unknown option '$k'. Known options: $known_opts"
@ -262,6 +287,24 @@ proc overtype::left {args} {
set opt_exposed2 [dict get $opts -exposed2] ;#widechar_exposed_right - todo set opt_exposed2 [dict get $opts -exposed2] ;#widechar_exposed_right - todo
# -- --- --- --- --- --- # -- --- --- --- --- ---
# ----------------------------
# -experimental dev flag to set flags etc
# ----------------------------
set data_mode 0
set test_mode 0
set opt_experimental [dict get $opts -experimental]
foreach o $opt_experimental {
switch -- $o {
test_mode {
set test_mode 1
}
data_mode {
set data_mode 1
}
}
}
# ----------------------------
#modes #modes
set insert_mode 0 ;#can be toggled by insert key or ansi IRM sequence ESC [ 4 h|l set insert_mode 0 ;#can be toggled by insert key or ansi IRM sequence ESC [ 4 h|l
set autowrap_mode $opt_wrap set autowrap_mode $opt_wrap
@ -288,6 +331,15 @@ proc overtype::left {args} {
} }
set overlines [split $overblock \n] set overlines [split $overblock \n]
if {$test_mode} {
set lflines [list]
foreach ln $overlines {
append ln \n
lappend lflines $ln
}
lset lflines end [string range [lindex $lflines end] 0 end-1]
set overlines $lflines[unset lflines]
}
#overblock height/width isn't useful in the presence of an ansi input overlay with movements. The number of lines may bear little relationship to the output height #overblock height/width isn't useful in the presence of an ansi input overlay with movements. The number of lines may bear little relationship to the output height
#lassign [blocksize $overblock] _w overblock_width _h overblock_height #lassign [blocksize $overblock] _w overblock_width _h overblock_height
@ -298,15 +350,20 @@ proc overtype::left {args} {
set cursor_saved_position [dict create] set cursor_saved_position [dict create]
set cursor_saved_attributes "" set cursor_saved_attributes ""
#underlines are not necessarily processed in order - depending on cursor-moves applied from overtext
set row 1
set prevrow 1
set col 1
set outputlines $underlines set outputlines $underlines
set underlay_resets [list] set underlay_resets [list]
set overidx 0 set overidx 0
#underlines are not necessarily processed in order - depending on cursor-moves applied from overtext
set prevrow 1
set row 1
if {$data_mode} {
set col [_get_row_append_column $row]
} else {
set col 1
}
while {$overidx < [llength $overlines]} { while {$overidx < [llength $overlines]} {
flush stdout flush stdout
@ -324,7 +381,7 @@ proc overtype::left {args} {
} }
#review insert_mode. As an 'overtype' function whose main function is not interactive keystrokes - insert is secondary - #review insert_mode. As an 'overtype' function whose main function is not interactive keystrokes - insert is secondary -
#but even if we didn't want it as an option to the function call - to process ansi adequately we need to support IRM (insertion-replacement mode) ESC [ 4 h|l #but even if we didn't want it as an option to the function call - to process ansi adequately we need to support IRM (insertion-replacement mode) ESC [ 4 h|l
set LASTCALL [list -info 1 -insert_mode $insert_mode -autowrap_mode $autowrap_mode -transparent $opt_transparent -width $colwidth -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -cursor_column $col -cursor_row $row $undertext $overtext] #set LASTCALL [list -info 1 -insert_mode $insert_mode -autowrap_mode $autowrap_mode -transparent $opt_transparent -width $colwidth -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -cursor_column $col -cursor_row $row $undertext $overtext]
set rinfo [renderline -info 1 -insert_mode $insert_mode -autowrap_mode $autowrap_mode -transparent $opt_transparent -width $colwidth -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -cursor_column $col -cursor_row $row $undertext $overtext] set rinfo [renderline -info 1 -insert_mode $insert_mode -autowrap_mode $autowrap_mode -transparent $opt_transparent -width $colwidth -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -cursor_column $col -cursor_row $row $undertext $overtext]
set instruction [dict get $rinfo instruction] set instruction [dict get $rinfo instruction]
set insert_mode [dict get $rinfo insert_mode] set insert_mode [dict get $rinfo insert_mode]
@ -406,18 +463,33 @@ proc overtype::left {args} {
set nextprefix "" set nextprefix ""
#todo - handle potential insertion mode as above for cursor restore? #todo - handle potential insertion mode as above for cursor restore?
#keeping separate branches for debugging - review and merge as appropriate when stable #keeping separate branches for debugging - review and merge as appropriate when stable
switch -- $instruction { switch -- $instruction {
{} { {} {
flush stdout if {$test_mode == 0} {
if {$unapplied eq "" && [ansistring length $rendered]} {
#consumed all overlay - no instruction
set col 1
incr row incr row
if {$data_mode} {
set col [_get_row_append_column $row]
if {$col > $colwidth} {
}
} else { } else {
set col 1 set col 1
incr row }
} else {
#lf included in data
set row $post_render_row
if {$post_render_row != $renderedrow} {
if {$data_mode} {
set col [_get_row_append_column $row]
} else {
set col 1
}
} else {
set col $post_render_col
}
} }
} }
up { up {
@ -434,7 +506,22 @@ proc overtype::left {args} {
#puts stdout "1 row:$row col $col" #puts stdout "1 row:$row col $col"
set row $post_render_row set row $post_render_row
#data_mode (naming?) determines if we move to end of existing data or not.
#data_mode 0 means ignore existing line length and go to exact column
#set by -experimental flag
if {$data_mode == 0} {
set col $post_render_col set col $post_render_col
} else {
#This doesn't really work if columns are pre-filled with spaces..we can't distinguish them from data
#we need renderline to return the number of the maximum column filled (or min if we ever do r-to-l)
set existingdata [lindex $outputlines [expr {$post_render_row -1}]]
set lastdatacol [punk::ansi::printing_length $existingdata]
if {$lastdatacol < $colwidth} {
set col [expr {$lastdatacol+1}]
} else {
set col $colwidth
}
}
#puts stdout "2 row:$row col $col" #puts stdout "2 row:$row col $col"
#puts stdout "-----------------------" #puts stdout "-----------------------"
@ -442,6 +529,7 @@ proc overtype::left {args} {
#flush stdout #flush stdout
} }
down { down {
if {$data_mode == 0} {
#renderline doesn't know how far down we can go.. #renderline doesn't know how far down we can go..
if {$post_render_row > [llength $outputlines]} { if {$post_render_row > [llength $outputlines]} {
if {$opt_appendlines} { if {$opt_appendlines} {
@ -454,6 +542,25 @@ proc overtype::left {args} {
} }
set row $post_render_row set row $post_render_row
set col $post_render_col set col $post_render_col
} else {
if {$post_render_row > [llength $outputlines]} {
if {$opt_appendlines} {
set diff [expr {$post_render_row - [llength $outputlines]}]
if {$diff > 0} {
lappend outputlines {*}[lrepeat $diff ""]
}
lappend outputlines ""
}
}
set existingdata [lindex $outputlines [expr {$post_render_row -1}]]
set lastdatacol [punk::ansi::printing_length $existingdata]
if {$lastdatacol < $colwidth} {
set col [expr {$lastdatacol+1}]
} else {
set col $colwidth
}
}
} }
restore_cursor { restore_cursor {
#testfile belinda.ans uses this #testfile belinda.ans uses this
@ -513,16 +620,27 @@ proc overtype::left {args} {
#overflow + unapplied? #overflow + unapplied?
} }
newlines_above { newlines_above {
#renderline doesn't advance the row for us - the caller has the choice to implement or not #renderline doesn't advance the row for us - the caller has the choice to implement or not
set row $post_render_row set row $post_render_row
set col $post_render_col set col $post_render_col
if {$new_lines_above > 0} { if {$insert_lines_above > 0} {
set outputlines [linsert $outputlines $row [lrepeat $new_lines_above ""]] set row $renderedrow
incr row $new_lines_above ;#we should end up on the same line of text (at a different index), with new empties inserted above set outputlines [linsert $outputlines $renderedrow-1 {*}[lrepeat $insert_lines_above ""]]
incr row $insert_lines_above ;#we should end up on the same line of text (at a different index), with new empties inserted above
#? set row $post_render_row #can renderline tell us?
} }
} }
newlines_below { newlines_below {
puts newlines_below puts --->nl_below
set row $post_render_row
set col $post_render_col
if {$insert_lines_below == 1} {
set row $renderedrow
set outputlines [linsert $outputlines [expr {$renderedrow}] {*}[lrepeat $insert_lines_below ""]] ;#note - linsert can add to end too
incr row $insert_lines_below
set col 1
}
} }
wrapmoveforward { wrapmoveforward {
#doesn't seem to be used by fruit.ans testfile #doesn't seem to be used by fruit.ans testfile
@ -1365,6 +1483,10 @@ proc overtype::renderline {args} {
g { g {
set ch $item set ch $item
incr idx_over; #idx_over (until unapplied reached anyway) is per *grapheme* in the overlay - not per col. incr idx_over; #idx_over (until unapplied reached anyway) is per *grapheme* in the overlay - not per col.
if {($idx < ($opt_colstart -1))} {
incr idx [grapheme_width_cached $ch]
continue
}
set within_undercols [expr {$idx <= [llength $undercols]-1}] ;#within our active data width set within_undercols [expr {$idx <= [llength $undercols]-1}] ;#within our active data width
@ -1414,9 +1536,8 @@ proc overtype::renderline {args} {
if {($idx < ($opt_colstart -1))} { if {($do_transparency && [regexp $opt_transparent $ch])} {
incr idx #todo - move this branch of the if
} elseif {($do_transparency && [regexp $opt_transparent $ch])} {
#pre opt_colstart is effectively transparent (we have applied padding of required number of columns to left of overlay) #pre opt_colstart is effectively transparent (we have applied padding of required number of columns to left of overlay)
if {$idx > [llength $outcols]-1} { if {$idx > [llength $outcols]-1} {
lappend outcols " " lappend outcols " "
@ -1479,6 +1600,7 @@ proc overtype::renderline {args} {
} }
} else { } else {
set chtest [string map [list \n <lf> \b <bs> \r <cr> \v <vt> \x7f <del>] $ch] set chtest [string map [list \n <lf> \b <bs> \r <cr> \v <vt> \x7f <del>] $ch]
#specials - each shoud have it's own test of what to do if it happens after overflow_idx reached
switch -- $chtest { switch -- $chtest {
"<lf>" { "<lf>" {
if 1 { if 1 {
@ -1488,6 +1610,13 @@ proc overtype::renderline {args} {
#leave the overflow_idx #leave the overflow_idx
set insert_lines_above 1 ;#keep for consistency with ansi sequence that requests insertion of line(s)? set insert_lines_above 1 ;#keep for consistency with ansi sequence that requests insertion of line(s)?
set instruction newlines_above set instruction newlines_above
#idx_over already incremented
priv::render_unapplied $overlay_grapheme_control_list $gci
break
} elseif {$idx > $overflow_idx} {
incr cursor_row
#todo
} else { } else {
#linefeed occurred in middle or at end of text #linefeed occurred in middle or at end of text
incr cursor_row incr cursor_row
@ -1495,12 +1624,10 @@ proc overtype::renderline {args} {
set overflow_idx $idx set overflow_idx $idx
set insert_lines_below 1 set insert_lines_below 1
set instruction newlines_below set instruction newlines_below
}
#idx_over already incremented #idx_over already incremented
priv::render_unapplied $overlay_grapheme_control_list $gci priv::render_unapplied $overlay_grapheme_control_list $gci
break break
}
} else { } else {
@ -1670,6 +1797,8 @@ proc overtype::renderline {args} {
} }
} ;# end switch } ;# end switch
} }
} }
other { other {
set code $item set code $item
@ -1814,12 +1943,6 @@ proc overtype::renderline {args} {
if {$num eq ""} {set num 1} if {$num eq ""} {set num 1}
incr cursor_row -$num incr cursor_row -$num
#if {$overflow_idx != -1} {
# if {$idx == $overflow_idx} {
# #compensate for linefeed
# incr cursor_row
# }
#}
if {$cursor_row < 1} { if {$cursor_row < 1} {
set cursor_row 1 set cursor_row 1
} }
@ -1837,17 +1960,6 @@ proc overtype::renderline {args} {
if {$num eq ""} {set num 1} if {$num eq ""} {set num 1}
incr cursor_row $num incr cursor_row $num
#if {$overflow_idx != -1} {
# if {$idx == $overflow_idx} {
# #incr cursor_row -1
# if {$cursor_row == $row_before_move} {
# if {!$opt_overflow} {
# #allow other controls to be processed or next grapheme to overflow
# continue
# }
# }
# }
#}
incr idx_over ;#idx_over hasn't encountered a grapheme and hasn't advanced yet incr idx_over ;#idx_over hasn't encountered a grapheme and hasn't advanced yet
priv::render_unapplied $overlay_grapheme_control_list $gci priv::render_unapplied $overlay_grapheme_control_list $gci

Loading…
Cancel
Save