1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* Terminal Control Screen Image Management */
 14 /* format: style2,linecom,^indnoniterdo,indcomtxt,^inditerdo,dclind5,idind25 */
 15 tc_screen:
 16      procedure;
 17           return;
 18 
 19 /* Coded June 1981 by, Benson I. Margulies, because I had no choice. */
 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 /*  a virtual video terminal, more or less. Insert mode
 35    is replaced with extra entrypoints to simplify things. */
 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):                                              /* ERROR */
 76 OPERATION (1):                                              /* POSITION CURSOR */
 77 OPERATION (4):                                              /* HOME */
 78 OPERATION (10):                                             /* INSERT_CHARS */
 79 OPERATION (11):                                             /* END INSERT CHARS */
 80 OPERATION (6):                                              /* UP, down, etc. */
 81 OPERATION (7):
 82 OPERATION (8):
 83 OPERATION (9):
 84           return;
 85 
 86 
 87 OPERATION (2):                                              /* Clear screen */
 88           string (screen.lines (*)) = "";
 89           screen.is_clear = "1"b;
 90           return;
 91 
 92 OPERATION (3):                                              /* clear to EOS */
 93                                                             /* too hard to check for is_clear */
 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):                                             /* DELETE CHARS */
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):                                             /* INSERT LINES */
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):                                             /* DELETE LINES */
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):                                              /* EOL */
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):                                             /* whatever the prefix */
169                     substr (line, Op_col + length (Text)) = substr (line, Op_col);
170                                                             /* would take stringsize */
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 /* Case statement for efficiency */
213 /* though Isub defining could probably do it in one nasty dcl */
214 
215           if Op_col = 1                                     /* start at origin */
216                & Op_row = 1                                 /* ditto */
217                & Rows = screen.n_lines                      /* all the way down */
218                & Columns = screen.n_columns                 /* and across */
219           then return (is_the_screen_clear ());
220 
221           if Rows > 4                                       /* just a heuristic for cost */
222           then if is_the_screen_clear ()                    /* perhaps the screen is empty? */
223                then return ("1"b);
224 
225 /* we have to look at a region */
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:                                        /* interrogate screen.is_clear FIRST */
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;