diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index bf56e8c..0157411 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -106,7 +106,7 @@ namespace eval punk::ansi::class { #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 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 -width $w -appendlines 1 "" [$o_ansistringobj get]] + set o_rendered [overtype::left -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] if {$cksum eq "not-done"} { #if dimensions changed - the checksum won't have been done set o_rendered_what [$o_ansistringobj checksum] @@ -129,10 +129,41 @@ namespace eval punk::ansi::class { set o_dimensions $dimensions - set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width $w -appendlines 1 "" [$o_ansistringobj get]] + set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" [$o_ansistringobj get]] return $rendered } - method render_to_input_line {x {minuschar 0}} { + method render_to_input_line {args} { + if {[llength $args] < 1} { + puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + } + set x [lindex $args end] + set arglist [lrange $args 0 end-1] + if {[llength $arglist] %2 != 0} { + puts stderr "render_to_input_line usage: ?-dimensions WxH? ?-minus charcount? x" + } + set defaults [dict create\ + -dimensions 80x24\ + -minus 0\ + ] + dict for {k v} $arglist { + switch -- $k { + -dimensions - -minus { } + default { + puts stderr "render_to_input_line unexpected argument '$k' usage: ?-dimensions WxH? ?-minus charcount? x" + } + } + } + set opts [dict merge $defaults $arglist] + set opt_dimensions [dict get $opts -dimensions] + set opt_minus [dict get $opts -minus] + lassign [split $opt_dimensions x] w h + if {![string is integer -strict $w] || ![string is integer -strict $h] || $w < 1 || $h < 1} { + puts stderr "render_to_input_line WxH width & height must be positive integer values usage: ?-dimensions WxH? ?-minus charcount? x" + } + if {![string is integer -strict $opt_minus]} { + puts stderr "render_to_input_line -minus must be positive integer value representing number of chars to exclude from end. usage: ?-dimensions WxH? ?-minus charcount? x" + } + package require textblock set lfvis [ansistring VIEW -lf 1 \n] set maplf [list \n "[a+ green bold reverse]${lfvis}[a]\n"] ;#a mapping to highlight newlines @@ -141,12 +172,12 @@ namespace eval punk::ansi::class { set rlines [lrange $lines 0 $x] set chunk [::join $rlines \n] append chunk \n - if {$minuschar ne "0"} { - set chunk [string range $chunk 0 end-$minuschar] + if {$opt_minus ne "0"} { + set chunk [string range $chunk 0 end-$opt_minus] } - set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width 80 -appendlines 1 "" $chunk] + set rendered [overtype::left -experimental {test_mode} -overflow 0 -wrap 1 -width $w -height $h -appendlines 1 "" $chunk] set marker "" - for {set i 1} {$i <= 80} {incr i} { + for {set i 1} {$i <= $w} {incr i} { if {$i % 10 == 0} { ::append marker "|" } elseif {$i % 5 == 0} { @@ -159,13 +190,19 @@ namespace eval punk::ansi::class { set xline [lindex $rlines $x]\n set xlinev [ansistring VIEWSTYLE $xline] set xlinev [string map $maplf $xlinev] - set xlinedisplay [overtype::left -wrap 1 -width 80 "" $xlinev] + set xlinedisplay [overtype::left -wrap 1 -width $w -height 1 "" $xlinev] ::append rendered \n $xlinedisplay set chunk [ansistring VIEWSTYLE $chunk] set chunk [string map $maplf $chunk] - set chunkdisplay [overtype::left -wrap 1 -width 80 "" $chunk] - textblock::join $rendered $chunkdisplay + #keep chunkdisplay narrower - leave at 80 or it will get unwieldy for larger image widths + set chunkdisplay [overtype::left -wrap 1 -width 80 -height 1 "" $chunk] + set renderheight [llength [split $rendered \n]] + set chunkdisplay_lines [split $chunkdisplay \n] + set chunkdisplay_tail [lrange $chunkdisplay_lines end-$renderheight end] + set chunkdisplay_block [join $chunkdisplay_tail \n] + #the input chunk lines are often much longer than the output.. resulting in main content being way up the screen. It's often impractical to view more than the tail of the chunkdisplay. + textblock::join $rendered $chunkdisplay_block } method checksum {} { @@ -335,6 +372,43 @@ namespace eval punk::ansi { ] + # -------------------------------------- + #comparitive test (performance) string-append vs 2-object (with existing splits) append + proc test_cat1 {ansi1 ansi2} { + #make sure objects have splits + set s1 [ansistring NEW $ansi1] + namespace eval [info object namespace $s1] {my MakeSplit} + set s2 [ansistring NEW $ansi2] + namespace eval [info object namespace $s2] {my MakeSplit} + + #operation under test + # -- + #standard string append + $s1 append $ansi2 + # -- + + #$s1 append \033\[31mX ;#redX + return $s1 + } + proc test_cat2 {ansi1 ansi2} { + #make sure objects have splits + set s1 [ansistring NEW $ansi1] + namespace eval [info object namespace $s1] {my MakeSplit} + set s2 [ansistring NEW $ansi2] + namespace eval [info object namespace $s2] {my MakeSplit} + + #operation under test + # -- + #ansistring object append + $s1 appendobj $s2 + # -- + + #$s1 append \033\[31mX ;#redX + return $s1 + } + # -------------------------------------- + + #review - We have file possibly encoded directly in another codepage such as 437 - or utf8,utf16 etc, but then still needing post conversion to e.g cp437? #In testing old ansi graphics files available on the web, some files need encoding {utf-8 cp437} some just cp437 proc readfile {fname {encoding cp437}} { @@ -376,7 +450,7 @@ namespace eval punk::ansi { } if {$dimensions eq ""} { - set dimensions 80x26 + set dimensions 80x24 } set ansidata [fcat -encoding $encoding $fname] @@ -2587,6 +2661,9 @@ namespace eval punk::ansi::class { set codestack [list] set gx0_state 0 ;#default off set current_split_index 0 ;#incremented for each pt block, incremented for each code + if {$o_count eq ""} { + set o_count 0 + } foreach {pt code} $o_ansisplits { lappend o_ptlist $pt foreach grapheme [punk::char::grapheme_split $pt] { @@ -2594,6 +2671,7 @@ namespace eval punk::ansi::class { lappend o_sgrstacks $codestack lappend o_gx0states $gx0_state lappend o_splitindex $current_split_index + incr o_count } #after handling the pt block - incr the current_split_index incr current_split_index ;#increment for each pt block - whether empty string or not. Indices corresponding to empty PT blocks will therefore not be present in o_splitindex as there were no elements in that ansisplit entry @@ -2605,7 +2683,7 @@ namespace eval punk::ansi::class { #maintenance warning - dup in append! if {[punk::ansi::codetype::is_sgr_reset $code]} { - set codestack [list] + set codestack [list "\x1b\[m"] lappend o_elements [list sgr $code] } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { set codestack [list $code] @@ -2669,7 +2747,7 @@ namespace eval punk::ansi::class { return 0 } my MakeSplit - set o_count [my DoCount [join $o_ptlist ""]] + #set o_count [my DoCount [join $o_ptlist ""]] } return $o_count } @@ -2823,15 +2901,16 @@ namespace eval punk::ansi::class { lappend o_sgrstacks $last_codestack lappend o_gx0states $last_gx0state lappend o_splitindex $current_split_index + incr o_count } - incr o_count [my DoCount $catstr] + #incr o_count [my DoCount $catstr] ;#from before we were doing grapheme split.. review } 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] + my MakeSplit ;#update o_count + #set combined_plaintext [join $o_ptlist ""] + #set o_count [my DoCount $combined_plaintext] assert {[llength $o_elements] == [llength $o_sgrstacks] && [llength $o_elements] == [llength $o_gx0states] && [llength $o_elements] == [llength $o_splitindex]} return $o_string } else { @@ -2841,15 +2920,18 @@ namespace eval punk::ansi::class { set ptnew "" set codestack [lindex $o_sgrstacks end] set gx0_state [lindex $o_gx0states end] - set current_split_index 0 + set current_split_index [lindex $o_splitindex end] + #first pt must be merged with last element of o_ptlist + set new_pt_list [list] foreach {pt code} $newsplits { - lappend o_ptlist $pt + lappend new_pt_list $pt append ptnew $pt - foreach grapheme [punk::char::grapheme_split $catstr] { + foreach grapheme [punk::char::grapheme_split $pt] { lappend o_elements [list g $grapheme] lappend o_sgrstacks $codestack lappend o_gx0states $gx0_state lappend o_splitindex $current_split_index + incr o_count } incr current_split_index ;#increment 1 of 2 within each loop if {$code ne ""} { @@ -2858,7 +2940,7 @@ namespace eval punk::ansi::class { lappend o_splitindex $current_split_index #maintenance - dup in MakeSplit! if {[punk::ansi::codetype::is_sgr_reset $code]} { - set codestack [list] + set codestack [list "\x1b\[m"] lappend o_elements [list sgr $code] } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { set codestack [list $code] @@ -2883,14 +2965,78 @@ namespace eval punk::ansi::class { incr current_split_index ;#increment 2 of 2 } } + lset o_ptlist end [string cat [lindex $o_ptlist end] [lindex $new_pt_list 0]] + lappend o_ptlist {*}[lrange $new_pt_list 1 end] 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] + + #if {$o_count eq ""} { + # #we have splits - but didn't count graphemes? + # set o_count [my DoCount [join $o_ptlist ""]] ;#o_ptlist already has ptnew parts + #} else { + # incr o_count [my DoCount $ptnew] + #} + } } assert {[llength $o_elements] == [llength $o_sgrstacks] && [llength $o_elements] == [llength $o_gx0states] && [llength $o_elements] == [llength $o_splitindex]} return $o_string } + + #we are currently assuming that the component strings have complete graphemes ie no split clusters - and therefore we don't attempt to check for and combine at the string catenation points. + #This is 'often'? likely to be true - We don't have grapheme cluster support yet anyway. review. + method appendobj {args} { + if {![llength $o_ansisplits]} { + my MakeSplit + } + foreach a $args { + set ns [info object namespace $a] + upvar ${ns}::o_ansisplits new_ansisplits + upvar ${ns}::o_count new_count + if {![llength $new_ansisplits] || $new_count eq ""} { + namespace eval $ns {my MakeSplit} + } + upvar ${ns}::o_ptlist new_ptlist + upvar ${ns}::o_string new_string + upvar ${ns}::o_elements new_elements + upvar ${ns}::o_sgrstacks new_sgrstacks + upvar ${ns}::o_gx0states new_gx0states + upvar ${ns}::o_splitindex new_splitindex + + lset o_ansisplits end [string cat [lindex $o_ansisplits end] [lindex $new_ansisplits 0]] + lappend o_ansisplits {*}[lrange $new_ansisplits 1 end] + lset o_ptlist end [string cat [lindex $o_ptlist end] [lindex $new_ptlist 0]] + lappend o_ptlist {*}[lrange $new_ptlist 1 end] + + append o_string $new_string + lappend o_elements {*}$new_elements + + #prepend the previous sgr stack to all stacks in the new list. + #This allows us to use only list operations to keep the sgr data valid - but we don't yet make it canonical/flat by examining each for resets etc. + #ie just call sgr_merge_list once now. + set laststack [lindex $o_sgrstacks end] + set mergedtail [punk::ansi::codetype::sgr_merge_list "" {*}$laststack] + foreach n $new_sgrstacks { + lappend o_sgrstacks [list $mergedtail {*}$n] + } + + + lappend o_gx0states {*}$new_gx0states + + #first and last of ansisplits splits merge + set lastidx [lindex $o_splitindex end] + set firstnewidx [lindex $new_splitindex 0] + set diffidx [expr {$lastidx - $firstnewidx}] ;#may be negative + foreach v $new_splitindex { + lappend o_splitindex [expr {$v + $diffidx}] + } + + incr o_count $new_count + } + return $o_count + } + + #method append_and_render - append and render up to end of appended data at same time method view {args} { @@ -2941,62 +3087,118 @@ namespace eval punk::ansi::class { foreach {pt code} $o_ansisplits { append output [ansistring VIEW {*}$args $pt] - if {[punk::ansi::codetype::is_sgr_reset $code]} { - set displaycode [ansistring VIEW $code] - append output ${whiteb}$displaycode$RST - } elseif {[punk::ansi::codetype::is_gx_open $code]} { - append output ${GX}GX+$RST - } elseif {[punk::ansi::codetype::is_gx_close $code]} { - append output ${GX}GX-$RST - } elseif {[punk::ansi::codetype::is_sgr $code]} { - set displaycode [ansistring VIEW $code] - if {[punk::ansi::codetype::has_sgr_leadingreset $code]} { - #highlight the esc & leftbracket in white as indication there is a leading reset - set cposn [string first ";" $displaycode] - append output ${whiteb}[string range $displaycode 0 $cposn]$RST${greenb}[string range $displaycode $cposn+1 end]$RST - } else { - append output ${greenb}$displaycode$RST + + #map DEC cursor_save/restore to CSI version + set code [string map [list \x1b7 \x1b\[s \x1b8 \x1b\[u ] $code] + + + set c1 [string index $code 0] + set c1c2 [string range $code 0 1] + #set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} + set leadernorm [string range [string map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\] 7OSC\ + \x1b\( 7GFX\ + \x9d 8OSC\ + \x1b 7ESC\ + ] $c1c2] 0 3] ;#leadernorm is 1st 2 chars mapped to 4char normalised indicator - or is original 2 chars + + #we leave the tail of the code unmapped for now + switch -- $leadernorm { + 7CSI - 7OSC { + set codenorm [string cat $leadernorm [string range $code 2 end]] } - } else { - switch -regexp -matchvar matchinfo -- $code\ - $re_row_move { - set displaycode [ansistring VIEW $code] - set displaycode [string map [list A "A$arrow_up" B "B$arrow_down"] $displaycode] - append output ${cyanb}$displaycode$RST - }\ - $re_col_move { - lassign $matchinfo _match num type - set displaycode [ansistring VIEW $code] - set displaycode [string map [list C "C$arrow_right" D "D$arrow_left" G "G$arrow_lr"] $displaycode] - append output ${cyanb}$displaycode$RST - }\ - $re_both_move { - lassign $matchinfo _match row col - set displaycode [ansistring VIEW $code] - if {$col eq ""} { - #row only move - set map [list H "H${arrow_lr}"] - } else { - #row and col move - set map [list H "H${arrow_lr}${arrow_du}"] + 7ESC { + set codenorm [string cat $leadernorm [string range $code 1 end]] + } + 8CSI - 8OSC { + set codenorm [string cat $leadernorm [string range $code 1 end]] + } + default { + #we haven't made a mapping for this + set codenorm $code + } + } + + switch -- $leadernorm { + {7CSI} - {8CSI} { + set param [string range $codenorm 4 end-1] + #puts stdout "--> CSI [string index $leadernorm 0] bit param:$param" + switch -- [string index $codenorm end] { + m { + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set displaycode [ansistring VIEW $code] + append output ${whiteb}$displaycode$RST + } else { + set displaycode [ansistring VIEW $code] + if {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + #highlight the esc & leftbracket in white as indication there is a leading reset + set cposn [string first ";" $displaycode] + append output ${whiteb}[string range $displaycode 0 $cposn]$RST${greenb}[string range $displaycode $cposn+1 end]$RST + } else { + append output ${greenb}$displaycode$RST + } + } + } + A - B { + #row move + set displaycode [ansistring VIEW $code] + set displaycode [string map [list A "A$arrow_up" B "B$arrow_down"] $displaycode] + append output ${cyanb}$displaycode$RST + + } + C - D - G { + #set num [string range $codenorm 4 end-1] + set displaycode [ansistring VIEW $code] + set displaycode [string map [list C "C$arrow_right" D "D$arrow_left" G "G$arrow_lr"] $displaycode] + append output ${cyanb}$displaycode$RST + } + H - f { + set params [string range $codenorm 4 end-1] + lassign [split $params {;}] row col + #lassign $matchinfo _match row col + set displaycode [ansistring VIEW $code] + if {$col eq ""} { + #row only move + set map [list H "H${arrow_lr}" f "f${arrow_lr}] + } else { + #row and col move + set map [list H "H${arrow_lr}${arrow_du}" f "${arrow_lr}${arrow_du}"] + } + set displaycode [string map $map $displaycode] + append output ${cyanb}$displaycode$RST + } + s { + append output ${blueb}[ansistring VIEW $code]$RST + } + u { + append output ${blueb_r}[ansistring VIEW $code]$RST + } + default { + append output ${unk}[ansistring VIEW -lf 1 $code]$RST } - set displaycode [string map $map $displaycode] - append output ${cyanb}$displaycode$RST - }\ - $re_cursor_save -\ - $re_cursor_save_dec { - append output ${blueb}[ansistring VIEW $code]$RST - }\ - $re_cursor_restore -\ - $re_cursor_restore_dec { - append output ${blueb_r}[ansistring VIEW $code]$RST - }\ - default { - #if the code is a PM (or other encapsulation type code e.g terminated by ST) we want to see linefeeds as visual representation character - append output ${unk}[ansistring VIEW -lf 1 $code]$RST } - + } + 7GFX { + switch -- [string index $codenorm 4] { + "0" { + append output ${GX}GX+$RST + } + "B" { + append output ${GX}GX-$RST + } + } + } + 7ESC { + append output ${unk}[ansistring VIEW -lf 1 $code]$RST + } + default { + #if the code is a PM (or other encapsulation type code e.g terminated by ST) we want to see linefeeds as visual representation character + append output ${unk}[ansistring VIEW -lf 1 $code]$RST + } } + } return $output } diff --git a/src/modules/punk/repl-0.1.tm b/src/modules/punk/repl-0.1.tm index 9b74eb6..58a7bb7 100644 --- a/src/modules/punk/repl-0.1.tm +++ b/src/modules/punk/repl-0.1.tm @@ -1140,9 +1140,11 @@ namespace eval punk::repl::class { set result [dict get $mergedinfo result] set o_insert_mode [dict get $mergedinfo insert_mode] set result_col [dict get $mergedinfo cursor_column] - set cmove [dict get $mergedinfo cursor_row] + set result_row [dict get $mergedinfo cursor_row] set overflow_right [dict get $mergedinfo overflow_right] ;#should be empty if no \v set unapplied [dict get $mergedinfo unapplied] + set instruction [dict get $mergedinfo instruction] + set insert_lines_below [dict get $mergedinfo insert_lines_below] set insert_lines_above [dict get $mergedinfo insert_lines_above] @@ -1151,7 +1153,7 @@ namespace eval punk::repl::class { #puts "merged: $mergedinfo" set debug "add_chunk0" append debug \n $mergedinfo - append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $new0] before row:$o_cursor_row after row: $cmove before col:$o_cursor_col after col:$result_col" + append debug \n "input:[ansistring VIEW -lf 1 -vt 1 $new0] before row:$o_cursor_row after row: $result_row before col:$o_cursor_col after col:$result_col" package require textblock set debug [textblock::frame $debug] catch {punk::console::move_emitblock_return $debug_first_row 1 $debug} @@ -1161,13 +1163,16 @@ namespace eval punk::repl::class { set cursor_row_idx [expr {$o_cursor_row-1}] lset o_rendered_lines $cursor_row_idx $result - set nextrow $cmove - #if {$insert_lines_below > 0} { - # for {set i 0} {$i < $insert_lines_below} {incr i} { - # lappend o_rendered_lines "" - # } - # set o_cursor_col 1 - #} + set nextrow $result_row + switch -- $instruction { + lf_start { + #for normal commandline - we just add a line below + lappend o_rendered_lines "" + incr nextrow + set o_cursor_col 1 + } + } + if {$insert_lines_below == 1} { if {[string length $overflow_right]} { lappend o_rendered_lines $overflow_right diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index 2b50b33..077659f 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -364,11 +364,12 @@ namespace eval textblock { -width ""\ -ansiborder ""\ -align "left"\ + -ellipsis 1\ ] set opts [dict merge $defaults $arglist] foreach {k v} $opts { switch -- $k { - -etabs - -type - -title - -subtitle - -width - -ansiborder - -align {} + -etabs - -type - -title - -subtitle - -width - -ansiborder - -align - -ellipsis {} default { error "frame option '$k' not understood. Valid options are [dict keys $defaults]" } @@ -418,6 +419,7 @@ namespace eval textblock { #these are all valid commands for overtype:: # -- --- --- --- --- --- set opt_ansiborder [dict get $opts -ansiborder] + set opt_ellipsis [dict get $opts -ellipsis] # -- --- --- --- --- --- if {[string last \t $contents] >= 0} { @@ -638,7 +640,7 @@ namespace eval textblock { set bottombar $bbar } append fs $tlc$topbar$trc\n - set inner [overtype::$opt_align -ellipsis 1 $column $contents] + set inner [overtype::$opt_align -ellipsis $opt_ellipsis $column $contents] set body [textblock::join -- $lhs $inner $rhs] append fs $body append fs \n $blc$bottombar$brc diff --git a/src/vendormodules/overtype-1.6.0.tm b/src/vendormodules/overtype-1.6.0.tm index 385ec10..39f62fd 100644 --- a/src/vendormodules/overtype-1.6.0.tm +++ b/src/vendormodules/overtype-1.6.0.tm @@ -252,6 +252,7 @@ proc overtype::left {args} { set defaults [dict create\ -bias ignored\ -width \uFFEF\ + -height \uFFeF\ -wrap 0\ -ellipsis 0\ -ellipsistext $default_ellipsis_horizontal\ @@ -262,13 +263,13 @@ proc overtype::left {args} { -exposed1 \uFFFD\ -exposed2 \uFFFD\ -experimental 0\ - -looplimit 15000\ + -looplimit 100000\ ] #-ellipsis args not used if -wrap is true set argsflags [lrange $args 0 end-2] dict for {k v} $argsflags { switch -- $k { - -looplimit - -width - -bias - -wrap - -ellipsis - -ellipsistext - -ellipsiswhitespace - -overflow - -appendlines - -transparent - -exposed1 - -exposed2 - -experimental {} + -looplimit - -width - -height - -bias - -wrap - -ellipsis - -ellipsistext - -ellipsiswhitespace - -overflow - -appendlines - -transparent - -exposed1 - -exposed2 - -experimental {} default { set known_opts [dict keys $defaults] error "overtype::left unknown option '$k'. Known options: $known_opts" @@ -284,6 +285,7 @@ proc overtype::left {args} { ##### #for repl - standard output line indicator is a dash - todo, add a different indicator for a continued line. set opt_width [dict get $opts -width] + set opt_height [dict get $opts -height] set opt_appendlines [dict get $opts -appendlines] set opt_transparent [dict get $opts -transparent] set opt_ellipsistext [dict get $opts -ellipsistext] @@ -337,9 +339,12 @@ proc overtype::left {args} { lassign [blocksize $underblock] _w colwidth _h colheight } else { set colwidth $opt_width + set colheight $opt_height } if {$underblock eq ""} { - set underlines [list "\x1b\[0m\x1b\[0m"] + set blank "\x1b\[0m\x1b\[0m" + #set underlines [list "\x1b\[0m\x1b\[0m"] + set underlines [lrepeat $colheight $blank] } else { set underlines [lines_as_list -ansiresets 1 $underblock] } @@ -347,7 +352,10 @@ proc overtype::left {args} { #todo - reconsider the 'line' as the natural chunking mechanism for the overlay. #In practice an overlay ANSI stream can be a single line with ansi moves/restores etc - or even have no moves or newlines, just relying on wrapping at the output colwidth #In such cases - we process the whole shebazzle for the first output line - only reducing by the applied amount at the head each time, reprocessing the long tail each time. + #(in cases where there are interline moves or cursor jumps anyway) #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 + if 0 { set inputchunks [split $overblock \n] if {$test_mode} { set lflines [list] @@ -360,6 +368,53 @@ proc overtype::left {args} { } set inputchunks $lflines[unset lflines] } + } + + if {!$test_mode} { + set inputchunks [split $overblock \n] + } else { + set scheme 3 + switch -- $scheme { + 0 { + set inputchunks [list $overblock] + } + 1 { + set inputchunks [punk::ansi::ta::split_codes $overblock] + } + 2 { + + #split into lines if possible first - then into plaintext/ansi-sequence chunks ? + set inputchunks [list ""] ;#put an empty plaintext split in for starters + set i 1 + set lines [split $overblock \n] + foreach ln $lines { + if {$i < [llength $lines]} { + append ln \n + } + set sequence_split [punk::ansi::ta::split_codes_single $ln] ;#use split_codes Not split_codes_single? + set lastpt [lindex $inputchunks end] + lset inputchunks end [string cat $lastpt [lindex $sequence_split 0]] + lappend inputchunks {*}[lrange $sequence_split 1 end] + incr i + } + } + 3 { + set lflines [list] + set inputchunks [split $overblock \n] + 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] + + } + } + } + + #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 @@ -391,6 +446,10 @@ proc overtype::left {args} { while {[llength $inputchunks]} { #set overtext [lindex $inputchunks $overidx]; lset inputchunks $overidx "" set overtext [lpop inputchunks 0] + if {![string length $overtext]} { + continue + } + #puts "----->[ansistring VIEW -lf 1 -vt 1 -nul 1 $overtext]<----" set undertext [lindex $outputlines [expr {$row -1}]] set renderedrow $row @@ -428,8 +487,9 @@ proc overtype::left {args} { #-- todo - detect looping properly - if {$row > 1 && $overtext ne "" && $unapplied eq $overtext && $post_render_row == $row} { + if {$row > 1 && $overtext ne "" && $unapplied eq $overtext && $post_render_row == $row && $instruction eq ""} { puts stderr "overtype::left loop?" + puts [ansistring VIEW $rinfo] break } #-- @@ -496,7 +556,9 @@ proc overtype::left {args} { } else { #lf included in data set row $post_render_row - set col 1 + set col $post_render_col + + #set col 1 #if {$post_render_row != $renderedrow} { # set col 1 #} else { @@ -617,17 +679,17 @@ proc overtype::left {args} { } move { ######## - #Ansi moves need to create new lines if {$post_render_row > [llength $outputlines]} { - if {$opt_appendlines} { - set diff [expr {$post_render_row - [llength $outputlines]}] - if {$diff > 0} { - lappend outputlines {*}[lrepeat $diff ""] - } - set row $post_render_row - } else { + #Ansi moves need to create new lines ? + #if {$opt_appendlines} { + # set diff [expr {$post_render_row - [llength $outputlines]}] + # if {$diff > 0} { + # lappend outputlines {*}[lrepeat $diff ""] + # } + # set row $post_render_row + #} else { set row [llength $outputlines] - } + #} } else { set row $post_render_row } @@ -666,7 +728,7 @@ proc overtype::left {args} { puts [textblock::join $lhs " $post_render_col " $rhs] } - if 1 { + if {!$test_mode} { #rendered append rendered $overflow_right #set replay_codes_overlay "" @@ -675,21 +737,32 @@ proc overtype::left {args} { set row $renderedrow + set col 1 incr row #only add newline if we're at the bottom if {$row > [llength $outputlines]} { lappend outputlines {*}[lrepeat 1 ""] } - set col 1 } else { - - set inputchunks [linsert $inputchunks 0 $overflow_right$unapplied] - set overflow_right "" - set unapplied "" - set row $renderedrow - set col $post_render_col - if {$row > [llength $outputlines]} { - lappend outputlines {*}[lrepeat 1 ""] + set edit_mode 0 + if {$edit_mode} { + set inputchunks [linsert $inputchunks 0 $overflow_right$unapplied] + set overflow_right "" + set unapplied "" + set row $post_render_row + #set col $post_render_col + set col 1 + if {$row > [llength $outputlines]} { + lappend outputlines {*}[lrepeat 1 ""] + } + } else { + append rendered $overflow_right + set overflow_right "" + set row $post_render_row + set col 1 + if {$row > [llength $outputlines]} { + lappend outputlines {*}[lrepeat 1 ""] + } } } } @@ -1523,28 +1596,55 @@ proc overtype::renderline {args} { #underlay should already have been rendered and not have non-sgr codes - but let's retain the check for them and not stack them if other codes are here #only stack SGR (graphics rendition) codes - not title sets, cursor moves etc - #order of if-else based on assumptions: - # that pure resets are fairly common - more so than leading resets with other info - # that non-sgr codes are not that common, so ok to check for resets before verifying it is actually SGR at all. if {$code ne ""} { - if {[punk::ansi::codetype::is_sgr_reset $code]} { - #set u_codestack [list] - set u_codestack [list "\x1b\[m"] - } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { - set u_codestack [list $code] - } elseif {[punk::ansi::codetype::is_sgr $code]} { - #basic simplification first.. straight dups - set dup_posns [lsearch -all -exact $u_codestack $code] ;#-exact because of square-bracket glob chars - set u_codestack [lremove $u_codestack {*}$dup_posns] - lappend u_codestack $code - } else { - #leave SGR stack as is - if {[punk::ansi::codetype::is_gx_open $code]} { - set u_gx_stack [list gx0_on] ;#we'd better use a placeholder - or debugging will probably get into a big mess - } elseif {[punk::ansi::codetype::is_gx_close $code]} { - set u_gx_stack [list] - } - } + set c1c2 [string range $code 0 1] + set leadernorm [string range [string map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\( 7GFX\ + ] $c1c2] 0 3] ;#leadernorm is 1st 2 chars mapped to 4char normalised indicator - or is original 2 chars + + switch -- $leadernorm { + 7CSI - 8CSI { + if {[string index $code end] eq "m"} { + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set u_codestack [list "\x1b\[m"] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set u_codestack [list $code] + } else { + #basic simplification first.. straight dups + set dup_posns [lsearch -all -exact $u_codestack $code] ;#-exact because of square-bracket glob chars + set u_codestack [lremove $u_codestack {*}$dup_posns] + lappend u_codestack $code + } + } + } + 7GFX { + switch -- [string index $code 2] { + "0" { + set u_gx_stack [list gx0_on] ;#we'd better use a placeholder - or debugging will probably get into a big mess + } + B { + set u_gx_stack [list] + } + } + } + default { + + } + + } + + #if {[punk::ansi::codetype::is_sgr_reset $code]} { + # #set u_codestack [list] + #} elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + #} elseif {[punk::ansi::codetype::is_sgr $code]} { + #} else { + # #leave SGR stack as is + # if {[punk::ansi::codetype::is_gx_open $code]} { + # } elseif {[punk::ansi::codetype::is_gx_close $code]} { + # } + #} } #consider also if there are other codes that should be stacked..? } @@ -1813,34 +1913,26 @@ proc overtype::renderline {args} { "" { set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] if {$idx == 0} { - #leave the overflow_idx - #idx_over already incremented + #puts "---a at col 1" + #linefeed at column 1 + #leave the overflow_idx ;#? review set instruction lf_start ;#specific instruction for newline at column 1 priv::render_unapplied $overlay_grapheme_control_list $gci break } elseif {$overflow_idx != -1 && $idx == $overflow_idx} { - puts "---c at overflow_idx=$overflow_idx" - - # - review special treatment? + #linefeed after final column + #puts "---c at overflow_idx=$overflow_idx" incr cursor_row - #override overflow_idx even if it was set to -1 due to opt_overflow = 1|2 - set overflow_idx $idx - #set insert_lines_below 1 - #set instruction newlines_below - set instruction lf_overflow - #idx_over already incremented + set overflow_idx $idx ;#override overflow_idx even if it was set to -1 due to opt_overflow = 1|2 + set instruction lf_overflow ;#only special treatment is to give it it's own instruction in case caller needs to handle differently priv::render_unapplied $overlay_grapheme_control_list $gci break } else { - #puts "---mid-or-end-text-linefeed idx:$idx overflow_idx:$overflow_idx" #linefeed occurred in middle or at end of text + #puts "---mid-or-end-text-linefeed idx:$idx overflow_idx:$overflow_idx" incr cursor_row - #override overflow_idx even if it was set to -1 due to opt_overflow = 1|2 - set overflow_idx $idx - #set insert_lines_below 1 - #set instruction newlines_below + set overflow_idx $idx ;#override overflow_idx even if it was set to -1 due to opt_overflow = 1|2 set instruction lf_mid - #idx_over already incremented priv::render_unapplied $overlay_grapheme_control_list $gci break } @@ -2075,7 +2167,7 @@ proc overtype::renderline {args} { } incr idx } - if {($cursor_column < [llength $outcols]) || $overflow_idx == -1} { + if {($cursor_column < [llength $outcols]) || $overflow_idx == -1 || $test_mode} { incr cursor_column } } elseif {$uwidth > 1} { @@ -2109,7 +2201,7 @@ proc overtype::renderline {args} { priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode incr idx incr cursor_column - if {$overflow_idx !=-1} { + if {$overflow_idx !=-1 && !$test_mode} { #overflow if {$cursor_column > [llength $outcols]} { set cursor_column [llength $outcols] @@ -2139,493 +2231,578 @@ proc overtype::renderline {args} { set re_decstbm {\x1b\[([0-9]*)(?:;){0,1}([0-9]*)r$} ;#DECSTBM set top and bottom margins set matchinfo [list] - switch -regexp -matchvar matchinfo -- $code\ - $re_col_move { - lassign $matchinfo _match num type - switch -- $type { - D { - #cursor back - #left-arrow/move-back when ltr mode - if {$num eq ""} {set num 1} - - set version 2 - if {$version eq "2"} { - #todo - startcolumn offset! - if {$cursor_column - $num >= 1} { + #remap of DEC cursor_save/cursor_restore from ESC sequence to equivalent CSI + #probably not ideal - consider putting cursor_save/cursor_restore in functions so they can be called from the appropriate switch branch instead of using this mapping + #review - cost/benefit of function calls within these switch-arms instead of inline code? + set code [string map [list \x1b7 \x1b\[s \x1b8 \x1b\[u ] $code] + + + set c1 [string index $code 0] + set c1c2 [string range $code 0 1] + #set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} + set leadernorm [string range [string map [list\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\] 7OSC\ + \x9d 8OSC\ + \x1b 7ESC\ + ] $c1c2] 0 3] ;#leadernorm is 1st 2 chars mapped to 4char normalised indicator - or is original 2 chars + + #we leave the tail of the code unmapped for now + switch -- $leadernorm { + 7CSI - 7OSC { + set codenorm [string cat $leadernorm [string range $code 2 end]] + } + 7ESC { + set codenorm [string cat $leadernorm [string range $code 1 end]] + } + 8CSI - 8OSC { + set codenorm [string cat $leadernorm [string range $code 1 end]] + } + default { + #we haven't made a mapping for this + set codenorm $code + } + } + + #we've mapped 7 and 8bit escapes to values we can handle as literals in switch statements to take advantange of jump tables. + switch -- $leadernorm { + {7CSI} - {8CSI} { + set param [string range $codenorm 4 end-1] + #puts stdout "--> CSI [string index $leadernorm 0] bit param:$param" + switch -- [string index $codenorm end] { + D { + #Col move + #puts stdout "<-back" + #cursor back + #left-arrow/move-back when ltr mode + set num $param + if {$num eq ""} {set num 1} + + set version 2 + if {$version eq "2"} { + #todo - startcolumn offset! + if {$cursor_column - $num >= 1} { + incr idx -$num + incr cursor_column -$num + } else { + if {!$autowrap_mode} { + set cursor_column 1 + set idx 0 + } else { + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + incr cursor_column -$num + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction wrapmovebackward + break + } + } + } else { incr idx -$num incr cursor_column -$num - } else { - if {!$autowrap_mode} { - set cursor_column 1 - set idx 0 - } else { - set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] - incr cursor_column -$num - priv::render_unapplied $overlay_grapheme_control_list $gci - set instruction wrapmovebackward - break + if {$idx < $opt_colstart-1} { + #wrap to previous line and position cursor at end of data + set idx [expr {$opt_colstart-1}] + set cursor_column $opt_colstart } } - } else { - incr idx -$num - incr cursor_column -$num - if {$idx < $opt_colstart-1} { - #wrap to previous line and position cursor at end of data - set idx [expr {$opt_colstart-1}] - set cursor_column $opt_colstart - } } - } - C { - #todo - consider right-to-left cursor mode (e.g Hebrew).. some day. - #cursor forward - #right-arrow/move forward - if {$num eq ""} {set num 1} - - #todo - retrict to moving 1 position past datalen? restrict to column width? - #should ideally wrap to next line when interactive and not on last row - #(some ansi art seems to expect this behaviour) - #This presumably depends on the terminal's wrap mode - #e.g DECAWM autowrap mode - # CSI ? 7 h - set: autowrap (also tput smam) - # CSI ? 7 l - reset: no autowrap (also tput rmam) - set version 2 - if {$version eq "2"} { - set max [llength $outcols] - if {$overflow_idx == -1} { - incr max - } + C { + #Col move + #puts stdout "->forward" + #todo - consider right-to-left cursor mode (e.g Hebrew).. some day. + #cursor forward + #right-arrow/move forward + set num $param + if {$num eq ""} {set num 1} + + #todo - retrict to moving 1 position past datalen? restrict to column width? + #should ideally wrap to next line when interactive and not on last row + #(some ansi art seems to expect this behaviour) + #This presumably depends on the terminal's wrap mode + #e.g DECAWM autowrap mode + # CSI ? 7 h - set: autowrap (also tput smam) + # CSI ? 7 l - reset: no autowrap (also tput rmam) + set version 2 + if {$version eq "2"} { + set max [llength $outcols] + if {$overflow_idx == -1} { + incr max + } + if {$test_mode && $cursor_column == $max+1} { + #move_forward while in overflow + incr cursor_column -1 + } - if {($cursor_column + $num) <= $max} { - incr idx $num - incr cursor_column $num - } else { - if {$autowrap_mode} { - set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] - if {$idx == $overflow_idx} { - incr num - } - #horizontal movement beyond line extent needs to wrap - throw back to caller - #we may have both overflow_rightand unapplied data - #(can have overflow_right if we were in insert_mode and processed chars prior to this movement) - #leave row as is - caller will need to determine how many rows the column-movement has consumed - incr cursor_column $num ;#give our caller the necessary info as columns from start of row - #incr idx_over - #should be gci following last one applied - priv::render_unapplied $overlay_grapheme_control_list $gci - set instruction wrapmoveforward - break + if {($cursor_column + $num) <= $max} { + incr idx $num + incr cursor_column $num } else { - set cursor_column $max - set idx [expr {$cursor_column -1}] - } - } - } else { - if {!$opt_overflow || ($cursor_column + $num) <= [llength $outcols+1]} { - incr idx $num - incr cursor_column $num - } else { - if {!$insert_mode} { - #block editing style with arrow keys - #overtype mode - set idxstart $idx - set idxend [llength $outcols] - set moveend [expr {$idxend - $idxstart}] - if {$moveend < 0} {set moveend 0} ;#sanity? - #puts "idxstart:$idxstart idxend:$idxend outcols[llength $outcols] undercols:[llength $undercols]" - incr idx $moveend - incr cursor_column $moveend - #if {[dict exists $understacks $idx]} { - # set stackinfo [dict get $understacks $idx] ;#use understack at end - which may or may not have already been replaced by stack from overtext - #} else { - # set stackinfo [list] - #} - if {$idx < [llength $understacks]} { - set stackinfo [lindex $understacks $idx] ;#use understack at end - which may or may not have already been replaced by stack from overtext - } else { - set stackinfo [list] - } - if {$idx < [llength $understacks_gx]} { - #set gxstackinfo [dict get $understacks_gx $idx] - set gxstackinfo [lindex $understacks_gx $idx] + if {$autowrap_mode} { + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + #jmn + if {$idx == $overflow_idx} { + incr num + } + + #horizontal movement beyond line extent needs to wrap - throw back to caller + #we may have both overflow_rightand unapplied data + #(can have overflow_right if we were in insert_mode and processed chars prior to this movement) + #leave row as is - caller will need to determine how many rows the column-movement has consumed + incr cursor_column $num ;#give our caller the necessary info as columns from start of row + #incr idx_over + #should be gci following last one applied + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction wrapmoveforward + break } else { - set gxstackinfo [list] - } - #pad outcols - set movemore [expr {$num - $moveend}] - #assert movemore always at least 1 or we wouldn't be in this branch - for {set m 1} {$m <= $movemore} {incr m} { - incr idx - incr cursor_column - priv::render_addchar $idx " " $stackinfo $gxstackinfo $insert_mode + set cursor_column $max + set idx [expr {$cursor_column -1}] } - } else { - #normal - insert + } + } else { + if {!$opt_overflow || ($cursor_column + $num) <= [llength $outcols+1]} { incr idx $num incr cursor_column $num - if {$idx > [llength $outcols]} { - set idx [llength $outcols];#allow one beyond - for adding character at end of line - set cursor_column [expr {[llength $outcols]+1}] + } else { + if {!$insert_mode} { + #block editing style with arrow keys + #overtype mode + set idxstart $idx + set idxend [llength $outcols] + set moveend [expr {$idxend - $idxstart}] + if {$moveend < 0} {set moveend 0} ;#sanity? + #puts "idxstart:$idxstart idxend:$idxend outcols[llength $outcols] undercols:[llength $undercols]" + incr idx $moveend + incr cursor_column $moveend + #if {[dict exists $understacks $idx]} { + # set stackinfo [dict get $understacks $idx] ;#use understack at end - which may or may not have already been replaced by stack from overtext + #} else { + # set stackinfo [list] + #} + if {$idx < [llength $understacks]} { + set stackinfo [lindex $understacks $idx] ;#use understack at end - which may or may not have already been replaced by stack from overtext + } else { + set stackinfo [list] + } + if {$idx < [llength $understacks_gx]} { + #set gxstackinfo [dict get $understacks_gx $idx] + set gxstackinfo [lindex $understacks_gx $idx] + } else { + set gxstackinfo [list] + } + #pad outcols + set movemore [expr {$num - $moveend}] + #assert movemore always at least 1 or we wouldn't be in this branch + for {set m 1} {$m <= $movemore} {incr m} { + incr idx + incr cursor_column + priv::render_addchar $idx " " $stackinfo $gxstackinfo $insert_mode + } + } else { + #normal - insert + incr idx $num + incr cursor_column $num + if {$idx > [llength $outcols]} { + set idx [llength $outcols];#allow one beyond - for adding character at end of line + set cursor_column [expr {[llength $outcols]+1}] + } } } } + } + G { + #Col move + #move absolute column + #adjust to colstart - as column 1 is within overlay + #??? + set idx [expr {$param + $opt_colstart -1}] + set cursor_column $param + error "renderline absolute col move ESC G unimplemented" } - } - G { - #move absolute column - #adjust to colstart - as column 1 is within overlay - #??? - set idx [expr {$num + $opt_colstart -1}] - set cursor_column $num - error "renderline absolute col move ESC G unimplemented" - } - } - }\ - $re_row_move { - lassign $matchinfo _match num type - switch -- $type { - A { - set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] - #move up - if {$num eq ""} {set num 1} - incr cursor_row -$num - - if {$cursor_row < 1} { - set cursor_row 1 + A { + #Row move - up + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + set num $param + if {$num eq ""} {set num 1} + incr cursor_row -$num + + if {$cursor_row < 1} { + set cursor_row 1 + } + + #ensure rest of *overlay* is emitted to remainder + incr idx_over + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction up + #retain cursor_column + break } + B { + #Row move - down + set num $param + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + #move down + if {$num eq ""} {set num 1} + incr cursor_row $num - #ensure rest of *overlay* is emitted to remainder - incr idx_over - priv::render_unapplied $overlay_grapheme_control_list $gci - set instruction up - #retain cursor_column - break - } - B { - set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] - #move down - if {$num eq ""} {set num 1} - incr cursor_row $num + incr idx_over ;#idx_over hasn't encountered a grapheme and hasn't advanced yet + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction down + #retain cursor_column + break + } + H - f { + #$re_both_move + lassign [split $param {;}] row col + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + #lassign $matchinfo _match row col - incr idx_over ;#idx_over hasn't encountered a grapheme and hasn't advanced yet - priv::render_unapplied $overlay_grapheme_control_list $gci - set instruction down - #retain cursor_column - break - } - } - }\ - $re_both_move { - set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] - lassign $matchinfo _match row col - - if {$col eq ""} {set col 1} - set max [llength $outcols] - if {$overflow_idx == -1} { - incr max - } - if {$col > $max} { - set cursor_column $max - } else { - set cursor_column $col - } - set idx [expr {$cursor_column -1}] + if {$col eq ""} {set col 1} + set max [llength $outcols] + if {$overflow_idx == -1} { + incr max + } + if {$col > $max} { + set cursor_column $max + } else { + set cursor_column $col + } + set idx [expr {$cursor_column -1}] - if {$row eq ""} {set row 1} - set cursor_row $row - if {$cursor_row < 1} { - set cursor_row 1 - } + if {$row eq ""} {set row 1} + set cursor_row $row + if {$cursor_row < 1} { + set cursor_row 1 + } + + incr idx_over + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction move + break - incr idx_over - priv::render_unapplied $overlay_grapheme_control_list $gci - set instruction move - break - }\ - $re_decstbm { - #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 - lassign $matchinfo _match margin_top margin_bottom - - #todo - return these for the caller to process.. - puts stderr "overtype::renderline DECSTBM set top and bottom margin not implemented" - #Also moves the cursor to col 1 line 1 of the page - set cursor_column 1 - set cursor_row 1 - - incr idx_over - priv::render_unapplied $overlay_grapheme_control_list $gci - set instruction move ;#own instruction? decstbm? - break - }\ - $re_vt_sequence { - lassign $matchinfo _match key mod - #Note that f1 to f4 show as ESCOP|Q|R|S (VT220?) but f5+ show as ESC\[15~ - # - #e.g esc \[2~ insert esc \[2;2~ shift-insert - #mod - subtract 1, and then use bitmask - #shift = 1, (left)Alt = 2, control=4, meta=8 (meta seems to do nothing on many terminals on windows? Intercepted by windows?) - #puts stderr "vt key:$key mod:$mod code:[ansistring VIEW $code]" - if {$key eq "1"} { - #home - } elseif {$key eq "2"} { - #Insert - if {$mod eq ""} { - #no modifier key - set insert_mode [expr {!$insert_mode}] - #rather than set the cursor - we return the insert mode state so the caller can decide - } - } elseif {$key eq "3"} { - #Delete - presumably this shifts other chars in the line, with empty cells coming in from the end - switch -- $mod { - "" { - priv::render_delchar $idx } - "5" { - #ctrl-del - delete to end of word (pwsh) - possibly word on next line if current line empty(?) + r { + #$re_decstbm + #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 + lassign [split $param {;} margin_top margin_bottom] + + #todo - return these for the caller to process.. + puts stderr "overtype::renderline DECSTBM set top and bottom margin not implemented" + #Also moves the cursor to col 1 line 1 of the page + set cursor_column 1 + set cursor_row 1 + + incr idx_over + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction move ;#own instruction? decstbm? + break } - } - } elseif {$key eq "4"} { - #End - } elseif {$key eq "5"} { - #pgup - } elseif {$key eq "6"} { - #pgDn - } elseif {$key eq "7"} { - #Home - #?? - set idx [expr {$opt_colstart -1}] - set cursor_column 1 - } elseif {$key eq "8"} { - #End - } elseif {$key eq "11"} { - #F1 - or ESCOP or e.g shift F1 ESC\[1;2P - } elseif {$key eq "12"} { - #F2 - or ESCOQ - } elseif {$key eq "13"} { - #F3 - or ESCOR - } elseif {$key eq "14"} { - #F4 - or ESCOS - } elseif {$key eq "15"} { - #F5 or shift F5 ESC\[15;2~ - } elseif {$key eq "17"} { - #F6 - } elseif {$key eq "18"} { - #F7 - } elseif {$key eq "19"} { - #F8 - } elseif {$key eq "20"} { - #F9 - } elseif {$key eq "21"} { - #F10 - } elseif {$key eq "23"} { - #F11 - } elseif {$key eq "24"} { - #F12 - } + s { + #$re_cursor_save + #cursor save could come after last column + if {$overflow_idx != -1 && $idx == $overflow_idx} { + #bartman2.ans test file - fixes misalignment at bottom of dialog bubble + #incr cursor_row + #set cursor_column 1 + #bwings1.ans test file - breaks if we actually incr cursor (has repeated saves) + set cursor_saved_position [list row [expr {$cursor_row+1}] column 1] + } else { + set cursor_saved_position [list row $cursor_row column $cursor_column] + } + #there may be overlay stackable codes emitted that aren't in the understacks because they come between the last emmited character and the cursor_save control. + #we need the SGR and gx overlay codes prior to the cursor_save + + #a real terminal would not be able to know the state of the underlay.. so we should probably ignore it. + #set sgr_stack [lindex $understacks $idx] + #set gx_stack [lindex $understacks_gx $idx] ;#not actually a stack - just a boolean state (for now?) + + set sgr_stack [list] + set gx_stack [list] + + #we shouldn't need to scan for intermediate cursor save/restores - as restores would throw-back to the calling loop - so our overlay 'line' is since those. + #The overlay_grapheme_control_list had leading resets from previous lines - so we go back to the beginning not just the first grapheme. + + foreach gc [lrange $overlay_grapheme_control_list 0 $gci-1] { + lassign $gc type code + #types g other sgr gx0 + switch -- $type { + gx0 { + #code is actually a stand-in for the graphics on/off code - not the raw code + #It is either gx0_on or gx0_off + set gx_stack [list $code] + } + sgr { + #code is the raw code + if {[punk::ansi::codetype::is_sgr_reset $code]} { + #jmn + set sgr_stack [list "\x1b\[m"] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set sgr_stack [list $code] + lappend overlay_grapheme_control_list [list sgr $code] + } elseif {[priv::is_sgr $code]} { + #often we don't get resets - and codes just pile up. + #as a first step to simplifying - at least remove earlier straight up dupes + set dup_posns [lsearch -all -exact $sgr_stack $code] ;#needs -exact - codes have square-brackets (glob chars) + set sgr_stack [lremove $sgr_stack {*}$dup_posns] + lappend sgr_stack $code + } + } + } + } + set cursor_saved_attributes "" + switch -- [lindex $gx_stack 0] { + gx0_on { + append cursor_saved_attributes "\x1b(0" + } + gx0_off { + append cursor_saved_attributes "\x1b(B" + } + } + #append cursor_saved_attributes [join $sgr_stack ""] + append cursor_saved_attributes [punk::ansi::codetype::sgr_merge_list {*}$sgr_stack] - }\ - $re_cursor_save - $re_cursor_save_dec { - #cursor save could come after last column - if {$overflow_idx != -1 && $idx == $overflow_idx} { - #bartman2.ans test file - fixes misalignment at bottom of dialog bubble - #incr cursor_row - #set cursor_column 1 - #bwings1.ans test file - breaks if we actually incr cursor (has repeated saves) - set cursor_saved_position [list row [expr {$cursor_row+1}] column 1] - } else { - set cursor_saved_position [list row $cursor_row column $cursor_column] - } - #there may be overlay stackable codes emitted that aren't in the understacks because they come between the last emmited character and the cursor_save control. - #we need the SGR and gx overlay codes prior to the cursor_save + #as there is apparently only one cursor storage element we don't need to throw back to the calling loop for a save. - #a real terminal would not be able to know the state of the underlay.. so we should probably ignore it. - #set sgr_stack [lindex $understacks $idx] - #set gx_stack [lindex $understacks_gx $idx] ;#not actually a stack - just a boolean state (for now?) - - set sgr_stack [list] - set gx_stack [list] - - #we shouldn't need to scan for intermediate cursor save/restores - as restores would throw-back to the calling loop - so our overlay 'line' is since those. - #The overlay_grapheme_control_list had leading resets from previous lines - so we go back to the beginning not just the first grapheme. - - foreach gc [lrange $overlay_grapheme_control_list 0 $gci-1] { - lassign $gc type code - #types g other sgr gx0 - switch -- $type { - gx0 { - #code is actually a stand-in for the graphics on/off code - not the raw code - #It is either gx0_on or gx0_off - set gx_stack [list $code] + #don't incr index - or the save will cause cursor to move to the right + #carry on + } - sgr { - #code is the raw code - if {[punk::ansi::codetype::is_sgr_reset $code]} { - #jmn - set sgr_stack [list "\x1b\[m"] - } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { - set sgr_stack [list $code] - lappend overlay_grapheme_control_list [list sgr $code] - } elseif {[priv::is_sgr $code]} { - #often we don't get resets - and codes just pile up. - #as a first step to simplifying - at least remove earlier straight up dupes - set dup_posns [lsearch -all -exact $sgr_stack $code] ;#needs -exact - codes have square-brackets (glob chars) - set sgr_stack [lremove $sgr_stack {*}$dup_posns] - lappend sgr_stack $code + u { + #$re_cursor_restore + #we are going to jump somewhere.. for now we will assume another line, and process accordingly. + #The caller has the cursor_saved_position/cursor_saved_attributes if any (?review - if we always pass it back it, we could save some calls for moves in same line) + #don't set overflow at this point. The existing underlay to the right must be preserved. + #we only want to jump and render the unapplied at the new location. + + #lset overstacks $idx_over [list] + #set replay_codes_overlay "" + + #if {$cursor_saved_attributes ne ""} { + # set replay_codes_overlay $cursor_saved_attributes ;#empty - or last save if it happend in this input chunk + #} else { + #jj + #set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + set replay_codes_overlay "" + #} + + #like priv::render_unapplied - but without the overlay's ansi reset or gx stacks from before the restore code + incr idx_over + + set unapplied "" + foreach gc [lrange $overlay_grapheme_control_list $gci+1 end] { + lassign $gc type item + if {$type eq "gx0"} { + if {$item eq "gx0_on"} { + append unapplied "\x1b(0" + } elseif {$item eq "gx0_off"} { + append unapplied "\x1b(B" + } + } else { + append unapplied $item + } + #incr idx_over } + #if the save occured within this line - that's ok - it's in the return value list and caller can prepend for the next loop. + set instruction restore_cursor + break } - } - } - set cursor_saved_attributes "" - switch -- [lindex $gx_stack 0] { - gx0_on { - append cursor_saved_attributes "\x1b(0" - } - gx0_off { - append cursor_saved_attributes "\x1b(B" - } - } - #append cursor_saved_attributes [join $sgr_stack ""] - append cursor_saved_attributes [punk::ansi::codetype::sgr_merge_list {*}$sgr_stack] - - #as there is apparently only one cursor storage element we don't need to throw back to the calling loop for a save. - - #don't incr index - or the save will cause cursor to move to the right - #carry on - }\ - $re_cursor_restore - $re_cursor_restore_dec { - #we are going to jump somewhere.. for now we will assume another line, and process accordingly. - #The caller has the cursor_saved_position/cursor_saved_attributes if any (?review - if we always pass it back it, we could save some calls for moves in same line) - #don't set overflow at this point. The existing underlay to the right must be preserved. - #we only want to jump and render the unapplied at the new location. - - #lset overstacks $idx_over [list] - #set replay_codes_overlay "" - - #if {$cursor_saved_attributes ne ""} { - # set replay_codes_overlay $cursor_saved_attributes ;#empty - or last save if it happend in this input chunk - #} else { - #jj - #set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] - set replay_codes_overlay "" - #} - - #like priv::render_unapplied - but without the overlay's ansi reset or gx stacks from before the restore code - incr idx_over - - set unapplied "" - foreach gc [lrange $overlay_grapheme_control_list $gci+1 end] { - lassign $gc type item - if {$type eq "gx0"} { - if {$item eq "gx0_on"} { - append unapplied "\x1b(0" - } elseif {$item eq "gx0_off"} { - append unapplied "\x1b(B" - } - } else { - append unapplied $item - } - #incr idx_over - } + ~ { + #$re_vt_sequence + #lassign $matchinfo _match key mod + lassign [split $param {;}] key mod - #if the save occured within this line - that's ok - it's in the return value list and caller can prepend for the next loop. - - set instruction restore_cursor - break - }\ - $re_other_single { - lassign $matchinfo _match type - switch -- $type { - D { - #index (IND) - #vt102-docs: "Moves cursor down one line in same column. If cursor is at bottom margin, screen performs a scroll-up" - puts stderr "ESC D not fully implemented" - incr cursor_row - priv::render_unapplied $overlay_grapheme_control_list $gci - set instruction down - #retain cursor_column - break - } - M { - #Reverse Index (RI) - #vt102-docs: "Moves cursor up one line in same column. If cursor is at top margin, screen performs a scroll-down" - puts stderr "ESC M not fully implemented" - - set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] - #move up - incr cursor_row -1 - if {$cursor_row < 1} { - set cursor_row 1 - } - #ensure rest of *overlay* is emitted to remainder - priv::render_unapplied $overlay_grapheme_control_list $gci - set instruction up ;#need instruction for scroll-down? - #retain cursor_column - break - } - E { - #review - is behaviour different to 8bit c1 NEL \x85? lf? - #Next Line (NEL) - puts stderr "ESC E" + #Note that f1 to f4 show as ESCOP|Q|R|S (VT220?) but f5+ show as ESC\[15~ + # + #e.g esc \[2~ insert esc \[2;2~ shift-insert + #mod - subtract 1, and then use bitmask + #shift = 1, (left)Alt = 2, control=4, meta=8 (meta seems to do nothing on many terminals on windows? Intercepted by windows?) + #puts stderr "vt key:$key mod:$mod code:[ansistring VIEW $code]" + if {$key eq "1"} { + #home + } elseif {$key eq "2"} { + #Insert + if {$mod eq ""} { + #no modifier key + set insert_mode [expr {!$insert_mode}] + #rather than set the cursor - we return the insert mode state so the caller can decide + } + } elseif {$key eq "3"} { + #Delete - presumably this shifts other chars in the line, with empty cells coming in from the end + switch -- $mod { + "" { + priv::render_delchar $idx + } + "5" { + #ctrl-del - delete to end of word (pwsh) - possibly word on next line if current line empty(?) + } + } + } elseif {$key eq "4"} { + #End + } elseif {$key eq "5"} { + #pgup + } elseif {$key eq "6"} { + #pgDn + } elseif {$key eq "7"} { + #Home + #?? + set idx [expr {$opt_colstart -1}] + set cursor_column 1 + } elseif {$key eq "8"} { + #End + } elseif {$key eq "11"} { + #F1 - or ESCOP or e.g shift F1 ESC\[1;2P + } elseif {$key eq "12"} { + #F2 - or ESCOQ + } elseif {$key eq "13"} { + #F3 - or ESCOR + } elseif {$key eq "14"} { + #F4 - or ESCOS + } elseif {$key eq "15"} { + #F5 or shift F5 ESC\[15;2~ + } elseif {$key eq "17"} { + #F6 + } elseif {$key eq "18"} { + #F7 + } elseif {$key eq "19"} { + #F8 + } elseif {$key eq "20"} { + #F9 + } elseif {$key eq "21"} { + #F10 + } elseif {$key eq "23"} { + #F11 + } elseif {$key eq "24"} { + #F12 + } - } - } - }\ - $re_mode { - lassign $matchinfo _match num type - switch -- $num { - 5 { - #DECSNM - reverse video - #How we simulate this to render within a block of text is an open question. - #track all SGR stacks and constantly flip based on the current SGR reverse state? - #It is the job of the calling loop to do this - so at this stage we'll just set the states - #DECAWM autowrap - if {$type eq "h"} { - #set (enable) - set reverse_mode 1 - } else { - #reset (disable) - set reverse_mode 0 } + h - l { + #we are matching only last char to get to this arm - but are there other sequences ending in h|l we need to handle? + + #$re_mode if first after CSI is "?" + #some docs mention ESC=h|l - not seen on windows terminals.. review + #e.g https://www2.math.upenn.edu/~kazdan/210/computer/ansi.html + if {[string index $codenorm 4] eq "?"} { + set num [string range $codenorm 5 end-1] ;#param between ? and h|l + #lassign $matchinfo _match num type + switch -- $num { + 5 { + #DECSNM - reverse video + #How we simulate this to render within a block of text is an open question. + #track all SGR stacks and constantly flip based on the current SGR reverse state? + #It is the job of the calling loop to do this - so at this stage we'll just set the states + #DECAWM autowrap + if {$type eq "h"} { + #set (enable) + set reverse_mode 1 + } else { + #reset (disable) + set reverse_mode 0 + } + + } + 7 { + #DECAWM autowrap + if {$type eq "h"} { + #set (enable) + set autowrap_mode 1 + if {$opt_width ne "\uFFEF"} { + set overflow_idx $opt_width + } else { + #review - this is also the cursor position when adding a char at end of line? + set overflow_idx [expr {[llength $undercols]}] ;#index at which we would be *in* overflow a row move may still override it + } + #review - can idx ever be beyond overflow_idx limit when we change e.g with a width setting and cursor movements? presume not - but sanity check for now. + if {$idx >= $overflow_idx} { + puts stderr "renderline error - idx '$idx' >= overflow_idx '$overflow_idx' - unexpected" + } + } else { + #reset (disable) + set autowrap_mode 0 + set overflow_idx -1 + } + } + 25 { + if {$type eq "h"} { + #visible cursor + + } else { + #invisible cursor + + } + } + } - } - 7 { - #DECAWM autowrap - if {$type eq "h"} { - #set (enable) - set autowrap_mode 1 - if {$opt_width ne "\uFFEF"} { - set overflow_idx $opt_width } else { - #review - this is also the cursor position when adding a char at end of line? - set overflow_idx [expr {[llength $undercols]}] ;#index at which we would be *in* overflow a row move may still override it + puts stderr "overtype::renderline CSI...h|l code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented" } - #review - can idx ever be beyond overflow_idx limit when we change e.g with a width setting and cursor movements? presume not - but sanity check for now. - if {$idx >= $overflow_idx} { - puts stderr "renderline error - idx '$idx' >= overflow_idx '$overflow_idx' - unexpected" + } + default { + puts stderr "overtype::renderline CSI code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented" + } + } + } + 7ESC { + #$re_other_single + switch -- [string index $codenorm end] { + D { + #\x84 + #index (IND) + #vt102-docs: "Moves cursor down one line in same column. If cursor is at bottom margin, screen performs a scroll-up" + puts stderr "ESC D not fully implemented" + incr cursor_row + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction down + #retain cursor_column + break + } + M { + #\x8D + #Reverse Index (RI) + #vt102-docs: "Moves cursor up one line in same column. If cursor is at top margin, screen performs a scroll-down" + puts stderr "ESC M not fully implemented" + + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + #move up + incr cursor_row -1 + if {$cursor_row < 1} { + set cursor_row 1 } - } else { - #reset (disable) - set autowrap_mode 0 - set overflow_idx -1 + #ensure rest of *overlay* is emitted to remainder + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction up ;#need instruction for scroll-down? + #retain cursor_column + break } - } - 25 { - if {$type eq "h"} { - #visible cursor - - } else { - #invisible cursor + E { + #\x85 + #review - is behaviour different to lf? + #todo - possibly(?) same logic as handling above. i.e return instruction depends on where column_cursor is at the time we get NEL + #leave implementation until logic for is set in stone... still under review + #It's arguable NEL is a pure cursor movement as opposed to the semantic meaning of crlf or lf in a file. + # + #Next Line (NEL) "Move the cursor to the left margin on the next line. If the cursor is at the bottom margin, scroll the page up" + puts stderr "ESC E unimplemented" } + default { + puts stderr "overtype::renderline ESC code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented" + } } + } - }\ - default { - puts stderr "overtype::renderline code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented" } + #switch -regexp -matchvar matchinfo -- $code\ + #$re_mode { + #}\ + #default { + # puts stderr "overtype::renderline code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented" + #} + } default { #don't need to handle sgr or gx0 types