From ce9c53cb34aa1a4d110d03771ae6816167c377b3 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sun, 28 Dec 2025 02:10:44 +1100 Subject: [PATCH] ansi DEC modes, DECRQSS+DECRPSS, minor sixel work --- src/bootsupport/modules/overtype-1.7.4.tm | 115 ++++++++++++- src/bootsupport/modules/punk/ansi-0.1.1.tm | 15 +- src/bootsupport/modules/punk/console-0.1.1.tm | 160 ++++++++++++++++++ src/modules/overtype-999999.0a1.0.tm | 115 ++++++++++++- src/modules/punk/ansi-999999.0a1.0.tm | 15 +- src/modules/punk/console-999999.0a1.0.tm | 160 ++++++++++++++++++ src/modules/punk/sixel-999999.0a1.0.tm | 58 ++++++- .../src/bootsupport/modules/overtype-1.7.4.tm | 115 ++++++++++++- .../bootsupport/modules/punk/ansi-0.1.1.tm | 15 +- .../bootsupport/modules/punk/console-0.1.1.tm | 160 ++++++++++++++++++ .../src/bootsupport/modules/overtype-1.7.4.tm | 115 ++++++++++++- .../bootsupport/modules/punk/ansi-0.1.1.tm | 15 +- .../bootsupport/modules/punk/console-0.1.1.tm | 160 ++++++++++++++++++ .../_vfscommon.vfs/modules/overtype-1.7.4.tm | 115 ++++++++++++- .../_vfscommon.vfs/modules/punk/ansi-0.1.1.tm | 15 +- .../modules/punk/console-0.1.1.tm | 160 ++++++++++++++++++ .../modules/punk/sixel-0.1.0.tm | 58 ++++++- 17 files changed, 1519 insertions(+), 47 deletions(-) diff --git a/src/bootsupport/modules/overtype-1.7.4.tm b/src/bootsupport/modules/overtype-1.7.4.tm index e4ea54d7..d3a642da 100644 --- a/src/bootsupport/modules/overtype-1.7.4.tm +++ b/src/bootsupport/modules/overtype-1.7.4.tm @@ -3327,10 +3327,12 @@ tcl::namespace::eval overtype { } 7DCS { #ESC P + #e.g sixel #Device Control String https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h4-Controls-beginning-with-ESC:ESC-F.C74 set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 2 end]] } 8DCS { + #e.g sixel #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } @@ -4466,14 +4468,115 @@ tcl::namespace::eval overtype { } 7DCS - 8DCS { - puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" - #ST (string terminator) \x9c or \x1b\\ - if {[tcl::string::index $codenorm end] eq "\x9c"} { - set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + #match 'DCS P1 ; P2 ; P3' (without spaces) + # where Ps1,P2,P3 are all optional and P1,P2 are single digit and P3 can *technically* be any positive integer but is usually ignored (commonly set to zero) + # Our regexp isn't precise as we will validate number of params and values after matching - but we will assume P3 should be small (review for micrometres - could be 4 digits? more?) + # (limit to 10 chars to avoid insane values?) + #https://github.com/hackerb9/vt340test/blob/main/physicalsixels.md + # P1P2P3q - "Protocol Selector" + # P1 - Pixel Aspect Ratio (Vertical:Horizontal) + # P2 - background control + # P3 - horizontal grid size (default units decipoints 1/720 inch - but theoretically controlled by ANSI SSU sequence) + # P1P2P3 commonly omitted - with subsequent P4;P5;P6;P7 "Raster Attributes (DECGRA)" being used for: + # Aspect Ratio (P4,P5) + set sixelstart [tcl::string::range $codenorm 4 13] + set sixelmatch [regexp -all -inline {^((?:[0-9]*;){0,2}(?:[0-9]*))q} $sixelstart] + if {[llength $sixelmatch] == 2} { + #sixel + #note sixel data can have newlines before ST + set sixelparams [lindex $sixelmatch 1] + set params [split $sixelparams {;}] + set badsixelparams 0 + if {[llength $params] > 3} { + set badsixelparams 1 + } + lassign $params P1 P2 P3 + if {[string length $P1] > 1 || [string length $P2] > 1 || [string length $P3] > 3} { + set badsixelparams 1 + } + if {$badsixelparams} { + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but bad params. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } else { + #todo - move to punk::sixel library + + #P1 - Pixel Aspect Ratio + # round(10/P1):1 if 2<= P1 <= 9) 2:1 otherwise + # omitted 2:1 (default) + # 0,1 2:1 + # 2 5:1 + # 3,4 3:1 + # 5,6 2:1 + # 7,8,9 1:1 + switch -- $P1 { + "" - 0 - 1 { + #omitted (default) + set sixel_pixel_aspect "2:1" + } + 2 { + set sixel_pixel_aspect "5:1" + } + 3 - 4 { + set sixel_pixel_aspect "3:1" + } + 5 - 6 { + set sixel_pixel_aspect "2:1" + } + 7 - 8 - 9 { + set sixel_pixel_aspect "1:1" + } + default { + set sixel_pixel_aspect "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P1 (pixel aspect ratio). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + #P2 - background colour + # 0,2 (default) pixel positions specified as 0 are set to current bg colour + # 1 pixel positions specified as 0 remain at current colour + switch -- $P2 { + "" - 0 - 2 { + set sixel_background "current_background" + } + 1 { + set sixel_background "transparent" + } + default { + set sixel_background "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P2 (background control). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + + #P3 horizontal grid size - ignored on VT300 - commonly set to zero + + # ECMA-48 SSU (ESC Ps I) + # 0 - CHARACTER + # 1 - MILLIMETRE + # 2 - COMPUTER DECIPOINT 0.03528mm 1/720 of 25.4mm) + # 3 - DECIDIDOT 0.03759mm (10/266mm) + # 4 - MIL 0.0254mm (1/1000 of 25.4mm) + # 5 - BASIC MEASURING UNIT (BMU) 0.02117mm (1/1200 of 25.4mm) + # 6 - MICROMETRE 0.001mm + # 7 - PIXEL - the smallest increment that can be specified in a device + # 8 - DECIPOINT - 0.03514mm (35/996mm) + set sixel_horizontal_grid $P3 + set sixel_ssu "decipoint" ;#todo? + + #todo - look for and parse DECGRA introduced by double quote + puts stderr "overtype::renderline SIXEL aspect: $sixel_pixel_aspect bg: $sixel_background hgrid: $sixel_horizontal_grid. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + + + #todo + } } else { - set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" + #ST (string terminator) \x9c or \x1b\\ + if {[tcl::string::index $codenorm end] eq "\x9c"} { + set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + } else { + set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + } } - } 7OSC - 8OSC { # OSCs are terminated with ST of either \007 or \x1b\\ - we allow either whether code was 7 or 8 bit diff --git a/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/bootsupport/modules/punk/ansi-0.1.1.tm index 45f53981..69affd9b 100644 --- a/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -5039,6 +5039,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # mouse_urxvt 1015\ # mouse_sgr_pixel 1016\ #] + # + # some more ansi mode/sequence info: + #https://pkg.go.dev/github.com/charmbracelet/x/ansi + variable decmode_data { 1 { {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} @@ -5059,6 +5063,9 @@ In VT52 mode - use \x1b< to exit. 5 { {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} } + 6 { + {origin DEC description "DECOM - Origin Mode (whether cursor is restricted to within page margins)" names {DECOM}} + } 7 { {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} } @@ -5090,7 +5097,13 @@ be as if this was off - ie lone CR. {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} } 66 { - {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + {origin DEC description "DECNKM - Numeric Keypad Mode" see "https://vt100.net/docs/vt510-rm/DECNKM.html" names {DECNKM}} + } + 67 { + {origin DEC description "DECBKM - Backarrow Key Mode" see "https://vt100.net/docs/vt510-rm/DECBKM.html" names {DECBKM}} + } + 69 { + {origin DEC description "DECLRMM - Left Right Margin Mode" see "https://vt100.net/docs/vt510-rm/DECLRMM.html" names {DECLRMM}} } 1000 { {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { diff --git a/src/bootsupport/modules/punk/console-0.1.1.tm b/src/bootsupport/modules/punk/console-0.1.1.tm index 3bbc65cf..b62c497b 100644 --- a/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/bootsupport/modules/punk/console-0.1.1.tm @@ -570,6 +570,14 @@ namespace eval punk::console { puts -nonewline stdout \x1b\[?1006l flush stdout } + proc enable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000h\x1b\[?1003h\x1b\[?1016h + flush stdout + } + proc disable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000l\x1b\[?1003l\x1b\[?1016l + flush stdout + } proc enable_bracketed_paste {} { puts -nonewline stdout \x1b\[?2004h } @@ -1762,6 +1770,158 @@ namespace eval punk::console { puts -nonewline "\x1b\[?${m}l" } + variable has_mode_cache + set has_mode_cache [dict create] + lappend PUNKARGS [list { + @id -id ::punk::console::has_mode + @cmd -name punk::console::has_mode\ + -summary\ + {Check if console supports DEC mode}\ + -help\ + {Check if console supports DEC mode by emitting query to the console using + the sequence: + ESC [ ? $ p + Where is an integer identifier. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + -refresh -type none + @values -min 1 -max 1 + mode -type {int|string} -help\ + "integer for DEC mode, or name as in the dict: + ::punk::ansi::decmode_names" + }] + proc has_mode {args} { + set argd [punk::args::parse $args withid ::punk::console::has_mode] + lassign [dict values $argd] leaders opts values received + set console [dict get $opts -console] + set num_or_name [dict get $values mode] + if {[dict exists $received -refresh]} { + set do_refresh 1 + } else { + set do_refresh 0 + } + + if {[string is integer -strict $num_or_name]} { + set m $num_or_name + } else { + upvar ::punk::ansi::decmode_names decmode_names + if {[dict exists $decmode_names $num_or_name]} { + set m [dict get $decmode_names $num_or_name] + } else { + error "punk::console::get_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" + } + } + variable has_mode_cache + if {$do_refresh} { + if {[dict exists $has_mode_cache $console $m]} { + dict unset has_mode_cache $console $m + } + } + + if {![dict exists $has_mode_cache $console $m]} { + set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload + set request "\x1b\[?$m\$p" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set has_mode [expr {$payload != 0}] + dict set has_mode_cache $console $m $has_mode + } else { + set has_mode [dict get $has_mode_cache $console $m] + } + return $has_mode + } + + set DECRQSS_DATA { + "Select Active Status Display" DECSASD "$\}" + "Select Attribute Change Extent" DECSACE "*x" + "Set Character Attribute" DECSCA "\"q" + "Set Conformance Level" DECSCL "\"p" + "Set Columns Per Page" DECSCPP "\$|" + "Set Lines Per Page" DECSLPP "t" + "Set Number of Lines per Screen" DECSNLS "*|" + "Set Status Line Type" DECSSDT "$~" + "Set Left and Right Margins" DECSLRM "s" + "Set Top and Bottom Margins" DECSTBM "r" + "Set Graphic Rendition" SGR "m" + "Select Set-Up Language" DECSSL "p" + "Select Printer Type" DECSPRTT "\$s" + "Select Refresh Rate" DECSRFR "\"t" + "Select Digital Printed Data Type" DECSDPT "(p" + "Select ProPrinter Character Set" DECSPPCS "*p" + "Select Communication Speed" DECSCS "*r" + "Select Communication Port" DECSCP "*u" + "Set Scroll Speed" DECSSCLS " p" + "Set Cursor Style" DECSCUSR " q" + "Set Key Click Volume" DECSKCV " r" + "Set Warning Bell Volume" DECSWBV " t" + "Set Margin Bell Volume" DECSMBV " u" + "Set Lock Key Style" DECSLCK " v" + "Select Flow Control Type" DECSFC "*s" + "Select Disconnect Delay Time" DECSDDT "\$q" + "Set Transmit Rate Limit" DECSTRL "u" + "Set Port Parameter" DECSPP "\+w" + } + set DECRQSS_DICT [dict create] + foreach {desc name str} $DECRQSS_DATA { + dict set DECRQSS_DICT $name $str + } + + #emit DECRQSS and get DECRPSS response + # --------------------- + #NOTE: https://vt100.net/docs/vt510-rm/DECRPSS.html + #response: DCS Ps $ r D...D ST + #Conflict between above doc saying Ps of 0 indicates a valid request and 1 indicates invalid - and the behaviour of windows terminal, wezterm and the reported xterm behaviour + # shown at: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html + #REVIEW + # --------------------- + #Note also on Freebsd xterm we seem to getresponse ': 1 $ r D...D ST' + #(no leading DCS) - this + + lappend PUNKARGS [list { + @id -id ::punk::console::request_dec_setting + @cmd -name punk::console::request_dec_setting\ + -summary\ + {Perform DECRQSS query to get DECRPSS response}\ + -help\ + {DECRQSS query for DEC Selection or Setting. + Return payload from console's DECRPSS response. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + @values -min 1 -max 1 + name -type string + }] + proc request_dec_setting {args} { + set argd [punk::args::parse $args withid ::punk::console::request_dec_setting] + lassign [dict values $argd] leaders opts values + set console [dict get $opts -console] + set name [dict get $values name] + + variable DECRQSS_DICT + if {![dict exists $DECRQSS_DICT $name]} { + error "request_dec_setting unrecognised name $name. Known values: [dict keys $DECRQSS_DICT]" + } + set str [dict get $DECRQSS_DICT $name] + set re_str [string map [list * \\* \$ \\\$ + \\+ ( \\(] $str] ;#regex escaped + #review {[0-9;:]} - too restrictive? - what values can be returned? alnum? - we perhaps at least need to exclude ESC so we don't overmatch + set capturingregex [string map [list %s% $re_str] {(.*)(\x1bP([0-1]\$r[0-9;:]*)(?:%s%){0,1}\x1b\\)$}] ;#must capture prefix,entire-response,response-payload + #todo - handle xterm : [0-1] $ r D...D ST + set request "\x1bP\$q${str}\x1b\\" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set c1 [string index $payload 0] + switch -- $c1 { + 0 { + error "request_dec_setting - terminal doesn't recognise request '[punk::ansi::ansistring VIEW $request]' as valid" + } + 1 {} + default { + #shouldn't get here + error "request_dec_setting - unrecognised response to request '[punk::ansi::ansistring VIEW $request]'. payload: [punk::ansi::ansistring VIEW $payload]" + } + } + #strip leading 1$r + return [string range $payload 3 end] + } #terminals lie. This should be a reasonable (albeit relatively slow) test of actual width - but some terminals seem to miscalculate. #todo - a visual interactive test/questionnaire to ask user if things are lining up or if the terminal is telling fibs about cursor position. diff --git a/src/modules/overtype-999999.0a1.0.tm b/src/modules/overtype-999999.0a1.0.tm index 0efea4da..dad03b77 100644 --- a/src/modules/overtype-999999.0a1.0.tm +++ b/src/modules/overtype-999999.0a1.0.tm @@ -3327,10 +3327,12 @@ tcl::namespace::eval overtype { } 7DCS { #ESC P + #e.g sixel #Device Control String https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h4-Controls-beginning-with-ESC:ESC-F.C74 set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 2 end]] } 8DCS { + #e.g sixel #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } @@ -4466,14 +4468,115 @@ tcl::namespace::eval overtype { } 7DCS - 8DCS { - puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" - #ST (string terminator) \x9c or \x1b\\ - if {[tcl::string::index $codenorm end] eq "\x9c"} { - set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + #match 'DCS P1 ; P2 ; P3' (without spaces) + # where Ps1,P2,P3 are all optional and P1,P2 are single digit and P3 can *technically* be any positive integer but is usually ignored (commonly set to zero) + # Our regexp isn't precise as we will validate number of params and values after matching - but we will assume P3 should be small (review for micrometres - could be 4 digits? more?) + # (limit to 10 chars to avoid insane values?) + #https://github.com/hackerb9/vt340test/blob/main/physicalsixels.md + # P1P2P3q - "Protocol Selector" + # P1 - Pixel Aspect Ratio (Vertical:Horizontal) + # P2 - background control + # P3 - horizontal grid size (default units decipoints 1/720 inch - but theoretically controlled by ANSI SSU sequence) + # P1P2P3 commonly omitted - with subsequent P4;P5;P6;P7 "Raster Attributes (DECGRA)" being used for: + # Aspect Ratio (P4,P5) + set sixelstart [tcl::string::range $codenorm 4 13] + set sixelmatch [regexp -all -inline {^((?:[0-9]*;){0,2}(?:[0-9]*))q} $sixelstart] + if {[llength $sixelmatch] == 2} { + #sixel + #note sixel data can have newlines before ST + set sixelparams [lindex $sixelmatch 1] + set params [split $sixelparams {;}] + set badsixelparams 0 + if {[llength $params] > 3} { + set badsixelparams 1 + } + lassign $params P1 P2 P3 + if {[string length $P1] > 1 || [string length $P2] > 1 || [string length $P3] > 3} { + set badsixelparams 1 + } + if {$badsixelparams} { + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but bad params. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } else { + #todo - move to punk::sixel library + + #P1 - Pixel Aspect Ratio + # round(10/P1):1 if 2<= P1 <= 9) 2:1 otherwise + # omitted 2:1 (default) + # 0,1 2:1 + # 2 5:1 + # 3,4 3:1 + # 5,6 2:1 + # 7,8,9 1:1 + switch -- $P1 { + "" - 0 - 1 { + #omitted (default) + set sixel_pixel_aspect "2:1" + } + 2 { + set sixel_pixel_aspect "5:1" + } + 3 - 4 { + set sixel_pixel_aspect "3:1" + } + 5 - 6 { + set sixel_pixel_aspect "2:1" + } + 7 - 8 - 9 { + set sixel_pixel_aspect "1:1" + } + default { + set sixel_pixel_aspect "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P1 (pixel aspect ratio). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + #P2 - background colour + # 0,2 (default) pixel positions specified as 0 are set to current bg colour + # 1 pixel positions specified as 0 remain at current colour + switch -- $P2 { + "" - 0 - 2 { + set sixel_background "current_background" + } + 1 { + set sixel_background "transparent" + } + default { + set sixel_background "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P2 (background control). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + + #P3 horizontal grid size - ignored on VT300 - commonly set to zero + + # ECMA-48 SSU (ESC Ps I) + # 0 - CHARACTER + # 1 - MILLIMETRE + # 2 - COMPUTER DECIPOINT 0.03528mm 1/720 of 25.4mm) + # 3 - DECIDIDOT 0.03759mm (10/266mm) + # 4 - MIL 0.0254mm (1/1000 of 25.4mm) + # 5 - BASIC MEASURING UNIT (BMU) 0.02117mm (1/1200 of 25.4mm) + # 6 - MICROMETRE 0.001mm + # 7 - PIXEL - the smallest increment that can be specified in a device + # 8 - DECIPOINT - 0.03514mm (35/996mm) + set sixel_horizontal_grid $P3 + set sixel_ssu "decipoint" ;#todo? + + #todo - look for and parse DECGRA introduced by double quote + puts stderr "overtype::renderline SIXEL aspect: $sixel_pixel_aspect bg: $sixel_background hgrid: $sixel_horizontal_grid. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + + + #todo + } } else { - set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" + #ST (string terminator) \x9c or \x1b\\ + if {[tcl::string::index $codenorm end] eq "\x9c"} { + set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + } else { + set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + } } - } 7OSC - 8OSC { # OSCs are terminated with ST of either \007 or \x1b\\ - we allow either whether code was 7 or 8 bit diff --git a/src/modules/punk/ansi-999999.0a1.0.tm b/src/modules/punk/ansi-999999.0a1.0.tm index fde23a3e..fcf90446 100644 --- a/src/modules/punk/ansi-999999.0a1.0.tm +++ b/src/modules/punk/ansi-999999.0a1.0.tm @@ -5039,6 +5039,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # mouse_urxvt 1015\ # mouse_sgr_pixel 1016\ #] + # + # some more ansi mode/sequence info: + #https://pkg.go.dev/github.com/charmbracelet/x/ansi + variable decmode_data { 1 { {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} @@ -5059,6 +5063,9 @@ In VT52 mode - use \x1b< to exit. 5 { {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} } + 6 { + {origin DEC description "DECOM - Origin Mode (whether cursor is restricted to within page margins)" names {DECOM}} + } 7 { {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} } @@ -5090,7 +5097,13 @@ be as if this was off - ie lone CR. {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} } 66 { - {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + {origin DEC description "DECNKM - Numeric Keypad Mode" see "https://vt100.net/docs/vt510-rm/DECNKM.html" names {DECNKM}} + } + 67 { + {origin DEC description "DECBKM - Backarrow Key Mode" see "https://vt100.net/docs/vt510-rm/DECBKM.html" names {DECBKM}} + } + 69 { + {origin DEC description "DECLRMM - Left Right Margin Mode" see "https://vt100.net/docs/vt510-rm/DECLRMM.html" names {DECLRMM}} } 1000 { {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { diff --git a/src/modules/punk/console-999999.0a1.0.tm b/src/modules/punk/console-999999.0a1.0.tm index 72dbc7e8..1830400f 100644 --- a/src/modules/punk/console-999999.0a1.0.tm +++ b/src/modules/punk/console-999999.0a1.0.tm @@ -570,6 +570,14 @@ namespace eval punk::console { puts -nonewline stdout \x1b\[?1006l flush stdout } + proc enable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000h\x1b\[?1003h\x1b\[?1016h + flush stdout + } + proc disable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000l\x1b\[?1003l\x1b\[?1016l + flush stdout + } proc enable_bracketed_paste {} { puts -nonewline stdout \x1b\[?2004h } @@ -1762,6 +1770,158 @@ namespace eval punk::console { puts -nonewline "\x1b\[?${m}l" } + variable has_mode_cache + set has_mode_cache [dict create] + lappend PUNKARGS [list { + @id -id ::punk::console::has_mode + @cmd -name punk::console::has_mode\ + -summary\ + {Check if console supports DEC mode}\ + -help\ + {Check if console supports DEC mode by emitting query to the console using + the sequence: + ESC [ ? $ p + Where is an integer identifier. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + -refresh -type none + @values -min 1 -max 1 + mode -type {int|string} -help\ + "integer for DEC mode, or name as in the dict: + ::punk::ansi::decmode_names" + }] + proc has_mode {args} { + set argd [punk::args::parse $args withid ::punk::console::has_mode] + lassign [dict values $argd] leaders opts values received + set console [dict get $opts -console] + set num_or_name [dict get $values mode] + if {[dict exists $received -refresh]} { + set do_refresh 1 + } else { + set do_refresh 0 + } + + if {[string is integer -strict $num_or_name]} { + set m $num_or_name + } else { + upvar ::punk::ansi::decmode_names decmode_names + if {[dict exists $decmode_names $num_or_name]} { + set m [dict get $decmode_names $num_or_name] + } else { + error "punk::console::get_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" + } + } + variable has_mode_cache + if {$do_refresh} { + if {[dict exists $has_mode_cache $console $m]} { + dict unset has_mode_cache $console $m + } + } + + if {![dict exists $has_mode_cache $console $m]} { + set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload + set request "\x1b\[?$m\$p" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set has_mode [expr {$payload != 0}] + dict set has_mode_cache $console $m $has_mode + } else { + set has_mode [dict get $has_mode_cache $console $m] + } + return $has_mode + } + + set DECRQSS_DATA { + "Select Active Status Display" DECSASD "$\}" + "Select Attribute Change Extent" DECSACE "*x" + "Set Character Attribute" DECSCA "\"q" + "Set Conformance Level" DECSCL "\"p" + "Set Columns Per Page" DECSCPP "\$|" + "Set Lines Per Page" DECSLPP "t" + "Set Number of Lines per Screen" DECSNLS "*|" + "Set Status Line Type" DECSSDT "$~" + "Set Left and Right Margins" DECSLRM "s" + "Set Top and Bottom Margins" DECSTBM "r" + "Set Graphic Rendition" SGR "m" + "Select Set-Up Language" DECSSL "p" + "Select Printer Type" DECSPRTT "\$s" + "Select Refresh Rate" DECSRFR "\"t" + "Select Digital Printed Data Type" DECSDPT "(p" + "Select ProPrinter Character Set" DECSPPCS "*p" + "Select Communication Speed" DECSCS "*r" + "Select Communication Port" DECSCP "*u" + "Set Scroll Speed" DECSSCLS " p" + "Set Cursor Style" DECSCUSR " q" + "Set Key Click Volume" DECSKCV " r" + "Set Warning Bell Volume" DECSWBV " t" + "Set Margin Bell Volume" DECSMBV " u" + "Set Lock Key Style" DECSLCK " v" + "Select Flow Control Type" DECSFC "*s" + "Select Disconnect Delay Time" DECSDDT "\$q" + "Set Transmit Rate Limit" DECSTRL "u" + "Set Port Parameter" DECSPP "\+w" + } + set DECRQSS_DICT [dict create] + foreach {desc name str} $DECRQSS_DATA { + dict set DECRQSS_DICT $name $str + } + + #emit DECRQSS and get DECRPSS response + # --------------------- + #NOTE: https://vt100.net/docs/vt510-rm/DECRPSS.html + #response: DCS Ps $ r D...D ST + #Conflict between above doc saying Ps of 0 indicates a valid request and 1 indicates invalid - and the behaviour of windows terminal, wezterm and the reported xterm behaviour + # shown at: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html + #REVIEW + # --------------------- + #Note also on Freebsd xterm we seem to getresponse ': 1 $ r D...D ST' + #(no leading DCS) - this + + lappend PUNKARGS [list { + @id -id ::punk::console::request_dec_setting + @cmd -name punk::console::request_dec_setting\ + -summary\ + {Perform DECRQSS query to get DECRPSS response}\ + -help\ + {DECRQSS query for DEC Selection or Setting. + Return payload from console's DECRPSS response. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + @values -min 1 -max 1 + name -type string + }] + proc request_dec_setting {args} { + set argd [punk::args::parse $args withid ::punk::console::request_dec_setting] + lassign [dict values $argd] leaders opts values + set console [dict get $opts -console] + set name [dict get $values name] + + variable DECRQSS_DICT + if {![dict exists $DECRQSS_DICT $name]} { + error "request_dec_setting unrecognised name $name. Known values: [dict keys $DECRQSS_DICT]" + } + set str [dict get $DECRQSS_DICT $name] + set re_str [string map [list * \\* \$ \\\$ + \\+ ( \\(] $str] ;#regex escaped + #review {[0-9;:]} - too restrictive? - what values can be returned? alnum? - we perhaps at least need to exclude ESC so we don't overmatch + set capturingregex [string map [list %s% $re_str] {(.*)(\x1bP([0-1]\$r[0-9;:]*)(?:%s%){0,1}\x1b\\)$}] ;#must capture prefix,entire-response,response-payload + #todo - handle xterm : [0-1] $ r D...D ST + set request "\x1bP\$q${str}\x1b\\" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set c1 [string index $payload 0] + switch -- $c1 { + 0 { + error "request_dec_setting - terminal doesn't recognise request '[punk::ansi::ansistring VIEW $request]' as valid" + } + 1 {} + default { + #shouldn't get here + error "request_dec_setting - unrecognised response to request '[punk::ansi::ansistring VIEW $request]'. payload: [punk::ansi::ansistring VIEW $payload]" + } + } + #strip leading 1$r + return [string range $payload 3 end] + } #terminals lie. This should be a reasonable (albeit relatively slow) test of actual width - but some terminals seem to miscalculate. #todo - a visual interactive test/questionnaire to ask user if things are lining up or if the terminal is telling fibs about cursor position. diff --git a/src/modules/punk/sixel-999999.0a1.0.tm b/src/modules/punk/sixel-999999.0a1.0.tm index 0d9c03e4..ea51b313 100644 --- a/src/modules/punk/sixel-999999.0a1.0.tm +++ b/src/modules/punk/sixel-999999.0a1.0.tm @@ -134,7 +134,7 @@ tcl::namespace::eval punk::sixel { if {$cell_size_override ne ""} { lassign [split [string tolower $cell_size_override] x] cwidth cheight if {![string is integer -strict $cwidth] || ![string is integer -strict $cheight]} { - error "punk::sixel::get_info -cell_sixe must be of the form WxH where W and H are positive integers" + error "punk::sixel::get_info -cell_sixel must be of the form WxH where W and H are positive integers" } set cell_size $cell_size_override } else { @@ -143,7 +143,11 @@ tcl::namespace::eval punk::sixel { lassign [split $cell_size x] cwidth cheight set height_cells [expr {int(ceil($height_pixels /double($cheight)))}] set sixelparams "" - set sixel_extents [list] ;#number of sixes in each line taking into account retraces due to $ + set sixel_extents [list] ;#number of sixels in each line taking into account retraces due to $ + + #REVIEW + #There can be multiple raster-attribute instructions repeatedly changing the size and aspect ratio of subsequent pixels. + #see sixel/multisize.six set line0 [lindex $raster_lines 0] if {[regexp -indices {^\x1bP([;0-9]*)q} $line0 i_match]} { @@ -196,11 +200,11 @@ tcl::namespace::eval punk::sixel { #don't use escape in switch selector - ensures jump table is used. if {$c eq "\x1b"} { if {[string index $linedata $s+1] eq "\\"} { - #7bit ST + #7bit ST break } } else { - incr line_sixelrun + incr line_sixelrun } } } @@ -219,6 +223,48 @@ tcl::namespace::eval punk::sixel { } + punk::args::define { + @id -id ::punk::sixel::can_sixel + @cmd -name punk::sixel::can_sixel\ + -summary\ + "Report whether terminal can display sixel graphics."\ + -help\ + "return a boolean indicating whether the terminal has sixel capability." + -refresh -type none -help\ + "When supplied, will make a new call to punk::console::get_device_attributes, + rather than relying on a cached answer" + @values -min 0 -max 1 + terminal -type list -minsize 2 -default {stdin stdout} + } + #review + variable device_attribute_cache + set device_attribute_cache [dict create] + proc can_sixel {args} { + set argd [punk::args::parse $args withid ::punk::sixel::can_sixel] + lassign [dict values $argd] leaders opts values received + set terminal [dict get $values terminal] + + variable device_attribute_cache + if {[dict exists $received -refresh]} { + set attribs [punk::console::get_device_attributes $terminal] + dict set device_attribute_cache $terminal $attribs + } else { + if {[dict exists $device_attribute_cache $terminal]} { + set attribs [dict get $device_attribute_cache $terminal] + } else { + set attribs [punk::console::get_device_attributes $terminal] + dict set device_attribute_cache $terminal $attribs + } + } + + set codes [split $attribs {;}] + if {"4" in $codes} { + return true + } else { + return false + } + } + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::sixel ---}] } @@ -259,11 +305,11 @@ tcl::namespace::eval punk::sixel::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -## Ready +## Ready package provide punk::sixel [tcl::namespace::eval punk::sixel { variable pkg punk::sixel variable version - set version 999999.0a1.0 + set version 999999.0a1.0 }] return diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/overtype-1.7.4.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/overtype-1.7.4.tm index e4ea54d7..d3a642da 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/overtype-1.7.4.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/overtype-1.7.4.tm @@ -3327,10 +3327,12 @@ tcl::namespace::eval overtype { } 7DCS { #ESC P + #e.g sixel #Device Control String https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h4-Controls-beginning-with-ESC:ESC-F.C74 set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 2 end]] } 8DCS { + #e.g sixel #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } @@ -4466,14 +4468,115 @@ tcl::namespace::eval overtype { } 7DCS - 8DCS { - puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" - #ST (string terminator) \x9c or \x1b\\ - if {[tcl::string::index $codenorm end] eq "\x9c"} { - set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + #match 'DCS P1 ; P2 ; P3' (without spaces) + # where Ps1,P2,P3 are all optional and P1,P2 are single digit and P3 can *technically* be any positive integer but is usually ignored (commonly set to zero) + # Our regexp isn't precise as we will validate number of params and values after matching - but we will assume P3 should be small (review for micrometres - could be 4 digits? more?) + # (limit to 10 chars to avoid insane values?) + #https://github.com/hackerb9/vt340test/blob/main/physicalsixels.md + # P1P2P3q - "Protocol Selector" + # P1 - Pixel Aspect Ratio (Vertical:Horizontal) + # P2 - background control + # P3 - horizontal grid size (default units decipoints 1/720 inch - but theoretically controlled by ANSI SSU sequence) + # P1P2P3 commonly omitted - with subsequent P4;P5;P6;P7 "Raster Attributes (DECGRA)" being used for: + # Aspect Ratio (P4,P5) + set sixelstart [tcl::string::range $codenorm 4 13] + set sixelmatch [regexp -all -inline {^((?:[0-9]*;){0,2}(?:[0-9]*))q} $sixelstart] + if {[llength $sixelmatch] == 2} { + #sixel + #note sixel data can have newlines before ST + set sixelparams [lindex $sixelmatch 1] + set params [split $sixelparams {;}] + set badsixelparams 0 + if {[llength $params] > 3} { + set badsixelparams 1 + } + lassign $params P1 P2 P3 + if {[string length $P1] > 1 || [string length $P2] > 1 || [string length $P3] > 3} { + set badsixelparams 1 + } + if {$badsixelparams} { + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but bad params. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } else { + #todo - move to punk::sixel library + + #P1 - Pixel Aspect Ratio + # round(10/P1):1 if 2<= P1 <= 9) 2:1 otherwise + # omitted 2:1 (default) + # 0,1 2:1 + # 2 5:1 + # 3,4 3:1 + # 5,6 2:1 + # 7,8,9 1:1 + switch -- $P1 { + "" - 0 - 1 { + #omitted (default) + set sixel_pixel_aspect "2:1" + } + 2 { + set sixel_pixel_aspect "5:1" + } + 3 - 4 { + set sixel_pixel_aspect "3:1" + } + 5 - 6 { + set sixel_pixel_aspect "2:1" + } + 7 - 8 - 9 { + set sixel_pixel_aspect "1:1" + } + default { + set sixel_pixel_aspect "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P1 (pixel aspect ratio). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + #P2 - background colour + # 0,2 (default) pixel positions specified as 0 are set to current bg colour + # 1 pixel positions specified as 0 remain at current colour + switch -- $P2 { + "" - 0 - 2 { + set sixel_background "current_background" + } + 1 { + set sixel_background "transparent" + } + default { + set sixel_background "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P2 (background control). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + + #P3 horizontal grid size - ignored on VT300 - commonly set to zero + + # ECMA-48 SSU (ESC Ps I) + # 0 - CHARACTER + # 1 - MILLIMETRE + # 2 - COMPUTER DECIPOINT 0.03528mm 1/720 of 25.4mm) + # 3 - DECIDIDOT 0.03759mm (10/266mm) + # 4 - MIL 0.0254mm (1/1000 of 25.4mm) + # 5 - BASIC MEASURING UNIT (BMU) 0.02117mm (1/1200 of 25.4mm) + # 6 - MICROMETRE 0.001mm + # 7 - PIXEL - the smallest increment that can be specified in a device + # 8 - DECIPOINT - 0.03514mm (35/996mm) + set sixel_horizontal_grid $P3 + set sixel_ssu "decipoint" ;#todo? + + #todo - look for and parse DECGRA introduced by double quote + puts stderr "overtype::renderline SIXEL aspect: $sixel_pixel_aspect bg: $sixel_background hgrid: $sixel_horizontal_grid. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + + + #todo + } } else { - set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" + #ST (string terminator) \x9c or \x1b\\ + if {[tcl::string::index $codenorm end] eq "\x9c"} { + set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + } else { + set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + } } - } 7OSC - 8OSC { # OSCs are terminated with ST of either \007 or \x1b\\ - we allow either whether code was 7 or 8 bit diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm index 45f53981..69affd9b 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -5039,6 +5039,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # mouse_urxvt 1015\ # mouse_sgr_pixel 1016\ #] + # + # some more ansi mode/sequence info: + #https://pkg.go.dev/github.com/charmbracelet/x/ansi + variable decmode_data { 1 { {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} @@ -5059,6 +5063,9 @@ In VT52 mode - use \x1b< to exit. 5 { {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} } + 6 { + {origin DEC description "DECOM - Origin Mode (whether cursor is restricted to within page margins)" names {DECOM}} + } 7 { {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} } @@ -5090,7 +5097,13 @@ be as if this was off - ie lone CR. {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} } 66 { - {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + {origin DEC description "DECNKM - Numeric Keypad Mode" see "https://vt100.net/docs/vt510-rm/DECNKM.html" names {DECNKM}} + } + 67 { + {origin DEC description "DECBKM - Backarrow Key Mode" see "https://vt100.net/docs/vt510-rm/DECBKM.html" names {DECBKM}} + } + 69 { + {origin DEC description "DECLRMM - Left Right Margin Mode" see "https://vt100.net/docs/vt510-rm/DECLRMM.html" names {DECLRMM}} } 1000 { {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm index 3bbc65cf..b62c497b 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/console-0.1.1.tm @@ -570,6 +570,14 @@ namespace eval punk::console { puts -nonewline stdout \x1b\[?1006l flush stdout } + proc enable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000h\x1b\[?1003h\x1b\[?1016h + flush stdout + } + proc disable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000l\x1b\[?1003l\x1b\[?1016l + flush stdout + } proc enable_bracketed_paste {} { puts -nonewline stdout \x1b\[?2004h } @@ -1762,6 +1770,158 @@ namespace eval punk::console { puts -nonewline "\x1b\[?${m}l" } + variable has_mode_cache + set has_mode_cache [dict create] + lappend PUNKARGS [list { + @id -id ::punk::console::has_mode + @cmd -name punk::console::has_mode\ + -summary\ + {Check if console supports DEC mode}\ + -help\ + {Check if console supports DEC mode by emitting query to the console using + the sequence: + ESC [ ? $ p + Where is an integer identifier. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + -refresh -type none + @values -min 1 -max 1 + mode -type {int|string} -help\ + "integer for DEC mode, or name as in the dict: + ::punk::ansi::decmode_names" + }] + proc has_mode {args} { + set argd [punk::args::parse $args withid ::punk::console::has_mode] + lassign [dict values $argd] leaders opts values received + set console [dict get $opts -console] + set num_or_name [dict get $values mode] + if {[dict exists $received -refresh]} { + set do_refresh 1 + } else { + set do_refresh 0 + } + + if {[string is integer -strict $num_or_name]} { + set m $num_or_name + } else { + upvar ::punk::ansi::decmode_names decmode_names + if {[dict exists $decmode_names $num_or_name]} { + set m [dict get $decmode_names $num_or_name] + } else { + error "punk::console::get_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" + } + } + variable has_mode_cache + if {$do_refresh} { + if {[dict exists $has_mode_cache $console $m]} { + dict unset has_mode_cache $console $m + } + } + + if {![dict exists $has_mode_cache $console $m]} { + set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload + set request "\x1b\[?$m\$p" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set has_mode [expr {$payload != 0}] + dict set has_mode_cache $console $m $has_mode + } else { + set has_mode [dict get $has_mode_cache $console $m] + } + return $has_mode + } + + set DECRQSS_DATA { + "Select Active Status Display" DECSASD "$\}" + "Select Attribute Change Extent" DECSACE "*x" + "Set Character Attribute" DECSCA "\"q" + "Set Conformance Level" DECSCL "\"p" + "Set Columns Per Page" DECSCPP "\$|" + "Set Lines Per Page" DECSLPP "t" + "Set Number of Lines per Screen" DECSNLS "*|" + "Set Status Line Type" DECSSDT "$~" + "Set Left and Right Margins" DECSLRM "s" + "Set Top and Bottom Margins" DECSTBM "r" + "Set Graphic Rendition" SGR "m" + "Select Set-Up Language" DECSSL "p" + "Select Printer Type" DECSPRTT "\$s" + "Select Refresh Rate" DECSRFR "\"t" + "Select Digital Printed Data Type" DECSDPT "(p" + "Select ProPrinter Character Set" DECSPPCS "*p" + "Select Communication Speed" DECSCS "*r" + "Select Communication Port" DECSCP "*u" + "Set Scroll Speed" DECSSCLS " p" + "Set Cursor Style" DECSCUSR " q" + "Set Key Click Volume" DECSKCV " r" + "Set Warning Bell Volume" DECSWBV " t" + "Set Margin Bell Volume" DECSMBV " u" + "Set Lock Key Style" DECSLCK " v" + "Select Flow Control Type" DECSFC "*s" + "Select Disconnect Delay Time" DECSDDT "\$q" + "Set Transmit Rate Limit" DECSTRL "u" + "Set Port Parameter" DECSPP "\+w" + } + set DECRQSS_DICT [dict create] + foreach {desc name str} $DECRQSS_DATA { + dict set DECRQSS_DICT $name $str + } + + #emit DECRQSS and get DECRPSS response + # --------------------- + #NOTE: https://vt100.net/docs/vt510-rm/DECRPSS.html + #response: DCS Ps $ r D...D ST + #Conflict between above doc saying Ps of 0 indicates a valid request and 1 indicates invalid - and the behaviour of windows terminal, wezterm and the reported xterm behaviour + # shown at: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html + #REVIEW + # --------------------- + #Note also on Freebsd xterm we seem to getresponse ': 1 $ r D...D ST' + #(no leading DCS) - this + + lappend PUNKARGS [list { + @id -id ::punk::console::request_dec_setting + @cmd -name punk::console::request_dec_setting\ + -summary\ + {Perform DECRQSS query to get DECRPSS response}\ + -help\ + {DECRQSS query for DEC Selection or Setting. + Return payload from console's DECRPSS response. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + @values -min 1 -max 1 + name -type string + }] + proc request_dec_setting {args} { + set argd [punk::args::parse $args withid ::punk::console::request_dec_setting] + lassign [dict values $argd] leaders opts values + set console [dict get $opts -console] + set name [dict get $values name] + + variable DECRQSS_DICT + if {![dict exists $DECRQSS_DICT $name]} { + error "request_dec_setting unrecognised name $name. Known values: [dict keys $DECRQSS_DICT]" + } + set str [dict get $DECRQSS_DICT $name] + set re_str [string map [list * \\* \$ \\\$ + \\+ ( \\(] $str] ;#regex escaped + #review {[0-9;:]} - too restrictive? - what values can be returned? alnum? - we perhaps at least need to exclude ESC so we don't overmatch + set capturingregex [string map [list %s% $re_str] {(.*)(\x1bP([0-1]\$r[0-9;:]*)(?:%s%){0,1}\x1b\\)$}] ;#must capture prefix,entire-response,response-payload + #todo - handle xterm : [0-1] $ r D...D ST + set request "\x1bP\$q${str}\x1b\\" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set c1 [string index $payload 0] + switch -- $c1 { + 0 { + error "request_dec_setting - terminal doesn't recognise request '[punk::ansi::ansistring VIEW $request]' as valid" + } + 1 {} + default { + #shouldn't get here + error "request_dec_setting - unrecognised response to request '[punk::ansi::ansistring VIEW $request]'. payload: [punk::ansi::ansistring VIEW $payload]" + } + } + #strip leading 1$r + return [string range $payload 3 end] + } #terminals lie. This should be a reasonable (albeit relatively slow) test of actual width - but some terminals seem to miscalculate. #todo - a visual interactive test/questionnaire to ask user if things are lining up or if the terminal is telling fibs about cursor position. diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/overtype-1.7.4.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/overtype-1.7.4.tm index e4ea54d7..d3a642da 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/overtype-1.7.4.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/overtype-1.7.4.tm @@ -3327,10 +3327,12 @@ tcl::namespace::eval overtype { } 7DCS { #ESC P + #e.g sixel #Device Control String https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h4-Controls-beginning-with-ESC:ESC-F.C74 set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 2 end]] } 8DCS { + #e.g sixel #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } @@ -4466,14 +4468,115 @@ tcl::namespace::eval overtype { } 7DCS - 8DCS { - puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" - #ST (string terminator) \x9c or \x1b\\ - if {[tcl::string::index $codenorm end] eq "\x9c"} { - set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + #match 'DCS P1 ; P2 ; P3' (without spaces) + # where Ps1,P2,P3 are all optional and P1,P2 are single digit and P3 can *technically* be any positive integer but is usually ignored (commonly set to zero) + # Our regexp isn't precise as we will validate number of params and values after matching - but we will assume P3 should be small (review for micrometres - could be 4 digits? more?) + # (limit to 10 chars to avoid insane values?) + #https://github.com/hackerb9/vt340test/blob/main/physicalsixels.md + # P1P2P3q - "Protocol Selector" + # P1 - Pixel Aspect Ratio (Vertical:Horizontal) + # P2 - background control + # P3 - horizontal grid size (default units decipoints 1/720 inch - but theoretically controlled by ANSI SSU sequence) + # P1P2P3 commonly omitted - with subsequent P4;P5;P6;P7 "Raster Attributes (DECGRA)" being used for: + # Aspect Ratio (P4,P5) + set sixelstart [tcl::string::range $codenorm 4 13] + set sixelmatch [regexp -all -inline {^((?:[0-9]*;){0,2}(?:[0-9]*))q} $sixelstart] + if {[llength $sixelmatch] == 2} { + #sixel + #note sixel data can have newlines before ST + set sixelparams [lindex $sixelmatch 1] + set params [split $sixelparams {;}] + set badsixelparams 0 + if {[llength $params] > 3} { + set badsixelparams 1 + } + lassign $params P1 P2 P3 + if {[string length $P1] > 1 || [string length $P2] > 1 || [string length $P3] > 3} { + set badsixelparams 1 + } + if {$badsixelparams} { + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but bad params. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } else { + #todo - move to punk::sixel library + + #P1 - Pixel Aspect Ratio + # round(10/P1):1 if 2<= P1 <= 9) 2:1 otherwise + # omitted 2:1 (default) + # 0,1 2:1 + # 2 5:1 + # 3,4 3:1 + # 5,6 2:1 + # 7,8,9 1:1 + switch -- $P1 { + "" - 0 - 1 { + #omitted (default) + set sixel_pixel_aspect "2:1" + } + 2 { + set sixel_pixel_aspect "5:1" + } + 3 - 4 { + set sixel_pixel_aspect "3:1" + } + 5 - 6 { + set sixel_pixel_aspect "2:1" + } + 7 - 8 - 9 { + set sixel_pixel_aspect "1:1" + } + default { + set sixel_pixel_aspect "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P1 (pixel aspect ratio). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + #P2 - background colour + # 0,2 (default) pixel positions specified as 0 are set to current bg colour + # 1 pixel positions specified as 0 remain at current colour + switch -- $P2 { + "" - 0 - 2 { + set sixel_background "current_background" + } + 1 { + set sixel_background "transparent" + } + default { + set sixel_background "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P2 (background control). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + + #P3 horizontal grid size - ignored on VT300 - commonly set to zero + + # ECMA-48 SSU (ESC Ps I) + # 0 - CHARACTER + # 1 - MILLIMETRE + # 2 - COMPUTER DECIPOINT 0.03528mm 1/720 of 25.4mm) + # 3 - DECIDIDOT 0.03759mm (10/266mm) + # 4 - MIL 0.0254mm (1/1000 of 25.4mm) + # 5 - BASIC MEASURING UNIT (BMU) 0.02117mm (1/1200 of 25.4mm) + # 6 - MICROMETRE 0.001mm + # 7 - PIXEL - the smallest increment that can be specified in a device + # 8 - DECIPOINT - 0.03514mm (35/996mm) + set sixel_horizontal_grid $P3 + set sixel_ssu "decipoint" ;#todo? + + #todo - look for and parse DECGRA introduced by double quote + puts stderr "overtype::renderline SIXEL aspect: $sixel_pixel_aspect bg: $sixel_background hgrid: $sixel_horizontal_grid. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + + + #todo + } } else { - set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" + #ST (string terminator) \x9c or \x1b\\ + if {[tcl::string::index $codenorm end] eq "\x9c"} { + set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + } else { + set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + } } - } 7OSC - 8OSC { # OSCs are terminated with ST of either \007 or \x1b\\ - we allow either whether code was 7 or 8 bit diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm index 45f53981..69affd9b 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ansi-0.1.1.tm @@ -5039,6 +5039,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # mouse_urxvt 1015\ # mouse_sgr_pixel 1016\ #] + # + # some more ansi mode/sequence info: + #https://pkg.go.dev/github.com/charmbracelet/x/ansi + variable decmode_data { 1 { {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} @@ -5059,6 +5063,9 @@ In VT52 mode - use \x1b< to exit. 5 { {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} } + 6 { + {origin DEC description "DECOM - Origin Mode (whether cursor is restricted to within page margins)" names {DECOM}} + } 7 { {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} } @@ -5090,7 +5097,13 @@ be as if this was off - ie lone CR. {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} } 66 { - {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + {origin DEC description "DECNKM - Numeric Keypad Mode" see "https://vt100.net/docs/vt510-rm/DECNKM.html" names {DECNKM}} + } + 67 { + {origin DEC description "DECBKM - Backarrow Key Mode" see "https://vt100.net/docs/vt510-rm/DECBKM.html" names {DECBKM}} + } + 69 { + {origin DEC description "DECLRMM - Left Right Margin Mode" see "https://vt100.net/docs/vt510-rm/DECLRMM.html" names {DECLRMM}} } 1000 { {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm index 3bbc65cf..b62c497b 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/console-0.1.1.tm @@ -570,6 +570,14 @@ namespace eval punk::console { puts -nonewline stdout \x1b\[?1006l flush stdout } + proc enable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000h\x1b\[?1003h\x1b\[?1016h + flush stdout + } + proc disable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000l\x1b\[?1003l\x1b\[?1016l + flush stdout + } proc enable_bracketed_paste {} { puts -nonewline stdout \x1b\[?2004h } @@ -1762,6 +1770,158 @@ namespace eval punk::console { puts -nonewline "\x1b\[?${m}l" } + variable has_mode_cache + set has_mode_cache [dict create] + lappend PUNKARGS [list { + @id -id ::punk::console::has_mode + @cmd -name punk::console::has_mode\ + -summary\ + {Check if console supports DEC mode}\ + -help\ + {Check if console supports DEC mode by emitting query to the console using + the sequence: + ESC [ ? $ p + Where is an integer identifier. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + -refresh -type none + @values -min 1 -max 1 + mode -type {int|string} -help\ + "integer for DEC mode, or name as in the dict: + ::punk::ansi::decmode_names" + }] + proc has_mode {args} { + set argd [punk::args::parse $args withid ::punk::console::has_mode] + lassign [dict values $argd] leaders opts values received + set console [dict get $opts -console] + set num_or_name [dict get $values mode] + if {[dict exists $received -refresh]} { + set do_refresh 1 + } else { + set do_refresh 0 + } + + if {[string is integer -strict $num_or_name]} { + set m $num_or_name + } else { + upvar ::punk::ansi::decmode_names decmode_names + if {[dict exists $decmode_names $num_or_name]} { + set m [dict get $decmode_names $num_or_name] + } else { + error "punk::console::get_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" + } + } + variable has_mode_cache + if {$do_refresh} { + if {[dict exists $has_mode_cache $console $m]} { + dict unset has_mode_cache $console $m + } + } + + if {![dict exists $has_mode_cache $console $m]} { + set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload + set request "\x1b\[?$m\$p" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set has_mode [expr {$payload != 0}] + dict set has_mode_cache $console $m $has_mode + } else { + set has_mode [dict get $has_mode_cache $console $m] + } + return $has_mode + } + + set DECRQSS_DATA { + "Select Active Status Display" DECSASD "$\}" + "Select Attribute Change Extent" DECSACE "*x" + "Set Character Attribute" DECSCA "\"q" + "Set Conformance Level" DECSCL "\"p" + "Set Columns Per Page" DECSCPP "\$|" + "Set Lines Per Page" DECSLPP "t" + "Set Number of Lines per Screen" DECSNLS "*|" + "Set Status Line Type" DECSSDT "$~" + "Set Left and Right Margins" DECSLRM "s" + "Set Top and Bottom Margins" DECSTBM "r" + "Set Graphic Rendition" SGR "m" + "Select Set-Up Language" DECSSL "p" + "Select Printer Type" DECSPRTT "\$s" + "Select Refresh Rate" DECSRFR "\"t" + "Select Digital Printed Data Type" DECSDPT "(p" + "Select ProPrinter Character Set" DECSPPCS "*p" + "Select Communication Speed" DECSCS "*r" + "Select Communication Port" DECSCP "*u" + "Set Scroll Speed" DECSSCLS " p" + "Set Cursor Style" DECSCUSR " q" + "Set Key Click Volume" DECSKCV " r" + "Set Warning Bell Volume" DECSWBV " t" + "Set Margin Bell Volume" DECSMBV " u" + "Set Lock Key Style" DECSLCK " v" + "Select Flow Control Type" DECSFC "*s" + "Select Disconnect Delay Time" DECSDDT "\$q" + "Set Transmit Rate Limit" DECSTRL "u" + "Set Port Parameter" DECSPP "\+w" + } + set DECRQSS_DICT [dict create] + foreach {desc name str} $DECRQSS_DATA { + dict set DECRQSS_DICT $name $str + } + + #emit DECRQSS and get DECRPSS response + # --------------------- + #NOTE: https://vt100.net/docs/vt510-rm/DECRPSS.html + #response: DCS Ps $ r D...D ST + #Conflict between above doc saying Ps of 0 indicates a valid request and 1 indicates invalid - and the behaviour of windows terminal, wezterm and the reported xterm behaviour + # shown at: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html + #REVIEW + # --------------------- + #Note also on Freebsd xterm we seem to getresponse ': 1 $ r D...D ST' + #(no leading DCS) - this + + lappend PUNKARGS [list { + @id -id ::punk::console::request_dec_setting + @cmd -name punk::console::request_dec_setting\ + -summary\ + {Perform DECRQSS query to get DECRPSS response}\ + -help\ + {DECRQSS query for DEC Selection or Setting. + Return payload from console's DECRPSS response. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + @values -min 1 -max 1 + name -type string + }] + proc request_dec_setting {args} { + set argd [punk::args::parse $args withid ::punk::console::request_dec_setting] + lassign [dict values $argd] leaders opts values + set console [dict get $opts -console] + set name [dict get $values name] + + variable DECRQSS_DICT + if {![dict exists $DECRQSS_DICT $name]} { + error "request_dec_setting unrecognised name $name. Known values: [dict keys $DECRQSS_DICT]" + } + set str [dict get $DECRQSS_DICT $name] + set re_str [string map [list * \\* \$ \\\$ + \\+ ( \\(] $str] ;#regex escaped + #review {[0-9;:]} - too restrictive? - what values can be returned? alnum? - we perhaps at least need to exclude ESC so we don't overmatch + set capturingregex [string map [list %s% $re_str] {(.*)(\x1bP([0-1]\$r[0-9;:]*)(?:%s%){0,1}\x1b\\)$}] ;#must capture prefix,entire-response,response-payload + #todo - handle xterm : [0-1] $ r D...D ST + set request "\x1bP\$q${str}\x1b\\" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set c1 [string index $payload 0] + switch -- $c1 { + 0 { + error "request_dec_setting - terminal doesn't recognise request '[punk::ansi::ansistring VIEW $request]' as valid" + } + 1 {} + default { + #shouldn't get here + error "request_dec_setting - unrecognised response to request '[punk::ansi::ansistring VIEW $request]'. payload: [punk::ansi::ansistring VIEW $payload]" + } + } + #strip leading 1$r + return [string range $payload 3 end] + } #terminals lie. This should be a reasonable (albeit relatively slow) test of actual width - but some terminals seem to miscalculate. #todo - a visual interactive test/questionnaire to ask user if things are lining up or if the terminal is telling fibs about cursor position. diff --git a/src/vfs/_vfscommon.vfs/modules/overtype-1.7.4.tm b/src/vfs/_vfscommon.vfs/modules/overtype-1.7.4.tm index e4ea54d7..d3a642da 100644 --- a/src/vfs/_vfscommon.vfs/modules/overtype-1.7.4.tm +++ b/src/vfs/_vfscommon.vfs/modules/overtype-1.7.4.tm @@ -3327,10 +3327,12 @@ tcl::namespace::eval overtype { } 7DCS { #ESC P + #e.g sixel #Device Control String https://invisible-island.net/xterm/ctlseqs/ctlseqs.html#h4-Controls-beginning-with-ESC:ESC-F.C74 set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 2 end]] } 8DCS { + #e.g sixel #8-bit Device Control String set codenorm [tcl::string::cat $leadernorm [tcl::string::range $code 1 end]] } @@ -4466,14 +4468,115 @@ tcl::namespace::eval overtype { } 7DCS - 8DCS { - puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" - #ST (string terminator) \x9c or \x1b\\ - if {[tcl::string::index $codenorm end] eq "\x9c"} { - set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + #match 'DCS P1 ; P2 ; P3' (without spaces) + # where Ps1,P2,P3 are all optional and P1,P2 are single digit and P3 can *technically* be any positive integer but is usually ignored (commonly set to zero) + # Our regexp isn't precise as we will validate number of params and values after matching - but we will assume P3 should be small (review for micrometres - could be 4 digits? more?) + # (limit to 10 chars to avoid insane values?) + #https://github.com/hackerb9/vt340test/blob/main/physicalsixels.md + # P1P2P3q - "Protocol Selector" + # P1 - Pixel Aspect Ratio (Vertical:Horizontal) + # P2 - background control + # P3 - horizontal grid size (default units decipoints 1/720 inch - but theoretically controlled by ANSI SSU sequence) + # P1P2P3 commonly omitted - with subsequent P4;P5;P6;P7 "Raster Attributes (DECGRA)" being used for: + # Aspect Ratio (P4,P5) + set sixelstart [tcl::string::range $codenorm 4 13] + set sixelmatch [regexp -all -inline {^((?:[0-9]*;){0,2}(?:[0-9]*))q} $sixelstart] + if {[llength $sixelmatch] == 2} { + #sixel + #note sixel data can have newlines before ST + set sixelparams [lindex $sixelmatch 1] + set params [split $sixelparams {;}] + set badsixelparams 0 + if {[llength $params] > 3} { + set badsixelparams 1 + } + lassign $params P1 P2 P3 + if {[string length $P1] > 1 || [string length $P2] > 1 || [string length $P3] > 3} { + set badsixelparams 1 + } + if {$badsixelparams} { + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but bad params. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } else { + #todo - move to punk::sixel library + + #P1 - Pixel Aspect Ratio + # round(10/P1):1 if 2<= P1 <= 9) 2:1 otherwise + # omitted 2:1 (default) + # 0,1 2:1 + # 2 5:1 + # 3,4 3:1 + # 5,6 2:1 + # 7,8,9 1:1 + switch -- $P1 { + "" - 0 - 1 { + #omitted (default) + set sixel_pixel_aspect "2:1" + } + 2 { + set sixel_pixel_aspect "5:1" + } + 3 - 4 { + set sixel_pixel_aspect "3:1" + } + 5 - 6 { + set sixel_pixel_aspect "2:1" + } + 7 - 8 - 9 { + set sixel_pixel_aspect "1:1" + } + default { + set sixel_pixel_aspect "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P1 (pixel aspect ratio). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + #P2 - background colour + # 0,2 (default) pixel positions specified as 0 are set to current bg colour + # 1 pixel positions specified as 0 remain at current colour + switch -- $P2 { + "" - 0 - 2 { + set sixel_background "current_background" + } + 1 { + set sixel_background "transparent" + } + default { + set sixel_background "invalid" + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING looks like sixel, but unrecognised P2 (background control). sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + } + } + + + #P3 horizontal grid size - ignored on VT300 - commonly set to zero + + # ECMA-48 SSU (ESC Ps I) + # 0 - CHARACTER + # 1 - MILLIMETRE + # 2 - COMPUTER DECIPOINT 0.03528mm 1/720 of 25.4mm) + # 3 - DECIDIDOT 0.03759mm (10/266mm) + # 4 - MIL 0.0254mm (1/1000 of 25.4mm) + # 5 - BASIC MEASURING UNIT (BMU) 0.02117mm (1/1200 of 25.4mm) + # 6 - MICROMETRE 0.001mm + # 7 - PIXEL - the smallest increment that can be specified in a device + # 8 - DECIPOINT - 0.03514mm (35/996mm) + set sixel_horizontal_grid $P3 + set sixel_ssu "decipoint" ;#todo? + + #todo - look for and parse DECGRA introduced by double quote + puts stderr "overtype::renderline SIXEL aspect: $sixel_pixel_aspect bg: $sixel_background hgrid: $sixel_horizontal_grid. sixelstart [ansistring VIEW -lf 1 -vt 1 -nul 1 $sixelstart]" + + + #todo + } } else { - set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + puts stderr "overtype::renderline DCS - DEVICE CONTROL STRING command UNIMPLEMENTED. code [ansistring VIEW -lf 1 -vt 1 -nul 1 $code]" + #ST (string terminator) \x9c or \x1b\\ + if {[tcl::string::index $codenorm end] eq "\x9c"} { + set code_content [tcl::string::range $codenorm 4 end-1] ;#ST is 8-bit 0x9c + } else { + set code_content [tcl::string::range $codenorm 4 end-2] ;#ST is \x1b\\ + } } - } 7OSC - 8OSC { # OSCs are terminated with ST of either \007 or \x1b\\ - we allow either whether code was 7 or 8 bit diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm index 45f53981..69affd9b 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ansi-0.1.1.tm @@ -5039,6 +5039,10 @@ Brightblack 100 Brightred 101 Brightgreen 102 Brightyellow 103 Brightblu # mouse_urxvt 1015\ # mouse_sgr_pixel 1016\ #] + # + # some more ansi mode/sequence info: + #https://pkg.go.dev/github.com/charmbracelet/x/ansi + variable decmode_data { 1 { {origin DEC description "DECCKM - Cursor Keys Mode" names {DECCKM cursor_keys}} @@ -5059,6 +5063,9 @@ In VT52 mode - use \x1b< to exit. 5 { {origin DEC description "DECSCNM - Screen Mode (light or dark screen)" names {DECSNM lightmode}} } + 6 { + {origin DEC description "DECOM - Origin Mode (whether cursor is restricted to within page margins)" names {DECOM}} + } 7 { {origin DEC description "DECAWM - Auto Wrap Mode" names {DECAWM line_wrap}} } @@ -5090,7 +5097,13 @@ be as if this was off - ie lone CR. {origin DEC description "DECGRPM - Graphics Rotated Print Mode (obsolete?)" names {DECGRPM}} } 66 { - {origin DEC description "DECNKM - Numeric Keypad Mode" names {DECNKM}} + {origin DEC description "DECNKM - Numeric Keypad Mode" see "https://vt100.net/docs/vt510-rm/DECNKM.html" names {DECNKM}} + } + 67 { + {origin DEC description "DECBKM - Backarrow Key Mode" see "https://vt100.net/docs/vt510-rm/DECBKM.html" names {DECBKM}} + } + 69 { + {origin DEC description "DECLRMM - Left Right Margin Mode" see "https://vt100.net/docs/vt510-rm/DECLRMM.html" names {DECLRMM}} } 1000 { {origin "xterm" description "VT200 compatibility mouse" names {SET_VT200_MOUSE} note { diff --git a/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm index 3bbc65cf..b62c497b 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/console-0.1.1.tm @@ -570,6 +570,14 @@ namespace eval punk::console { puts -nonewline stdout \x1b\[?1006l flush stdout } + proc enable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000h\x1b\[?1003h\x1b\[?1016h + flush stdout + } + proc disable_mouse_sgr {} { + puts -nonewline stdout \x1b\[?1000l\x1b\[?1003l\x1b\[?1016l + flush stdout + } proc enable_bracketed_paste {} { puts -nonewline stdout \x1b\[?2004h } @@ -1762,6 +1770,158 @@ namespace eval punk::console { puts -nonewline "\x1b\[?${m}l" } + variable has_mode_cache + set has_mode_cache [dict create] + lappend PUNKARGS [list { + @id -id ::punk::console::has_mode + @cmd -name punk::console::has_mode\ + -summary\ + {Check if console supports DEC mode}\ + -help\ + {Check if console supports DEC mode by emitting query to the console using + the sequence: + ESC [ ? $ p + Where is an integer identifier. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + -refresh -type none + @values -min 1 -max 1 + mode -type {int|string} -help\ + "integer for DEC mode, or name as in the dict: + ::punk::ansi::decmode_names" + }] + proc has_mode {args} { + set argd [punk::args::parse $args withid ::punk::console::has_mode] + lassign [dict values $argd] leaders opts values received + set console [dict get $opts -console] + set num_or_name [dict get $values mode] + if {[dict exists $received -refresh]} { + set do_refresh 1 + } else { + set do_refresh 0 + } + + if {[string is integer -strict $num_or_name]} { + set m $num_or_name + } else { + upvar ::punk::ansi::decmode_names decmode_names + if {[dict exists $decmode_names $num_or_name]} { + set m [dict get $decmode_names $num_or_name] + } else { + error "punk::console::get_mode unrecognised mode '$num_or_name'. Known mode names: [dict keys $decmode_names]" + } + } + variable has_mode_cache + if {$do_refresh} { + if {[dict exists $has_mode_cache $console $m]} { + dict unset has_mode_cache $console $m + } + } + + if {![dict exists $has_mode_cache $console $m]} { + set capturingregex [string map [list %MODE% $m] {(.*)(\x1b\[\?%MODE%;([0-9]+)\$y)$}] ;#must capture prefix,entire-response,response-payload + set request "\x1b\[?$m\$p" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set has_mode [expr {$payload != 0}] + dict set has_mode_cache $console $m $has_mode + } else { + set has_mode [dict get $has_mode_cache $console $m] + } + return $has_mode + } + + set DECRQSS_DATA { + "Select Active Status Display" DECSASD "$\}" + "Select Attribute Change Extent" DECSACE "*x" + "Set Character Attribute" DECSCA "\"q" + "Set Conformance Level" DECSCL "\"p" + "Set Columns Per Page" DECSCPP "\$|" + "Set Lines Per Page" DECSLPP "t" + "Set Number of Lines per Screen" DECSNLS "*|" + "Set Status Line Type" DECSSDT "$~" + "Set Left and Right Margins" DECSLRM "s" + "Set Top and Bottom Margins" DECSTBM "r" + "Set Graphic Rendition" SGR "m" + "Select Set-Up Language" DECSSL "p" + "Select Printer Type" DECSPRTT "\$s" + "Select Refresh Rate" DECSRFR "\"t" + "Select Digital Printed Data Type" DECSDPT "(p" + "Select ProPrinter Character Set" DECSPPCS "*p" + "Select Communication Speed" DECSCS "*r" + "Select Communication Port" DECSCP "*u" + "Set Scroll Speed" DECSSCLS " p" + "Set Cursor Style" DECSCUSR " q" + "Set Key Click Volume" DECSKCV " r" + "Set Warning Bell Volume" DECSWBV " t" + "Set Margin Bell Volume" DECSMBV " u" + "Set Lock Key Style" DECSLCK " v" + "Select Flow Control Type" DECSFC "*s" + "Select Disconnect Delay Time" DECSDDT "\$q" + "Set Transmit Rate Limit" DECSTRL "u" + "Set Port Parameter" DECSPP "\+w" + } + set DECRQSS_DICT [dict create] + foreach {desc name str} $DECRQSS_DATA { + dict set DECRQSS_DICT $name $str + } + + #emit DECRQSS and get DECRPSS response + # --------------------- + #NOTE: https://vt100.net/docs/vt510-rm/DECRPSS.html + #response: DCS Ps $ r D...D ST + #Conflict between above doc saying Ps of 0 indicates a valid request and 1 indicates invalid - and the behaviour of windows terminal, wezterm and the reported xterm behaviour + # shown at: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html + #REVIEW + # --------------------- + #Note also on Freebsd xterm we seem to getresponse ': 1 $ r D...D ST' + #(no leading DCS) - this + + lappend PUNKARGS [list { + @id -id ::punk::console::request_dec_setting + @cmd -name punk::console::request_dec_setting\ + -summary\ + {Perform DECRQSS query to get DECRPSS response}\ + -help\ + {DECRQSS query for DEC Selection or Setting. + Return payload from console's DECRPSS response. + } + @opts + -console -type list -minsize 2 -default {stdin stdout} + @values -min 1 -max 1 + name -type string + }] + proc request_dec_setting {args} { + set argd [punk::args::parse $args withid ::punk::console::request_dec_setting] + lassign [dict values $argd] leaders opts values + set console [dict get $opts -console] + set name [dict get $values name] + + variable DECRQSS_DICT + if {![dict exists $DECRQSS_DICT $name]} { + error "request_dec_setting unrecognised name $name. Known values: [dict keys $DECRQSS_DICT]" + } + set str [dict get $DECRQSS_DICT $name] + set re_str [string map [list * \\* \$ \\\$ + \\+ ( \\(] $str] ;#regex escaped + #review {[0-9;:]} - too restrictive? - what values can be returned? alnum? - we perhaps at least need to exclude ESC so we don't overmatch + set capturingregex [string map [list %s% $re_str] {(.*)(\x1bP([0-1]\$r[0-9;:]*)(?:%s%){0,1}\x1b\\)$}] ;#must capture prefix,entire-response,response-payload + #todo - handle xterm : [0-1] $ r D...D ST + set request "\x1bP\$q${str}\x1b\\" + set payload [punk::console::internal::get_ansi_response_payload -terminal $console $request $capturingregex] + set c1 [string index $payload 0] + switch -- $c1 { + 0 { + error "request_dec_setting - terminal doesn't recognise request '[punk::ansi::ansistring VIEW $request]' as valid" + } + 1 {} + default { + #shouldn't get here + error "request_dec_setting - unrecognised response to request '[punk::ansi::ansistring VIEW $request]'. payload: [punk::ansi::ansistring VIEW $payload]" + } + } + #strip leading 1$r + return [string range $payload 3 end] + } #terminals lie. This should be a reasonable (albeit relatively slow) test of actual width - but some terminals seem to miscalculate. #todo - a visual interactive test/questionnaire to ask user if things are lining up or if the terminal is telling fibs about cursor position. diff --git a/src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm index c9002166..0cb5be16 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/sixel-0.1.0.tm @@ -134,7 +134,7 @@ tcl::namespace::eval punk::sixel { if {$cell_size_override ne ""} { lassign [split [string tolower $cell_size_override] x] cwidth cheight if {![string is integer -strict $cwidth] || ![string is integer -strict $cheight]} { - error "punk::sixel::get_info -cell_sixe must be of the form WxH where W and H are positive integers" + error "punk::sixel::get_info -cell_sixel must be of the form WxH where W and H are positive integers" } set cell_size $cell_size_override } else { @@ -143,7 +143,11 @@ tcl::namespace::eval punk::sixel { lassign [split $cell_size x] cwidth cheight set height_cells [expr {int(ceil($height_pixels /double($cheight)))}] set sixelparams "" - set sixel_extents [list] ;#number of sixes in each line taking into account retraces due to $ + set sixel_extents [list] ;#number of sixels in each line taking into account retraces due to $ + + #REVIEW + #There can be multiple raster-attribute instructions repeatedly changing the size and aspect ratio of subsequent pixels. + #see sixel/multisize.six set line0 [lindex $raster_lines 0] if {[regexp -indices {^\x1bP([;0-9]*)q} $line0 i_match]} { @@ -196,11 +200,11 @@ tcl::namespace::eval punk::sixel { #don't use escape in switch selector - ensures jump table is used. if {$c eq "\x1b"} { if {[string index $linedata $s+1] eq "\\"} { - #7bit ST + #7bit ST break } } else { - incr line_sixelrun + incr line_sixelrun } } } @@ -219,6 +223,48 @@ tcl::namespace::eval punk::sixel { } + punk::args::define { + @id -id ::punk::sixel::can_sixel + @cmd -name punk::sixel::can_sixel\ + -summary\ + "Report whether terminal can display sixel graphics."\ + -help\ + "return a boolean indicating whether the terminal has sixel capability." + -refresh -type none -help\ + "When supplied, will make a new call to punk::console::get_device_attributes, + rather than relying on a cached answer" + @values -min 0 -max 1 + terminal -type list -minsize 2 -default {stdin stdout} + } + #review + variable device_attribute_cache + set device_attribute_cache [dict create] + proc can_sixel {args} { + set argd [punk::args::parse $args withid ::punk::sixel::can_sixel] + lassign [dict values $argd] leaders opts values received + set terminal [dict get $values terminal] + + variable device_attribute_cache + if {[dict exists $received -refresh]} { + set attribs [punk::console::get_device_attributes $terminal] + dict set device_attribute_cache $terminal $attribs + } else { + if {[dict exists $device_attribute_cache $terminal]} { + set attribs [dict get $device_attribute_cache $terminal] + } else { + set attribs [punk::console::get_device_attributes $terminal] + dict set device_attribute_cache $terminal $attribs + } + } + + set codes [split $attribs {;}] + if {"4" in $codes} { + return true + } else { + return false + } + } + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::sixel ---}] } @@ -259,11 +305,11 @@ tcl::namespace::eval punk::sixel::lib { # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -## Ready +## Ready package provide punk::sixel [tcl::namespace::eval punk::sixel { variable pkg punk::sixel variable version - set version 0.1.0 + set version 0.1.0 }] return