From 4875f1c5f88f1e13e948ecd26e3521d2a669a429 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Mon, 1 Apr 2024 05:15:22 +1100 Subject: [PATCH] telnet/ansi fixes --- src/bootsupport/modules/overtype-1.6.1.tm | 3394 ++++++++++++++++++ src/bootsupport/modules/punk/ansi-0.1.1.tm | 22 +- src/modules/punk/ansi-999999.0a1.0.tm | 22 +- src/modules/punk/basictelnet-999999.0a1.0.tm | 55 +- src/vendormodules/overtype-1.6.0.tm | 73 +- src/vendormodules/overtype-1.6.1.tm | 3394 ++++++++++++++++++ 6 files changed, 6924 insertions(+), 36 deletions(-) create mode 100644 src/bootsupport/modules/overtype-1.6.1.tm create mode 100644 src/vendormodules/overtype-1.6.1.tm diff --git a/src/bootsupport/modules/overtype-1.6.1.tm b/src/bootsupport/modules/overtype-1.6.1.tm new file mode 100644 index 0000000..079caec --- /dev/null +++ b/src/bootsupport/modules/overtype-1.6.1.tm @@ -0,0 +1,3394 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) Julian Noble 2003-2023 +# +# @@ Meta Begin +# Application overtype 1.6.1 +# Meta platform tcl +# Meta license BSD +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin overtype_module_overtype 0 1.6.1] +#[copyright "2024"] +#[titledesc {overtype text layout - ansi aware}] [comment {-- Name section and table of contents description --}] +#[moddesc {overtype text layout}] [comment {-- Description at end of page heading --}] +#[require overtype] +#[keywords module text ansi] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of overtype +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by overtype +#[list_begin itemized] + +package require Tcl 8.6 +package require textutil +package require punk::lib ;#required for lines_as_list +package require punk::ansi ;#required to detect, split, strip and calculate lengths +package require punk::char ;#box drawing - and also unicode character width determination for proper layout of text with double-column-width chars +package require punk::assertion +#*** !doctools +#[item] [package {Tcl 8.6}] +#[item] [package textutil] +#[item] [package punk::ansi] +#[para] - required to detect, split, strip and calculate lengths of text possibly containing ansi codes +#[item] [package punk::char] +#[para] - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section API] + + +#Julian Noble - 2003 +#Released under standard 'BSD license' conditions. +# +#todo - ellipsis truncation indicator for center,right + +#v1.4 2023-07 - naive ansi color handling - todo - fix string range +# - need to extract and replace ansi codes? + +namespace eval overtype { + namespace import ::punk::assertion::assert + punk::assertion::active true + + namespace path ::punk::lib + + namespace export * + variable default_ellipsis_horizontal "..." ;#fallback + variable default_ellipsis_vertical "..." + namespace eval priv { + proc _init {} { + upvar ::overtype::default_ellipsis_horizontal e_h + upvar ::overtype::default_ellipsis_vertical e_v + set e_h [format %c 0x2026] ;#Unicode Horizontal Ellipsis + set e_v [format %c 0x22EE] + #The unicode ellipsis looks more natural than triple-dash which is centred vertically whereas ellipsis is at floorline of text + #Also - unicode ellipsis has semantic meaning that other processors can interpret + #unicode does also provide a midline horizontal ellipsis 0x22EF + + #set e [format %c 0x2504] ;#punk::char::charshort boxd_ltdshhz - Box Drawings Light Triple Dash Horizontal + #if {![catch {package require punk::char}]} { + # set e [punk::char::charshort boxd_ltdshhz] + #} + } + } + priv::_init +} +proc overtype::about {} { + return "Simple text formatting. Author JMN. BSD-License" +} + +namespace eval overtype { + variable grapheme_widths [dict create] + + variable escape_terminals + #single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~). + dict set escape_terminals CSI [list @ \\ ^ _ ` | ~ a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z "\{" "\}"] + #dict set escape_terminals CSI [list J K m n A B C D E F G s u] ;#basic + dict set escape_terminals OSC [list \007 \033\\] ;#note mix of 1 and 2-byte terminals + + #self-contained 2 byte ansi escape sequences - review more? + variable ansi_2byte_codes_dict + set ansi_2byte_codes_dict [dict create\ + "reset_terminal" "\u001bc"\ + "save_cursor_posn" "\u001b7"\ + "restore_cursor_posn" "\u001b8"\ + "cursor_up_one" "\u001bM"\ + "NEL - Next Line" "\u001bE"\ + "IND - Down one line" "\u001bD"\ + "HTS - Set Tab Stop" "\u001bH"\ + ] + + #debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway. + # "PM - Privacy Message" "\u001b^somethinghidden\033\\"\ +} + + +#proc overtype::stripansi {text} { +# variable escape_terminals ;#dict +# variable ansi_2byte_codes_dict +# #important that we don't spend too much time on this for plain text that doesn't contain any escapes anyway +# if {[string first \033 $text] <0 && [string first \009c $text] <0} { +# #\033 same as \x1b +# return $text +# } +# +# set text [convert_g0 $text] +# +# #we process char by char - line-endings whether \r\n or \n should be processed as per any other character. +# #line endings can theoretically occur within an ansi escape sequence (review e.g title?) +# set inputlist [split $text ""] +# set outputlist [list] +# +# set 2bytecodes [dict values $ansi_2byte_codes_dict] +# +# set in_escapesequence 0 +# #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls +# set i 0 +# foreach u $inputlist { +# set v [lindex $inputlist $i+1] +# set uv ${u}${v} +# if {$in_escapesequence eq "2b"} { +# #2nd byte - done. +# set in_escapesequence 0 +# } elseif {$in_escapesequence != 0} { +# set escseq [dict get $escape_terminals $in_escapesequence] +# if {$u in $escseq} { +# set in_escapesequence 0 +# } elseif {$uv in $escseq} { +# set in_escapseequence 2b ;#flag next byte as last in sequence +# } +# } else { +# #handle both 7-bit and 8-bit CSI and OSC +# if {[regexp {^(?:\033\[|\u009b)} $uv]} { +# set in_escapesequence CSI +# } elseif {[regexp {^(?:\033\]|\u009c)} $uv]} { +# set in_escapesequence OSC +# } elseif {$uv in $2bytecodes} { +# #self-contained e.g terminal reset - don't pass through. +# set in_escapesequence 2b +# } else { +# lappend outputlist $u +# } +# } +# incr i +# } +# return [join $outputlist ""] +#} + + + + + +proc overtype::string_columns {text} { + if {[punk::ansi::ta::detect $text]} { + #error "error string_columns is for calculating character length of string - ansi codes must be stripped/rendered first e.g with punk::ansi::stripansi. Alternatively try punk::ansi::printing_length" + set text [punk::ansi::stripansi $text] + } + return [punk::char::ansifreestring_width $text] +} + +#todo - consider a way to merge overtype::left/centre/right +#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. +#(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 +#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 overlay may just be an ansi-colourised block - or may contain ansi cursor movements and cursor save/restore calls - in which case the apparent length and width of the overlay can't be determined as if it was a block of text. +#This is a single-shot rendering of strings - ie there is no way to chain another call containing a cursor-restore to previously rendered output and have it know about any cursor-saves in the first call. +# a cursor start position other than top-left is a possible addition to consider. +#see editbuf in punk::repl for a more stateful ansi-processor. Both systems use loops over overtype::renderline +proc overtype::left {args} { + #*** !doctools + #[call [fun overtype::left] [arg args] ] + #[para] usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext + + # @c overtype starting at left (overstrike) + # @c can/should we use something like this?: 'format "%-*s" $len $overtext + variable default_ellipsis_horizontal + + if {[llength $args] < 2} { + error {usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} + } + lassign [lrange $args end-1 end] underblock overblock + set defaults [dict create\ + -bias ignored\ + -width \uFFEF\ + -height \uFFEF\ + -wrap 0\ + -ellipsis 0\ + -ellipsistext $default_ellipsis_horizontal\ + -ellipsiswhitespace 0\ + -overflow 0\ + -appendlines 1\ + -transparent 0\ + -exposed1 \uFFFD\ + -exposed2 \uFFFD\ + -experimental 0\ + -looplimit \uFFEF\ + ] + #-ellipsis args not used if -wrap is true + set argsflags [lrange $args 0 end-2] + dict for {k v} $argsflags { + switch -- $k { + -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" + } + } + } + set opts [dict merge $defaults $argsflags] + # -- --- --- --- --- --- + set opt_overflow [dict get $opts -overflow] + ##### + # review -wrap should map onto DECAWM terminal mode - the wrap 2 idea may not fit in with this?. + set opt_wrap [dict get $opts -wrap] ;#wrap 1 is hard wrap cutting word at exact column, or 1 column early for 2w-glyph, wrap 2 is for language-based word-wrap algorithm (todo) + ##### + #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] + set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] + set opt_exposed1 [dict get $opts -exposed1] ;#widechar_exposed_left - 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 1 + set info_mode 0 + set edit_mode 0 + set opt_experimental [dict get $opts -experimental] + foreach o $opt_experimental { + switch -- $o { + test_mode { + set test_mode 1 + set info_mode 1 + } + old_mode { + set test_mode 0 + set info_mode 1 + } + data_mode { + set data_mode 1 + } + info_mode { + set info_mode 1 + } + edit_mode { + set edit_mode 1 + } + } + } + # ---------------------------- + + #modes + set insert_mode 0 ;#can be toggled by insert key or ansi IRM sequence ESC [ 4 h|l + set autowrap_mode $opt_wrap + set reverse_mode 0 + + + set norm [list \r\n \n] + set underblock [string map $norm $underblock] + set overblock [string map $norm $overblock] + + + #set underlines [split $underblock \n] + + #underblock is a 'rendered' block - so width height make sense + #colwidth & colheight were originally named with reference to rendering into a 'column' of output e.g a table column - before cursor row/col was implemented. + #The naming is now confusing. It should be something like renderwidth renderheight ?? review + + if {$opt_width eq "\uFFEF"} { + lassign [blocksize $underblock] _w colwidth _h colheight + } else { + set colwidth $opt_width + set colheight $opt_height + } + if {$underblock eq ""} { + 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] + } + + #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 + + #a hack until we work out how to avoid infinite loops... + # + set looplimit [dict get $opts -looplimit] + if {$looplimit eq "\uFFEF"} { + #looping for each char is worst case (all newlines?) - anything over that is an indication of something broken? + #do we need any margin above the length? (telnet mapscii.me test) + set looplimit [expr {[string length $overblock] + 10}] + } + + if {!$test_mode} { + set inputchunks [split $overblock \n] + } else { + set scheme 3 + switch -- $scheme { + 0 { + #one big chunk + 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 { + #it turns out line based chunks are faster than the above.. probably because some of those end up doing the regex splitting twice + set lflines [list] + set 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 + + + set replay_codes_underlay [dict create 1 ""] + #lappend replay_codes_overlay "" + set replay_codes_overlay "" + set unapplied "" + set cursor_saved_position [dict create] + set cursor_saved_attributes "" + + + set outputlines $underlines + set overidx 0 + + #underlines are not necessarily processed in order - depending on cursor-moves applied from overtext + set row 1 + if {$data_mode} { + set col [_get_row_append_column $row] + } else { + set col 1 + } + + set instruction_stats [dict create] + + set loop 0 + #while {$overidx < [llength $inputchunks]} { } + + while {[llength $inputchunks]} { + #set overtext [lindex $inputchunks $overidx]; lset inputchunks $overidx "" + set overtext [lpop inputchunks 0] + if {![string length $overtext]} { + incr loop + continue + } + #puts "----->[ansistring VIEW -lf 1 -vt 1 -nul 1 $overtext]<----" + set undertext [lindex $outputlines [expr {$row -1}]] + set renderedrow $row + + #renderline pads each underaly line to width with spaces and should track where end of data is + + + #set overtext [string cat [lindex $replay_codes_overlay $overidx] $overtext] + set overtext [string cat $replay_codes_overlay $overtext] + if {[dict exists $replay_codes_underlay $row]} { + set undertext [string cat [dict get $replay_codes_underlay $row] $undertext] + } + #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 + 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 -experimental $opt_experimental -info 1 -insert_mode $insert_mode -cursor_restore_attributes $cursor_saved_attributes -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 insert_mode [dict get $rinfo insert_mode] + set autowrap_mode [dict get $rinfo autowrap_mode] ;# + #set reverse_mode [dict get $rinfo reverse_mode];#how to support in rendered linelist? we need to examine all pt/code blocks and flip each SGR stack? + set rendered [dict get $rinfo result] + set overflow_right [dict get $rinfo overflow_right] + set overflow_right_column [dict get $rinfo overflow_right_column] + set unapplied [dict get $rinfo unapplied] + set unapplied_list [dict get $rinfo unapplied_list] + set post_render_col [dict get $rinfo cursor_column] + set post_render_row [dict get $rinfo cursor_row] + set c_saved_pos [dict get $rinfo cursor_saved_position] + set c_saved_attributes [dict get $rinfo cursor_saved_attributes] + set visualwidth [dict get $rinfo visualwidth] + set insert_lines_above [dict get $rinfo insert_lines_above] + set insert_lines_below [dict get $rinfo insert_lines_below] + dict set replay_codes_underlay [expr {$renderedrow+1}] [dict get $rinfo replay_codes_underlay] + #lset replay_codes_overlay [expr $overidx+1] [dict get $rinfo replay_codes_overlay] + set replay_codes_overlay [dict get $rinfo replay_codes_overlay] + + + + #-- todo - detect looping properly + if {$row > 1 && $overtext ne "" && $unapplied eq $overtext && $post_render_row == $row && $instruction eq ""} { + puts stderr "overtype::left loop?" + puts [ansistring VIEW $rinfo] + break + } + #-- + + if {[dict size $c_saved_pos] >= 1} { + set cursor_saved_position $c_saved_pos + set cursor_saved_attributes $c_saved_attributes + } + + #background line is narrower than data in line + + set overflow_handled 0 + if {!$opt_overflow && !$autowrap_mode} { + #not allowed to overflow column or wrap therefore we get overflow data to truncate + if {[dict get $opts -ellipsis]} { + set show_ellipsis 1 + if {!$opt_ellipsiswhitespace} { + #we don't want ellipsis if only whitespace was lost + set lostdata "" + if {$overflow_right ne ""} { + append lostdata $overflow_right + } + if {$unapplied ne ""} { + append lostdata $unapplied + } + if {[string trim $lostdata] eq ""} { + set show_ellipsis 0 + } + #set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] + if {[string trim [ansistrip $lostdata]] eq ""} { + set show_ellipsis 0 + } + } + if {$show_ellipsis} { + set rendered [overtype::right $rendered $opt_ellipsistext] + } + set overflow_handled 1 + } else { + #no wrap - no ellipsis - silently truncate + set overflow_handled 1 + } + } + + + + set nextprefix "" + + + #todo - handle potential insertion mode as above for cursor restore? + #keeping separate branches for debugging - review and merge as appropriate when stable + dict incr instruction_stats $instruction + switch -- $instruction { + {} { + if {$test_mode == 0} { + incr row + if {$data_mode} { + set col [_get_row_append_column $row] + if {$col > $colwidth} { + + } + } else { + set col 1 + } + } else { + #lf included in data + set row $post_render_row + set col $post_render_col + + #set col 1 + #if {$post_render_row != $renderedrow} { + # set col 1 + #} else { + # set col $post_render_col + #} + } + } + up { + + #renderline knows it's own line number, and knows not to go above row l + #it knows that a move whilst 1-beyond the width conflicts with the linefeed and reduces the move by one accordingly. + #row returned should be correct. + #column may be the overflow column - as it likes to report that to the caller. + + #Note that an ansi up sequence after last column going up to a previous line and also beyond the last column, will result in the next grapheme going onto the following line. + #this seems correct - as the column remains beyond the right margin so subsequent chars wrap (?) review + #puts stderr "up $post_render_row" + #puts stderr "$rinfo" + + #puts stdout "1 row:$row col $col" + 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 + } 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 "-----------------------" + #puts stdout $rinfo + #flush stdout + } + down { + if {$data_mode == 0} { + #renderline doesn't know how far down we can go.. + 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 row $post_render_row + 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 { + #testfile belinda.ans uses this + + #puts stdout "[a+ blue bold]CURSOR_RESTORE[a]" + if {[dict exists $cursor_saved_position row]} { + set row [dict get $cursor_saved_position row] + set col [dict get $cursor_saved_position column] + #puts stdout "restoring: row $row col $col [ansistring VIEW $cursor_saved_attributes] [a] unapplied [ansistring VIEWCODES $unapplied]" + #set nextprefix $cursor_saved_attributes + #lset replay_codes_overlay [expr $overidx+1] $cursor_saved_attributes + set replay_codes_overlay [dict get $rinfo replay_codes_overlay]$cursor_saved_attributes + #set replay_codes_overlay $cursor_saved_attributes + set cursor_saved_position [dict create] + set cursor_saved_attributes "" + } else { + #TODO + #?restore without save? + #should move to home position and reset ansi SGR? + #puts stderr "overtype::left cursor_restore without save data available" + } + #If we were inserting prior to hitting the cursor_restore - there could be overflow_right data - generally the overtype functions aren't for inserting - but ansi can enable it + #if we were already in overflow when cursor_restore was hit - it shouldn't have been processed as an action - just stored. + if {!$overflow_handled && $overflow_right ne ""} { + #wrap before restore? - possible effect on saved cursor position + #this overflow data has previously been rendered so has no cursor movements or further save/restore operations etc + #we can just insert another call to renderline to solve this.. ? + #It would perhaps be more properly handled as a queue of instructions from our initial renderline call + #we don't need to worry about overflow next call (?)- but we should carry forward our gx and ansi stacks + + puts stdout ">>>[a+ red bold]overflow_right during restore_cursor[a]" + + set sub_info [overtype::renderline -info 1 -width $colwidth -insert_mode $insert_mode -autowrap_mode $autowrap_mode -overflow [dict get $opts -overflow] "" $overflow_right] + set foldline [dict get $sub_info result] + set insert_mode [dict get $sub_info insert_mode] ;#probably not needed.. + set autowrap_mode [dict get $sub_info autowrap_mode] ;#nor this.. + linsert outputlines $renderedrow $foldline + #review - row & col set by restore - but not if there was no save.. + } + set overflow_handled 1 + + } + move { + ######## + if {$post_render_row > [llength $outputlines]} { + #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 + } + ####### + set col $post_render_col + #overflow + unapplied? + } + lf_start { + #raw newlines - must be test_mode + # ---------------------- + #test with fruit.ans + #test - treating as newline below... + #append rendered $overflow_right + #set overflow_right "" + set row $renderedrow + incr row + if {$row > [llength $outputlines]} { + lappend outputlines "" + } + set col 1 + # ---------------------- + } + lf_mid { + + if 0 { + #set rhswidth [punk::ansi::printing_length $overflow_right] + #only show debug when we have overflow? + set lhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -nul 1 -lf 1 -vt 1 $rendered]] + set lhs [textblock::frame -title "rendered $visualwidth cols" -subtitle "row-$renderedrow" $lhs] + + set rhs "" + if {$overflow_right ne ""} { + set rhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -nul 1 -lf 1 -vt 1 $overflow_right]] + set rhs [textblock::frame -title overflow_right $rhs] + } + puts [textblock::join $lhs " $post_render_col " $rhs] + } + + if {!$test_mode} { + #rendered + append rendered $overflow_right + #set replay_codes_overlay "" + set overflow_right "" + + + 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 ""] + } + } else { + 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 ""] + } + } + } + } + lf_overflow { + #linefeed after colwidth e.g at column 81 for an 80 col width + #we may also have other control sequences that came after col 80 e.g cursor save + + if 0 { + set lhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -nul 1 -lf 1 -vt 1 $rendered]] + set lhs [textblock::frame -title "rendered $visualwidth cols" -subtitle "row-$renderedrow" $lhs] + set rhs "" + + #assertion - there should be no overflow.. + puts $lhs + } + assert {$overflow_right eq ""} lf_overflow should not get data in overflow_right + + set row $post_render_row + #set row $renderedrow + #incr row + #only add newline if we're at the bottom + if {$row > [llength $outputlines]} { + lappend outputlines {*}[lrepeat 1 ""] + } + set col 1 + + } + newlines_above { + #we get a newlines_above instruction when received at column 1 + #In some cases we want to treat that as request to insert a new blank line above, and move our row 1 down (staying with the data) + #in other cases - we want to treat at column 1 the same as any other + + puts "--->newlines_above" + puts "rinfo: $rinfo" + #renderline doesn't advance the row for us - the caller has the choice to implement or not + set row $post_render_row + set col $post_render_col + if {$insert_lines_above > 0} { + set row $renderedrow + set outputlines [linsert $outputlines $renderedrow-1 {*}[lrepeat $insert_lines_above ""]] + incr row [expr {$insert_lines_above -1}] ;#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 { + #obsolete? - use for ANSI insert lines sequence + if {$data_mode == 0} { + puts --->nl_below + set row $post_render_row + set col $post_render_col + if {$insert_lines_below == 1} { + if {$test_mode == 0} { + 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 + } else { + #set lhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -lf 1 -vt 1 $rendered]] + #set lhs [textblock::frame -title rendered -subtitle "row-$renderedrow" $lhs] + #set rhs "" + #if {$overflow_right ne ""} { + # set rhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -lf 1 -vt 1 $overflow_right]] + # set rhs [textblock::frame -title overflow_right $rhs] + #} + #puts [textblock::join $lhs $rhs] + + #rendered + append rendered $overflow_right + # + + + set overflow_right "" + set row $renderedrow + #only add newline if we're at the bottom + if {$row > [llength $outputlines]} { + lappend outputlines {*}[lrepeat $insert_lines_below ""] + } + incr row $insert_lines_below + set col 1 + + + + } + } + } else { + set row $post_render_row + 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 "" + } + } else { + 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 + } + } + } + } + wrapmoveforward { + #doesn't seem to be used by fruit.ans testfile + #used by dzds.ans + #note that cursor_forward may move deep into the next line - or even span multiple lines !TODO + set c $colwidth + set r $post_render_row + if {$post_render_col > $colwidth} { + set i $c + while {$i <= $post_render_col} { + if {$c == $colwidth+1} { + incr r + if {$opt_appendlines} { + if {$r < [llength $outputlines]} { + lappend outputlines "" + } + } + set c 1 + } else { + incr c + } + incr i + } + set col $c + } else { + #why are we getting this instruction then? + puts stderr "wrapmoveforward - test" + set r [expr {$post_render_row +1}] + set c $post_render_col + } + set row $r + set col $c + } + wrapmovebackward { + set c $colwidth + set r $post_render_row + if {$post_render_col < 1} { + set c 1 + set i $c + while {$i >= $post_render_col} { + if {$c == 0} { + if {$r > 1} { + incr r -1 + set c $colwidth + } else { + #leave r at 1 set c 1 + #testfile besthpav.ans first line top left border alignment + set c 1 + break + } + } else { + incr c -1 + } + incr i -1 + } + set col $c + } else { + puts stderr "Wrapmovebackward - but postrendercol >= 1???" + } + set row $r + set col $c + } + overflow { + #normal single-width grapheme overflow + #puts "----normal overflow --- [ansistring VIEWSTYLE -lf 1 -nul 1 -vt 1 $rendered]" + set row $post_render_row ;#renderline will not advance row when reporting overflow char + if {$autowrap_mode} { + incr row + set col 1 ;#whether wrap or not - next data is at column 1 ?? + } else { + #this works for test_mode (which should become the default) - but could give a bad result otherwise - review - add tests fix. + set col $post_render_col + #set unapplied "" ;#this seems wrong? + #set unapplied [string range $unapplied 1 end] + #The overflow can only be triggered by a grapheme (todo cluster?) - but our unapplied could contain SGR codes prior to the grapheme that triggered overflow - so we need to skip beyond any SGRs + #There may be more than one, because although the stack leading up to overflow may have been merged - codes between the last column and the overflowing grapheme will remain separate + #We don't expect any movement or other ANSI codes - as if they came before the grapheme, they would have triggered a different instruction to 'overflow' + set idx 0 + set next_grapheme_index -1 + foreach u $unapplied_list { + if {![punk::ansi::ta::detect $u]} { + set next_grapheme_index $idx + break + } + incr idx + } + assert {$next_grapheme_index >= 0} + #drop the overflow grapheme - keeping all codes in place. + set unapplied [join [lreplace $unapplied_list $next_grapheme_index $next_grapheme_index] ""] + #we need to run the reduced unapplied on the same line - further graphemes will just overflow again, but codes or control chars could trigger jumps to other lines + + set overflow_handled 1 + #handled by dropping overflow if any + } + } + overflow_splitchar { + set row $post_render_row ;#renderline will not advance row when reporting overflow char + + #2nd half of grapheme would overflow - treggering grapheme is returned in unapplied. There may also be overflow_right from earlier inserts + #todo - consider various options .. re-render a single trailing space or placeholder on same output line, etc + if {$autowrap_mode} { + if {$colwidth < 2} { + #edge case of rendering to a single column output - any 2w char will just cause a loop if we don't substitute with something, or drop the character + set idx 0 + set triggering_grapheme_index -1 + foreach u $unapplied_list { + if {![punk::ansi::ta::detect $u]} { + set triggering_grapheme_index $idx + break + } + incr idx + } + set unapplied [join [lreplace $unapplied_list $triggering_grapheme_index $triggering_grapheme_index $opt_exposed1] ""] + } else { + set col 1 + incr row + } + } else { + set overflow_handled 1 + #handled by dropping entire overflow if any + if {$colwidth < 2} { + set idx 0 + set triggering_grapheme_index -1 + foreach u $unapplied_list { + if {![punk::ansi::ta::detect $u]} { + set triggering_grapheme_index $idx + break + } + incr idx + } + set unapplied [join [lreplace $unapplied_list $triggering_grapheme_index $triggering_grapheme_index $opt_exposed1] ""] + } + } + + } + vt { + + #can vt add a line like a linefeed can? + set row $post_render_row + set col $post_render_col + } + default { + puts stderr "overtype::left unhandled renderline instruction '$instruction'" + } + + } + + if {$renderedrow <= [llength $outputlines]} { + lset outputlines [expr {$renderedrow-1}] $rendered + } else { + if {$opt_appendlines} { + lappend outputlines $rendered + } else { + #? + lset outputlines [expr {$renderedrow-1}] $rendered + } + } + + if {!$overflow_handled} { + append nextprefix $overflow_right + } + + append nextprefix $unapplied + + if 0 { + if {$nextprefix ne ""} { + set nextoveridx [expr {$overidx+1}] + if {$nextoveridx >= [llength $inputchunks]} { + lappend inputchunks $nextprefix + } else { + #lset overlines $nextoveridx $nextprefix[lindex $overlines $nextoveridx] + set inputchunks [linsert $inputchunks $nextoveridx $nextprefix] + } + } + } + + if {$nextprefix ne ""} { + set inputchunks [linsert $inputchunks 0 $nextprefix] + } + + + incr overidx + incr loop + if {$loop >= $looplimit} { + puts stderr "overtype::left looplimit reached ($looplimit)" + lappend outputlines "[a+ red bold] - looplimit $looplimit reached[a]" + set Y [a+ yellow bold] + set RST [a] + set sep_header ----DEBUG----- + set debugmsg "" + append debugmsg "${Y}${sep_header}${RST}" \n + append debugmsg "looplimit $looplimit reached\n" + append debugmsg "test_mode:$test_mode\n" + append debugmsg "data_mode:$data_mode\n" + append debugmsg "opt_appendlines:$opt_appendlines\n" + append debugmsg "prev_row :[dict get $LASTCALL -cursor_row]\n" + append debugmsg "prev_col :[dict get $LASTCALL -cursor_column]\n" + dict for {k v} $rinfo { + append debugmsg "${Y}$k [ansistring VIEW -lf 1 -vt 1 $v]$RST" \n + } + append debugmsg "${Y}[string repeat - [string length $sep_header]]$RST" \n + + puts stdout $debugmsg + #todo - config regarding error dumps rather than just dumping in working dir + set fd [open [pwd]/error_overtype.txt w] + puts $fd $debugmsg + close $fd + error $debugmsg + break + } + } + + set result [join $outputlines \n] + if {$info_mode} { + #emit to debug window like basictelnet does? make debug configurable as syslog or even a telnet server to allow on 2nd window? + #append result \n$instruction_stats\n + } + return $result +} + +namespace eval overtype::piper { + proc overcentre {args} { + if {[llength $args] < 2} { + error {usage: ?-bias left|right? ?-transparent [0|1|]? ?-exposed1 ? ?-exposed2 ? ?-overflow [1|0]? overtext pipelinedata} + } + lassign [lrange $args end-1 end] over under + set argsflags [lrange $args 0 end-2] + tailcall overtype::centre {*}$argsflags $under $over + } + proc overleft {args} { + if {[llength $args] < 2} { + error {usage: ?-startcolumn ? ?-transparent [0|1|]? ?-exposed1 ? ?-exposed2 ? ?-overflow [1|0]? overtext pipelinedata} + } + lassign [lrange $args end-1 end] over under + set argsflags [lrange $args 0 end-2] + tailcall overtype::left {*}$argsflags $under $over + } +} +#todo - left-right ellipsis ? +proc overtype::centre {args} { + variable default_ellipsis_horizontal + if {[llength $args] < 2} { + error {usage: ?-transparent [0|1]? ?-bias [left|right]? ?-overflow [1|0]? undertext overtext} + } + + foreach {underblock overblock} [lrange $args end-1 end] break + + #todo - vertical vs horizontal overflow for blocks + set defaults [dict create\ + -bias left\ + -ellipsis 0\ + -ellipsistext $default_ellipsis_horizontal\ + -ellipsiswhitespace 0\ + -overflow 0\ + -transparent 0\ + -exposed1 \uFFFD\ + -exposed2 \uFFFD\ + ] + set argsflags [lrange $args 0 end-2] + dict for {k v} $argsflags { + switch -- $k { + -bias - -ellipsis - -ellipsistext - -ellipsiswhitespace - -overflow - -transparent - -exposed1 - -exposed2 {} + default { + set known_opts [dict keys $defaults] + error "overtype::centre unknown option '$k'. Known options: $known_opts" + } + } + } + set opts [dict merge $defaults $argsflags] + # -- --- --- --- --- --- + set opt_transparent [dict get $opts -transparent] + set opt_ellipsis [dict get $opts -ellipsis] + set opt_ellipsistext [dict get $opts -ellipsistext] + set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] + set opt_exposed1 [dict get $opts -exposed1] + set opt_exposed2 [dict get $opts -exposed2] + # -- --- --- --- --- --- + + + set norm [list \r\n \n] + set underblock [string map $norm $underblock] + set overblock [string map $norm $overblock] + + set underlines [split $underblock \n] + #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] + lassign [blocksize $underblock] _w colwidth _h colheight + set overlines [split $overblock \n] + #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] + lassign [blocksize $overblock] _w overblock_width _h overblock_height + set under_exposed_max [expr {$colwidth - $overblock_width}] + if {$under_exposed_max > 0} { + #background block is wider + if {$under_exposed_max % 2 == 0} { + #even left/right exposure + set left_exposed [expr {$under_exposed_max / 2}] + } else { + set beforehalf [expr {$under_exposed_max / 2}] ;#1 less than half due to integer division + if {[string tolower [dict get $opts -bias]] eq "left"} { + set left_exposed $beforehalf + } else { + #bias to the right + set left_exposed [expr {$beforehalf + 1}] + } + } + } else { + set left_exposed 0 + } + + set outputlines [list] + if {[punk::ansi::ta::detect_sgr [lindex $overlines 0]]} { + set replay_codes "[punk::ansi::a]" + } else { + set replay_codes "" + } + set replay_codes_underlay "" + set replay_codes_overlay "" + foreach undertext $underlines overtext $overlines { + set overtext_datalen [punk::ansi::printing_length $overtext] + set ulen [punk::ansi::printing_length $undertext] + if {$ulen < $colwidth} { + set udiff [expr {$colwidth - $ulen}] + set undertext "$undertext[string repeat { } $udiff]" + } + set undertext [string cat $replay_codes_underlay $undertext] + set overtext [string cat $replay_codes_overlay $overtext] + + set overflowlength [expr {$overtext_datalen - $colwidth}] + #review - right-to-left langs should elide on left! - extra option required + + if {$overflowlength > 0} { + #overlay line wider or equal + set rinfo [renderline -info 1 -insert_mode 0 -transparent $opt_transparent -overflow [dict get $opts -overflow] -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] + set rendered [dict get $rinfo result] + set overflow_right [dict get $rinfo overflow_right] + set unapplied [dict get $rinfo unapplied] + #todo - get replay_codes from overflow_right instead of wherever it was truncated? + + #overlay line data is wider - trim if overflow not specified in opts - and overtype an ellipsis at right if it was specified + if {![dict get $opts -overflow]} { + #lappend outputlines [string range $overtext 0 [expr {$colwidth - 1}]] + #set overtext [string range $overtext 0 $colwidth-1 ] + if {$opt_ellipsis} { + set show_ellipsis 1 + if {!$opt_ellipsiswhitespace} { + #we don't want ellipsis if only whitespace was lost + #don't use string range on ANSI data + #set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] + set lostdata "" + if {$overflow_right ne ""} { + append lostdata $overflow_right + } + if {$unapplied ne ""} { + append lostdata $unapplied + } + if {[string trim $lostdata] eq ""} { + set show_ellipsis 0 + } + } + if {$show_ellipsis} { + set rendered [overtype::right $rendered $opt_ellipsistext] + } + } + } + lappend outputlines $rendered + #lappend outputlines [renderline -insert_mode 0 -transparent $opt_transparent $undertext $overtext] + } else { + #background block is wider than or equal to data for this line + #lappend outputlines [renderline -insert_mode 0 -startcolumn [expr {$left_exposed + 1}] -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] + set rinfo [renderline -info 1 -insert_mode 0 -startcolumn [expr {$left_exposed + 1}] -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] + lappend outputlines [dict get $rinfo result] + } + set replay_codes_underlay [dict get $rinfo replay_codes_underlay] + set replay_codes_overlay [dict get $rinfo replay_codes_overlay] + } + return [join $outputlines \n] +} + +proc overtype::right {args} { + #NOT the same as align-right - which should be done to the overblock first if required + variable default_ellipsis_horizontal + # @d !todo - implement overflow, length checks etc + + if {[llength $args] < 2} { + error {usage: ?-overflow [1|0]? ?-transparent 0|? undertext overtext} + } + foreach {underblock overblock} [lrange $args end-1 end] break + + set defaults [dict create\ + -bias ignored\ + -ellipsis 0\ + -ellipsistext $default_ellipsis_horizontal\ + -ellipsiswhitespace 0\ + -overflow 0\ + -transparent 0\ + -exposed1 \uFFFD\ + -exposed2 \uFFFD\ + -align "left"\ + ] + set argsflags [lrange $args 0 end-2] + dict for {k v} $argsflags { + switch -- $k { + -bias - -ellipsis - -ellipsistext - -ellipsiswhitespace - -overflow - -transparent - -exposed1 - -exposed2 - -align {} + default { + set known_opts [dict keys $defaults] + error "overtype::centre unknown option '$k'. Known options: $known_opts" + } + } + } + set opts [dict merge $defaults $argsflags] + # -- --- --- --- --- --- + set opt_transparent [dict get $opts -transparent] + set opt_ellipsis [dict get $opts -ellipsis] + set opt_ellipsistext [dict get $opts -ellipsistext] + set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] + set opt_overflow [dict get $opts -overflow] + set opt_exposed1 [dict get $opts -exposed1] + set opt_exposed2 [dict get $opts -exposed2] + set opt_align [dict get $opts -align] + # -- --- --- --- --- --- + + set norm [list \r\n \n] + set underblock [string map $norm $underblock] + set overblock [string map $norm $overblock] + + set underlines [split $underblock \n] + #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] + lassign [blocksize $underblock] _w colwidth _h colheight + set overlines [split $overblock \n] + #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] + lassign [blocksize $overblock] _w overblock_width _h overblock_height + set under_exposed_max [expr {max(0,$colwidth - $overblock_width)}] + set left_exposed $under_exposed_max + + + + set outputlines [list] + if {[punk::ansi::ta::detect_sgr [lindex $overlines 0]]} { + set replay_codes "[punk::ansi::a]" + } else { + set replay_codes "" + } + set replay_codes_underlay "" + set replay_codes_overlay "" + foreach undertext $underlines overtext $overlines { + set overtext_datalen [punk::ansi::printing_length $overtext] + set ulen [punk::ansi::printing_length $undertext] + if {$ulen < $colwidth} { + set udiff [expr {$colwidth - $ulen}] + #puts xxx + append undertext [string repeat { } $udiff] + } + if {$overtext_datalen < $overblock_width} { + set odiff [expr {$overblock_width - $overtext_datalen}] + switch -- $opt_align { + left { + set startoffset 0 + } + right { + set startoffset $odiff + } + default { + set half [expr {$odiff / 2}] + #set lhs [string repeat { } $half] + #set righthalf [expr {$odiff - $half}] ;#remainder - may be one more - so we are biased left + #set rhs [string repeat { } $righthalf] + set startoffset $half + } + } + } else { + set startoffset 0 ;#negative? + } + + set undertext [string cat $replay_codes_underlay $undertext] + set overtext [string cat $replay_codes_overlay $overtext] + + set overflowlength [expr {$overtext_datalen - $colwidth}] + if {$overflowlength > 0} { + #raw overtext wider than undertext column + set rinfo [renderline -info 1 -insert_mode 0 -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -startcolumn [expr {1 + $startoffset}] $undertext $overtext] + set replay_codes [dict get $rinfo replay_codes] + set rendered [dict get $rinfo result] + if {!$opt_overflow} { + if {$opt_ellipsis} { + set show_ellipsis 1 + if {!$opt_ellipsiswhitespace} { + #we don't want ellipsis if only whitespace was lost + set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] + if {[string trim $lostdata] eq ""} { + set show_ellipsis 0 + } + } + if {$show_ellipsis} { + set ellipsis [string cat $replay_codes $opt_ellipsistext] + #todo - overflow on left if allign = right?? + set rendered [overtype::right $rendered $ellipsis] + } + } + } + lappend outputlines $rendered + } else { + #padded overtext + #lappend outputlines [renderline -insert_mode 0 -transparent $opt_transparent -startcolumn [expr {$left_exposed + 1}] $undertext $overtext] + #Note - we still need overflow here - as although the overtext is short - it may oveflow due to the startoffset + set rinfo [renderline -info 1 -insert_mode 0 -transparent $opt_transparent -overflow $opt_overflow -startcolumn [expr {$left_exposed + 1 + $startoffset}] $undertext $overtext] + lappend outputlines [dict get $rinfo result] + } + set replay_codes [dict get $rinfo replay_codes] + set replay_codes_underlay [dict get $rinfo replay_codes_underlay] + set replay_codes_overlay [dict get $rinfo replay_codes_overlay] + } + + return [join $outputlines \n] +} + +# -- --- --- --- --- --- --- --- --- --- --- +proc overtype::transparentline {args} { + foreach {under over} [lrange $args end-1 end] break + set argsflags [lrange $args 0 end-2] + set defaults [dict create\ + -transparent 1\ + -exposed 1 " "\ + -exposed 2 " "\ + ] + set newargs [dict merge $defaults $argsflags] + tailcall overtype::renderline {*}$newargs $under $over +} +#renderline may not make sense as it is in the long run for blocks of text - but is handy in the single-line-handling form anyway. +# We are trying to handle ansi codes in a block of text which is acting like a mini-terminal in some sense. +#We can process standard cursor moves such as \b \r - but no way to respond to other cursor movements e.g moving to other lines. +# +namespace eval overtype::piper { + proc renderline {args} { + if {[llength $args] < 2} { + error {usage: ?-start ? ?-transparent [0|1|]? ?-overflow [1|0]? overtext pipelinedata} + } + foreach {over under} [lrange $args end-1 end] break + set argsflags [lrange $args 0 end-2] + tailcall overtype::renderline {*}$argsflags $under $over + } +} +interp alias "" piper_renderline "" overtype::piper::renderline + +#intended for single grapheme - but will work for multiple +#cannot contain ansi or newlines +#(a cache of ansifreestring_width calls - as these are quite regex heavy) +proc overtype::grapheme_width_cached {ch} { + variable grapheme_widths + if {[dict exists $grapheme_widths $ch]} { + return [dict get $grapheme_widths $ch] + } + set width [punk::char::ansifreestring_width $ch] + dict set grapheme_widths $ch $width + return $width +} + + + +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### +# renderline written from a left-right line orientation perspective as a first-shot at getting something useful. +# ultimately right-to-left, top-to-bottom and bottom-to-top are probably needed. +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### +# +# +#-returnextra enables returning of overflow and length +#review - use punk::ansi::ta::detect to short-circuit processing and do simpler string calcs as an optimisation? +#review - DECSWL/DECDWL double width line codes - very difficult/impossible to align and compose with other elements +#(could render it by faking it with sixels and a lot of work - find/make a sixel font and ensure it's exactly 2 cols per char) +#todo - review transparency issues with single/double width characters +#bidi - need a base direction and concept of directional runs for RTL vs LTR - may be best handled at another layer? +proc overtype::renderline {args} { + #*** !doctools + #[call [fun overtype::renderline] [arg args] ] + #[para] renderline is the core engine for overtype string processing (frames & textblocks), and the raw mode commandline repl for the Tcl Punk Shell + #[para] It is also a central part of an ansi (micro) virtual terminal-emulator of sorts + #[para] This system does a half decent job at rendering 90's ANSI art to manipulable colour text blocks that can be joined & framed for layout display within a unix or windows terminal + #[para] Renderline helps maintain ANSI text styling reset/replay codes so that the styling of one block doesn't affect another. + #[para] Calling on the punk::ansi library - it can coalesce codes to keep the size down. + #[para] It is a giant mess of doing exactly what common wisdom says not to do... lots at once. + #[para] renderline is part of the Unicode and ANSI aware Overtype system which 'renders' a block of text onto a static underlay + #[para] The underlay is generally expected to be an ordered set of lines or a rectangular text block analogous to a terminal screen - but it can also be ragged in line length, or just blank. + #[para] The overlay couuld be similar - in which case it may often be used to overwrite a column or section of the underlay. + #[para] The overlay could however be a sequence of ANSI-laden text that jumps all over the place. + # + #[para] renderline itself only deals with a single line - or sometimes a single character. It is generally called from a loop that does further terminal-like or textblock processing. + #[para] By suppyling the -info 1 option - it can return various fields indicating the state of the render. + #[para] The main 3 are the result, overflow_right, and unapplied. + #[para] Renderline handles cursor movements from either keystrokes or ANSI sequences but for a full system the aforementioned loop will need to be in place to manage the set of lines under manipulation. + + if {[llength $args] < 2} { + error {usage: ?-info 0|1? ?-startcolumn ? ?-cursor_column ? ?-cursor_row |""? ?-transparent [0|1|]? ?-overflow [1|0]? undertext overtext} + } + lassign [lrange $args end-1 end] under over + if {[string first \n $under] >= 0} { + error "overtype::renderline not allowed to contain newlines in undertext" + } + #if {[string first \n $over] >=0 || [string first \n $under] >= 0} { + # error "overtype::renderline not allowed to contain newlines" + #} + + set defaults [dict create\ + -etabs 0\ + -width \uFFEF\ + -overflow 0\ + -transparent 0\ + -startcolumn 1\ + -cursor_column 1\ + -cursor_row ""\ + -insert_mode 1\ + -autowrap_mode 1\ + -reverse_mode 0\ + -info 0\ + -exposed1 \uFFFD\ + -exposed2 \uFFFD\ + -cursor_restore_attributes ""\ + -experimental {}\ + ] + #-cursor_restore_attributes only - for replay stack - position and actual setting/restoring handled by throwback to caller + + #cursor_row, when numeric will allow detection of certain row moves that are still within our row - allowing us to avoid an early return + #An empty string for cursor_row tells us we have no info about our own row context, and to return with an unapplied string if any row move occurs + + #exposed1 and exposed2 for first and second col of underying 2wide char which is truncated by transparency or overflow + #todo - return info about such grapheme 'cuts' in -info structure and/or create option to raise an error + + set argsflags [lrange $args 0 end-2] + dict for {k v} $argsflags { + switch -- $k { + -experimental - -width - -overflow - -transparent - -startcolumn - -cursor_column - -cursor_row - -insert_mode - -autowrap_mode - -reverse_mode - -info - -exposed1 - -exposed2 - -cursor_restore_attributes {} + default { + set known_opts [dict keys $defaults] + error "overtype::renderline unknown option '$k'. Known options: $known_opts" + } + } + } + set opts [dict merge $defaults $argsflags] + # -- --- --- --- --- --- --- --- --- --- --- --- + set opt_width [dict get $opts -width] + set opt_etabs [dict get $opts -etabs] + set opt_overflow [dict get $opts -overflow] + set opt_colstart [dict get $opts -startcolumn] ;#lhs limit for overlay - an offset to cursor_column - first visible column is 1. 0 or < 0 are before the start of the underlay + set opt_colcursor [dict get $opts -cursor_column];#start cursor column relative to overlay + set opt_row_context [dict get $opts -cursor_row] + if {[string length $opt_row_context]} { + if {![string is integer -strict $opt_row_context] || $opt_row_context <1 } { + error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'" + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- + #The _mode flags correspond to terminal modes that can be set/reset via escape sequences (e.g DECAWM wraparound mode) + set opt_insert_mode [dict get $opts -insert_mode];#should usually be 1 for each new line in editor mode but must be initialised to 1 externally (review) + #default is for overtype + # -- --- --- --- --- --- --- --- --- --- --- --- + set opt_autowrap_mode [dict get $opts -autowrap_mode] ;#DECAWM - char or movement can go beyond leftmost/rightmost col to prev/next line + set opt_reverse_mode [dict get $opts -reverse_mode] ;#DECSNM + # -- --- --- --- --- --- --- --- --- --- --- --- + set temp_cursor_saved [dict get $opts -cursor_restore_attributes] + + set test_mode 0 + set cp437_glyphs 0 + foreach e [dict get $opts -experimental] { + switch -- $e { + test_mode { + set test_mode 1 + set cp437_glyphs 1 + } + } + } + set cp437_map [dict create] + if {$cp437_glyphs} { + set cp437_map [set ::punk::ansi::cp437_map] + #for cp437 images we need to map these *after* splitting ansi + #some old files might use newline for its glyph.. but we can't easily support that. + #Not sure how old files did it.. maybe cr lf in sequence was newline and any lone cr or lf were displayed as glyphs? + dict unset cp437_map \n + } + + set opt_transparent [dict get $opts -transparent] + if {$opt_transparent eq "0"} { + set do_transparency 0 + } else { + set do_transparency 1 + if {$opt_transparent eq "1"} { + set opt_transparent {[\s]} + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- + set opt_returnextra [dict get $opts -info] + # -- --- --- --- --- --- --- --- --- --- --- --- + set opt_exposed1 [dict get $opts -exposed1] + set opt_exposed2 [dict get $opts -exposed2] + # -- --- --- --- --- --- --- --- --- --- --- --- + + if {$opt_row_context eq ""} { + set cursor_row 1 + } else { + set cursor_row $opt_row_context + } + + + #----- + # + if {[info exists punk::console::tabwidth]} { + #punk console is updated if punk::console::set_tabstop_width is used or rep is started/restarted + #It is way too slow to test the current width by querying the terminal here - so it could conceivably get out of sync + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + + set overdata $over + if {!$cp437_glyphs} { + #REVIEW! tabify will give different answers for an ANSI colourised string vs plain text + if {!$opt_etabs} { + if {[string first \t $under] >= 0} { + #set under [textutil::tabify::untabify2 $under] + set under [textutil::tabify::untabifyLine $under $tw] + } + if {[string first \t $over] >= 0} { + #set overdata [textutil::tabify::untabify2 $over] + set overdata [textutil::tabify::untabifyLine $over $tw] + } + } + } + #------- + + #ta_detect ansi and do simpler processing? + + #we repeat tests for grapheme width in different loops - rather than create another datastructure to store widths based on column, + #we'll use the grapheme_width_cached function as a lookup table of all graphemes encountered - as there will often be repeats in different positions anyway. + + # -- --- --- --- --- --- --- --- + if {$under ne ""} { + set undermap [punk::ansi::ta::split_codes_single $under] + } else { + set undermap [list] + } + set understacks [list] + set understacks_gx [list] + + set i_u -1 ;#underlay may legitimately be empty + set undercols [list] + set u_codestack [list] + #u_gx_stack probably isn't really a stack - I don't know if g0 g1 can stack or not - for now we support only g0 anyway + set u_gx_stack [list] ;#separate stack for g0 (g1 g2 g3?) graphics on and off (DEC special graphics) + #set pt_underchars "" ;#for string_columns length calculation for overflow 0 truncation + set remainder [list] ;#for returnextra + foreach {pt code} $undermap { + #pt = plain text + #append pt_underchars $pt + if {$cp437_glyphs} { + set pt [string map $cp437_map $pt] + } + foreach grapheme [punk::char::grapheme_split $pt] { + #an ugly hack to serve *some* common case ascii quickly with byte-compiled literal switch - feels dirty. + #.. but even 0.5uS per char (grapheme_width_cached) adds up quickly when stitching lots of lines together. + switch -- $grapheme { + " " - - - _ - ! - @ - # - $ - % - ^ - & - * - = - + - : - . - , - / - | - ? - + a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - + z - A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { + set width 1 + } + default { + if {$grapheme eq "\u0000"} { + #use null as empty cell representation - review + #use of this will probably collide with some application at some point + #consider an option to set the empty cell character + set width 1 + } else { + set width [grapheme_width_cached $grapheme] + #we still want most controls and other zero-length codepoints such as \u200d (zero width joiner) to stay zero-length + #we substitute lone ESC that weren't captured within ANSI context as a debugging aid to see malformed ANSI + #todo - default to off and add a flag (?) to enable this substitution + set sub_stray_escapes 0 + if {$sub_stray_escapes && $width == 0} { + if {$grapheme eq "\x1b"} { + set gvis [ansistring VIEW $grapheme] + set grapheme $gvis + set width 1 + } + } + } + } + } + #set width [grapheme_width_cached $grapheme] + incr i_u + lappend understacks $u_codestack + lappend understacks_gx $u_gx_stack + + lappend undercols $grapheme + if {$width > 1} { + #presumably there are no triple-column or wider unicode chars.. until the aliens arrive.(?) + #but what about emoji combinations etc - can they be wider than 2? + #todo - if -etabs enabled - then we treat \t as the width determined by our elastic tabstop + incr i_u + lappend understacks $u_codestack + lappend understacks_gx $u_gx_stack + lappend undercols "" + } + } + + #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 + if {$code ne ""} { + 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 { + #need to exclude certain leaders after the lb e.g < for SGR 1006 mouse + #REVIEW - what else could end in m but be mistaken as a normal SGR code here? + set maybemouse "" + if {[string index $c1c2 0] eq "\x1b"} { + set maybemouse [string index $code 2] + } + + if {$maybemouse ne "<" && [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..? + } + + if {!$test_mode} { + #fill columns to width with spaces, and carry over stacks - we will have to keep track of where the underlying data ends manually - TODO + #Specifying a width is suitable for terminal-like applications and text-blocks + if {$opt_width ne "\uFFEF"} { + if {[llength $understacks]} { + set cs $u_codestack + set gs $u_gx_stack + } else { + set cs [list] + set gs [list] + } + if {[llength $undercols]< $opt_width} { + set diff [expr {$opt_width- [llength $undercols]}] + if {$diff > 0} { + lappend undercols {*}[lrepeat $diff " "] + lappend understacks {*}[lrepeat $diff $cs] + lappend understacks_gx {*}[lrepeat $diff $gs] + } + } + } + } else { + #NULL empty cell indicator + if {$opt_width ne "\uFFEF"} { + if {[llength $understacks]} { + set cs $u_codestack + set gs $u_gx_stack + } else { + set cs [list] + set gs [list] + } + if {[llength $undercols]< $opt_width} { + set diff [expr {$opt_width- [llength $undercols]}] + if {$diff > 0} { + lappend undercols {*}[lrepeat $diff "\u0000"] + lappend understacks {*}[lrepeat $diff $cs] + lappend understacks_gx {*}[lrepeat $diff $gs] + } + } + } + + } + if {$opt_width ne "\uFFEF"} { + set colwidth $opt_width + } else { + set colwidth [llength $undercols] + } + + + if 0 { + # ----------------- + # if we aren't extending understacks & understacks_gx each time we incr idx above the undercols length.. this doesn't really serve a purpose + # Review. + # ----------------- + #replay code for last overlay position in input line + # whether or not we get that far - we need to return it for possible replay on next line + if {[llength $understacks]} { + lappend understacks $u_codestack + lappend understacks_gx $u_gx_stack + } else { + #in case overlay onto emptystring as underlay + lappend understacks [list] + lappend understacks_gx [list] + } + # ----------------- + } + + #trailing codes in effect for underlay + if {[llength $u_codestack]} { + #set replay_codes_underlay [join $u_codestack ""] + set replay_codes_underlay [punk::ansi::codetype::sgr_merge_list {*}$u_codestack] + } else { + set replay_codes_underlay "" + } + + + # -- --- --- --- --- --- --- --- + #### + #if opt_colstart - we need to build a space (or any singlewidth char ?) padding on the left of the right number of columns. + #this will be processed as transparent - and handle doublewidth underlay characters appropriately + set startpad_overlay [string repeat " " [expr {$opt_colstart -1}]] + append startpad_overlay $overdata ;#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency + set overmap [punk::ansi::ta::split_codes_single $startpad_overlay] + #### + + #??? + set colcursor $opt_colstart + #TODO - make a little virtual column object + #we need to refer to column1 or columnmin? or columnmax without calculating offsets due to to startcolumn + #need to lock-down what start column means from perspective of ANSI codes moving around - the offset perspective is unclear and a mess. + + + #set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} + #as at 2024-02 punk::char::grapheme_split uses these - not aware of more complex graphemes + + set overstacks [list] + set overstacks_gx [list] + + set o_codestack [list]; #SGR codestack (not other codes such as movement,insert key etc) + set o_gxstack [list] + set pt_overchars "" + set i_o 0 + set overlay_grapheme_control_list [list] ;#tag each with g, sgr or other. 'other' are things like cursor-movement or insert-mode or codes we don't recognise/use + #experiment + set overlay_grapheme_control_stacks [list] + foreach {pt code} $overmap { + if {$cp437_glyphs} { + set pt [string map $cp437_map $pt] + } + append pt_overchars $pt + #will get empty pt between adjacent codes + foreach grapheme [punk::char::grapheme_split $pt] { + lappend overstacks $o_codestack + lappend overstacks_gx $o_gxstack + incr i_o + lappend overlay_grapheme_control_list [list g $grapheme] + lappend overlay_grapheme_control_stacks $o_codestack + } + + #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 ""} { + lappend overlay_grapheme_control_stacks $o_codestack + #there will always be an empty code at end due to foreach on 2 vars with odd-sized list ending with pt (overmap coming from perlish split) + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set o_codestack [list "\x1b\[m"] ;#reset better than empty list - fixes some ansi art issues + lappend overlay_grapheme_control_list [list sgr $code] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set o_codestack [list $code] + lappend overlay_grapheme_control_list [list sgr $code] + } elseif {[priv::is_sgr $code]} { + #basic simplification first - remove straight dupes + set dup_posns [lsearch -all -exact $o_codestack $code] ;#must be -exact because of square-bracket glob chars + set o_codestack [lremove $o_codestack {*}$dup_posns] + lappend o_codestack $code + lappend overlay_grapheme_control_list [list sgr $code] + } elseif {[regexp {\x1b7|\x1b\[s} $code]} { + #experiment + #cursor_save - for the replays review. + #jmn + #set temp_cursor_saved [punk::ansi::codetype::sgr_merge_list {*}$o_codestack] + lappend overlay_grapheme_control_list [list other $code] + } elseif {[regexp {\x1b8|\x1b\[u} $code]} { + #experiment + #cursor_restore - for the replays + set o_codestack [list $temp_cursor_saved] + lappend overlay_grapheme_control_list [list other $code] + } else { + if {[punk::ansi::codetype::is_gx_open $code]} { + set o_gxstack [list "gx0_on"] + lappend overlay_grapheme_control_list [list gx0 gx0_on] ;#don't store code - will complicate debugging if we spit it out and jump character sets + } elseif {[punk::ansi::codetype::is_gx_close $code]} { + set o_gxstack [list] + lappend overlay_grapheme_control_list [list gx0 gx0_off] ;#don't store code - will complicate debugging if we spit it out and jump character sets + } else { + lappend overlay_grapheme_control_list [list other $code] + } + } + } + + } + #replay code for last overlay position in input line - should take account of possible trailing sgr code after last grapheme + set max_overlay_grapheme_index [expr {$i_o -1}] + lappend overstacks $o_codestack + lappend overstacks_gx $o_gxstack + + #set replay_codes_overlay [join $o_codestack ""] + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}$o_codestack] + + #if {[dict exists $overstacks $max_overlay_grapheme_index]} { + # set replay_codes_overlay [join [dict get $overstacks $max_overlay_grapheme_index] ""] + #} else { + # set replay_codes_overlay "" + #} + # -- --- --- --- --- --- --- --- + + + #potential problem - combinining diacritics directly following control chars like \r \b + + # -- --- --- + #we need to initialise overflow_idx before any potential row-movements - as they need to perform a loop break and force in_excess to 1 + if {$opt_overflow} { + #somewhat counterintuitively - overflow true means we can have lines as long as we want, but either way there can be excess data that needs to be thrown back to the calling loop. + set overflow_idx -1 + } else { + #overflow zero - we can't grow beyond our column width - so we get ellipsis or truncation + if {$opt_width ne "\uFFEF"} { + set overflow_idx [expr {$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 + } + } + # -- --- --- + + set outcols $undercols ;#leave undercols as is, outcols can potentially be appended to. + + set unapplied "" ;#if we break for move row (but not for /v ?) + set unapplied_list [list] + + set insert_lines_above 0 ;#return key + set insert_lines_below 0 + set instruction "" + + # -- --- --- + #cursor_save_dec, cursor_restore_dec etc + set cursor_restore_required 0 + set cursor_saved_attributes "" + set cursor_saved_position "" + # -- --- --- + + #set idx 0 ;# line index (cursor - 1) + #set idx [expr {$opt_colstart + $opt_colcursor} -1] + + #idx is the per column output index + set idx [expr {$opt_colcursor -1}] ;#don't use opt_colstart here - we have padded and won't start emitting until idx reaches opt_colstart-1 + #cursor_column is usually one above idx - but we have opt_colstart which is like a margin - todo: remove cursor_column from the following loop and calculate it's offset when breaking or at end. + #(for now we are incrementing/decrementing both in sync - which is a bit silly) + set cursor_column $opt_colcursor + + #idx_over is the per grapheme overlay index + set idx_over -1 + + + #movements only occur within the overlay range. + #an underlay is however not necessary.. e.g + #renderline -overflow 1 "" data + #foreach {pt code} $overmap {} + set insert_mode $opt_insert_mode ;#default 1 + set autowrap_mode $opt_autowrap_mode ;#default 1 + + + #puts "-->$overlay_grapheme_control_list<--" + #puts "-->overflow_idx: $overflow_idx" + for {set gci 0} {$gci < [llength $overlay_grapheme_control_list]} {incr gci} { + set gc [lindex $overlay_grapheme_control_list $gci] + lassign $gc type item + + #emit plaintext chars first using existing SGR codes from under/over stack as appropriate + #then check if the following code is a cursor movement within the line and adjust index if so + #foreach ch $overlay_graphemes {} + switch -- $type { + g { + set ch $item + 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 <= $colwidth-1}] + + #https://www.enigma.com/resources/blog/the-secret-world-of-newline-characters + #\x85 NEL in the c1 control set is treated by some terminal emulators (e.g Hyper) as a newline, + #on some it's invisble but doesn't change the line, on some it's a visible glyph of width 1. + #This is hard to process in any standard manner - but I think the Hyper behaviour of doing what it was intended is perhaps most reasonable + #We will map it to the same behaviour as lf here for now... but we need also to consider the equivalent ANSI sequence: \x1bE + + set chtest [string map [list \n \x85 \b \r \v \x7f ] $ch] + #puts --->chtest:$chtest + #specials - each shoud have it's own test of what to do if it happens after overflow_idx reached + switch -- $chtest { + "" { + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + if {$idx == 0} { + #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} { + #linefeed after final column + #puts "---c at overflow_idx=$overflow_idx" + incr cursor_row + 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 { + #linefeed occurred in middle or at end of text + #puts "---mid-or-end-text-linefeed idx:$idx overflow_idx:$overflow_idx" + incr cursor_row + set overflow_idx $idx ;#override overflow_idx even if it was set to -1 due to opt_overflow = 1|2 + set instruction lf_mid + priv::render_unapplied $overlay_grapheme_control_list $gci + break + } + + } + "" { + #will we want/need to use raw for keypresses in terminal? (terminal with LNM in standard reset mode means enter= this is the usual config for terminals) + #So far we are assuming the caller has translated to and handle above.. REVIEW. + + #consider also the old space-carriagereturn softwrap convention used in some terminals. + #In the context of rendering to a block of text - this works similarly in that the space gets eaten so programs emitting space-cr at the terminal width col will pretty much get what they expect. + set idx [expr {$opt_colstart -1}] + set cursor_column $opt_colstart ;#? + } + "" { + #literal backspace char - not necessarily from keyboard + #review - backspace effect on double-width chars - we are taking a column-editing perspective in overtype + #(important for -transparent option - hence replacement chars for half-exposed etc) + #review - overstrike support as per nroff/less (generally considered an old technology replaced by unicode mechanisms and/or ansi SGR) + if {$idx > ($opt_colstart -1)} { + incr idx -1 + incr cursor_column -1 + } else { + set flag 0 + if $flag { + #review - conflicting requirements? Need a different sequence for destructive interactive backspace? + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction backspace_at_start + break + } + } + } + "" { + #literal del character - some terminals send just this for what is generally expected to be a destructive backspace + #We instead treat this as a pure delete at current cursor position - it is up to the repl or terminal to remap backspace key to a sequence that has the desired effect. + priv::render_delchar $idx + } + "" { + #end processing this overline. rest of line is remainder. cursor for column as is. + #REVIEW - this theoretically depends on terminal's vertical tabulation setting (name?) + #e.g it could be configured to jump down 6 rows. + #On the other hand I've seen indications that some modern terminal emulators treat it pretty much as a linefeed. + #todo? + incr cursor_row + set overflow_idx $idx + #idx_over has already been incremented as this is both a movement-control and in some sense a grapheme + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction vt + break + } + default { + if {$overflow_idx != -1} { + #review - how to check arbitrary length item such as tab is going to overflow .. before we get to overflow_idx? + #call grapheme_width_cached on each ch, or look for tab specifically as it's currently the only known reason to have a grapheme width > 2? + #we need to decide what a tab spanning the overflow_idx means and how it affects wrap etc etc + if {$idx == $overflow_idx-1} { + set owidth [grapheme_width_cached $ch] + if {$owidth == 2} { + #review split 2w overflow? + #we don't want to make the decision here to split a 2w into replacement characters at end of line and beginning of next line + #better to consider the overlay char as unable to be applied to the line + #render empty string to column(?) - and reduce overlay grapheme index by one so that the current ch goes into unapplied + #throwing back to caller with instruction complicates its job - but is necessary to avoid making decsions for it here. + priv::render_addchar $idx "" [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + #change the overflow_idx + set overflow_idx $idx + incr idx + incr idx_over -1 ;#set overlay grapheme index back one so that sgr stack from previous overlay grapheme used + priv::render_unapplied $overlay_grapheme_control_list [expr {$gci-1}] ;#note $gci-1 instead of just gci + #throw back to caller's loop - add instruction to caller as this is not the usual case + #caller may for example choose to render a single replacement char to this line and omit the grapheme, or wrap it to the next line + set instruction overflow_splitchar + break + } elseif {$owidth > 2} { + #? tab? + #TODO! + puts stderr "overtype::renderline long overtext grapheme '[ansistring VIEW -lf 1 -vt 1 $ch]' not handled" + #tab of some length dependent on tabstops/elastic tabstop settings? + } + } elseif {$idx >= $overflow_idx} { + #jmn? + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci-1]] + #set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + #don't incr idx beyond the overflow_idx + #idx_over already incremented - decrement so current overlay grapheme stacks go to unapplied + incr idx_over -1 + #priv::render_unapplied $overlay_grapheme_control_list [expr {$gci-1}] ;#back one index here too + priv::render_this_unapplied $overlay_grapheme_control_list $gci ;# + set instruction overflow + break + } + } else { + #review. + #This corresponds to opt_overflow being true (at least until overflow_idx is in some cases forced to a value when throwing back to calling loop) + } + + if {($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) + if {$idx > [llength $outcols]-1} { + lappend outcols " " + #dict set understacks $idx [list] ;#review - use idx-1 codestack? + lset understacks $idx [list] + incr idx + incr cursor_column + } else { + #todo - punk::char::char_width + set g [lindex $outcols $idx] + set uwidth [grapheme_width_cached $g] + if {[lindex $outcols $idx] eq ""} { + #2nd col of 2-wide char in underlay + incr idx + incr cursor_column + } elseif {$uwidth == 0} { + #e.g control char ? combining diacritic ? + incr idx + incr cursor_column + } elseif {$uwidth == 1} { + set owidth [grapheme_width_cached $ch] + incr idx + incr cursor_column + if {$owidth > 1} { + incr idx + incr cursor_column + } + } elseif {$uwidth > 1} { + if {[grapheme_width_cached $ch] == 1} { + if {!$insert_mode} { + #normal singlewide transparent overlay onto double-wide underlay + set next_pt_overchar [string index $pt_overchars $idx_over+1] ;#lookahead of next plain-text char in overlay + if {$next_pt_overchar eq ""} { + #special-case trailing transparent - no next_pt_overchar + incr idx + incr cursor_column + } else { + if {[regexp $opt_transparent $next_pt_overchar]} { + incr idx + incr cursor_column + } else { + #next overlay char is not transparent.. first-half of underlying 2wide char is exposed + #priv::render_addchar $idx $opt_exposed1 [dict get $overstacks $idx_over] [dict get $overstacks_gx $idx_over] $insert_mode + priv::render_addchar $idx $opt_exposed1 [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + incr cursor_column + } + } + } else { + #? todo - decide what transparency even means for insert mode + incr idx + incr cursor_column + } + } else { + #2wide transparency over 2wide in underlay - review + incr idx + incr cursor_column + } + } + } + } else { + + set idxchar [lindex $outcols $idx] + #non-transparent char in overlay or empty cell + if {$idxchar eq "\u0000"} { + #empty/erased cell indicator + set uwidth 1 + } else { + set uwidth [grapheme_width_cached $idxchar] + } + if {$within_undercols} { + if {$idxchar eq ""} { + #2nd col of 2wide char in underlay + if {!$insert_mode} { + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] 0 + #JMN - this has to expose if our startposn chopped an underlay - but not if we already overwrote the first half of the widechar underlay grapheme + #e.g renderline \uFF21\uFF21--- a\uFF23\uFF23 + #vs + # renderline -startcolumn 2 \uFF21---- \uFF23 + if {[lindex $outcols $idx-1] != ""} { + #verified it's an empty following a filled - so it's a legit underlay remnant (REVIEW - when would it not be??) + #reset previous to an exposed 1st-half - but leave understacks code as is + priv::render_addchar [expr {$idx-1}] $opt_exposed1 [lindex $understacks $idx-1] [lindex $understacks_gx $idx-1] 0 + } + incr idx + } else { + set prevcolinfo [lindex $outcols $idx-1] + #for insert mode - first replace the empty 2ndhalf char with exposed2 before shifting it right + #REVIEW - this leaves a replacement character permanently in our columns.. but it is consistent regarding length (?) + #The alternative is to disallow insertion at a column cursor that is at 2nd half of 2wide char + #perhaps by inserting after the char - this may be worthwhile - but may cause other surprises + #It is perhaps best avoided at another level and try to make renderline do exactly as it's told + #the advantage of this 2w splitting method is that the inserted character ends up in exactly the column we expect. + priv::render_addchar $idx $opt_exposed2 [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] 0 ;#replace not insert + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] 1 ;#insert - same index + if {$prevcolinfo ne ""} { + #we've split the 2wide - it may already have been rendered as an exposed1 - but not for example if our startcolumn was current idx + priv::render_addchar [expr {$idx-1}] $opt_exposed1 [lindex $understacks $idx-1] [lindex $understacks_gx $idx-1] 0 ;#replace not insert + } ;# else?? + incr idx + } + if {$cursor_column < [llength $outcols] || $overflow_idx == -1} { + incr cursor_column + } + } elseif {$uwidth == 0} { + #what if this is some other c0/c1 control we haven't handled specifically? + + #by emitting a preceding empty-string column - we associate whatever this char is with the preceeding non-zero-length character and any existing zero-lengths that follow it + #e.g combining diacritic - increment before over char REVIEW + #arguably the previous overchar should have done this - ie lookahead for combiners? + #if we can get a proper grapheme_split function - this should be easier to tidy up. + priv::render_addchar $idx "" [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + incr cursor_column 2 + + if {$cursor_column > [llength $outcols] && $overflow_idx != -1} { + set cursor_column [llength $outcols] + } + } elseif {$uwidth == 1} { + #includes null empty cells + set owidth [grapheme_width_cached $ch] + if {$owidth == 1} { + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + } else { + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + priv::render_addchar $idx "" [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + #if next column in underlay empty - we've overwritten first half of underlying 2wide grapheme + #replace with rhs exposure in case there are no more overlay graphemes coming - use underlay's stack + if {([llength $outcols] >= $idx +2) && [lindex $outcols $idx+1] eq ""} { + priv::render_addchar [expr {$idx+1}] $opt_exposed2 [lindex $understacks $idx+1] [lindex $understacks_gx $idx+1] $insert_mode + } + incr idx + } + if {($cursor_column < [llength $outcols]) || $overflow_idx == -1 || $test_mode} { + incr cursor_column + } + } elseif {$uwidth > 1} { + set owidth [grapheme_width_cached $ch] + if {$owidth == 1} { + #1wide over 2wide in underlay + if {!$insert_mode} { + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + incr cursor_column + priv::render_addchar $idx $opt_exposed2 [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + #don't incr idx - we are just putting a broken-indication in the underlay - which may get overwritten by next overlay char + } else { + #insert mode just pushes all to right - no exposition char here + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + incr cursor_column + } + } else { + #2wide over 2wide + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx 2 + incr cursor_column 2 + } + + if {$cursor_column > [llength $outcols] && $overflow_idx != -1} { + set cursor_column [llength $outcols] + } + } + } else { + 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 && !$test_mode} { + #overflow + if {$cursor_column > [llength $outcols]} { + set cursor_column [llength $outcols] + } + } + } + } + } + } ;# end switch + + + } + other { + set code $item + #since this element isn't a grapheme - advance idx_over to next grapheme overlay when about to fill 'unapplied' + + set re_mode {\x1b\[\?([0-9]*)(h|l)} ;#e.g DECAWM + set re_col_move {\x1b\[([0-9]*)(C|D|G)$} + set re_row_move {\x1b\[([0-9]*)(A|B)$} + set re_both_move {\x1b\[([0-9]*)(?:;){0,1}([0-9]*)H$} ;# or "f" ? + set re_vt_sequence {\x1b\[([0-9]*)(?:;){0,1}([0-9]*)~$} + set re_cursor_save {\x1b\[s$} ;#note probable incompatibility with DECSLRM (set left right margin)! + set re_cursor_restore {\x1b\[u$} + set re_cursor_save_dec {\x1b7$} + set re_cursor_restore_dec {\x1b8$} + set re_other_single {\x1b(D|M|E)$} + set re_decstbm {\x1b\[([0-9]*)(?:;){0,1}([0-9]*)r$} ;#DECSTBM set top and bottom margins + set matchinfo [list] + + #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? + + #todo - consider CSI s DECSLRM vs ansi.sys \x1b\[s - we need \x1b\[s for oldschool ansi art - but may have to enable only for that. + #we should probably therefore reverse this mapping so that x1b7 x1b8 are the primary codes for save/restore + set code [string map [list \x1b7 \x1b\[s \x1b8 \x1b\[u ] $code] + + + set c1 [string index $code 0] + set c1c2c3 [string range $code 0 2] + #set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} + set leadernorm [string range [string map [list\ + \x1b\[< 1006\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\] 7OSC\ + \x9d 8OSC\ + \x1b 7ESC\ + ] $c1c2c3] 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 { + 1006 { + #https://invisible-island.net/xterm/ctlseqs/ctlseqs.html + #SGR (1006) CSI < followed by colon separated encoded-button-value,px,py ordinates and final M for button press m for button release + set codenorm [string cat $leadernorm [string range $code 3 end]] + } + 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 { + 1006 { + #TODO + # + switch -- [string index $codenorm end] { + M { + puts stderr "mousedown $codenorm" + } + m { + puts stderr "mouseup $codenorm" + } + } + + } + {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 + 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 { + #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]] + #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 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] + } 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" + } + 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 + + + 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 + + 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 + } + + incr idx_over + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction move + break + + } + X { + puts stderr "X - $param" + #ECH - erase character + if {$param eq "" || $param eq "0"} {set param 1}; #param=count of chars to erase + priv::render_erasechar $idx $param + #cursor position doesn't change. + } + 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 + } + s { + # - todo - make ansi.sys CSI s cursor save only apply for certain cases? - may need to support DECSLRM instead which uses same code + + #$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] + + #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 + + } + 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 "" + set unapplied_list [list] + foreach gc [lrange $overlay_grapheme_control_list $gci+1 end] { + lassign $gc type item + if {$type eq "gx0"} { + if {$item eq "gx0_on"} { + lappend unapplied_list "\x1b(0" + } elseif {$item eq "gx0_off"} { + lappend unapplied_list "\x1b(B" + } + } else { + lappend unapplied_list $item + } + #incr idx_over + } + set unapplied [join $unapplied_list ""] + #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_vt_sequence + #lassign $matchinfo _match key mod + lassign [split $param {;}] 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(?) + } + } + } 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 + } + + } + 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 + + } + } + } + + } else { + puts stderr "overtype::renderline CSI...h|l code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented" + } + } + 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 + } + #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 { + #\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" + } + } + + } + } + + #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 + #we have our sgr gx0 codes already in stacks for each overlay grapheme + } + } + } + + #-------- + if {$opt_overflow == 0} { + #need to truncate to the width of the original undertext + #review - string_width vs printing_length here. undertext requirement to be already rendered therefore punk::char::string_width ok? + #set num_under_columns [punk::char::string_width $pt_underchars] ;#plaintext underchars + } + if {$overflow_idx == -1} { + #overflow was initially unlimited and hasn't been overridden + } else { + + } + #-------- + + + #coalesce and replay codestacks for outcols grapheme list + set outstring "" ;#output prior to overflow + set overflow_right "" ;#remainder after overflow point reached + set i 0 + set cstack [list] + set prevstack [list] + set prev_g0 [list] + #note overflow_idx may already have been set lower if we had a row move above due to \v or ANSI moves + set in_overflow 0 ;#used to stop char-width scanning once in overflow + if {$overflow_idx == 0} { + #how does caller avoid an infinite loop if they have autowrap on and keep throwing graphemes to the next line? REVIEW + set in_overflow 1 + } + foreach ch $outcols { + #puts "---- [ansistring VIEW $ch]" + + set gxleader "" + if {$i < [llength $understacks_gx]} { + #set g0 [dict get $understacks_gx $i] + set g0 [lindex $understacks_gx $i] + if {$g0 ne $prev_g0} { + if {$g0 eq [list "gx0_on"]} { + set gxleader "\x1b(0" + } else { + set gxleader "\x1b(B" + } + } + set prev_g0 $g0 + } else { + set prev_g0 [list] + } + + set sgrleader "" + if {$i < [llength $understacks]} { + #set cstack [dict get $understacks $i] + set cstack [lindex $understacks $i] + if {$cstack ne $prevstack} { + if {[llength $prevstack] && ![llength $cstack]} { + #This reset is important e.g testfile fruit.ans - we get overhang on rhs without it. But why is cstack empty? + append sgrleader \033\[m + } else { + append sgrleader [punk::ansi::codetype::sgr_merge_list {*}$cstack] + } + } + set prevstack $cstack + } else { + set prevstack [list] + } + + + + if {$in_overflow} { + if {$i == $overflow_idx} { + set 0 [lindex $understacks_gx $i] + set gxleader "" + if {$g0 eq [list "gx0_on"]} { + set gxleader "\x1b(0" + } elseif {$g0 eq [list "gx0_off"]} { + set gxleader "\x1b(B" + } + append overflow_right $gxleader + set cstack [lindex $understacks $i] + set sgrleader "" + #whether cstack is same or differs from previous char's stack - we must have an output at the start of the overflow_right + #if {[llength $prevstack] && ![llength $cstack]} { + # append sgrleader \033\[m + #} + append sgrleader [punk::ansi::codetype::sgr_merge_list {*}$cstack] + append overflow_right $sgrleader + append overflow_right $ch + } else { + append overflow_right $gxleader + append overflow_right $sgrleader + append overflow_right $ch + } + } else { + if {$overflow_idx != -1 && $i+1 == $overflow_idx} { + #one before overflow + #will be in overflow in next iteration + set in_overflow 1 + if {[grapheme_width_cached $ch]> 1} { + #we overflowed with second-half of a double-width char - replace first-half with user-supplied exposition char (should be 1 wide) + set ch $opt_exposed1 + } + } + append outstring $gxleader + append outstring $sgrleader + if {$idx+1 < $cursor_column} { + append outstring [string map [list "\u0000" " "] $ch] + } else { + append outstring $ch + } + } + incr i + } + #flower.ans good test for null handling - reverse line building + if {![ansistring length $overflow_right]} { + set outstring [string trimright $outstring "\u0000"] + } + set outstring [string map [list "\u0000" " "] $outstring] + set overflow_right [string trimright $overflow_right "\u0000"] + set overflow_right [string map [list "\u0000" " "] $overflow_right] + + set replay_codes "" + if {[llength $understacks] > 0} { + if {$overflow_idx == -1} { + #set tail_idx [dict size $understacks] + set tail_idx [llength $understacks] + } else { + set tail_idx [llength $undercols] + } + if {$tail_idx-1 < [llength $understacks]} { + #set replay_codes [join [lindex $understacks $tail_idx-1] ""] ;#tail replay codes + set replay_codes [punk::ansi::codetype::sgr_merge_list {*}[lindex $understacks $tail_idx-1]] ;#tail replay codes + } + if {$tail_idx-1 < [llength $understacks_gx]} { + set gx0 [lindex $understacks_gx $tail_idx-1] + if {$gx0 eq [list "gx0_on"]} { + #if it was on, turn gx0 off at the point we stop processing overlay + append outstring "\x1b(B" + } + } + } + if {[string length $overflow_right]} { + #puts stderr "remainder:$overflow_right" + } + #pdict $understacks + if {[punk::ansi::ta::detect_sgr $outstring]} { + append outstring [punk::ansi::a] + #close off any open gx? + #probably should - and overflow_right reopen? + } + + if {$opt_returnextra} { + #replay_codes is the codestack at the boundary - used for ellipsis colouring to match elided text - review + #replay_codes_underlay is the set of codes in effect at the very end of the original underlay + + #review + #replay_codes_overlay is the set of codes in effect at the very end of the original overlay (even if not all overlay was applied) + #todo - replay_codes for gx0 mode + + #overflow_idx may change during ansi & character processing + if {$overflow_idx == -1} { + set overflow_right_column "" + } else { + set overflow_right_column [expr {$overflow_idx+1}] + } + set result [dict create\ + result $outstring\ + visualwidth [punk::ansi::printing_length $outstring]\ + instruction $instruction\ + stringlen [string length $outstring]\ + overflow_right_column $overflow_right_column\ + overflow_right $overflow_right\ + unapplied $unapplied\ + unapplied_list $unapplied_list\ + insert_mode $insert_mode\ + autowrap_mode $autowrap_mode\ + insert_lines_above $insert_lines_above\ + insert_lines_below $insert_lines_below\ + cursor_saved_position $cursor_saved_position\ + cursor_saved_attributes $cursor_saved_attributes\ + cursor_column $cursor_column\ + cursor_row $cursor_row\ + opt_overflow $opt_overflow\ + replay_codes $replay_codes\ + replay_codes_underlay $replay_codes_underlay\ + replay_codes_overlay $replay_codes_overlay\ + ] + if {$opt_returnextra == 1} { + return $result + } else { + #human/debug - map special chars to visual glyphs + set viewop VIEW + switch -- $opt_returnextra { + 2 { + #codes and character data + set viewop VIEWCODES ;#ansi colorisation of codes - green for SGR, blue/blue reverse for cursor_save/cursor_restore, cyan for movements, orange for others + } + 3 { + set viewop VIEWSTYLE ;#ansi colorise the characters within the output with preceding codes, stacking codes only within each dict value - may not be same SGR effect as the effect in-situ. + } + } + dict set result result [ansistring $viewop -lf 1 -vt 1 [dict get $result result]] + dict set result overflow_right [ansistring VIEW -lf 1 -vt 1 [dict get $result overflow_right]] + dict set result unapplied [ansistring VIEW -lf 1 -vt 1 [dict get $result unapplied]] + dict set result unapplied_list [ansistring VIEW -lf 1 -vt 1 [dict get $result unapplied_list]] + dict set result replay_codes [ansistring $viewop -lf 1 -vt 1 [dict get $result replay_codes]] + dict set result replay_codes_underlay [ansistring $viewop -lf 1 -vt 1 [dict get $result replay_codes_underlay]] + dict set result replay_codes_overlay [ansistring $viewop -lf 1 -vt 1 [dict get $result replay_codes_overlay]] + dict set result cursor_saved_attributes [ansistring $viewop -lf 1 -vt 1 [dict get $result cursor_saved_attributes]] + return $result + } + } else { + return $outstring + } + #return [join $out ""] +} +proc overtype::test_renderline {} { + set t \uFF5E ;#2-wide tilde + set u \uFF3F ;#2-wide underscore + set missing \uFFFD + return [list $t $u A${t}B] +} + +#maintenance warning +#same as textblock::size - but we don't want that circular dependency +#block width and height can be tricky. e.g \v handled differently on different terminal emulators and can affect both +proc overtype::blocksize {textblock} { + if {$textblock eq ""} { + return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings + } + if {[string first \t $textblock] >= 0} { + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::stripansi $textblock] + } + if {[string first \n $textblock] >= 0} { + set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list + set width [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } else { + set num_le 0 + set width [punk::char::ansifreestring_width $textblock] + } + #our concept of block-height is likely to be different to other line-counting mechanisms + set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le + + return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize ]] width height +} + +namespace eval overtype::priv { + variable cache_is_sgr [dict create] + + #we are likely to be asking the same question of the same ansi codes repeatedly + #caching the answer saves some regex expense - possibly a few uS to lookup vs under 1uS + #todo - test if still worthwhile after a large cache is built up. (limit cache size?) + proc is_sgr {code} { + variable cache_is_sgr + if {[dict exists $cache_is_sgr $code]} { + return [dict get $cache_is_sgr $code] + } + set answer [punk::ansi::codetype::is_sgr $code] + dict set cache_is_sgr $code $answer + return $answer + } + proc render_unapplied {overlay_grapheme_control_list gci} { + upvar idx_over idx_over + upvar unapplied unapplied + upvar unapplied_list unapplied_list ;#maintaining as a list allows caller to utilize it without having to re-split + upvar overstacks overstacks + upvar overstacks_gx overstacks_gx + upvar overlay_grapheme_control_stacks og_stacks + + #set unapplied [join [lrange $overlay_grapheme_control_list $gci+1 end]] + set unapplied "" + set unapplied_list [list] + #append unapplied [join [lindex $overstacks $idx_over] ""] + #append unapplied [punk::ansi::codetype::sgr_merge_list {*}[lindex $overstacks $idx_over]] + set sgr_merged [punk::ansi::codetype::sgr_merge_list {*}[lindex $og_stacks $gci]] + if {$sgr_merged ne ""} { + lappend unapplied_list $sgr_merged + } + switch -- [lindex $overstacks_gx $idx_over] { + "gx0_on" { + lappend unapplied_list "\x1b(0" + } + "gx0_off" { + lappend unapplied_list "\x1b(B" + } + } + + foreach gc [lrange $overlay_grapheme_control_list $gci+1 end] { + lassign $gc type item + #types g other sgr gx0 + if {$type eq "gx0"} { + if {$item eq "gx0_on"} { + lappend unapplied_list "\x1b(0" + } elseif {$item eq "gx0_off"} { + lappend unapplied_list "\x1b(B" + } + } else { + lappend unapplied_list $item + } + } + set unapplied [join $unapplied_list ""] + } + + #clearer - renders the specific gci forward as unapplied - prefixed with it's merged sgr stack + proc render_this_unapplied {overlay_grapheme_control_list gci} { + upvar idx_over idx_over + upvar unapplied unapplied + upvar unapplied_list unapplied_list + upvar overstacks overstacks + upvar overstacks_gx overstacks_gx + upvar overlay_grapheme_control_stacks og_stacks + + #set unapplied [join [lrange $overlay_grapheme_control_list $gci+1 end]] + set unapplied "" + set unapplied_list [list] + + set sgr_merged [punk::ansi::codetype::sgr_merge_list {*}[lindex $og_stacks $gci]] + if {$sgr_merged ne ""} { + lappend unapplied_list $sgr_merged + } + switch -- [lindex $overstacks_gx $idx_over] { + "gx0_on" { + lappend unapplied_list "\x1b(0" + } + "gx0_off" { + lappend unapplied_list "\x1b(B" + } + } + + foreach gc [lrange $overlay_grapheme_control_list $gci end] { + lassign $gc type item + #types g other sgr gx0 + if {$type eq "gx0"} { + if {$item eq "gx0_on"} { + lappend unapplied_list "\x1b(0" + } elseif {$item eq "gx0_off"} { + lappend unapplied_list "\x1b(B" + } + } else { + lappend unapplied_list $item + } + } + set unapplied [join $unapplied_list ""] + } + proc render_delchar {i} { + upvar outcols o + upvar understacks ustacks + upvar understacks_gx gxstacks + set nxt [llength $o] + if {$i < $nxt} { + set o [lreplace $o $i $i] + set ustacks [lreplace $ustacks $i $i] + set gxstacks [lreplace $gxstacks $i $i] + } else { + + } + } + proc render_erasechar {i count} { + upvar outcols o + upvar understacks ustacks + upvar understacks_gx gxstacks + #ECH clears character attributes from erased character positions + #ECH accepts 0 or empty parameter, which is equivalent to 1. Caller should do that mapping and only supply 1 or greater. + if {![string is integer -strict $count] || $count < 1} { + error "render_erasechar count must be integer >= 1" + } + set start $i + set end [expr {$i + $count -1}] + #we restrict ECH to current line - as some terminals do - review - is that the only way it's implemented? + if {$i > [llength $o]-1} { + return + } + if {$end > [llength $o]-1} { + set end [expr {[llength $o]-1}] + } + set num [expr {$end - $start + 1}] + set o [lreplace $o $start $end {*}[lrepeat $num \u0000]] ;#or space? + set ustacks [lreplace $ustacks $start $end {*}[lrepeat $num [list]]] + set gxstacks [lreplace $gxstacks $start $end {*}[lrepeat $num [list]]] + return + } + proc render_setchar {i c } { + upvar outcols o + lset o $i $c + } + #is actually addgrapheme? + proc render_addchar {i c sgrstack gx0stack {insert_mode 0}} { + upvar outcols o + upvar understacks ustacks + upvar understacks_gx gxstacks + + if 0 { + if {$c eq "c"} { + puts "i:$i c:$c sgrstack:[ansistring VIEW $sgrstack]" + puts "understacks:[ansistring VIEW $ustacks]" + upvar overstacks overstacks + puts "overstacks:[ansistring VIEW $overstacks]" + puts "info level 0:[info level 0]" + } + } + + set nxt [llength $o] + if {!$insert_mode} { + if {$i < $nxt} { + #These lists must always be in sync + lset o $i $c + } else { + lappend o $c + } + if {$i < [llength $ustacks]} { + lset ustacks $i $sgrstack + lset gxstacks $i $gx0stack + } else { + lappend ustacks $sgrstack + lappend gxstacks $gx0stack + } + } else { + #insert of single-width vs double-width when underlying is double-width? + if {$i < $nxt} { + set o [linsert $o $i $c] + } else { + lappend o $c + } + if {$i < [llength $ustacks]} { + set ustacks [linsert $ustacks $i $sgrstack] + set gxstacks [linsert $gxstacks $i $gx0stack] + } else { + lappend ustacks $sgrstack + lappend gxstacks $gx0stack + } + } + } + +} + + + +# -- --- --- --- --- --- --- --- --- --- --- +namespace eval overtype { + interp alias {} ::overtype::center {} ::overtype::centre +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide overtype [namespace eval overtype { + variable version + set version 1.6.1 +}] +return + +#*** !doctools +#[manpage_end] diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index 137dca2..17aa99c 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -1762,10 +1762,15 @@ namespace eval punk::ansi { foreach c $args { #normalize 8bit to a token of the same length so our string operations on the code are the same and we can maintain a switch statement with literals rather than escapes #.. but preserve original c - set cnorm [string map [list \x9b {8[} ] $c] - switch -- [string index $cnorm 1][string index $cnorm end] { - {[m} { - set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m + #set cnorm [string map [list \x9b {8[} ] $c] + #switch -- [string index $cnorm 1][string index $cnorm end] {} + # {[m} + + set cnorm [string map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] + switch -- [string range $cnorm 0 3][string index $cnorm end] { + 7CSIm - 8CSIm { + #set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m + set params [string range $cnorm 4 end-1] ;#string leading XCSI and trailing m #some systems use colon for 256 colors or RGB or nonstandard subparameters #- it is therefore probably not ok to map to semicolon within SGR codes and treat the same. @@ -2059,11 +2064,16 @@ namespace eval punk::ansi { } } } - set codemerge [string trimright $codemerge {;}] if {$did_reset} { set codemerge "0\;$codemerge" } - return "\x1b\[${codemerge}m[join $othercodes ""]" + if {[string length $codemerge]} { + set codemerge [string trimright $codemerge {;}] + return "\x1b\[${codemerge}m[join $othercodes ""]" + } else { + #there were no SGR codes - not even resets + return [join $othercodes ""] + } } #has_sgr_reset - rather than support this function - create an sgr normalize function that removes dead params and brings reset to front of param list? diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index 661b841..31c742b 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -1762,10 +1762,15 @@ namespace eval punk::ansi { foreach c $args { #normalize 8bit to a token of the same length so our string operations on the code are the same and we can maintain a switch statement with literals rather than escapes #.. but preserve original c - set cnorm [string map [list \x9b {8[} ] $c] - switch -- [string index $cnorm 1][string index $cnorm end] { - {[m} { - set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m + #set cnorm [string map [list \x9b {8[} ] $c] + #switch -- [string index $cnorm 1][string index $cnorm end] {} + # {[m} + + set cnorm [string map [list \x9b 8CSI "\x1b\[" 7CSI ] $c] + switch -- [string range $cnorm 0 3][string index $cnorm end] { + 7CSIm - 8CSIm { + #set params [string range $cnorm 2 end-1] ;#strip leading esc lb and trailing m + set params [string range $cnorm 4 end-1] ;#string leading XCSI and trailing m #some systems use colon for 256 colors or RGB or nonstandard subparameters #- it is therefore probably not ok to map to semicolon within SGR codes and treat the same. @@ -2059,11 +2064,16 @@ namespace eval punk::ansi { } } } - set codemerge [string trimright $codemerge {;}] if {$did_reset} { set codemerge "0\;$codemerge" } - return "\x1b\[${codemerge}m[join $othercodes ""]" + if {[string length $codemerge]} { + set codemerge [string trimright $codemerge {;}] + return "\x1b\[${codemerge}m[join $othercodes ""]" + } else { + #there were no SGR codes - not even resets + return [join $othercodes ""] + } } #has_sgr_reset - rather than support this function - create an sgr normalize function that removes dead params and brings reset to front of param list? diff --git a/src/modules/punk/basictelnet-999999.0a1.0.tm b/src/modules/punk/basictelnet-999999.0a1.0.tm index 6d816dd..8ea4eef 100644 --- a/src/modules/punk/basictelnet-999999.0a1.0.tm +++ b/src/modules/punk/basictelnet-999999.0a1.0.tm @@ -142,6 +142,7 @@ namespace eval punk::basictelnet { variable terminal_type "VT100" #try: DUMB,ANSI,VT100,XTERM #see also the Mud Terminal Type Standard as an extensiont to RFC1091 Telenet Terminal-Type + #https://tintin.mudhalla.net/protocols/mtts/ variable remote_terminal_type set remote_terminal_type "" ;#empty until/unless reported via an option 24 send from the remote @@ -214,6 +215,7 @@ namespace eval punk::basictelnet { #we are assuming we initiated the connection, and are in some sense the 'client' variable server_option_state variable client_option_state + variable client_option_declined #not all these will make sense as a boolean? review. #we use this also to support the Status option #this structure doesn't retain which side initiated - but it appears from the nature of the protocol that isn't always determinable or of importance. @@ -229,6 +231,8 @@ namespace eval punk::basictelnet { dict set server_option_state $k 0 ;#DO from our perspective dict set client_option_state $k 0 ;#WILL from our perspective } + variable client_option_declined ;#record explicit negative responses (won'ts) to DO requests from server + set client_option_declined [dict create] } reset_option_states ;#initialise to NVT - all off proc get_server_option_state_summary {} { @@ -261,6 +265,23 @@ namespace eval punk::basictelnet { } set summary [string trimright $summary ,] } + proc get_client_option_declined_summary {} { + variable client_option_declined + variable optioncodes + set summary "" + dict for {k v} $client_option_declined { + if {[dict exists $optioncodes $k]} { + if {[dict exists $optioncodes $k short]} { + append summary "[dict get $optioncodes $k short]," + } else { + append summary "[dict get $optioncodes $k name]," + } + } else { + append summary "unknown option '$k'," + } + } + set summary [string trimright $summary ,] + } # ----------------------------------- # A rudimentary hardcoded configuration for options/negotiation @@ -277,7 +298,7 @@ namespace eval punk::basictelnet { #define our positive responses here for those that we will do variable respond_will_do set respond_will_do [list] - #lappend respond_will_do 0 ;#binary + lappend respond_will_do 0 ;#binary lappend respond_will_do 1 ;#echo lappend respond_will_do 3 ;#suppress go-ahead lappend respond_will_do 5 ;#status - by agreeing to this we should be able to read unsolicited "IAC SB STATUS IS ... IAC SE" reports and compare to our perception of state. (and do something if mismatches?) @@ -286,7 +307,7 @@ namespace eval punk::basictelnet { #passively enabled client features - requests for our own behaviours we will respond positively variable respond_do_will set respond_do_will [list] - #lappend respond_do_will 0 ;#binary + lappend respond_do_will 0 ;#binary lappend respond_do_will 3 ;#Suppress go-ahead lappend respond_do_will 5 ;#status - by agreeing to this - we need to handle the subnegotiation "IAC SB STATUS SEND IAC SE" and respond with "IAC SB STATUS IS ... IAC SE" lappend respond_do_will 24 ;#terminal-type @@ -372,9 +393,10 @@ namespace eval punk::basictelnet { incr writing_debug_frame - set server_summary "SVR:[get_server_option_state_summary]" - set client_summary "CLI:[get_client_option_state_summary]" - set info $server_summary\n$client_summary\n$info + set server_summary "SVR-WILL:[a+ green][get_server_option_state_summary][a]" + set client_summary "CLI-WILL:[a+ green][get_client_option_state_summary][a]" + set client_declined "CLI-WONT:[a+ red bold][get_client_option_declined_summary][a]" + set info $server_summary\n$client_summary\n$client_declined\n$info #set existing_handler [fileevent stdin readable] set RST "\x1b\[m" @@ -582,8 +604,10 @@ namespace eval punk::basictelnet { #only do this text-processing work if debug is on append debug_info "------raw data [string length $data]---prev unprocessed:[string length $last_unprocessed]---" \n #append debug_info [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom utf-8 $data]] \n - set rawview [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom $encoding_guess $data]] - set viewblock [overtype::left -wrap 1 -width 78 -height 4 "" $rawview] + #set rawview [ansistring VIEW -lf 1 -vt 1 [encoding convertfrom $encoding_guess $data]] + set rawview [ansistring VIEW -lf 1 -vt 1 $data] + #set viewblock [overtype::left -wrap 1 -width 78 -height 4 "" $rawview] + set viewblock [overtype::left -experimental test_mode -wrap 1 -width 78 -height 4 "" $rawview] set lines [split $viewblock \n] if {[llength $lines] > 4} { append debug_info [join [list {*}[lrange $lines 0 1] "...<[expr {[llength $lines] -4}] lines undisplayed>..." {*}[lrange $lines end-1 end]] \n] @@ -818,6 +842,7 @@ namespace eval punk::basictelnet { variable respond_will_do variable respond_do_will variable client_option_state ;#WILLs + variable client_option_declined ;#WON'Ts - but only those that were actually requested by server - not our default won'ts variable server_option_state ;#DOs upvar 1 debug_info debug_info @@ -1011,7 +1036,7 @@ namespace eval punk::basictelnet { if {[dict get $server_option_state $opdec]} { #already known DO } else { - append debug_info ">>>responding to server WILL declaration. DO $opdec [dict get $optioncodes $opdec]" \n + append debug_info ">>>responding to server WILL declaration. DO $opdec [dict get $optioncodes $opdec]<<<" \n puts -nonewline $sock \xff\xfd$byte ;#respond DO dict set server_option_state $opdec 1 } @@ -1047,12 +1072,26 @@ namespace eval punk::basictelnet { } } else { # Attempt to negotiate; refuse! + dict set client_option_declined $opdec 1 ;#for now just store 1 - we could store a reason/timestamp? list? puts -nonewline $sock \xff\xfc$byte } flush $sock incr idx } fe {# DON'T - 254 + set byte [string index $data $idx] + if {[dict exists $client_option_state $opdec]} { + if {![dict get $client_option_state $opdec]} { + #already off + } else { + append debug_info ">>>responding to server DON'T request. WON'T $opdec [dict get $optioncodes $opdec]" \n + dict set client_option_state $opdec 0 + puts -nonewline $sock \xff\xfc$byte + flush $sock + } + } else { + #we don't even know that opdec + } incr idx } } diff --git a/src/vendormodules/overtype-1.6.0.tm b/src/vendormodules/overtype-1.6.0.tm index f5bdf82..6acf404 100644 --- a/src/vendormodules/overtype-1.6.0.tm +++ b/src/vendormodules/overtype-1.6.0.tm @@ -254,7 +254,7 @@ proc overtype::left {args} { set defaults [dict create\ -bias ignored\ -width \uFFEF\ - -height \uFFeF\ + -height \uFFEF\ -wrap 0\ -ellipsis 0\ -ellipsistext $default_ellipsis_horizontal\ @@ -265,7 +265,7 @@ proc overtype::left {args} { -exposed1 \uFFFD\ -exposed2 \uFFFD\ -experimental 0\ - -looplimit 100000\ + -looplimit \uFFEF\ ] #-ellipsis args not used if -wrap is true set argsflags [lrange $args 0 end-2] @@ -296,10 +296,6 @@ proc overtype::left {args} { set opt_exposed2 [dict get $opts -exposed2] ;#widechar_exposed_right - todo # -- --- --- --- --- --- - #a hack until we work out how to avoid infinite loops... - # - set looplimit [dict get $opts -looplimit] - # ---------------------------- # -experimental dev flag to set flags etc # ---------------------------- @@ -345,6 +341,9 @@ proc overtype::left {args} { #set underlines [split $underblock \n] #underblock is a 'rendered' block - so width height make sense + #colwidth & colheight were originally named with reference to rendering into a 'column' of output e.g a table column - before cursor row/col was implemented. + #The naming is now confusing. It should be something like renderwidth renderheight ?? review + if {$opt_width eq "\uFFEF"} { lassign [blocksize $underblock] _w colwidth _h colheight } else { @@ -366,6 +365,14 @@ proc overtype::left {args} { #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 + #a hack until we work out how to avoid infinite loops... + # + set looplimit [dict get $opts -looplimit] + if {$looplimit eq "\uFFEF"} { + #looping for each char is worst case (all newlines?) - anything over that is an indication of something very broken + set looplimit [expr {[string length $overblock] + 10}] + } + if {!$test_mode} { set inputchunks [split $overblock \n] } else { @@ -931,24 +938,41 @@ proc overtype::left {args} { #normal single-width grapheme overflow #puts "----normal overflow --- [ansistring VIEWSTYLE -lf 1 -nul 1 -vt 1 $rendered]" set row $post_render_row ;#renderline will not advance row when reporting overflow char - incr row - set col 1 ;#whether wrap or not - next data is at column 1 - if {!$autowrap_mode} { + if {$autowrap_mode} { + incr row + set col 1 ;#whether wrap or not - next data is at column 1 ?? + } else { + #this works for test_mode (which should become the default) - but gives a bad result otherwise - review - add tests fix. + set col $post_render_col set overflow_handled 1 - set unapplied "" - #handled by dropping it + #set unapplied "" ;#this seems wrong? + set unapplied [string range $unapplied 1 end] + #handled by dropping overflow if any } } overflow_splitchar { + set row $post_render_row ;#renderline will not advance row when reporting overflow char + #2nd half of grapheme would overflow - grapheme returned in unapplied. There may also be overflow_right from earlier inserts #todo - consider various options .. re-render a single trailing space or placeholder on same output line, etc - incr row if {$autowrap_mode} { - set col 1 + if {$colwidth < 2} { + #edge case of rendering to a single column output - any 2w char will just cause a loop if we don't substitute with something. + set unapplied "${opt_exposed1}[string range $unapplied 1 end]" + } else { + set col 1 + incr row + } } else { set overflow_handled 1 - #handled by dropping it + #handled by dropping entire overflow if any + if {$colwidth < 2} { + #set unapplied "[string range $unapplied 1 end]" + set unapplied "${opt_exposed1}[string range $unapplied 1 end]" + } } + + } vt { @@ -999,15 +1023,32 @@ proc overtype::left {args} { incr overidx incr loop if {$loop >= $looplimit} { - puts stderr "overtype::left looplimit reached" + puts stderr "overtype::left looplimit reached ($looplimit)" lappend outputlines "[a+ red bold] - looplimit $looplimit reached[a]" + set Y [a+ yellow bold] + set RST [a] + set sep_header ----DEBUG----- + set debugmsg "looplimit $looplimit reached\n" + append debugmsg "${Y}${sep_header}${RST}" \n + dict for {k v} $rinfo { + append debugmsg "${Y}$k [ansistring VIEW -lf 1 -vt 1 $v]$RST" \n + } + append debugmsg "${Y}[string repeat - [string length $sep_header]]$RST" \n + + puts stdout $debugmsg + #todo - config regarding error dumps rather than just dumping in working dir + set fd [open [pwd]/error_overtype.txt w] + puts $fd $debugmsg + close $fd + break } } set result [join $outputlines \n] if {$info_mode} { - append result \n$instruction_stats\n + #emit to debug window like basictelnet does? make debug configurable as syslog or even a telnet server to allow on 2nd window? + #append result \n$instruction_stats\n } return $result } diff --git a/src/vendormodules/overtype-1.6.1.tm b/src/vendormodules/overtype-1.6.1.tm new file mode 100644 index 0000000..079caec --- /dev/null +++ b/src/vendormodules/overtype-1.6.1.tm @@ -0,0 +1,3394 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) Julian Noble 2003-2023 +# +# @@ Meta Begin +# Application overtype 1.6.1 +# Meta platform tcl +# Meta license BSD +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin overtype_module_overtype 0 1.6.1] +#[copyright "2024"] +#[titledesc {overtype text layout - ansi aware}] [comment {-- Name section and table of contents description --}] +#[moddesc {overtype text layout}] [comment {-- Description at end of page heading --}] +#[require overtype] +#[keywords module text ansi] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of overtype +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by overtype +#[list_begin itemized] + +package require Tcl 8.6 +package require textutil +package require punk::lib ;#required for lines_as_list +package require punk::ansi ;#required to detect, split, strip and calculate lengths +package require punk::char ;#box drawing - and also unicode character width determination for proper layout of text with double-column-width chars +package require punk::assertion +#*** !doctools +#[item] [package {Tcl 8.6}] +#[item] [package textutil] +#[item] [package punk::ansi] +#[para] - required to detect, split, strip and calculate lengths of text possibly containing ansi codes +#[item] [package punk::char] +#[para] - box drawing - and also unicode character width determination for proper layout of text with double-column-width chars + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section API] + + +#Julian Noble - 2003 +#Released under standard 'BSD license' conditions. +# +#todo - ellipsis truncation indicator for center,right + +#v1.4 2023-07 - naive ansi color handling - todo - fix string range +# - need to extract and replace ansi codes? + +namespace eval overtype { + namespace import ::punk::assertion::assert + punk::assertion::active true + + namespace path ::punk::lib + + namespace export * + variable default_ellipsis_horizontal "..." ;#fallback + variable default_ellipsis_vertical "..." + namespace eval priv { + proc _init {} { + upvar ::overtype::default_ellipsis_horizontal e_h + upvar ::overtype::default_ellipsis_vertical e_v + set e_h [format %c 0x2026] ;#Unicode Horizontal Ellipsis + set e_v [format %c 0x22EE] + #The unicode ellipsis looks more natural than triple-dash which is centred vertically whereas ellipsis is at floorline of text + #Also - unicode ellipsis has semantic meaning that other processors can interpret + #unicode does also provide a midline horizontal ellipsis 0x22EF + + #set e [format %c 0x2504] ;#punk::char::charshort boxd_ltdshhz - Box Drawings Light Triple Dash Horizontal + #if {![catch {package require punk::char}]} { + # set e [punk::char::charshort boxd_ltdshhz] + #} + } + } + priv::_init +} +proc overtype::about {} { + return "Simple text formatting. Author JMN. BSD-License" +} + +namespace eval overtype { + variable grapheme_widths [dict create] + + variable escape_terminals + #single "final byte" in the range 0x40–0x7E (ASCII @A–Z[\]^_`a–z{|}~). + dict set escape_terminals CSI [list @ \\ ^ _ ` | ~ a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z "\{" "\}"] + #dict set escape_terminals CSI [list J K m n A B C D E F G s u] ;#basic + dict set escape_terminals OSC [list \007 \033\\] ;#note mix of 1 and 2-byte terminals + + #self-contained 2 byte ansi escape sequences - review more? + variable ansi_2byte_codes_dict + set ansi_2byte_codes_dict [dict create\ + "reset_terminal" "\u001bc"\ + "save_cursor_posn" "\u001b7"\ + "restore_cursor_posn" "\u001b8"\ + "cursor_up_one" "\u001bM"\ + "NEL - Next Line" "\u001bE"\ + "IND - Down one line" "\u001bD"\ + "HTS - Set Tab Stop" "\u001bH"\ + ] + + #debatable whether strip should reveal the somethinghidden - some terminals don't hide it anyway. + # "PM - Privacy Message" "\u001b^somethinghidden\033\\"\ +} + + +#proc overtype::stripansi {text} { +# variable escape_terminals ;#dict +# variable ansi_2byte_codes_dict +# #important that we don't spend too much time on this for plain text that doesn't contain any escapes anyway +# if {[string first \033 $text] <0 && [string first \009c $text] <0} { +# #\033 same as \x1b +# return $text +# } +# +# set text [convert_g0 $text] +# +# #we process char by char - line-endings whether \r\n or \n should be processed as per any other character. +# #line endings can theoretically occur within an ansi escape sequence (review e.g title?) +# set inputlist [split $text ""] +# set outputlist [list] +# +# set 2bytecodes [dict values $ansi_2byte_codes_dict] +# +# set in_escapesequence 0 +# #assumption - undertext already 'rendered' - ie no backspaces or carriagereturns or other cursor movement controls +# set i 0 +# foreach u $inputlist { +# set v [lindex $inputlist $i+1] +# set uv ${u}${v} +# if {$in_escapesequence eq "2b"} { +# #2nd byte - done. +# set in_escapesequence 0 +# } elseif {$in_escapesequence != 0} { +# set escseq [dict get $escape_terminals $in_escapesequence] +# if {$u in $escseq} { +# set in_escapesequence 0 +# } elseif {$uv in $escseq} { +# set in_escapseequence 2b ;#flag next byte as last in sequence +# } +# } else { +# #handle both 7-bit and 8-bit CSI and OSC +# if {[regexp {^(?:\033\[|\u009b)} $uv]} { +# set in_escapesequence CSI +# } elseif {[regexp {^(?:\033\]|\u009c)} $uv]} { +# set in_escapesequence OSC +# } elseif {$uv in $2bytecodes} { +# #self-contained e.g terminal reset - don't pass through. +# set in_escapesequence 2b +# } else { +# lappend outputlist $u +# } +# } +# incr i +# } +# return [join $outputlist ""] +#} + + + + + +proc overtype::string_columns {text} { + if {[punk::ansi::ta::detect $text]} { + #error "error string_columns is for calculating character length of string - ansi codes must be stripped/rendered first e.g with punk::ansi::stripansi. Alternatively try punk::ansi::printing_length" + set text [punk::ansi::stripansi $text] + } + return [punk::char::ansifreestring_width $text] +} + +#todo - consider a way to merge overtype::left/centre/right +#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. +#(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 +#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 overlay may just be an ansi-colourised block - or may contain ansi cursor movements and cursor save/restore calls - in which case the apparent length and width of the overlay can't be determined as if it was a block of text. +#This is a single-shot rendering of strings - ie there is no way to chain another call containing a cursor-restore to previously rendered output and have it know about any cursor-saves in the first call. +# a cursor start position other than top-left is a possible addition to consider. +#see editbuf in punk::repl for a more stateful ansi-processor. Both systems use loops over overtype::renderline +proc overtype::left {args} { + #*** !doctools + #[call [fun overtype::left] [arg args] ] + #[para] usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext + + # @c overtype starting at left (overstrike) + # @c can/should we use something like this?: 'format "%-*s" $len $overtext + variable default_ellipsis_horizontal + + if {[llength $args] < 2} { + error {usage: ?-transparent [0|1]? ?-overflow [1|0]? ?-ellipsis [1|0]? ?-ellipsistext ...? undertext overtext} + } + lassign [lrange $args end-1 end] underblock overblock + set defaults [dict create\ + -bias ignored\ + -width \uFFEF\ + -height \uFFEF\ + -wrap 0\ + -ellipsis 0\ + -ellipsistext $default_ellipsis_horizontal\ + -ellipsiswhitespace 0\ + -overflow 0\ + -appendlines 1\ + -transparent 0\ + -exposed1 \uFFFD\ + -exposed2 \uFFFD\ + -experimental 0\ + -looplimit \uFFEF\ + ] + #-ellipsis args not used if -wrap is true + set argsflags [lrange $args 0 end-2] + dict for {k v} $argsflags { + switch -- $k { + -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" + } + } + } + set opts [dict merge $defaults $argsflags] + # -- --- --- --- --- --- + set opt_overflow [dict get $opts -overflow] + ##### + # review -wrap should map onto DECAWM terminal mode - the wrap 2 idea may not fit in with this?. + set opt_wrap [dict get $opts -wrap] ;#wrap 1 is hard wrap cutting word at exact column, or 1 column early for 2w-glyph, wrap 2 is for language-based word-wrap algorithm (todo) + ##### + #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] + set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] + set opt_exposed1 [dict get $opts -exposed1] ;#widechar_exposed_left - 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 1 + set info_mode 0 + set edit_mode 0 + set opt_experimental [dict get $opts -experimental] + foreach o $opt_experimental { + switch -- $o { + test_mode { + set test_mode 1 + set info_mode 1 + } + old_mode { + set test_mode 0 + set info_mode 1 + } + data_mode { + set data_mode 1 + } + info_mode { + set info_mode 1 + } + edit_mode { + set edit_mode 1 + } + } + } + # ---------------------------- + + #modes + set insert_mode 0 ;#can be toggled by insert key or ansi IRM sequence ESC [ 4 h|l + set autowrap_mode $opt_wrap + set reverse_mode 0 + + + set norm [list \r\n \n] + set underblock [string map $norm $underblock] + set overblock [string map $norm $overblock] + + + #set underlines [split $underblock \n] + + #underblock is a 'rendered' block - so width height make sense + #colwidth & colheight were originally named with reference to rendering into a 'column' of output e.g a table column - before cursor row/col was implemented. + #The naming is now confusing. It should be something like renderwidth renderheight ?? review + + if {$opt_width eq "\uFFEF"} { + lassign [blocksize $underblock] _w colwidth _h colheight + } else { + set colwidth $opt_width + set colheight $opt_height + } + if {$underblock eq ""} { + 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] + } + + #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 + + #a hack until we work out how to avoid infinite loops... + # + set looplimit [dict get $opts -looplimit] + if {$looplimit eq "\uFFEF"} { + #looping for each char is worst case (all newlines?) - anything over that is an indication of something broken? + #do we need any margin above the length? (telnet mapscii.me test) + set looplimit [expr {[string length $overblock] + 10}] + } + + if {!$test_mode} { + set inputchunks [split $overblock \n] + } else { + set scheme 3 + switch -- $scheme { + 0 { + #one big chunk + 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 { + #it turns out line based chunks are faster than the above.. probably because some of those end up doing the regex splitting twice + set lflines [list] + set 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 + + + set replay_codes_underlay [dict create 1 ""] + #lappend replay_codes_overlay "" + set replay_codes_overlay "" + set unapplied "" + set cursor_saved_position [dict create] + set cursor_saved_attributes "" + + + set outputlines $underlines + set overidx 0 + + #underlines are not necessarily processed in order - depending on cursor-moves applied from overtext + set row 1 + if {$data_mode} { + set col [_get_row_append_column $row] + } else { + set col 1 + } + + set instruction_stats [dict create] + + set loop 0 + #while {$overidx < [llength $inputchunks]} { } + + while {[llength $inputchunks]} { + #set overtext [lindex $inputchunks $overidx]; lset inputchunks $overidx "" + set overtext [lpop inputchunks 0] + if {![string length $overtext]} { + incr loop + continue + } + #puts "----->[ansistring VIEW -lf 1 -vt 1 -nul 1 $overtext]<----" + set undertext [lindex $outputlines [expr {$row -1}]] + set renderedrow $row + + #renderline pads each underaly line to width with spaces and should track where end of data is + + + #set overtext [string cat [lindex $replay_codes_overlay $overidx] $overtext] + set overtext [string cat $replay_codes_overlay $overtext] + if {[dict exists $replay_codes_underlay $row]} { + set undertext [string cat [dict get $replay_codes_underlay $row] $undertext] + } + #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 + 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 -experimental $opt_experimental -info 1 -insert_mode $insert_mode -cursor_restore_attributes $cursor_saved_attributes -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 insert_mode [dict get $rinfo insert_mode] + set autowrap_mode [dict get $rinfo autowrap_mode] ;# + #set reverse_mode [dict get $rinfo reverse_mode];#how to support in rendered linelist? we need to examine all pt/code blocks and flip each SGR stack? + set rendered [dict get $rinfo result] + set overflow_right [dict get $rinfo overflow_right] + set overflow_right_column [dict get $rinfo overflow_right_column] + set unapplied [dict get $rinfo unapplied] + set unapplied_list [dict get $rinfo unapplied_list] + set post_render_col [dict get $rinfo cursor_column] + set post_render_row [dict get $rinfo cursor_row] + set c_saved_pos [dict get $rinfo cursor_saved_position] + set c_saved_attributes [dict get $rinfo cursor_saved_attributes] + set visualwidth [dict get $rinfo visualwidth] + set insert_lines_above [dict get $rinfo insert_lines_above] + set insert_lines_below [dict get $rinfo insert_lines_below] + dict set replay_codes_underlay [expr {$renderedrow+1}] [dict get $rinfo replay_codes_underlay] + #lset replay_codes_overlay [expr $overidx+1] [dict get $rinfo replay_codes_overlay] + set replay_codes_overlay [dict get $rinfo replay_codes_overlay] + + + + #-- todo - detect looping properly + if {$row > 1 && $overtext ne "" && $unapplied eq $overtext && $post_render_row == $row && $instruction eq ""} { + puts stderr "overtype::left loop?" + puts [ansistring VIEW $rinfo] + break + } + #-- + + if {[dict size $c_saved_pos] >= 1} { + set cursor_saved_position $c_saved_pos + set cursor_saved_attributes $c_saved_attributes + } + + #background line is narrower than data in line + + set overflow_handled 0 + if {!$opt_overflow && !$autowrap_mode} { + #not allowed to overflow column or wrap therefore we get overflow data to truncate + if {[dict get $opts -ellipsis]} { + set show_ellipsis 1 + if {!$opt_ellipsiswhitespace} { + #we don't want ellipsis if only whitespace was lost + set lostdata "" + if {$overflow_right ne ""} { + append lostdata $overflow_right + } + if {$unapplied ne ""} { + append lostdata $unapplied + } + if {[string trim $lostdata] eq ""} { + set show_ellipsis 0 + } + #set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] + if {[string trim [ansistrip $lostdata]] eq ""} { + set show_ellipsis 0 + } + } + if {$show_ellipsis} { + set rendered [overtype::right $rendered $opt_ellipsistext] + } + set overflow_handled 1 + } else { + #no wrap - no ellipsis - silently truncate + set overflow_handled 1 + } + } + + + + set nextprefix "" + + + #todo - handle potential insertion mode as above for cursor restore? + #keeping separate branches for debugging - review and merge as appropriate when stable + dict incr instruction_stats $instruction + switch -- $instruction { + {} { + if {$test_mode == 0} { + incr row + if {$data_mode} { + set col [_get_row_append_column $row] + if {$col > $colwidth} { + + } + } else { + set col 1 + } + } else { + #lf included in data + set row $post_render_row + set col $post_render_col + + #set col 1 + #if {$post_render_row != $renderedrow} { + # set col 1 + #} else { + # set col $post_render_col + #} + } + } + up { + + #renderline knows it's own line number, and knows not to go above row l + #it knows that a move whilst 1-beyond the width conflicts with the linefeed and reduces the move by one accordingly. + #row returned should be correct. + #column may be the overflow column - as it likes to report that to the caller. + + #Note that an ansi up sequence after last column going up to a previous line and also beyond the last column, will result in the next grapheme going onto the following line. + #this seems correct - as the column remains beyond the right margin so subsequent chars wrap (?) review + #puts stderr "up $post_render_row" + #puts stderr "$rinfo" + + #puts stdout "1 row:$row col $col" + 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 + } 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 "-----------------------" + #puts stdout $rinfo + #flush stdout + } + down { + if {$data_mode == 0} { + #renderline doesn't know how far down we can go.. + 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 row $post_render_row + 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 { + #testfile belinda.ans uses this + + #puts stdout "[a+ blue bold]CURSOR_RESTORE[a]" + if {[dict exists $cursor_saved_position row]} { + set row [dict get $cursor_saved_position row] + set col [dict get $cursor_saved_position column] + #puts stdout "restoring: row $row col $col [ansistring VIEW $cursor_saved_attributes] [a] unapplied [ansistring VIEWCODES $unapplied]" + #set nextprefix $cursor_saved_attributes + #lset replay_codes_overlay [expr $overidx+1] $cursor_saved_attributes + set replay_codes_overlay [dict get $rinfo replay_codes_overlay]$cursor_saved_attributes + #set replay_codes_overlay $cursor_saved_attributes + set cursor_saved_position [dict create] + set cursor_saved_attributes "" + } else { + #TODO + #?restore without save? + #should move to home position and reset ansi SGR? + #puts stderr "overtype::left cursor_restore without save data available" + } + #If we were inserting prior to hitting the cursor_restore - there could be overflow_right data - generally the overtype functions aren't for inserting - but ansi can enable it + #if we were already in overflow when cursor_restore was hit - it shouldn't have been processed as an action - just stored. + if {!$overflow_handled && $overflow_right ne ""} { + #wrap before restore? - possible effect on saved cursor position + #this overflow data has previously been rendered so has no cursor movements or further save/restore operations etc + #we can just insert another call to renderline to solve this.. ? + #It would perhaps be more properly handled as a queue of instructions from our initial renderline call + #we don't need to worry about overflow next call (?)- but we should carry forward our gx and ansi stacks + + puts stdout ">>>[a+ red bold]overflow_right during restore_cursor[a]" + + set sub_info [overtype::renderline -info 1 -width $colwidth -insert_mode $insert_mode -autowrap_mode $autowrap_mode -overflow [dict get $opts -overflow] "" $overflow_right] + set foldline [dict get $sub_info result] + set insert_mode [dict get $sub_info insert_mode] ;#probably not needed.. + set autowrap_mode [dict get $sub_info autowrap_mode] ;#nor this.. + linsert outputlines $renderedrow $foldline + #review - row & col set by restore - but not if there was no save.. + } + set overflow_handled 1 + + } + move { + ######## + if {$post_render_row > [llength $outputlines]} { + #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 + } + ####### + set col $post_render_col + #overflow + unapplied? + } + lf_start { + #raw newlines - must be test_mode + # ---------------------- + #test with fruit.ans + #test - treating as newline below... + #append rendered $overflow_right + #set overflow_right "" + set row $renderedrow + incr row + if {$row > [llength $outputlines]} { + lappend outputlines "" + } + set col 1 + # ---------------------- + } + lf_mid { + + if 0 { + #set rhswidth [punk::ansi::printing_length $overflow_right] + #only show debug when we have overflow? + set lhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -nul 1 -lf 1 -vt 1 $rendered]] + set lhs [textblock::frame -title "rendered $visualwidth cols" -subtitle "row-$renderedrow" $lhs] + + set rhs "" + if {$overflow_right ne ""} { + set rhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -nul 1 -lf 1 -vt 1 $overflow_right]] + set rhs [textblock::frame -title overflow_right $rhs] + } + puts [textblock::join $lhs " $post_render_col " $rhs] + } + + if {!$test_mode} { + #rendered + append rendered $overflow_right + #set replay_codes_overlay "" + set overflow_right "" + + + 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 ""] + } + } else { + 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 ""] + } + } + } + } + lf_overflow { + #linefeed after colwidth e.g at column 81 for an 80 col width + #we may also have other control sequences that came after col 80 e.g cursor save + + if 0 { + set lhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -nul 1 -lf 1 -vt 1 $rendered]] + set lhs [textblock::frame -title "rendered $visualwidth cols" -subtitle "row-$renderedrow" $lhs] + set rhs "" + + #assertion - there should be no overflow.. + puts $lhs + } + assert {$overflow_right eq ""} lf_overflow should not get data in overflow_right + + set row $post_render_row + #set row $renderedrow + #incr row + #only add newline if we're at the bottom + if {$row > [llength $outputlines]} { + lappend outputlines {*}[lrepeat 1 ""] + } + set col 1 + + } + newlines_above { + #we get a newlines_above instruction when received at column 1 + #In some cases we want to treat that as request to insert a new blank line above, and move our row 1 down (staying with the data) + #in other cases - we want to treat at column 1 the same as any other + + puts "--->newlines_above" + puts "rinfo: $rinfo" + #renderline doesn't advance the row for us - the caller has the choice to implement or not + set row $post_render_row + set col $post_render_col + if {$insert_lines_above > 0} { + set row $renderedrow + set outputlines [linsert $outputlines $renderedrow-1 {*}[lrepeat $insert_lines_above ""]] + incr row [expr {$insert_lines_above -1}] ;#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 { + #obsolete? - use for ANSI insert lines sequence + if {$data_mode == 0} { + puts --->nl_below + set row $post_render_row + set col $post_render_col + if {$insert_lines_below == 1} { + if {$test_mode == 0} { + 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 + } else { + #set lhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -lf 1 -vt 1 $rendered]] + #set lhs [textblock::frame -title rendered -subtitle "row-$renderedrow" $lhs] + #set rhs "" + #if {$overflow_right ne ""} { + # set rhs [overtype::left -width 40 -wrap 1 "" [ansistring VIEWSTYLE -lf 1 -vt 1 $overflow_right]] + # set rhs [textblock::frame -title overflow_right $rhs] + #} + #puts [textblock::join $lhs $rhs] + + #rendered + append rendered $overflow_right + # + + + set overflow_right "" + set row $renderedrow + #only add newline if we're at the bottom + if {$row > [llength $outputlines]} { + lappend outputlines {*}[lrepeat $insert_lines_below ""] + } + incr row $insert_lines_below + set col 1 + + + + } + } + } else { + set row $post_render_row + 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 "" + } + } else { + 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 + } + } + } + } + wrapmoveforward { + #doesn't seem to be used by fruit.ans testfile + #used by dzds.ans + #note that cursor_forward may move deep into the next line - or even span multiple lines !TODO + set c $colwidth + set r $post_render_row + if {$post_render_col > $colwidth} { + set i $c + while {$i <= $post_render_col} { + if {$c == $colwidth+1} { + incr r + if {$opt_appendlines} { + if {$r < [llength $outputlines]} { + lappend outputlines "" + } + } + set c 1 + } else { + incr c + } + incr i + } + set col $c + } else { + #why are we getting this instruction then? + puts stderr "wrapmoveforward - test" + set r [expr {$post_render_row +1}] + set c $post_render_col + } + set row $r + set col $c + } + wrapmovebackward { + set c $colwidth + set r $post_render_row + if {$post_render_col < 1} { + set c 1 + set i $c + while {$i >= $post_render_col} { + if {$c == 0} { + if {$r > 1} { + incr r -1 + set c $colwidth + } else { + #leave r at 1 set c 1 + #testfile besthpav.ans first line top left border alignment + set c 1 + break + } + } else { + incr c -1 + } + incr i -1 + } + set col $c + } else { + puts stderr "Wrapmovebackward - but postrendercol >= 1???" + } + set row $r + set col $c + } + overflow { + #normal single-width grapheme overflow + #puts "----normal overflow --- [ansistring VIEWSTYLE -lf 1 -nul 1 -vt 1 $rendered]" + set row $post_render_row ;#renderline will not advance row when reporting overflow char + if {$autowrap_mode} { + incr row + set col 1 ;#whether wrap or not - next data is at column 1 ?? + } else { + #this works for test_mode (which should become the default) - but could give a bad result otherwise - review - add tests fix. + set col $post_render_col + #set unapplied "" ;#this seems wrong? + #set unapplied [string range $unapplied 1 end] + #The overflow can only be triggered by a grapheme (todo cluster?) - but our unapplied could contain SGR codes prior to the grapheme that triggered overflow - so we need to skip beyond any SGRs + #There may be more than one, because although the stack leading up to overflow may have been merged - codes between the last column and the overflowing grapheme will remain separate + #We don't expect any movement or other ANSI codes - as if they came before the grapheme, they would have triggered a different instruction to 'overflow' + set idx 0 + set next_grapheme_index -1 + foreach u $unapplied_list { + if {![punk::ansi::ta::detect $u]} { + set next_grapheme_index $idx + break + } + incr idx + } + assert {$next_grapheme_index >= 0} + #drop the overflow grapheme - keeping all codes in place. + set unapplied [join [lreplace $unapplied_list $next_grapheme_index $next_grapheme_index] ""] + #we need to run the reduced unapplied on the same line - further graphemes will just overflow again, but codes or control chars could trigger jumps to other lines + + set overflow_handled 1 + #handled by dropping overflow if any + } + } + overflow_splitchar { + set row $post_render_row ;#renderline will not advance row when reporting overflow char + + #2nd half of grapheme would overflow - treggering grapheme is returned in unapplied. There may also be overflow_right from earlier inserts + #todo - consider various options .. re-render a single trailing space or placeholder on same output line, etc + if {$autowrap_mode} { + if {$colwidth < 2} { + #edge case of rendering to a single column output - any 2w char will just cause a loop if we don't substitute with something, or drop the character + set idx 0 + set triggering_grapheme_index -1 + foreach u $unapplied_list { + if {![punk::ansi::ta::detect $u]} { + set triggering_grapheme_index $idx + break + } + incr idx + } + set unapplied [join [lreplace $unapplied_list $triggering_grapheme_index $triggering_grapheme_index $opt_exposed1] ""] + } else { + set col 1 + incr row + } + } else { + set overflow_handled 1 + #handled by dropping entire overflow if any + if {$colwidth < 2} { + set idx 0 + set triggering_grapheme_index -1 + foreach u $unapplied_list { + if {![punk::ansi::ta::detect $u]} { + set triggering_grapheme_index $idx + break + } + incr idx + } + set unapplied [join [lreplace $unapplied_list $triggering_grapheme_index $triggering_grapheme_index $opt_exposed1] ""] + } + } + + } + vt { + + #can vt add a line like a linefeed can? + set row $post_render_row + set col $post_render_col + } + default { + puts stderr "overtype::left unhandled renderline instruction '$instruction'" + } + + } + + if {$renderedrow <= [llength $outputlines]} { + lset outputlines [expr {$renderedrow-1}] $rendered + } else { + if {$opt_appendlines} { + lappend outputlines $rendered + } else { + #? + lset outputlines [expr {$renderedrow-1}] $rendered + } + } + + if {!$overflow_handled} { + append nextprefix $overflow_right + } + + append nextprefix $unapplied + + if 0 { + if {$nextprefix ne ""} { + set nextoveridx [expr {$overidx+1}] + if {$nextoveridx >= [llength $inputchunks]} { + lappend inputchunks $nextprefix + } else { + #lset overlines $nextoveridx $nextprefix[lindex $overlines $nextoveridx] + set inputchunks [linsert $inputchunks $nextoveridx $nextprefix] + } + } + } + + if {$nextprefix ne ""} { + set inputchunks [linsert $inputchunks 0 $nextprefix] + } + + + incr overidx + incr loop + if {$loop >= $looplimit} { + puts stderr "overtype::left looplimit reached ($looplimit)" + lappend outputlines "[a+ red bold] - looplimit $looplimit reached[a]" + set Y [a+ yellow bold] + set RST [a] + set sep_header ----DEBUG----- + set debugmsg "" + append debugmsg "${Y}${sep_header}${RST}" \n + append debugmsg "looplimit $looplimit reached\n" + append debugmsg "test_mode:$test_mode\n" + append debugmsg "data_mode:$data_mode\n" + append debugmsg "opt_appendlines:$opt_appendlines\n" + append debugmsg "prev_row :[dict get $LASTCALL -cursor_row]\n" + append debugmsg "prev_col :[dict get $LASTCALL -cursor_column]\n" + dict for {k v} $rinfo { + append debugmsg "${Y}$k [ansistring VIEW -lf 1 -vt 1 $v]$RST" \n + } + append debugmsg "${Y}[string repeat - [string length $sep_header]]$RST" \n + + puts stdout $debugmsg + #todo - config regarding error dumps rather than just dumping in working dir + set fd [open [pwd]/error_overtype.txt w] + puts $fd $debugmsg + close $fd + error $debugmsg + break + } + } + + set result [join $outputlines \n] + if {$info_mode} { + #emit to debug window like basictelnet does? make debug configurable as syslog or even a telnet server to allow on 2nd window? + #append result \n$instruction_stats\n + } + return $result +} + +namespace eval overtype::piper { + proc overcentre {args} { + if {[llength $args] < 2} { + error {usage: ?-bias left|right? ?-transparent [0|1|]? ?-exposed1 ? ?-exposed2 ? ?-overflow [1|0]? overtext pipelinedata} + } + lassign [lrange $args end-1 end] over under + set argsflags [lrange $args 0 end-2] + tailcall overtype::centre {*}$argsflags $under $over + } + proc overleft {args} { + if {[llength $args] < 2} { + error {usage: ?-startcolumn ? ?-transparent [0|1|]? ?-exposed1 ? ?-exposed2 ? ?-overflow [1|0]? overtext pipelinedata} + } + lassign [lrange $args end-1 end] over under + set argsflags [lrange $args 0 end-2] + tailcall overtype::left {*}$argsflags $under $over + } +} +#todo - left-right ellipsis ? +proc overtype::centre {args} { + variable default_ellipsis_horizontal + if {[llength $args] < 2} { + error {usage: ?-transparent [0|1]? ?-bias [left|right]? ?-overflow [1|0]? undertext overtext} + } + + foreach {underblock overblock} [lrange $args end-1 end] break + + #todo - vertical vs horizontal overflow for blocks + set defaults [dict create\ + -bias left\ + -ellipsis 0\ + -ellipsistext $default_ellipsis_horizontal\ + -ellipsiswhitespace 0\ + -overflow 0\ + -transparent 0\ + -exposed1 \uFFFD\ + -exposed2 \uFFFD\ + ] + set argsflags [lrange $args 0 end-2] + dict for {k v} $argsflags { + switch -- $k { + -bias - -ellipsis - -ellipsistext - -ellipsiswhitespace - -overflow - -transparent - -exposed1 - -exposed2 {} + default { + set known_opts [dict keys $defaults] + error "overtype::centre unknown option '$k'. Known options: $known_opts" + } + } + } + set opts [dict merge $defaults $argsflags] + # -- --- --- --- --- --- + set opt_transparent [dict get $opts -transparent] + set opt_ellipsis [dict get $opts -ellipsis] + set opt_ellipsistext [dict get $opts -ellipsistext] + set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] + set opt_exposed1 [dict get $opts -exposed1] + set opt_exposed2 [dict get $opts -exposed2] + # -- --- --- --- --- --- + + + set norm [list \r\n \n] + set underblock [string map $norm $underblock] + set overblock [string map $norm $overblock] + + set underlines [split $underblock \n] + #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] + lassign [blocksize $underblock] _w colwidth _h colheight + set overlines [split $overblock \n] + #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] + lassign [blocksize $overblock] _w overblock_width _h overblock_height + set under_exposed_max [expr {$colwidth - $overblock_width}] + if {$under_exposed_max > 0} { + #background block is wider + if {$under_exposed_max % 2 == 0} { + #even left/right exposure + set left_exposed [expr {$under_exposed_max / 2}] + } else { + set beforehalf [expr {$under_exposed_max / 2}] ;#1 less than half due to integer division + if {[string tolower [dict get $opts -bias]] eq "left"} { + set left_exposed $beforehalf + } else { + #bias to the right + set left_exposed [expr {$beforehalf + 1}] + } + } + } else { + set left_exposed 0 + } + + set outputlines [list] + if {[punk::ansi::ta::detect_sgr [lindex $overlines 0]]} { + set replay_codes "[punk::ansi::a]" + } else { + set replay_codes "" + } + set replay_codes_underlay "" + set replay_codes_overlay "" + foreach undertext $underlines overtext $overlines { + set overtext_datalen [punk::ansi::printing_length $overtext] + set ulen [punk::ansi::printing_length $undertext] + if {$ulen < $colwidth} { + set udiff [expr {$colwidth - $ulen}] + set undertext "$undertext[string repeat { } $udiff]" + } + set undertext [string cat $replay_codes_underlay $undertext] + set overtext [string cat $replay_codes_overlay $overtext] + + set overflowlength [expr {$overtext_datalen - $colwidth}] + #review - right-to-left langs should elide on left! - extra option required + + if {$overflowlength > 0} { + #overlay line wider or equal + set rinfo [renderline -info 1 -insert_mode 0 -transparent $opt_transparent -overflow [dict get $opts -overflow] -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] + set rendered [dict get $rinfo result] + set overflow_right [dict get $rinfo overflow_right] + set unapplied [dict get $rinfo unapplied] + #todo - get replay_codes from overflow_right instead of wherever it was truncated? + + #overlay line data is wider - trim if overflow not specified in opts - and overtype an ellipsis at right if it was specified + if {![dict get $opts -overflow]} { + #lappend outputlines [string range $overtext 0 [expr {$colwidth - 1}]] + #set overtext [string range $overtext 0 $colwidth-1 ] + if {$opt_ellipsis} { + set show_ellipsis 1 + if {!$opt_ellipsiswhitespace} { + #we don't want ellipsis if only whitespace was lost + #don't use string range on ANSI data + #set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] + set lostdata "" + if {$overflow_right ne ""} { + append lostdata $overflow_right + } + if {$unapplied ne ""} { + append lostdata $unapplied + } + if {[string trim $lostdata] eq ""} { + set show_ellipsis 0 + } + } + if {$show_ellipsis} { + set rendered [overtype::right $rendered $opt_ellipsistext] + } + } + } + lappend outputlines $rendered + #lappend outputlines [renderline -insert_mode 0 -transparent $opt_transparent $undertext $overtext] + } else { + #background block is wider than or equal to data for this line + #lappend outputlines [renderline -insert_mode 0 -startcolumn [expr {$left_exposed + 1}] -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] + set rinfo [renderline -info 1 -insert_mode 0 -startcolumn [expr {$left_exposed + 1}] -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 $undertext $overtext] + lappend outputlines [dict get $rinfo result] + } + set replay_codes_underlay [dict get $rinfo replay_codes_underlay] + set replay_codes_overlay [dict get $rinfo replay_codes_overlay] + } + return [join $outputlines \n] +} + +proc overtype::right {args} { + #NOT the same as align-right - which should be done to the overblock first if required + variable default_ellipsis_horizontal + # @d !todo - implement overflow, length checks etc + + if {[llength $args] < 2} { + error {usage: ?-overflow [1|0]? ?-transparent 0|? undertext overtext} + } + foreach {underblock overblock} [lrange $args end-1 end] break + + set defaults [dict create\ + -bias ignored\ + -ellipsis 0\ + -ellipsistext $default_ellipsis_horizontal\ + -ellipsiswhitespace 0\ + -overflow 0\ + -transparent 0\ + -exposed1 \uFFFD\ + -exposed2 \uFFFD\ + -align "left"\ + ] + set argsflags [lrange $args 0 end-2] + dict for {k v} $argsflags { + switch -- $k { + -bias - -ellipsis - -ellipsistext - -ellipsiswhitespace - -overflow - -transparent - -exposed1 - -exposed2 - -align {} + default { + set known_opts [dict keys $defaults] + error "overtype::centre unknown option '$k'. Known options: $known_opts" + } + } + } + set opts [dict merge $defaults $argsflags] + # -- --- --- --- --- --- + set opt_transparent [dict get $opts -transparent] + set opt_ellipsis [dict get $opts -ellipsis] + set opt_ellipsistext [dict get $opts -ellipsistext] + set opt_ellipsiswhitespace [dict get $opts -ellipsiswhitespace] + set opt_overflow [dict get $opts -overflow] + set opt_exposed1 [dict get $opts -exposed1] + set opt_exposed2 [dict get $opts -exposed2] + set opt_align [dict get $opts -align] + # -- --- --- --- --- --- + + set norm [list \r\n \n] + set underblock [string map $norm $underblock] + set overblock [string map $norm $overblock] + + set underlines [split $underblock \n] + #set colwidth [tcl::mathfunc::max {*}[lmap v $underlines {punk::ansi::printing_length $v}]] + lassign [blocksize $underblock] _w colwidth _h colheight + set overlines [split $overblock \n] + #set overblock_width [tcl::mathfunc::max {*}[lmap v $overlines {punk::ansi::printing_length $v}]] + lassign [blocksize $overblock] _w overblock_width _h overblock_height + set under_exposed_max [expr {max(0,$colwidth - $overblock_width)}] + set left_exposed $under_exposed_max + + + + set outputlines [list] + if {[punk::ansi::ta::detect_sgr [lindex $overlines 0]]} { + set replay_codes "[punk::ansi::a]" + } else { + set replay_codes "" + } + set replay_codes_underlay "" + set replay_codes_overlay "" + foreach undertext $underlines overtext $overlines { + set overtext_datalen [punk::ansi::printing_length $overtext] + set ulen [punk::ansi::printing_length $undertext] + if {$ulen < $colwidth} { + set udiff [expr {$colwidth - $ulen}] + #puts xxx + append undertext [string repeat { } $udiff] + } + if {$overtext_datalen < $overblock_width} { + set odiff [expr {$overblock_width - $overtext_datalen}] + switch -- $opt_align { + left { + set startoffset 0 + } + right { + set startoffset $odiff + } + default { + set half [expr {$odiff / 2}] + #set lhs [string repeat { } $half] + #set righthalf [expr {$odiff - $half}] ;#remainder - may be one more - so we are biased left + #set rhs [string repeat { } $righthalf] + set startoffset $half + } + } + } else { + set startoffset 0 ;#negative? + } + + set undertext [string cat $replay_codes_underlay $undertext] + set overtext [string cat $replay_codes_overlay $overtext] + + set overflowlength [expr {$overtext_datalen - $colwidth}] + if {$overflowlength > 0} { + #raw overtext wider than undertext column + set rinfo [renderline -info 1 -insert_mode 0 -transparent $opt_transparent -exposed1 $opt_exposed1 -exposed2 $opt_exposed2 -overflow $opt_overflow -startcolumn [expr {1 + $startoffset}] $undertext $overtext] + set replay_codes [dict get $rinfo replay_codes] + set rendered [dict get $rinfo result] + if {!$opt_overflow} { + if {$opt_ellipsis} { + set show_ellipsis 1 + if {!$opt_ellipsiswhitespace} { + #we don't want ellipsis if only whitespace was lost + set lostdata [string range $overtext end-[expr {$overflowlength-1}] end] + if {[string trim $lostdata] eq ""} { + set show_ellipsis 0 + } + } + if {$show_ellipsis} { + set ellipsis [string cat $replay_codes $opt_ellipsistext] + #todo - overflow on left if allign = right?? + set rendered [overtype::right $rendered $ellipsis] + } + } + } + lappend outputlines $rendered + } else { + #padded overtext + #lappend outputlines [renderline -insert_mode 0 -transparent $opt_transparent -startcolumn [expr {$left_exposed + 1}] $undertext $overtext] + #Note - we still need overflow here - as although the overtext is short - it may oveflow due to the startoffset + set rinfo [renderline -info 1 -insert_mode 0 -transparent $opt_transparent -overflow $opt_overflow -startcolumn [expr {$left_exposed + 1 + $startoffset}] $undertext $overtext] + lappend outputlines [dict get $rinfo result] + } + set replay_codes [dict get $rinfo replay_codes] + set replay_codes_underlay [dict get $rinfo replay_codes_underlay] + set replay_codes_overlay [dict get $rinfo replay_codes_overlay] + } + + return [join $outputlines \n] +} + +# -- --- --- --- --- --- --- --- --- --- --- +proc overtype::transparentline {args} { + foreach {under over} [lrange $args end-1 end] break + set argsflags [lrange $args 0 end-2] + set defaults [dict create\ + -transparent 1\ + -exposed 1 " "\ + -exposed 2 " "\ + ] + set newargs [dict merge $defaults $argsflags] + tailcall overtype::renderline {*}$newargs $under $over +} +#renderline may not make sense as it is in the long run for blocks of text - but is handy in the single-line-handling form anyway. +# We are trying to handle ansi codes in a block of text which is acting like a mini-terminal in some sense. +#We can process standard cursor moves such as \b \r - but no way to respond to other cursor movements e.g moving to other lines. +# +namespace eval overtype::piper { + proc renderline {args} { + if {[llength $args] < 2} { + error {usage: ?-start ? ?-transparent [0|1|]? ?-overflow [1|0]? overtext pipelinedata} + } + foreach {over under} [lrange $args end-1 end] break + set argsflags [lrange $args 0 end-2] + tailcall overtype::renderline {*}$argsflags $under $over + } +} +interp alias "" piper_renderline "" overtype::piper::renderline + +#intended for single grapheme - but will work for multiple +#cannot contain ansi or newlines +#(a cache of ansifreestring_width calls - as these are quite regex heavy) +proc overtype::grapheme_width_cached {ch} { + variable grapheme_widths + if {[dict exists $grapheme_widths $ch]} { + return [dict get $grapheme_widths $ch] + } + set width [punk::char::ansifreestring_width $ch] + dict set grapheme_widths $ch $width + return $width +} + + + +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### +# renderline written from a left-right line orientation perspective as a first-shot at getting something useful. +# ultimately right-to-left, top-to-bottom and bottom-to-top are probably needed. +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### +# +# +#-returnextra enables returning of overflow and length +#review - use punk::ansi::ta::detect to short-circuit processing and do simpler string calcs as an optimisation? +#review - DECSWL/DECDWL double width line codes - very difficult/impossible to align and compose with other elements +#(could render it by faking it with sixels and a lot of work - find/make a sixel font and ensure it's exactly 2 cols per char) +#todo - review transparency issues with single/double width characters +#bidi - need a base direction and concept of directional runs for RTL vs LTR - may be best handled at another layer? +proc overtype::renderline {args} { + #*** !doctools + #[call [fun overtype::renderline] [arg args] ] + #[para] renderline is the core engine for overtype string processing (frames & textblocks), and the raw mode commandline repl for the Tcl Punk Shell + #[para] It is also a central part of an ansi (micro) virtual terminal-emulator of sorts + #[para] This system does a half decent job at rendering 90's ANSI art to manipulable colour text blocks that can be joined & framed for layout display within a unix or windows terminal + #[para] Renderline helps maintain ANSI text styling reset/replay codes so that the styling of one block doesn't affect another. + #[para] Calling on the punk::ansi library - it can coalesce codes to keep the size down. + #[para] It is a giant mess of doing exactly what common wisdom says not to do... lots at once. + #[para] renderline is part of the Unicode and ANSI aware Overtype system which 'renders' a block of text onto a static underlay + #[para] The underlay is generally expected to be an ordered set of lines or a rectangular text block analogous to a terminal screen - but it can also be ragged in line length, or just blank. + #[para] The overlay couuld be similar - in which case it may often be used to overwrite a column or section of the underlay. + #[para] The overlay could however be a sequence of ANSI-laden text that jumps all over the place. + # + #[para] renderline itself only deals with a single line - or sometimes a single character. It is generally called from a loop that does further terminal-like or textblock processing. + #[para] By suppyling the -info 1 option - it can return various fields indicating the state of the render. + #[para] The main 3 are the result, overflow_right, and unapplied. + #[para] Renderline handles cursor movements from either keystrokes or ANSI sequences but for a full system the aforementioned loop will need to be in place to manage the set of lines under manipulation. + + if {[llength $args] < 2} { + error {usage: ?-info 0|1? ?-startcolumn ? ?-cursor_column ? ?-cursor_row |""? ?-transparent [0|1|]? ?-overflow [1|0]? undertext overtext} + } + lassign [lrange $args end-1 end] under over + if {[string first \n $under] >= 0} { + error "overtype::renderline not allowed to contain newlines in undertext" + } + #if {[string first \n $over] >=0 || [string first \n $under] >= 0} { + # error "overtype::renderline not allowed to contain newlines" + #} + + set defaults [dict create\ + -etabs 0\ + -width \uFFEF\ + -overflow 0\ + -transparent 0\ + -startcolumn 1\ + -cursor_column 1\ + -cursor_row ""\ + -insert_mode 1\ + -autowrap_mode 1\ + -reverse_mode 0\ + -info 0\ + -exposed1 \uFFFD\ + -exposed2 \uFFFD\ + -cursor_restore_attributes ""\ + -experimental {}\ + ] + #-cursor_restore_attributes only - for replay stack - position and actual setting/restoring handled by throwback to caller + + #cursor_row, when numeric will allow detection of certain row moves that are still within our row - allowing us to avoid an early return + #An empty string for cursor_row tells us we have no info about our own row context, and to return with an unapplied string if any row move occurs + + #exposed1 and exposed2 for first and second col of underying 2wide char which is truncated by transparency or overflow + #todo - return info about such grapheme 'cuts' in -info structure and/or create option to raise an error + + set argsflags [lrange $args 0 end-2] + dict for {k v} $argsflags { + switch -- $k { + -experimental - -width - -overflow - -transparent - -startcolumn - -cursor_column - -cursor_row - -insert_mode - -autowrap_mode - -reverse_mode - -info - -exposed1 - -exposed2 - -cursor_restore_attributes {} + default { + set known_opts [dict keys $defaults] + error "overtype::renderline unknown option '$k'. Known options: $known_opts" + } + } + } + set opts [dict merge $defaults $argsflags] + # -- --- --- --- --- --- --- --- --- --- --- --- + set opt_width [dict get $opts -width] + set opt_etabs [dict get $opts -etabs] + set opt_overflow [dict get $opts -overflow] + set opt_colstart [dict get $opts -startcolumn] ;#lhs limit for overlay - an offset to cursor_column - first visible column is 1. 0 or < 0 are before the start of the underlay + set opt_colcursor [dict get $opts -cursor_column];#start cursor column relative to overlay + set opt_row_context [dict get $opts -cursor_row] + if {[string length $opt_row_context]} { + if {![string is integer -strict $opt_row_context] || $opt_row_context <1 } { + error "overtype::renderline -cursor_row must be empty for unspecified/unknown or a non-zero positive integer. received: '$opt_row_context'" + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- + #The _mode flags correspond to terminal modes that can be set/reset via escape sequences (e.g DECAWM wraparound mode) + set opt_insert_mode [dict get $opts -insert_mode];#should usually be 1 for each new line in editor mode but must be initialised to 1 externally (review) + #default is for overtype + # -- --- --- --- --- --- --- --- --- --- --- --- + set opt_autowrap_mode [dict get $opts -autowrap_mode] ;#DECAWM - char or movement can go beyond leftmost/rightmost col to prev/next line + set opt_reverse_mode [dict get $opts -reverse_mode] ;#DECSNM + # -- --- --- --- --- --- --- --- --- --- --- --- + set temp_cursor_saved [dict get $opts -cursor_restore_attributes] + + set test_mode 0 + set cp437_glyphs 0 + foreach e [dict get $opts -experimental] { + switch -- $e { + test_mode { + set test_mode 1 + set cp437_glyphs 1 + } + } + } + set cp437_map [dict create] + if {$cp437_glyphs} { + set cp437_map [set ::punk::ansi::cp437_map] + #for cp437 images we need to map these *after* splitting ansi + #some old files might use newline for its glyph.. but we can't easily support that. + #Not sure how old files did it.. maybe cr lf in sequence was newline and any lone cr or lf were displayed as glyphs? + dict unset cp437_map \n + } + + set opt_transparent [dict get $opts -transparent] + if {$opt_transparent eq "0"} { + set do_transparency 0 + } else { + set do_transparency 1 + if {$opt_transparent eq "1"} { + set opt_transparent {[\s]} + } + } + # -- --- --- --- --- --- --- --- --- --- --- --- + set opt_returnextra [dict get $opts -info] + # -- --- --- --- --- --- --- --- --- --- --- --- + set opt_exposed1 [dict get $opts -exposed1] + set opt_exposed2 [dict get $opts -exposed2] + # -- --- --- --- --- --- --- --- --- --- --- --- + + if {$opt_row_context eq ""} { + set cursor_row 1 + } else { + set cursor_row $opt_row_context + } + + + #----- + # + if {[info exists punk::console::tabwidth]} { + #punk console is updated if punk::console::set_tabstop_width is used or rep is started/restarted + #It is way too slow to test the current width by querying the terminal here - so it could conceivably get out of sync + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + + set overdata $over + if {!$cp437_glyphs} { + #REVIEW! tabify will give different answers for an ANSI colourised string vs plain text + if {!$opt_etabs} { + if {[string first \t $under] >= 0} { + #set under [textutil::tabify::untabify2 $under] + set under [textutil::tabify::untabifyLine $under $tw] + } + if {[string first \t $over] >= 0} { + #set overdata [textutil::tabify::untabify2 $over] + set overdata [textutil::tabify::untabifyLine $over $tw] + } + } + } + #------- + + #ta_detect ansi and do simpler processing? + + #we repeat tests for grapheme width in different loops - rather than create another datastructure to store widths based on column, + #we'll use the grapheme_width_cached function as a lookup table of all graphemes encountered - as there will often be repeats in different positions anyway. + + # -- --- --- --- --- --- --- --- + if {$under ne ""} { + set undermap [punk::ansi::ta::split_codes_single $under] + } else { + set undermap [list] + } + set understacks [list] + set understacks_gx [list] + + set i_u -1 ;#underlay may legitimately be empty + set undercols [list] + set u_codestack [list] + #u_gx_stack probably isn't really a stack - I don't know if g0 g1 can stack or not - for now we support only g0 anyway + set u_gx_stack [list] ;#separate stack for g0 (g1 g2 g3?) graphics on and off (DEC special graphics) + #set pt_underchars "" ;#for string_columns length calculation for overflow 0 truncation + set remainder [list] ;#for returnextra + foreach {pt code} $undermap { + #pt = plain text + #append pt_underchars $pt + if {$cp437_glyphs} { + set pt [string map $cp437_map $pt] + } + foreach grapheme [punk::char::grapheme_split $pt] { + #an ugly hack to serve *some* common case ascii quickly with byte-compiled literal switch - feels dirty. + #.. but even 0.5uS per char (grapheme_width_cached) adds up quickly when stitching lots of lines together. + switch -- $grapheme { + " " - - - _ - ! - @ - # - $ - % - ^ - & - * - = - + - : - . - , - / - | - ? - + a - b - c - d - e - f - g - h - i - j - k - l - m - n - o - p - q - r - s - t - u - v - w - x - y - + z - A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 { + set width 1 + } + default { + if {$grapheme eq "\u0000"} { + #use null as empty cell representation - review + #use of this will probably collide with some application at some point + #consider an option to set the empty cell character + set width 1 + } else { + set width [grapheme_width_cached $grapheme] + #we still want most controls and other zero-length codepoints such as \u200d (zero width joiner) to stay zero-length + #we substitute lone ESC that weren't captured within ANSI context as a debugging aid to see malformed ANSI + #todo - default to off and add a flag (?) to enable this substitution + set sub_stray_escapes 0 + if {$sub_stray_escapes && $width == 0} { + if {$grapheme eq "\x1b"} { + set gvis [ansistring VIEW $grapheme] + set grapheme $gvis + set width 1 + } + } + } + } + } + #set width [grapheme_width_cached $grapheme] + incr i_u + lappend understacks $u_codestack + lappend understacks_gx $u_gx_stack + + lappend undercols $grapheme + if {$width > 1} { + #presumably there are no triple-column or wider unicode chars.. until the aliens arrive.(?) + #but what about emoji combinations etc - can they be wider than 2? + #todo - if -etabs enabled - then we treat \t as the width determined by our elastic tabstop + incr i_u + lappend understacks $u_codestack + lappend understacks_gx $u_gx_stack + lappend undercols "" + } + } + + #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 + if {$code ne ""} { + 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 { + #need to exclude certain leaders after the lb e.g < for SGR 1006 mouse + #REVIEW - what else could end in m but be mistaken as a normal SGR code here? + set maybemouse "" + if {[string index $c1c2 0] eq "\x1b"} { + set maybemouse [string index $code 2] + } + + if {$maybemouse ne "<" && [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..? + } + + if {!$test_mode} { + #fill columns to width with spaces, and carry over stacks - we will have to keep track of where the underlying data ends manually - TODO + #Specifying a width is suitable for terminal-like applications and text-blocks + if {$opt_width ne "\uFFEF"} { + if {[llength $understacks]} { + set cs $u_codestack + set gs $u_gx_stack + } else { + set cs [list] + set gs [list] + } + if {[llength $undercols]< $opt_width} { + set diff [expr {$opt_width- [llength $undercols]}] + if {$diff > 0} { + lappend undercols {*}[lrepeat $diff " "] + lappend understacks {*}[lrepeat $diff $cs] + lappend understacks_gx {*}[lrepeat $diff $gs] + } + } + } + } else { + #NULL empty cell indicator + if {$opt_width ne "\uFFEF"} { + if {[llength $understacks]} { + set cs $u_codestack + set gs $u_gx_stack + } else { + set cs [list] + set gs [list] + } + if {[llength $undercols]< $opt_width} { + set diff [expr {$opt_width- [llength $undercols]}] + if {$diff > 0} { + lappend undercols {*}[lrepeat $diff "\u0000"] + lappend understacks {*}[lrepeat $diff $cs] + lappend understacks_gx {*}[lrepeat $diff $gs] + } + } + } + + } + if {$opt_width ne "\uFFEF"} { + set colwidth $opt_width + } else { + set colwidth [llength $undercols] + } + + + if 0 { + # ----------------- + # if we aren't extending understacks & understacks_gx each time we incr idx above the undercols length.. this doesn't really serve a purpose + # Review. + # ----------------- + #replay code for last overlay position in input line + # whether or not we get that far - we need to return it for possible replay on next line + if {[llength $understacks]} { + lappend understacks $u_codestack + lappend understacks_gx $u_gx_stack + } else { + #in case overlay onto emptystring as underlay + lappend understacks [list] + lappend understacks_gx [list] + } + # ----------------- + } + + #trailing codes in effect for underlay + if {[llength $u_codestack]} { + #set replay_codes_underlay [join $u_codestack ""] + set replay_codes_underlay [punk::ansi::codetype::sgr_merge_list {*}$u_codestack] + } else { + set replay_codes_underlay "" + } + + + # -- --- --- --- --- --- --- --- + #### + #if opt_colstart - we need to build a space (or any singlewidth char ?) padding on the left of the right number of columns. + #this will be processed as transparent - and handle doublewidth underlay characters appropriately + set startpad_overlay [string repeat " " [expr {$opt_colstart -1}]] + append startpad_overlay $overdata ;#overdata with left padding spaces based on col-start under will show through for left-padding portion regardless of -transparency + set overmap [punk::ansi::ta::split_codes_single $startpad_overlay] + #### + + #??? + set colcursor $opt_colstart + #TODO - make a little virtual column object + #we need to refer to column1 or columnmin? or columnmax without calculating offsets due to to startcolumn + #need to lock-down what start column means from perspective of ANSI codes moving around - the offset perspective is unclear and a mess. + + + #set re_diacritics {[\u0300-\u036f]+|[\u1ab0-\u1aff]+|[\u1dc0-\u1dff]+|[\u20d0-\u20ff]+|[\ufe20-\ufe2f]+} + #as at 2024-02 punk::char::grapheme_split uses these - not aware of more complex graphemes + + set overstacks [list] + set overstacks_gx [list] + + set o_codestack [list]; #SGR codestack (not other codes such as movement,insert key etc) + set o_gxstack [list] + set pt_overchars "" + set i_o 0 + set overlay_grapheme_control_list [list] ;#tag each with g, sgr or other. 'other' are things like cursor-movement or insert-mode or codes we don't recognise/use + #experiment + set overlay_grapheme_control_stacks [list] + foreach {pt code} $overmap { + if {$cp437_glyphs} { + set pt [string map $cp437_map $pt] + } + append pt_overchars $pt + #will get empty pt between adjacent codes + foreach grapheme [punk::char::grapheme_split $pt] { + lappend overstacks $o_codestack + lappend overstacks_gx $o_gxstack + incr i_o + lappend overlay_grapheme_control_list [list g $grapheme] + lappend overlay_grapheme_control_stacks $o_codestack + } + + #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 ""} { + lappend overlay_grapheme_control_stacks $o_codestack + #there will always be an empty code at end due to foreach on 2 vars with odd-sized list ending with pt (overmap coming from perlish split) + if {[punk::ansi::codetype::is_sgr_reset $code]} { + set o_codestack [list "\x1b\[m"] ;#reset better than empty list - fixes some ansi art issues + lappend overlay_grapheme_control_list [list sgr $code] + } elseif {[punk::ansi::codetype::has_sgr_leadingreset $code]} { + set o_codestack [list $code] + lappend overlay_grapheme_control_list [list sgr $code] + } elseif {[priv::is_sgr $code]} { + #basic simplification first - remove straight dupes + set dup_posns [lsearch -all -exact $o_codestack $code] ;#must be -exact because of square-bracket glob chars + set o_codestack [lremove $o_codestack {*}$dup_posns] + lappend o_codestack $code + lappend overlay_grapheme_control_list [list sgr $code] + } elseif {[regexp {\x1b7|\x1b\[s} $code]} { + #experiment + #cursor_save - for the replays review. + #jmn + #set temp_cursor_saved [punk::ansi::codetype::sgr_merge_list {*}$o_codestack] + lappend overlay_grapheme_control_list [list other $code] + } elseif {[regexp {\x1b8|\x1b\[u} $code]} { + #experiment + #cursor_restore - for the replays + set o_codestack [list $temp_cursor_saved] + lappend overlay_grapheme_control_list [list other $code] + } else { + if {[punk::ansi::codetype::is_gx_open $code]} { + set o_gxstack [list "gx0_on"] + lappend overlay_grapheme_control_list [list gx0 gx0_on] ;#don't store code - will complicate debugging if we spit it out and jump character sets + } elseif {[punk::ansi::codetype::is_gx_close $code]} { + set o_gxstack [list] + lappend overlay_grapheme_control_list [list gx0 gx0_off] ;#don't store code - will complicate debugging if we spit it out and jump character sets + } else { + lappend overlay_grapheme_control_list [list other $code] + } + } + } + + } + #replay code for last overlay position in input line - should take account of possible trailing sgr code after last grapheme + set max_overlay_grapheme_index [expr {$i_o -1}] + lappend overstacks $o_codestack + lappend overstacks_gx $o_gxstack + + #set replay_codes_overlay [join $o_codestack ""] + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}$o_codestack] + + #if {[dict exists $overstacks $max_overlay_grapheme_index]} { + # set replay_codes_overlay [join [dict get $overstacks $max_overlay_grapheme_index] ""] + #} else { + # set replay_codes_overlay "" + #} + # -- --- --- --- --- --- --- --- + + + #potential problem - combinining diacritics directly following control chars like \r \b + + # -- --- --- + #we need to initialise overflow_idx before any potential row-movements - as they need to perform a loop break and force in_excess to 1 + if {$opt_overflow} { + #somewhat counterintuitively - overflow true means we can have lines as long as we want, but either way there can be excess data that needs to be thrown back to the calling loop. + set overflow_idx -1 + } else { + #overflow zero - we can't grow beyond our column width - so we get ellipsis or truncation + if {$opt_width ne "\uFFEF"} { + set overflow_idx [expr {$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 + } + } + # -- --- --- + + set outcols $undercols ;#leave undercols as is, outcols can potentially be appended to. + + set unapplied "" ;#if we break for move row (but not for /v ?) + set unapplied_list [list] + + set insert_lines_above 0 ;#return key + set insert_lines_below 0 + set instruction "" + + # -- --- --- + #cursor_save_dec, cursor_restore_dec etc + set cursor_restore_required 0 + set cursor_saved_attributes "" + set cursor_saved_position "" + # -- --- --- + + #set idx 0 ;# line index (cursor - 1) + #set idx [expr {$opt_colstart + $opt_colcursor} -1] + + #idx is the per column output index + set idx [expr {$opt_colcursor -1}] ;#don't use opt_colstart here - we have padded and won't start emitting until idx reaches opt_colstart-1 + #cursor_column is usually one above idx - but we have opt_colstart which is like a margin - todo: remove cursor_column from the following loop and calculate it's offset when breaking or at end. + #(for now we are incrementing/decrementing both in sync - which is a bit silly) + set cursor_column $opt_colcursor + + #idx_over is the per grapheme overlay index + set idx_over -1 + + + #movements only occur within the overlay range. + #an underlay is however not necessary.. e.g + #renderline -overflow 1 "" data + #foreach {pt code} $overmap {} + set insert_mode $opt_insert_mode ;#default 1 + set autowrap_mode $opt_autowrap_mode ;#default 1 + + + #puts "-->$overlay_grapheme_control_list<--" + #puts "-->overflow_idx: $overflow_idx" + for {set gci 0} {$gci < [llength $overlay_grapheme_control_list]} {incr gci} { + set gc [lindex $overlay_grapheme_control_list $gci] + lassign $gc type item + + #emit plaintext chars first using existing SGR codes from under/over stack as appropriate + #then check if the following code is a cursor movement within the line and adjust index if so + #foreach ch $overlay_graphemes {} + switch -- $type { + g { + set ch $item + 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 <= $colwidth-1}] + + #https://www.enigma.com/resources/blog/the-secret-world-of-newline-characters + #\x85 NEL in the c1 control set is treated by some terminal emulators (e.g Hyper) as a newline, + #on some it's invisble but doesn't change the line, on some it's a visible glyph of width 1. + #This is hard to process in any standard manner - but I think the Hyper behaviour of doing what it was intended is perhaps most reasonable + #We will map it to the same behaviour as lf here for now... but we need also to consider the equivalent ANSI sequence: \x1bE + + set chtest [string map [list \n \x85 \b \r \v \x7f ] $ch] + #puts --->chtest:$chtest + #specials - each shoud have it's own test of what to do if it happens after overflow_idx reached + switch -- $chtest { + "" { + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + if {$idx == 0} { + #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} { + #linefeed after final column + #puts "---c at overflow_idx=$overflow_idx" + incr cursor_row + 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 { + #linefeed occurred in middle or at end of text + #puts "---mid-or-end-text-linefeed idx:$idx overflow_idx:$overflow_idx" + incr cursor_row + set overflow_idx $idx ;#override overflow_idx even if it was set to -1 due to opt_overflow = 1|2 + set instruction lf_mid + priv::render_unapplied $overlay_grapheme_control_list $gci + break + } + + } + "" { + #will we want/need to use raw for keypresses in terminal? (terminal with LNM in standard reset mode means enter= this is the usual config for terminals) + #So far we are assuming the caller has translated to and handle above.. REVIEW. + + #consider also the old space-carriagereturn softwrap convention used in some terminals. + #In the context of rendering to a block of text - this works similarly in that the space gets eaten so programs emitting space-cr at the terminal width col will pretty much get what they expect. + set idx [expr {$opt_colstart -1}] + set cursor_column $opt_colstart ;#? + } + "" { + #literal backspace char - not necessarily from keyboard + #review - backspace effect on double-width chars - we are taking a column-editing perspective in overtype + #(important for -transparent option - hence replacement chars for half-exposed etc) + #review - overstrike support as per nroff/less (generally considered an old technology replaced by unicode mechanisms and/or ansi SGR) + if {$idx > ($opt_colstart -1)} { + incr idx -1 + incr cursor_column -1 + } else { + set flag 0 + if $flag { + #review - conflicting requirements? Need a different sequence for destructive interactive backspace? + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction backspace_at_start + break + } + } + } + "" { + #literal del character - some terminals send just this for what is generally expected to be a destructive backspace + #We instead treat this as a pure delete at current cursor position - it is up to the repl or terminal to remap backspace key to a sequence that has the desired effect. + priv::render_delchar $idx + } + "" { + #end processing this overline. rest of line is remainder. cursor for column as is. + #REVIEW - this theoretically depends on terminal's vertical tabulation setting (name?) + #e.g it could be configured to jump down 6 rows. + #On the other hand I've seen indications that some modern terminal emulators treat it pretty much as a linefeed. + #todo? + incr cursor_row + set overflow_idx $idx + #idx_over has already been incremented as this is both a movement-control and in some sense a grapheme + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction vt + break + } + default { + if {$overflow_idx != -1} { + #review - how to check arbitrary length item such as tab is going to overflow .. before we get to overflow_idx? + #call grapheme_width_cached on each ch, or look for tab specifically as it's currently the only known reason to have a grapheme width > 2? + #we need to decide what a tab spanning the overflow_idx means and how it affects wrap etc etc + if {$idx == $overflow_idx-1} { + set owidth [grapheme_width_cached $ch] + if {$owidth == 2} { + #review split 2w overflow? + #we don't want to make the decision here to split a 2w into replacement characters at end of line and beginning of next line + #better to consider the overlay char as unable to be applied to the line + #render empty string to column(?) - and reduce overlay grapheme index by one so that the current ch goes into unapplied + #throwing back to caller with instruction complicates its job - but is necessary to avoid making decsions for it here. + priv::render_addchar $idx "" [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + #change the overflow_idx + set overflow_idx $idx + incr idx + incr idx_over -1 ;#set overlay grapheme index back one so that sgr stack from previous overlay grapheme used + priv::render_unapplied $overlay_grapheme_control_list [expr {$gci-1}] ;#note $gci-1 instead of just gci + #throw back to caller's loop - add instruction to caller as this is not the usual case + #caller may for example choose to render a single replacement char to this line and omit the grapheme, or wrap it to the next line + set instruction overflow_splitchar + break + } elseif {$owidth > 2} { + #? tab? + #TODO! + puts stderr "overtype::renderline long overtext grapheme '[ansistring VIEW -lf 1 -vt 1 $ch]' not handled" + #tab of some length dependent on tabstops/elastic tabstop settings? + } + } elseif {$idx >= $overflow_idx} { + #jmn? + set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci-1]] + #set replay_codes_overlay [punk::ansi::codetype::sgr_merge_list {*}[lindex $overlay_grapheme_control_stacks $gci]] + #don't incr idx beyond the overflow_idx + #idx_over already incremented - decrement so current overlay grapheme stacks go to unapplied + incr idx_over -1 + #priv::render_unapplied $overlay_grapheme_control_list [expr {$gci-1}] ;#back one index here too + priv::render_this_unapplied $overlay_grapheme_control_list $gci ;# + set instruction overflow + break + } + } else { + #review. + #This corresponds to opt_overflow being true (at least until overflow_idx is in some cases forced to a value when throwing back to calling loop) + } + + if {($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) + if {$idx > [llength $outcols]-1} { + lappend outcols " " + #dict set understacks $idx [list] ;#review - use idx-1 codestack? + lset understacks $idx [list] + incr idx + incr cursor_column + } else { + #todo - punk::char::char_width + set g [lindex $outcols $idx] + set uwidth [grapheme_width_cached $g] + if {[lindex $outcols $idx] eq ""} { + #2nd col of 2-wide char in underlay + incr idx + incr cursor_column + } elseif {$uwidth == 0} { + #e.g control char ? combining diacritic ? + incr idx + incr cursor_column + } elseif {$uwidth == 1} { + set owidth [grapheme_width_cached $ch] + incr idx + incr cursor_column + if {$owidth > 1} { + incr idx + incr cursor_column + } + } elseif {$uwidth > 1} { + if {[grapheme_width_cached $ch] == 1} { + if {!$insert_mode} { + #normal singlewide transparent overlay onto double-wide underlay + set next_pt_overchar [string index $pt_overchars $idx_over+1] ;#lookahead of next plain-text char in overlay + if {$next_pt_overchar eq ""} { + #special-case trailing transparent - no next_pt_overchar + incr idx + incr cursor_column + } else { + if {[regexp $opt_transparent $next_pt_overchar]} { + incr idx + incr cursor_column + } else { + #next overlay char is not transparent.. first-half of underlying 2wide char is exposed + #priv::render_addchar $idx $opt_exposed1 [dict get $overstacks $idx_over] [dict get $overstacks_gx $idx_over] $insert_mode + priv::render_addchar $idx $opt_exposed1 [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + incr cursor_column + } + } + } else { + #? todo - decide what transparency even means for insert mode + incr idx + incr cursor_column + } + } else { + #2wide transparency over 2wide in underlay - review + incr idx + incr cursor_column + } + } + } + } else { + + set idxchar [lindex $outcols $idx] + #non-transparent char in overlay or empty cell + if {$idxchar eq "\u0000"} { + #empty/erased cell indicator + set uwidth 1 + } else { + set uwidth [grapheme_width_cached $idxchar] + } + if {$within_undercols} { + if {$idxchar eq ""} { + #2nd col of 2wide char in underlay + if {!$insert_mode} { + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] 0 + #JMN - this has to expose if our startposn chopped an underlay - but not if we already overwrote the first half of the widechar underlay grapheme + #e.g renderline \uFF21\uFF21--- a\uFF23\uFF23 + #vs + # renderline -startcolumn 2 \uFF21---- \uFF23 + if {[lindex $outcols $idx-1] != ""} { + #verified it's an empty following a filled - so it's a legit underlay remnant (REVIEW - when would it not be??) + #reset previous to an exposed 1st-half - but leave understacks code as is + priv::render_addchar [expr {$idx-1}] $opt_exposed1 [lindex $understacks $idx-1] [lindex $understacks_gx $idx-1] 0 + } + incr idx + } else { + set prevcolinfo [lindex $outcols $idx-1] + #for insert mode - first replace the empty 2ndhalf char with exposed2 before shifting it right + #REVIEW - this leaves a replacement character permanently in our columns.. but it is consistent regarding length (?) + #The alternative is to disallow insertion at a column cursor that is at 2nd half of 2wide char + #perhaps by inserting after the char - this may be worthwhile - but may cause other surprises + #It is perhaps best avoided at another level and try to make renderline do exactly as it's told + #the advantage of this 2w splitting method is that the inserted character ends up in exactly the column we expect. + priv::render_addchar $idx $opt_exposed2 [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] 0 ;#replace not insert + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] 1 ;#insert - same index + if {$prevcolinfo ne ""} { + #we've split the 2wide - it may already have been rendered as an exposed1 - but not for example if our startcolumn was current idx + priv::render_addchar [expr {$idx-1}] $opt_exposed1 [lindex $understacks $idx-1] [lindex $understacks_gx $idx-1] 0 ;#replace not insert + } ;# else?? + incr idx + } + if {$cursor_column < [llength $outcols] || $overflow_idx == -1} { + incr cursor_column + } + } elseif {$uwidth == 0} { + #what if this is some other c0/c1 control we haven't handled specifically? + + #by emitting a preceding empty-string column - we associate whatever this char is with the preceeding non-zero-length character and any existing zero-lengths that follow it + #e.g combining diacritic - increment before over char REVIEW + #arguably the previous overchar should have done this - ie lookahead for combiners? + #if we can get a proper grapheme_split function - this should be easier to tidy up. + priv::render_addchar $idx "" [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + incr cursor_column 2 + + if {$cursor_column > [llength $outcols] && $overflow_idx != -1} { + set cursor_column [llength $outcols] + } + } elseif {$uwidth == 1} { + #includes null empty cells + set owidth [grapheme_width_cached $ch] + if {$owidth == 1} { + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + } else { + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + priv::render_addchar $idx "" [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + #if next column in underlay empty - we've overwritten first half of underlying 2wide grapheme + #replace with rhs exposure in case there are no more overlay graphemes coming - use underlay's stack + if {([llength $outcols] >= $idx +2) && [lindex $outcols $idx+1] eq ""} { + priv::render_addchar [expr {$idx+1}] $opt_exposed2 [lindex $understacks $idx+1] [lindex $understacks_gx $idx+1] $insert_mode + } + incr idx + } + if {($cursor_column < [llength $outcols]) || $overflow_idx == -1 || $test_mode} { + incr cursor_column + } + } elseif {$uwidth > 1} { + set owidth [grapheme_width_cached $ch] + if {$owidth == 1} { + #1wide over 2wide in underlay + if {!$insert_mode} { + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + incr cursor_column + priv::render_addchar $idx $opt_exposed2 [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + #don't incr idx - we are just putting a broken-indication in the underlay - which may get overwritten by next overlay char + } else { + #insert mode just pushes all to right - no exposition char here + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx + incr cursor_column + } + } else { + #2wide over 2wide + priv::render_addchar $idx $ch [lindex $overstacks $idx_over] [lindex $overstacks_gx $idx_over] $insert_mode + incr idx 2 + incr cursor_column 2 + } + + if {$cursor_column > [llength $outcols] && $overflow_idx != -1} { + set cursor_column [llength $outcols] + } + } + } else { + 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 && !$test_mode} { + #overflow + if {$cursor_column > [llength $outcols]} { + set cursor_column [llength $outcols] + } + } + } + } + } + } ;# end switch + + + } + other { + set code $item + #since this element isn't a grapheme - advance idx_over to next grapheme overlay when about to fill 'unapplied' + + set re_mode {\x1b\[\?([0-9]*)(h|l)} ;#e.g DECAWM + set re_col_move {\x1b\[([0-9]*)(C|D|G)$} + set re_row_move {\x1b\[([0-9]*)(A|B)$} + set re_both_move {\x1b\[([0-9]*)(?:;){0,1}([0-9]*)H$} ;# or "f" ? + set re_vt_sequence {\x1b\[([0-9]*)(?:;){0,1}([0-9]*)~$} + set re_cursor_save {\x1b\[s$} ;#note probable incompatibility with DECSLRM (set left right margin)! + set re_cursor_restore {\x1b\[u$} + set re_cursor_save_dec {\x1b7$} + set re_cursor_restore_dec {\x1b8$} + set re_other_single {\x1b(D|M|E)$} + set re_decstbm {\x1b\[([0-9]*)(?:;){0,1}([0-9]*)r$} ;#DECSTBM set top and bottom margins + set matchinfo [list] + + #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? + + #todo - consider CSI s DECSLRM vs ansi.sys \x1b\[s - we need \x1b\[s for oldschool ansi art - but may have to enable only for that. + #we should probably therefore reverse this mapping so that x1b7 x1b8 are the primary codes for save/restore + set code [string map [list \x1b7 \x1b\[s \x1b8 \x1b\[u ] $code] + + + set c1 [string index $code 0] + set c1c2c3 [string range $code 0 2] + #set re_ST_open {(?:\033P|\u0090|\033X|\u0098|\033\^|\u009e|\033_|\u009f)} + set leadernorm [string range [string map [list\ + \x1b\[< 1006\ + \x1b\[ 7CSI\ + \x9b 8CSI\ + \x1b\] 7OSC\ + \x9d 8OSC\ + \x1b 7ESC\ + ] $c1c2c3] 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 { + 1006 { + #https://invisible-island.net/xterm/ctlseqs/ctlseqs.html + #SGR (1006) CSI < followed by colon separated encoded-button-value,px,py ordinates and final M for button press m for button release + set codenorm [string cat $leadernorm [string range $code 3 end]] + } + 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 { + 1006 { + #TODO + # + switch -- [string index $codenorm end] { + M { + puts stderr "mousedown $codenorm" + } + m { + puts stderr "mouseup $codenorm" + } + } + + } + {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 + 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 { + #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]] + #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 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] + } 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" + } + 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 + + + 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 + + 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 + } + + incr idx_over + priv::render_unapplied $overlay_grapheme_control_list $gci + set instruction move + break + + } + X { + puts stderr "X - $param" + #ECH - erase character + if {$param eq "" || $param eq "0"} {set param 1}; #param=count of chars to erase + priv::render_erasechar $idx $param + #cursor position doesn't change. + } + 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 + } + s { + # - todo - make ansi.sys CSI s cursor save only apply for certain cases? - may need to support DECSLRM instead which uses same code + + #$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] + + #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 + + } + 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 "" + set unapplied_list [list] + foreach gc [lrange $overlay_grapheme_control_list $gci+1 end] { + lassign $gc type item + if {$type eq "gx0"} { + if {$item eq "gx0_on"} { + lappend unapplied_list "\x1b(0" + } elseif {$item eq "gx0_off"} { + lappend unapplied_list "\x1b(B" + } + } else { + lappend unapplied_list $item + } + #incr idx_over + } + set unapplied [join $unapplied_list ""] + #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_vt_sequence + #lassign $matchinfo _match key mod + lassign [split $param {;}] 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(?) + } + } + } 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 + } + + } + 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 + + } + } + } + + } else { + puts stderr "overtype::renderline CSI...h|l code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code] not implemented" + } + } + 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 + } + #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 { + #\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" + } + } + + } + } + + #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 + #we have our sgr gx0 codes already in stacks for each overlay grapheme + } + } + } + + #-------- + if {$opt_overflow == 0} { + #need to truncate to the width of the original undertext + #review - string_width vs printing_length here. undertext requirement to be already rendered therefore punk::char::string_width ok? + #set num_under_columns [punk::char::string_width $pt_underchars] ;#plaintext underchars + } + if {$overflow_idx == -1} { + #overflow was initially unlimited and hasn't been overridden + } else { + + } + #-------- + + + #coalesce and replay codestacks for outcols grapheme list + set outstring "" ;#output prior to overflow + set overflow_right "" ;#remainder after overflow point reached + set i 0 + set cstack [list] + set prevstack [list] + set prev_g0 [list] + #note overflow_idx may already have been set lower if we had a row move above due to \v or ANSI moves + set in_overflow 0 ;#used to stop char-width scanning once in overflow + if {$overflow_idx == 0} { + #how does caller avoid an infinite loop if they have autowrap on and keep throwing graphemes to the next line? REVIEW + set in_overflow 1 + } + foreach ch $outcols { + #puts "---- [ansistring VIEW $ch]" + + set gxleader "" + if {$i < [llength $understacks_gx]} { + #set g0 [dict get $understacks_gx $i] + set g0 [lindex $understacks_gx $i] + if {$g0 ne $prev_g0} { + if {$g0 eq [list "gx0_on"]} { + set gxleader "\x1b(0" + } else { + set gxleader "\x1b(B" + } + } + set prev_g0 $g0 + } else { + set prev_g0 [list] + } + + set sgrleader "" + if {$i < [llength $understacks]} { + #set cstack [dict get $understacks $i] + set cstack [lindex $understacks $i] + if {$cstack ne $prevstack} { + if {[llength $prevstack] && ![llength $cstack]} { + #This reset is important e.g testfile fruit.ans - we get overhang on rhs without it. But why is cstack empty? + append sgrleader \033\[m + } else { + append sgrleader [punk::ansi::codetype::sgr_merge_list {*}$cstack] + } + } + set prevstack $cstack + } else { + set prevstack [list] + } + + + + if {$in_overflow} { + if {$i == $overflow_idx} { + set 0 [lindex $understacks_gx $i] + set gxleader "" + if {$g0 eq [list "gx0_on"]} { + set gxleader "\x1b(0" + } elseif {$g0 eq [list "gx0_off"]} { + set gxleader "\x1b(B" + } + append overflow_right $gxleader + set cstack [lindex $understacks $i] + set sgrleader "" + #whether cstack is same or differs from previous char's stack - we must have an output at the start of the overflow_right + #if {[llength $prevstack] && ![llength $cstack]} { + # append sgrleader \033\[m + #} + append sgrleader [punk::ansi::codetype::sgr_merge_list {*}$cstack] + append overflow_right $sgrleader + append overflow_right $ch + } else { + append overflow_right $gxleader + append overflow_right $sgrleader + append overflow_right $ch + } + } else { + if {$overflow_idx != -1 && $i+1 == $overflow_idx} { + #one before overflow + #will be in overflow in next iteration + set in_overflow 1 + if {[grapheme_width_cached $ch]> 1} { + #we overflowed with second-half of a double-width char - replace first-half with user-supplied exposition char (should be 1 wide) + set ch $opt_exposed1 + } + } + append outstring $gxleader + append outstring $sgrleader + if {$idx+1 < $cursor_column} { + append outstring [string map [list "\u0000" " "] $ch] + } else { + append outstring $ch + } + } + incr i + } + #flower.ans good test for null handling - reverse line building + if {![ansistring length $overflow_right]} { + set outstring [string trimright $outstring "\u0000"] + } + set outstring [string map [list "\u0000" " "] $outstring] + set overflow_right [string trimright $overflow_right "\u0000"] + set overflow_right [string map [list "\u0000" " "] $overflow_right] + + set replay_codes "" + if {[llength $understacks] > 0} { + if {$overflow_idx == -1} { + #set tail_idx [dict size $understacks] + set tail_idx [llength $understacks] + } else { + set tail_idx [llength $undercols] + } + if {$tail_idx-1 < [llength $understacks]} { + #set replay_codes [join [lindex $understacks $tail_idx-1] ""] ;#tail replay codes + set replay_codes [punk::ansi::codetype::sgr_merge_list {*}[lindex $understacks $tail_idx-1]] ;#tail replay codes + } + if {$tail_idx-1 < [llength $understacks_gx]} { + set gx0 [lindex $understacks_gx $tail_idx-1] + if {$gx0 eq [list "gx0_on"]} { + #if it was on, turn gx0 off at the point we stop processing overlay + append outstring "\x1b(B" + } + } + } + if {[string length $overflow_right]} { + #puts stderr "remainder:$overflow_right" + } + #pdict $understacks + if {[punk::ansi::ta::detect_sgr $outstring]} { + append outstring [punk::ansi::a] + #close off any open gx? + #probably should - and overflow_right reopen? + } + + if {$opt_returnextra} { + #replay_codes is the codestack at the boundary - used for ellipsis colouring to match elided text - review + #replay_codes_underlay is the set of codes in effect at the very end of the original underlay + + #review + #replay_codes_overlay is the set of codes in effect at the very end of the original overlay (even if not all overlay was applied) + #todo - replay_codes for gx0 mode + + #overflow_idx may change during ansi & character processing + if {$overflow_idx == -1} { + set overflow_right_column "" + } else { + set overflow_right_column [expr {$overflow_idx+1}] + } + set result [dict create\ + result $outstring\ + visualwidth [punk::ansi::printing_length $outstring]\ + instruction $instruction\ + stringlen [string length $outstring]\ + overflow_right_column $overflow_right_column\ + overflow_right $overflow_right\ + unapplied $unapplied\ + unapplied_list $unapplied_list\ + insert_mode $insert_mode\ + autowrap_mode $autowrap_mode\ + insert_lines_above $insert_lines_above\ + insert_lines_below $insert_lines_below\ + cursor_saved_position $cursor_saved_position\ + cursor_saved_attributes $cursor_saved_attributes\ + cursor_column $cursor_column\ + cursor_row $cursor_row\ + opt_overflow $opt_overflow\ + replay_codes $replay_codes\ + replay_codes_underlay $replay_codes_underlay\ + replay_codes_overlay $replay_codes_overlay\ + ] + if {$opt_returnextra == 1} { + return $result + } else { + #human/debug - map special chars to visual glyphs + set viewop VIEW + switch -- $opt_returnextra { + 2 { + #codes and character data + set viewop VIEWCODES ;#ansi colorisation of codes - green for SGR, blue/blue reverse for cursor_save/cursor_restore, cyan for movements, orange for others + } + 3 { + set viewop VIEWSTYLE ;#ansi colorise the characters within the output with preceding codes, stacking codes only within each dict value - may not be same SGR effect as the effect in-situ. + } + } + dict set result result [ansistring $viewop -lf 1 -vt 1 [dict get $result result]] + dict set result overflow_right [ansistring VIEW -lf 1 -vt 1 [dict get $result overflow_right]] + dict set result unapplied [ansistring VIEW -lf 1 -vt 1 [dict get $result unapplied]] + dict set result unapplied_list [ansistring VIEW -lf 1 -vt 1 [dict get $result unapplied_list]] + dict set result replay_codes [ansistring $viewop -lf 1 -vt 1 [dict get $result replay_codes]] + dict set result replay_codes_underlay [ansistring $viewop -lf 1 -vt 1 [dict get $result replay_codes_underlay]] + dict set result replay_codes_overlay [ansistring $viewop -lf 1 -vt 1 [dict get $result replay_codes_overlay]] + dict set result cursor_saved_attributes [ansistring $viewop -lf 1 -vt 1 [dict get $result cursor_saved_attributes]] + return $result + } + } else { + return $outstring + } + #return [join $out ""] +} +proc overtype::test_renderline {} { + set t \uFF5E ;#2-wide tilde + set u \uFF3F ;#2-wide underscore + set missing \uFFFD + return [list $t $u A${t}B] +} + +#maintenance warning +#same as textblock::size - but we don't want that circular dependency +#block width and height can be tricky. e.g \v handled differently on different terminal emulators and can affect both +proc overtype::blocksize {textblock} { + if {$textblock eq ""} { + return [dict create width 0 height 1] ;#no such thing as zero-height block - for consistency with non-empty strings having no line-endings + } + if {[string first \t $textblock] >= 0} { + if {[info exists punk::console::tabwidth]} { + set tw $::punk::console::tabwidth + } else { + set tw 8 + } + set textblock [textutil::tabify::untabify2 $textblock $tw] + } + #stripansi on entire block in one go rather than line by line - result should be the same - review - make tests + if {[punk::ansi::ta::detect $textblock]} { + set textblock [punk::ansi::stripansi $textblock] + } + if {[string first \n $textblock] >= 0} { + set num_le [expr {[string length $textblock]-[string length [string map [list \n {}] $textblock]]}] ;#faster than splitting into single-char list + set width [tcl::mathfunc::max {*}[lmap v [split $textblock \n] {::punk::char::ansifreestring_width $v}]] + } else { + set num_le 0 + set width [punk::char::ansifreestring_width $textblock] + } + #our concept of block-height is likely to be different to other line-counting mechanisms + set height [expr {$num_le + 1}] ;# one line if no le - 2 if there is one trailing le even if no data follows le + + return [dict create width $width height $height] ;#maintain order in 'image processing' standard width then height - caller may use lassign [dict values [blocksize ]] width height +} + +namespace eval overtype::priv { + variable cache_is_sgr [dict create] + + #we are likely to be asking the same question of the same ansi codes repeatedly + #caching the answer saves some regex expense - possibly a few uS to lookup vs under 1uS + #todo - test if still worthwhile after a large cache is built up. (limit cache size?) + proc is_sgr {code} { + variable cache_is_sgr + if {[dict exists $cache_is_sgr $code]} { + return [dict get $cache_is_sgr $code] + } + set answer [punk::ansi::codetype::is_sgr $code] + dict set cache_is_sgr $code $answer + return $answer + } + proc render_unapplied {overlay_grapheme_control_list gci} { + upvar idx_over idx_over + upvar unapplied unapplied + upvar unapplied_list unapplied_list ;#maintaining as a list allows caller to utilize it without having to re-split + upvar overstacks overstacks + upvar overstacks_gx overstacks_gx + upvar overlay_grapheme_control_stacks og_stacks + + #set unapplied [join [lrange $overlay_grapheme_control_list $gci+1 end]] + set unapplied "" + set unapplied_list [list] + #append unapplied [join [lindex $overstacks $idx_over] ""] + #append unapplied [punk::ansi::codetype::sgr_merge_list {*}[lindex $overstacks $idx_over]] + set sgr_merged [punk::ansi::codetype::sgr_merge_list {*}[lindex $og_stacks $gci]] + if {$sgr_merged ne ""} { + lappend unapplied_list $sgr_merged + } + switch -- [lindex $overstacks_gx $idx_over] { + "gx0_on" { + lappend unapplied_list "\x1b(0" + } + "gx0_off" { + lappend unapplied_list "\x1b(B" + } + } + + foreach gc [lrange $overlay_grapheme_control_list $gci+1 end] { + lassign $gc type item + #types g other sgr gx0 + if {$type eq "gx0"} { + if {$item eq "gx0_on"} { + lappend unapplied_list "\x1b(0" + } elseif {$item eq "gx0_off"} { + lappend unapplied_list "\x1b(B" + } + } else { + lappend unapplied_list $item + } + } + set unapplied [join $unapplied_list ""] + } + + #clearer - renders the specific gci forward as unapplied - prefixed with it's merged sgr stack + proc render_this_unapplied {overlay_grapheme_control_list gci} { + upvar idx_over idx_over + upvar unapplied unapplied + upvar unapplied_list unapplied_list + upvar overstacks overstacks + upvar overstacks_gx overstacks_gx + upvar overlay_grapheme_control_stacks og_stacks + + #set unapplied [join [lrange $overlay_grapheme_control_list $gci+1 end]] + set unapplied "" + set unapplied_list [list] + + set sgr_merged [punk::ansi::codetype::sgr_merge_list {*}[lindex $og_stacks $gci]] + if {$sgr_merged ne ""} { + lappend unapplied_list $sgr_merged + } + switch -- [lindex $overstacks_gx $idx_over] { + "gx0_on" { + lappend unapplied_list "\x1b(0" + } + "gx0_off" { + lappend unapplied_list "\x1b(B" + } + } + + foreach gc [lrange $overlay_grapheme_control_list $gci end] { + lassign $gc type item + #types g other sgr gx0 + if {$type eq "gx0"} { + if {$item eq "gx0_on"} { + lappend unapplied_list "\x1b(0" + } elseif {$item eq "gx0_off"} { + lappend unapplied_list "\x1b(B" + } + } else { + lappend unapplied_list $item + } + } + set unapplied [join $unapplied_list ""] + } + proc render_delchar {i} { + upvar outcols o + upvar understacks ustacks + upvar understacks_gx gxstacks + set nxt [llength $o] + if {$i < $nxt} { + set o [lreplace $o $i $i] + set ustacks [lreplace $ustacks $i $i] + set gxstacks [lreplace $gxstacks $i $i] + } else { + + } + } + proc render_erasechar {i count} { + upvar outcols o + upvar understacks ustacks + upvar understacks_gx gxstacks + #ECH clears character attributes from erased character positions + #ECH accepts 0 or empty parameter, which is equivalent to 1. Caller should do that mapping and only supply 1 or greater. + if {![string is integer -strict $count] || $count < 1} { + error "render_erasechar count must be integer >= 1" + } + set start $i + set end [expr {$i + $count -1}] + #we restrict ECH to current line - as some terminals do - review - is that the only way it's implemented? + if {$i > [llength $o]-1} { + return + } + if {$end > [llength $o]-1} { + set end [expr {[llength $o]-1}] + } + set num [expr {$end - $start + 1}] + set o [lreplace $o $start $end {*}[lrepeat $num \u0000]] ;#or space? + set ustacks [lreplace $ustacks $start $end {*}[lrepeat $num [list]]] + set gxstacks [lreplace $gxstacks $start $end {*}[lrepeat $num [list]]] + return + } + proc render_setchar {i c } { + upvar outcols o + lset o $i $c + } + #is actually addgrapheme? + proc render_addchar {i c sgrstack gx0stack {insert_mode 0}} { + upvar outcols o + upvar understacks ustacks + upvar understacks_gx gxstacks + + if 0 { + if {$c eq "c"} { + puts "i:$i c:$c sgrstack:[ansistring VIEW $sgrstack]" + puts "understacks:[ansistring VIEW $ustacks]" + upvar overstacks overstacks + puts "overstacks:[ansistring VIEW $overstacks]" + puts "info level 0:[info level 0]" + } + } + + set nxt [llength $o] + if {!$insert_mode} { + if {$i < $nxt} { + #These lists must always be in sync + lset o $i $c + } else { + lappend o $c + } + if {$i < [llength $ustacks]} { + lset ustacks $i $sgrstack + lset gxstacks $i $gx0stack + } else { + lappend ustacks $sgrstack + lappend gxstacks $gx0stack + } + } else { + #insert of single-width vs double-width when underlying is double-width? + if {$i < $nxt} { + set o [linsert $o $i $c] + } else { + lappend o $c + } + if {$i < [llength $ustacks]} { + set ustacks [linsert $ustacks $i $sgrstack] + set gxstacks [linsert $gxstacks $i $gx0stack] + } else { + lappend ustacks $sgrstack + lappend gxstacks $gx0stack + } + } + } + +} + + + +# -- --- --- --- --- --- --- --- --- --- --- +namespace eval overtype { + interp alias {} ::overtype::center {} ::overtype::centre +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide overtype [namespace eval overtype { + variable version + set version 1.6.1 +}] +return + +#*** !doctools +#[manpage_end]