1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 tc_screen:
16 procedure;
17 return;
18
19
20
21 declare (
22 Screen_data_ptr pointer,
23 Operation fixed bin,
24 Op_row fixed bin,
25 Op_col fixed bin,
26 Op_count fixed bin,
27 Text character (*),
28 Insert bit (1) aligned,
29 Rows fixed bin,
30 Columns fixed bin
31 ) parameter;
32
33
34
35
36
37 %page;
38 %include tty_video_tables;
39 %page;
40 %include tc_screen_image;
41 %page;
42 declare (length, string, substr) builtin;
43 declare discovered_clear_screen bit (1) aligned;
44 declare line fixed bin;
45 ^L
46
47 init:
48 entry (Screen_data_ptr, Rows, Columns);
49
50 screen_n_lines = Rows;
51 screen_n_columns = Columns;
52 allocate screen;
53
54 string (screen.lines (*)) = "";
55 screen.is_clear = "1"b;
56 Screen_data_ptr = screen_ptr;
57
58 return;
59
60
61 shut:
62 entry (Screen_data_ptr);
63
64 free Screen_data_ptr -> screen;
65 return;
66 ^L
67
68 operation:
69 entry (Screen_data_ptr, Operation, Op_row, Op_col, Op_count);
70
71 screen_ptr = Screen_data_ptr;
72
73 go to OPERATION (Operation);
74
75 OPERATION (0):
76 OPERATION (1):
77 OPERATION (4):
78 OPERATION (10):
79 OPERATION (11):
80 OPERATION (6):
81 OPERATION (7):
82 OPERATION (8):
83 OPERATION (9):
84 return;
85
86
87 OPERATION (2):
88 string (screen.lines (*)) = "";
89 screen.is_clear = "1"b;
90 return;
91
92 OPERATION (3):
93
94 substr (screen.lines (Op_row), Op_col) = "";
95 if Op_row < screen.n_lines
96 then begin;
97 declare lines (screen.n_lines - Op_row) character (screen.n_columns)
98 defined (screen.lines (Op_row + 1));
99 lines (*) = "";
100 end;
101 return;
102
103 OPERATION (12):
104 if screen.is_clear
105 then return;
106 substr (screen.lines (Op_row), Op_col) = substr (screen.lines (Op_row), Op_col + Op_count);
107 return;
108
109 OPERATION (13):
110 if screen.is_clear
111 then return;
112 begin;
113 declare new_home (screen.n_lines - Op_row + 1 - Op_count)
114 character (screen.n_columns) defined (screen.lines (Op_row + Op_count));
115 declare old_stuff (screen.n_lines - Op_row + 1 - Op_count)
116 character (screen.n_columns) defined (screen.lines (Op_row));
117 declare to_blank (Op_count) character (screen.n_columns) defined (screen.lines (Op_row));
118
119
120 new_home = old_stuff;
121 to_blank = "";
122
123
124 end;
125 return;
126
127 OPERATION (14):
128 if screen.is_clear
129 then return;
130 begin;
131 declare old_stuff (screen.n_lines - Op_row + 1 - Op_count)
132 character (screen.n_columns) defined (screen.lines (Op_row + Op_count));
133 declare new_home (screen.n_lines - Op_row + 1 - Op_count)
134 character (screen.n_columns) defined (screen.lines (Op_row));
135 declare to_blank (Op_count) character (screen.n_columns)
136 defined (screen.lines (screen.n_lines - Op_count + 1));
137
138
139 new_home = old_stuff;
140 to_blank = "";
141
142 end;
143 return;
144
145 OPERATION (5):
146 if screen.is_clear
147 then return;
148 if Op_row <= screen.n_lines
149 then substr (screen.lines (Op_row), Op_col) = "";
150 else signal SCREEN_ERROR_;
151 declare SCREEN_ERROR_ condition;
152 return;
153
154 text:
155 entry (Screen_data_ptr, Op_row, Op_col, Insert, Text);
156
157 screen_ptr = Screen_data_ptr;
158 if length (Text) = 0
159 then return;
160 if Text ^= ""
161 then screen.is_clear = "0"b;
162
163 begin;
164 declare line character (screen.n_columns) defined (screen.lines (Op_row));
165 if ^Insert
166 then substr (line, Op_col, length (Text)) = Text;
167 else do;
168 (nostringsize):
169 substr (line, Op_col + length (Text)) = substr (line, Op_col);
170
171 substr (line, Op_col, length (Text)) = Text;
172 end;
173 end;
174 return;
175
176 clear_in_line:
177 entry (Screen_data_ptr, Op_row, Op_col, Op_count);
178
179 screen_ptr = Screen_data_ptr;
180 if screen.is_clear
181 then return;
182
183 substr (screen.lines (Op_row), Op_col, Op_count) = "";
184 return;
185
186 get_in_line:
187 entry (Screen_data_ptr, Op_row, Op_col, Text);
188
189 screen_ptr = Screen_data_ptr;
190 if screen.is_clear
191 then Text = "";
192 else Text = substr (screen.lines (Op_row), Op_col);
193 return;
194
195 may_echo_negotiate:
196 entry (Screen_data_ptr, Op_row, Op_col) returns (bit (1) aligned);
197
198 screen_ptr = Screen_data_ptr;
199
200 if screen.is_clear
201 then return ("1"b);
202
203 return (substr (screen.lines (Op_row), Op_col + 1) = "");
204
205 is_region_clear:
206 entry (Screen_data_ptr, Op_row, Op_col, Rows, Columns) returns (bit (1) aligned);
207
208 screen_ptr = Screen_data_ptr;
209 if screen.is_clear
210 then return ("1"b);
211
212
213
214
215 if Op_col = 1
216 & Op_row = 1
217 & Rows = screen.n_lines
218 & Columns = screen.n_columns
219 then return (is_the_screen_clear ());
220
221 if Rows > 4
222 then if is_the_screen_clear ()
223 then return ("1"b);
224
225
226
227 do line = Op_row to Op_row + Rows - 1;
228 if substr (screen.lines (line), Op_col, Columns) ^= ""
229 then return ("0"b);
230 end;
231 return ("1"b);
232
233 is_the_screen_clear:
234 procedure returns (bit (1) aligned);
235
236 if string (screen.lines (*)) = ""
237 then do;
238 screen.is_clear = "1"b;
239 return ("1"b);
240 end;
241 else return ("0"b);
242 end is_the_screen_clear;
243
244 end tc_screen;