1# -*- tcl -*-
2# ### ### ### ######### ######### #########
3## Terminal packages - ANSI - Control codes
4
5## References
6# [0] Google: ansi terminal control
7# [1] http://vt100.net/docs/vt100-ug/chapter3.html
8# [2] http://www.termsys.demon.co.uk/vtansi.htm
9# [3] http://rrbrandt.dyndns.org:60000/docs/tut/redes/ansi.php
10# [4] http://www.dee.ufcg.edu.br/~rrbrandt/tools/ansi.html
11# [5] http://www.ecma-international.org/publications/standards/Ecma-048.htm
12
13# ### ### ### ######### ######### #########
14## Requirements
15
16package require  term::ansi::code
17package require  term::ansi::code::attr
18
19namespace eval ::term::ansi::code::ctrl {}
20
21# ### ### ### ######### ######### #########
22## API. Symbolic names.
23
24proc ::term::ansi::code::ctrl::names {} {
25    variable ctrl
26    return  $ctrl
27}
28
29proc ::term::ansi::code::ctrl::import {{ns ctrl} args} {
30    if {![llength $args]} {set args *}
31    set args ::term::ansi::code::ctrl::[join $args " ::term::ansi::code::ctrl::"]
32    uplevel 1 [list namespace eval ${ns} [linsert $args 0 namespace import]]
33    return
34}
35
36# ### ### ### ######### ######### #########
37
38## TODO = symbolic key codes for skd.
39
40# ### ### ### ######### ######### #########
41## Internal - Setup
42
43proc ::term::ansi::code::ctrl::DEF {name esc value} {
44    variable  ctrl
45    define           $name $esc $value
46    lappend   ctrl   $name
47    namespace export $name
48    return
49}
50
51proc ::term::ansi::code::ctrl::DEFC {name arguments script} {
52    variable  ctrl
53    proc             $name $arguments $script
54    lappend   ctrl   $name
55    namespace export $name
56    return
57}
58
59proc ::term::ansi::code::ctrl::INIT {} {
60    # ### ### ### ######### ######### #########
61    ##
62
63    # Erasing
64
65    DEF	eeol    escb K  ; # Erase (to) End Of Line
66    DEF	esol    escb 1K ; # Erase (to) Start Of Line
67    DEF	el      escb 2K ; # Erase (current) Line
68    DEF	ed      escb J  ; # Erase Down (to bottom)
69    DEF	eu      escb 1J ; # Erase Up (to top)
70    DEF	es      escb 2J ; # Erase Screen
71
72    # Scrolling
73
74    DEF	sd      esc D    ; # Scroll Down
75    DEF	su      esc M    ; # Scroll Up
76
77    # Cursor Handling
78
79    DEF	ch      escb H  ; # Cursor Home
80    DEF	sc      escb s  ; # Save Cursor
81    DEF	rc      escb u  ; # Restore Cursor (Unsave)
82    DEF	sca     esc  7  ; # Save Cursor + Attributes
83    DEF	rca     esc  8  ; # Restore Cursor + Attributes
84
85    # Tabbing
86
87    DEF	st      esc  H  ; # Set Tab (@ current position)
88    DEF	ct      escb g  ; # Clear Tab (@ current position)
89    DEF	cat     escb 3g ; # Clear All Tabs
90
91    # Device Introspection
92
93    DEF	qdc     escb c  ; # Query Device Code
94    DEF	qds     escb 5n ; # Query Device Status
95    DEF	qcp     escb 6n ; # Query Cursor Position
96    DEF	rd      esc  c  ; # Reset Device
97
98    # Linewrap on/off
99
100    DEF	elw     escb 7h ; # Enable Line Wrap
101    DEF	dlw     escb 7l ; # Disable Line Wrap
102
103    # Graphics Mode (aka use alternate font on/off)
104
105    DEF eg      esc F   ; # Enter Graphics Mode
106    DEF lg      esc G   ; # Exit Graphics Mode
107
108    ##
109    # ### ### ### ######### ######### #########
110
111    # ### ### ### ######### ######### #########
112    ## Complex, parameterized codes
113
114    # Select Character Set
115    # Choose which char set is used for default and
116    # alternate font. This does not change whether
117    # default or alternate font are used
118
119    DEFC scs0 {tag} {esc  ($tag}  ; # Set default character set
120    DEFC scs1 {tag} {esc  )$tag}  ; # Set alternate character set
121
122    # tags in A : United Kingdom Set
123    #         B : ASCII Set
124    #         0 : Special Graphics
125    #         1 : Alternate Character ROM Standard Character Set
126    #         2 : Alternate Character ROM Special Graphics
127
128    # Set Display Attributes
129
130    DEFC sda {args} {escb [join $args ";"]m}
131
132    # Force Cursor Position (aka Go To)
133
134    DEFC fcp {r c}  {escb ${r}\;${c}f}
135
136    # Cursor Up, Down, Forward, Backward
137
138    DEFC cu {{n 1}} {escb [expr {$n == 1 ? "A" : "${n}A"}]}
139    DEFC cd {{n 1}} {escb [expr {$n == 1 ? "B" : "${n}B"}]}
140    DEFC cf {{n 1}} {escb [expr {$n == 1 ? "C" : "${n}C"}]}
141    DEFC cb {{n 1}} {escb [expr {$n == 1 ? "D" : "${n}D"}]}
142
143    # Scroll Screen (entire display, or between rows start end, inclusive).
144
145    DEFC ss {args} {
146	if {[llength $args] == 0} {return [escb r]}
147	if {[llength $args] == 2} {foreach {s e} $args break ; return [escb ${s};${e}r]}
148	return -code error "wrong\#args"
149    }
150
151    # Set Key Definition
152
153    DEFC skd {code str} {escb "${code};\"${str}\"p"}
154
155    # Terminal title
156
157    DEFC title {str} {esc "\]0;${str}\007"}
158
159    # Switch to and from character/box graphics.
160
161    DEFC gron  {} {return \016}
162    DEFC groff {} {return \017}
163
164    # Character graphics, box symbols
165    # - 4 corners, 4 t-junctions,
166    #   one 4-way junction, 2 lines
167
168    DEFC tlc   {} {return [gron]l[groff]} ; # Top    Left  Corner
169    DEFC trc   {} {return [gron]k[groff]} ; # Top    Right Corner
170    DEFC brc   {} {return [gron]j[groff]} ; # Bottom Right Corner
171    DEFC blc   {} {return [gron]m[groff]} ; # Bottom Left  Corner
172
173    DEFC ltj   {} {return [gron]t[groff]} ; # Left   T Junction
174    DEFC ttj   {} {return [gron]w[groff]} ; # Top    T Junction
175    DEFC rtj   {} {return [gron]u[groff]} ; # Right  T Junction
176    DEFC btj   {} {return [gron]v[groff]} ; # Bottom T Junction
177
178    DEFC fwj   {} {return [gron]n[groff]} ; # Four-Way Junction
179
180    DEFC hl    {} {return [gron]q[groff]} ; # Horizontal Line
181    DEFC vl    {} {return [gron]x[groff]} ; # Vertical   Line
182
183    # Optimize character graphics. The generator commands above create
184    # way to many superfluous commands shifting into and out of the
185    # graphics mode. The command below removes all shifts which are
186    # not needed. To this end it also knows which characters will look
187    # the same in both modes, to handle strings created outside this
188    # package.
189
190    DEFC groptim {string} {
191	variable grforw
192	variable grback
193	while {![string equal $string [set new [string map \
194		"\017\016 {} \016\017 {}" [string map \
195		$grback [string map \
196		$grforw $string]]]]]} {
197	    set string $new
198	}
199	return $string
200    }
201
202    ##
203    # ### ### ### ######### ######### #########
204
205    # ### ### ### ######### ######### #########
206    ## Higher level operations
207
208    # Clear screen <=> CursorHome + EraseDown
209    # Init (Fonts): Default ASCII, Alternate Graphics
210    # Show a block of text at a specific location.
211
212    DEFC clear {} {return [ch][ed]}
213    DEFC init  {} {return [scs0 B][scs1 0]}
214
215    DEFC showat {r c text} {
216	if {![string length $text]} {return {}}
217	return [fcp $r $c][sca][join \
218		[split $text \n] \
219		[rca][cd][sca]][rca][cd]
220    }
221
222    ##
223    # ### ### ### ######### ######### #########
224
225    # ### ### ### ######### ######### #########
226    ## Attribute control (single attributes)
227
228    foreach a [::term::ansi::code::attr::names] {
229	DEF sda_$a escb "[::term::ansi::code::attr::$a]m"
230    }
231
232    ##
233    # ### ### ### ######### ######### #########
234    return
235}
236
237# ### ### ### ######### ######### #########
238## Data structures.
239
240namespace eval ::term::ansi::code::ctrl {
241    namespace import ::term::ansi::code::define
242    namespace import ::term::ansi::code::esc
243    namespace import ::term::ansi::code::escb
244
245    variable grforw
246    variable grback
247    variable _
248    foreach _ {
249	! \" # $ % & ' ( ) * + , - . /
250	0 1 2 3 4 5 6 7 8 9 : ; < = >
251	? @ A B C D E F G H I J K L M
252	N O P Q R S T U V W X Y Z [ \\
253	] ^
254    } {
255	lappend grforw \016$_ $_\016
256	lappend grback $_\017 \017$_
257    }
258    unset _
259}
260
261::term::ansi::code::ctrl::INIT
262
263# ### ### ### ######### ######### #########
264## Ready
265
266package provide term::ansi::code::ctrl 0.1.1
267
268##
269# ### ### ### ######### ######### #########
270