Pascal Compiler IV.13 c6t-4 2/ 5/85 Page 1 1 0 0:d 1 { $L WORK:TTY.A.LIST.TEXT} 2 0 0:d 1 {$S+} {SWAPPING MODE FOR MORE SYMBOL TABLE SPACE} 3 0 0:d 1 4 2 1:d 1 PROGRAM TTY; 5 2 1:d 1 6 2 1:d 1 {PROGRAM TO ALLOW MICRO TO ACT AS A TERMINAL TO A REMOTE} 7 2 1:d 1 {AND TO TRANSFER FILES BETWEEN THE MICRO AND THE REMOTE } 8 2 1:d 1 9 2 1:d 1 Uses 10 2 1:d 1 {-----------------------------------------------------------------------------} 11 2 1:d 1 {TTY.UNIT.G - unit include file for general - 1-Feb-83 } 12 2 1:d 1 {-----------------------------------------------------------------------------} 13 2 1:d 1 14 2 1:d 1 {$U *system.library } ScreenOps 15 2 1:d 1 16 2 1:d 1 {-----------------------------------------------------------------------------} 17 2 1:d 1 {end TTY.UNIT.G} 18 2 1:d 1 {-----------------------------------------------------------------------------} 19 2 1:d 1 20 2 1:d 1 { holds specific units for target mc } Using SCREENOP 21 2 1:u 1 22 2 1:u 1 23 2 1:u 1 const 24 2 1:u 1 sc_fill_len = 11; 25 2 1:u 1 sc_eol = 13; 26 2 1:u 1 27 2 1:u 1 type 28 2 1:u 1 sc_chset = set of char; 29 2 1:u 1 sc_misc_rec = packed record 30 2 1:u 1 height, width : 0..255; 31 2 1:u 1 can_break, slow, xy_crt, lc_crt, 32 2 1:u 1 can_upscroll, can_downscroll : boolean; 33 2 1:u 1 end; 34 2 1:u 1 sc_date_rec = packed record 35 2 1:u 1 month : 0..12; 36 2 1:u 1 day : 0..31; 37 2 1:u 1 year : 0..99; 38 2 1:u 1 end; 39 2 1:u 1 sc_info_type = packed record 40 2 1:u 1 sc_version : string; 41 2 1:u 1 sc_date : sc_date_rec; 42 2 1:u 1 spec_char : sc_chset; {Characters not to echo} 43 2 1:u 1 misc_info : sc_misc_rec; 44 2 1:u 1 end; 45 2 1:u 1 sc_long_string = string[255]; 46 2 1:u 1 sc_scrn_command = (sc_whome, sc_eras_s, sc_erase_eol, sc_clear_lne, 47 2 1:u 1 sc_clear_scn, sc_up_cursor, sc_down_cursor, 48 2 1:u 1 sc_left_cursor, sc_right_cursor); 49 2 1:u 1 sc_key_command = (sc_backspace_key, sc_dc1_key, sc_eof_key, sc_etx_key, 50 2 1:u 1 sc_escape_key, sc_del_key, sc_up_key, sc_down_key, 51 2 1:u 1 sc_left_key, sc_right_key, sc_not_legal, sc_insert_key, 52 2 1:u 1 sc_delete_key); 53 2 1:u 1 sc_choice = (sc_get, sc_give); 54 2 1:u 1 sc_window = packed array [0..0] of char; 55 2 1:u 1 sc_tx_port = record Pascal Compiler IV.13 c6t-4 - *system.library 2/ 5/85 Page 2 56 2 1:u 1 row, col, { screen relative} 57 2 1:u 1 height, width, { size of txport (zero based)} 58 2 1:u 1 cur_x, cur_y : integer; 59 2 1:u 1 {cursor positions relative to the txport } 60 2 1:u 1 end; 61 2 1:u 1 62 2 1:u 1 {entries 4..syscom^.subsidstart-1 are valid} 63 2 1:u 1 sc_err_msg_array = array [4..4] of ^string; {accessed $R-} 64 2 1:u 1 65 2 1:u 1 var 66 2 1:u 1 sc_port : sc_tx_port; 67 2 1:u 7 sc_printable_chars : sc_chset; 68 2 1:u 23 sc_errorline : integer; 69 2 1:u 24 sc_errormessage : ^sc_err_msg_array; 70 2 1:u 25 71 2 1:u 25 procedure sc_use_info(do_what:sc_choice; var t_info:sc_info_type); 72 2 1:u 1 procedure sc_use_port(do_what:sc_choice; var t_port:sc_tx_port); 73 2 1:u 1 procedure sc_erase_to_eol(x,line:integer); 74 2 1:u 1 procedure sc_left; 75 2 1:u 1 procedure sc_right; 76 2 1:u 1 procedure sc_up; 77 2 1:u 1 procedure sc_down; 78 2 1:u 1 procedure sc_getc_ch(var ch:char; return_on_match:sc_chset); 79 2 1:u 1 procedure sc_clr_screen; 80 2 1:u 1 procedure sc_clr_line (y:integer); 81 2 1:u 1 procedure sc_home; 82 2 1:u 1 procedure sc_eras_eos (x,line:integer); 83 2 1:u 1 procedure sc_goto_xy(x, line:integer); 84 2 1:u 1 procedure sc_clr_cur_line; 85 2 1:u 1 function sc_find_x:integer; 86 2 1:u 1 function sc_find_y:integer; 87 2 1:u 1 function sc_scrn_has(what:sc_scrn_command):boolean; 88 2 1:u 1 function sc_has_key(what:sc_key_command):boolean; 89 2 1:u 1 function sc_map_crt_command(var k_ch:char):sc_key_command; 90 2 1:u 1 function sc_prompt(line :sc_long_string; x_cursor,y_cursor,x_pos, 91 2 1:u 1 where:integer; return_on_match:sc_chset; 92 2 1:u 21 no_char_back:boolean; break_char:char):char; 93 2 1:u 1 function sc_check_char(var buf:sc_window; var buf_index,bytes_left:integer) 94 2 1:u :boolean; 95 2 1:u 1 function sc_space_wait(flush:boolean):boolean; 96 2 1:u 1 procedure sc_init; 97 2 1:u 1 98 2 1:d 1 ; 99 2 1:d 1 100 2 1:d 1 {*******************************************************} 101 2 1:d 1 { } 102 2 1:d 1 { ERCC Microcomputer Support Unit } 103 2 1:d 1 { } 104 2 1:d 1 { Contributors Austin Tate } 105 2 1:d 1 { Stephen Hayes } 106 2 1:d 1 { Kenneth Currie } 107 2 1:d 1 { Gordon Wilkie } 108 2 1:d 1 { } 109 2 1:d 1 {*******************************************************} 110 2 1:d 1 111 2 1:d 1 CONST Version='20-Dec-84'; { last alteration date } 112 2 1:d 1 SPACE=' '; Pascal Compiler IV.13 c6t-4 2/ 5/85 Page 3 113 2 1:d 1 NUL=0; 114 2 1:d 1 CTRLA=1; 115 2 1:d 1 EOT=4; 116 2 1:d 1 BEL=7; 117 2 1:d 1 BS=8; 118 2 1:d 1 LF=10; 119 2 1:d 1 CTRLL=12; 120 2 1:d 1 CR=13; 121 2 1:d 1 DLE=16; 122 2 1:d 1 XON=17; 123 2 1:d 1 PADXON='|'; 124 2 1:d 1 XOFF=19; 125 2 1:d 1 CTRLX=24; 126 2 1:d 1 ESC=27; 127 2 1:d 1 DEL=127; 128 2 1:d 1 CRMSB=141; 129 2 1:d 1 XONMSB=145; {XON WITH MSB SET} 130 2 1:d 1 XOFFMSB=147; 131 2 1:d 1 msb1=177; {character '1' with the msb set} 132 2 1:d 1 msb3=179; 133 2 1:d 1 134 2 1:d 1 { HOST SPECIFIC CONSTANTS } 135 2 1:d 1 136 2 1:d 1 NEWLINE=10; { the host specific Newline character } 137 2 1:d 1 TransparenCh=16; { the Byte Stuff character for special cases } 138 2 1:d 1 BS_Map_Ch=127; { the host prefered ERASE character } 139 2 1:d 1 140 2 1:d 1 { VALUES SET IN INITDATA WHICH CAN BE ALTERED BY CONFIGURE } 141 2 1:d 1 { HALFDUPLEX=FALSE SET TO TRUE FOR A HALF DUPLEX HOST } 142 2 1:d 1 { CHINMOD=128 MASK FOR CHARACTERS REEIVED IN GETFILE} 143 2 1:d 1 144 2 1:d 1 type 145 2 1:d 1 short_string=string[12]; 146 2 1:d 1 long_string=string[255]; 147 2 1:d 1 VAR BreakChar,CH:CHAR; 148 2 1:d 3 MCNAME:STRING; {GIVES LOCAL MACHINE TYPE - INITIALISED BY REMSETUP} 149 2 1:d 44 escape_sequence,settcp, setpad:STRING; 150 2 1:d 167 str:long_string; 151 2 1:d 295 CRSTRING,CTRLASTRING, ctrlPstring:STRING[1]; 152 2 1:d 298 textfile,DEBUG,HALFDUPLEX:BOOLEAN; 153 2 1:d 301 bottomline,repeatch,CHINMOD,X_Chinmod,XOFNUM,WAITTIME,I,J:INTEGER; 154 2 1:d 309 CursorLost,ALTFILE,GOODLOCAL,TERMINAL:BOOLEAN; 155 2 1:d 313 PromptSet:set of char; 156 2 1:d 329 WAtX,WAtY,WWidth,WDepth,WCurX,WCurY:integer; { window variables } 157 2 1:d 335 Pascal Compiler IV.13 c6t-4 - TTY.MESS.D.TEXT 2/ 5/85 Page 4 158 2 1:d 335 {$P} 159 2 1:d 335 {-----------------------------------------------------------------------------} 160 2 1:d 335 {24-Mar-82 TTY.MESS.D} 161 2 1:d 335 {-----------------------------------------------------------------------------} 162 2 1:d 335 163 2 1:d 335 Const 164 2 1:d 335 sink_size=512; {the current sink size} 165 2 1:d 335 calls=6; {the number of allowed messages} 166 2 1:d 335 MessDVersion=1; 167 2 1:d 335 Type 168 2 1:d 335 mess_form=(empty, host, local, debugging, star ); {message types} 169 2 1:d 335 Var 170 2 1:d 335 sink:packed array[1..sink_size] of char; 171 2 1:d 591 TimeOutUnits,sink_pointer:integer; 172 2 1:d 593 Last_got_message:0..calls; 173 2 1:d 594 messages:array[1..calls] of string; 174 2 1:d 840 mess_type:array[1..calls] of mess_form; 175 2 1:d 846 Host_prompt:string; 176 2 1:d 887 177 2 1:d 887 {also needed are the following - assumed to come from elsewhere 178 2 1:d 887 179 {commented ';'} Var promptset:set of char; 180 {commented ';'} 181 {commented ';'} Procedure remread(ch:char); 182 2 1:d 887 } 183 2 1:d 887 184 2 1:d 887 {-----------------------------------------------------------------------------} 185 2 1:d 887 {end TTY.MESS.D} 186 2 1:d 887 {-----------------------------------------------------------------------------} 187 2 1:d 887 188 2 1:d 887 189 2 1:d 887 190 2 1:d 887 Procedure PutTxt(S:String); Forward; { used in DEV.X.X } 191 2 1:d 1 Procedure PutLn; Forward; 192 2 1:d 1 Procedure GetCh(var ch:char; Prompting,Echo:boolean); 193 2 1:d 1 Forward; 194 2 1:d 1 Procedure GetLn(Var S:LongString); Forward; 195 2 1:d 1 Pascal Compiler IV.13 c6t-4 - DEV.X.X.TEXT 2/ 5/85 Page 5 196 2 1:d 1 {$P} 197 2 1:d 1 {-----------------------------------------------------------------------------} 198 2 1:d 1 (* DEV.X.I *) 199 2 1:d 1 {-----------------------------------------------------------------------------} 200 2 1:d 1 (* Special routines for IBM from V4 and Sirius 1 X-talk *) 201 2 1:d 1 { 24-Dec-84 Gordon Wilkie REmflush modified so as not to print bells on IBM 202 2 1:d 1 as this takes 0.5 secs, and causes buffer overflow 203 2 1:d 1 21-Dec-84 Gordon Wilkie Remflush buffer increased to 512 for IBM PC 204 2 1:d 1 4-dec-84 Gordon Wilkie Null Breakcondition added } 205 2 1:d 1 { 29-Aug-84 Gordon Wilkie no call of REMDONE since it is a null routine 206 2 1:d 1 20-Aug-84 Gordon Wilkie no U/C conversion 207 2 1:d 1 Austin Tate and Ken Currie 17-Aug-82 } 208 2 1:d 1 209 2 1:d 1 var statrec: array [0..29] of integer; 210 2 1:d 916 211 2 1:d 916 (* DEFINITIONS FOR MACHINE CODE ROUTINE IN PORT.INIT *) 212 2 1:d 916 213 2 1:d 916 214 2 1:d 916 PROCEDURE REMCOMMAND(I:INTEGER); 215 2 6:0 0 BEGIN 216 2 6:0 0 (* dummy *) 217 2 1:0 0 END; 218 2 1:0 0 219 2 1:d 1 FUNCTION REMDONE:BOOLEAN; (* is normally EXTERNAL but dummy fo test *) 220 2 7:0 0 begin 221 2 7:1 0 remdone:=true; 222 2 1:0 0 end; 223 2 1:0 0 224 2 1:d 1 PROCEDURE REMWRITE(CH:CHAR); 225 2 8:d 1 var ch2:packed array [1..2] of char; 226 2 8:0 0 BEGIN 227 2 8:1 0 ch2[1]:=ch; 228 2 8:1 8 {WHILE NOT REMDONE DO {nothing;} 229 2 8:1 8 unitwrite(8,ch2[1],1,,12) 230 2 1:0 0 END; 231 2 1:0 0 232 2 1:d 1 PROCEDURE REMREAD(VAR CH:CHAR); 233 2 9:d 1 var ch2:packed array [1..2] of char; 234 2 9:0 0 BEGIN 235 2 9:1 0 unitread(7,ch2[1],1,,12); 236 2 9:1 12 ch:=ch2[1]; 237 2 1:0 0 END; 238 2 1:0 0 239 2 1:d 1 FUNCTION REMPRESS:BOOLEAN; 240 2 10:0 0 BEGIN 241 2 10:1 0 unitstatus(7,statrec,1); 242 2 10:1 7 REMPRESS:=(Statrec[0]>0); 243 2 1:0 0 END; 244 2 1:0 0 245 2 1:d 1 PROCEDURE REMBAUD; 246 2 11:0 0 BEGIN 247 2 11:1 0 PUTTXT('Set values during initial boot configuration.'); 248 2 11:1 7 PUTLN; 249 2 1:0 0 END; 250 2 1:0 0 251 2 1:d 1 PROCEDURE REMSETUP; 252 2 12:0 0 BEGIN Pascal Compiler IV.13 c6t-4 - DEV.X.X.TEXT 2/ 5/85 Page 6 253 2 12:1 0 MCNAME:='General V4'; 254 2 12:1 8 SC_Use_port(SCGet, SCPort); 255 2 12:1 14 Bottomline:=SCPort.Height; 256 2 12:1 20 {BottomLine:=23;} 257 2 1:0 0 END; 258 2 1:0 0 259 2 1:d 1 PROCEDURE REMFLUSH; 260 2 13:d 1 var i,j,k:integer; 261 2 13:d 4 ch:char; 262 2 13:d 5 ch2:packed array [0..1511] of char; 263 2 13:d 761 statrec: array [0..29] of integer; 264 2 13:d 791 265 2 13:d 791 {$r-} 266 2 13:0 0 BEGIN 267 2 13:1 0 unitstatus(7,statrec,1); 268 2 13:1 7 k:=statrec[0]; 269 2 13:1 15 while k > 0 do {ch available} 270 2 13:2 20 begin 271 2 13:3 20 unitread(7,ch2,k,,12); 272 2 13:3 28 for i:= 0 to k-1 do ch2[i]:=chr(ord(ch2[i]) mod 128); 273 2 13:3 56 j:=SCAN(k,=chr(7),ch2); 274 2 13:3 66 while j<>k do 275 2 13:4 70 begin 276 2 13:5 70 ch2[j]:=chr(0); 277 2 13:5 74 j:=SCAN(k,=chr(7),ch2); 278 2 13:4 84 end; 279 2 13:3 86 unitwrite(1,Ch2,k,,12); 280 2 13:3 94 unitstatus(7,statrec,1); 281 2 13:3 101 k:=statrec[0]; 282 2 13:2 109 end; 283 2 1:0 0 END; 284 2 1:0 0 {$r+} 285 2 1:0 0 286 2 1:0 0 287 2 1:d 1 PROCEDURE BREAKCONDITION; 288 2 1:d 1 289 2 14:0 0 BEGIN 290 2 14:1 0 write ('Cannot Generate Break!'); 291 2 14:1 13 REMWRITE(CHR(CR)); 292 2 1:0 0 END; 293 2 1:0 0 294 2 1:d 1 PROCEDURE REMCLOSE; 295 2 15:0 0 BEGIN 296 2 1:0 0 END; 297 2 1:0 0 298 2 1:d 1 FUNCTION KEYPRESS:BOOLEAN; 299 2 16:0 0 BEGIN 300 2 16:1 0 unitstatus(2,statrec,1); 301 2 16:1 7 KEYPRESS:=(Statrec[0]>0); 302 2 1:0 0 END; 303 2 1:0 0 304 2 1:d 1 PROCEDURE KEYREAD(VAR CH:CHAR;PROMPTING,ECHO:BOOLEAN); 305 2 17:d 1 var ch2:packed array [1..2] of char; 306 2 17:d 2 I : INTEGER; 307 2 17:0 0 BEGIN 308 2 17:1 0 unitread(2,ch2[1],1,,12); 309 2 17:1 12 ch:=ch2[1]; Pascal Compiler IV.13 c6t-4 - DEV.X.X.TEXT 2/ 5/85 Page 7 310 2 17:1 21 IF CH=CHR(CR) THEN BEGIN 311 2 17:3 26 IF ECHO THEN WRITELN; 312 2 17:2 36 END ELSE BEGIN 313 2 17:3 38 IF PROMPTING THEN BEGIN 314 2 17:5 41 IF CH<(' ') THEN CH:=CHR(BEL) 315 2 17:5 50 {ELSE IF ('a'<=CH) AND (CH<='z') THEN 316 2 17:4 50 CH:=CHR((ORD(CH)-ORD('a'))+ORD('A'))}; 317 2 17:4 51 END; 318 2 17:3 51 IF ECHO THEN WRITE(CH); 319 2 17:2 64 END; 320 2 1:0 0 END; 321 2 1:0 0 322 2 1:d 1 FUNCTION PARTX1:CHAR; 323 2 18:0 0 BEGIN (*MACHINE SPECIFIC PART MACHINE CHARACTER*) 324 2 18:1 0 PARTX1:='I'; 325 2 1:0 0 END; 326 2 1:0 0 327 2 1:d 1 FUNCTION PARTX2:INTEGER; 328 2 19:0 0 BEGIN 329 2 19:0 0 (*MACHINE SPECIFIC PART REVISION NUMBER*) 330 2 19:1 0 PARTX2:=7; 331 2 1:0 0 END; 332 2 1:0 0 333 2 1:0 0 {-----------------------------------------------------------------------------} 334 2 1:0 0 {end DEV.X.G} 335 2 1:0 0 {-----------------------------------------------------------------------------} 336 2 1:0 0 337 2 1:0 0 338 2 1:0 0 339 2 1:0 0 340 2 1:0 0 { remote routines appropriate for MCNAME only. 341 2 1:0 0 Appropriate file is renamed to DEV.X.X.TEXT before compilation } Pascal Compiler IV.13 c6t-4 - TTY.MESS.TEXT 2/ 5/85 Page 8 342 2 1:0 0 {$p} 343 2 1:0 0 {-----------------------------------------------------------------------------} 344 2 1:0 0 {18-Dec-84 - TTY.MESS} 345 2 1:0 0 {-----------------------------------------------------------------------------} 346 2 1:0 0 347 2 1:d 1 Function PartM:integer; 348 2 20:0 0 begin 349 2 20:1 0 PartM:=4; 350 2 1:0 0 end; 351 2 1:0 0 352 2 1:0 0 { This is the message handling part of X-Talk. The message structure 353 2 1:0 0 is accessed only by the routine PUT_MESSAGE, which enters the 354 2 1:0 0 messages, PRINT_MESSAGE, which outputs the messages to the screen 355 2 1:0 0 and GET_MESSAGE, which gets the next message in the structure - if 356 2 1:0 0 there is one. 357 2 1:0 0 358 2 1:0 0 It is assumed that the declarations in TTY.MESS.D.TEXT are available 359 2 1:0 0 } 360 2 1:0 0 361 2 1:d 1 Procedure Print_Messages; { write all messages to screen } 362 2 1:d 1 (*--------1------------*) 363 2 21:d 1 Var 364 2 21:d 1 i:integer; 365 2 21:0 0 begin 366 2 21:0 0 (* we should always be at the start of a new line *) 367 2 21:1 0 for i:=1 to calls do 368 2 21:2 9 if mess_type[i] <> empty 369 2 21:2 20 then writeln(messages[i]); 370 2 1:0 0 end; (* print_messages *) 371 2 1:0 0 372 2 1:d 1 Procedure Init_Messages; { initialises the messages and sets message } 373 2 1:d 1 (*----------1---------*) { pointer to zero } 374 2 22:d 1 var 375 2 22:d 1 i:integer; 376 2 22:0 0 begin 377 2 22:1 0 last_got_message:=0; 378 2 22:1 7 for i:=1 to calls do 379 2 22:2 16 mess_type[i]:=empty; 380 2 22:1 33 host_prompt:=''; 381 2 1:0 0 end; (* zero_messages *) 382 2 1:0 0 383 2 1:d 1 Procedure Put_Message(mess:string; importance:messform); 384 2 1:d 1 (*----------------------1-----------------------------*) 385 2 23:d 1 var { enters a message into the structure } 386 2 23:d 1 room_for_it:boolean; 387 2 23:d 2 i,j,lowest:integer; 388 2 23:0 0 begin 389 2 23:1 5 room_for_it:=false; 390 2 23:1 7 lowest:=1; 391 2 23:1 9 j:=ord(importance); 392 2 23:1 12 for i:=1 to calls do 393 2 23:2 21 if ord(mess_type[i]) < j then begin 394 2 23:4 36 room_for_it:=true; 395 2 23:4 38 lowest:=i; 396 2 23:4 40 j:=ord(mess_type[i]); 397 2 23:3 52 end; 398 2 23:1 57 if room_for_it then Pascal Compiler IV.13 c6t-4 - TTY.MESS.TEXT 2/ 5/85 Page 9 399 2 23:2 60 begin 400 2 23:3 60 mess_type[lowest]:=importance; 401 2 23:3 73 messages[lowest]:=mess; 402 2 23:2 87 end else writeln(mess); (* if we can't save it write it *) 403 2 1:0 0 end; (* put_messages *) 404 2 1:0 0 405 2 1:d 1 Procedure Get_Message(Var Mess:string); 406 2 1:d 1 (*-------------1---------------------*) 407 2 24:0 0 begin { gets the next message in the structure, if any} 408 2 24:1 0 mess:=''; 409 2 24:1 7 if last_got_message < calls (* there may be another message *) 410 2 24:1 10 then begin 411 2 24:3 14 last_got_message:=succ(last_got_message); 412 2 24:3 24 if mess_type[last_got_message] <> empty 413 2 24:3 37 then mess:=messages[last_got_message]; (* there was! *) 414 2 24:2 56 end; 415 2 1:0 0 end; 416 2 1:0 0 417 2 1:d 1 Function Prompt_Verify(Match:string):boolean; 418 2 1:d 1 (*------------------1----------------------*) 419 2 1:d 1 {checks to see if match is last substring of host_prompt } 420 2 25:0 0 begin 421 2 25:1 5 if match='' then prompt_verify:=true 422 2 25:1 14 else 423 2 25:2 19 if length(host_prompt)chr(CR)) OR (sink[i]<>chr(LF))) 441 2 27:1 42 (* prompt is taken as an incomplete line at the end *) 442 2 27:1 42 then host_prompt:=temp 443 2 27:1 48 else begin 444 2 27:3 56 if temp[1]='*' then begin 445 2 27:5 66 put_message(temp,star); 446 2 27:5 73 stars:=true; 447 2 27:4 77 end 448 2 27:3 77 else put_message(temp,host); 449 2 27:2 86 end; 450 2 26:0 0 end; (* What_String *) 451 2 26:0 0 452 2 26:0 0 453 2 26:0 0 begin (* decypher *) 454 2 26:1 0 i:=0; (* a simple pointer along the length of the sink *) 455 2 26:1 3 if sink[1]=chr(NUL) then i:=1; (* ignore leading NUL *) Pascal Compiler IV.13 c6t-4 - TTY.MESS.TEXT 2/ 5/85 Page 10 456 2 26:1 20 st_length:=0; stars:=false; 457 2 26:1 27 (*$R-*) 458 2 26:1 27 repeat (* get a string *) 459 2 26:2 27 i:=i+1; 460 2 26:2 32 if sink[i] in [chr(CR),chr(LF)] then 461 2 26:3 49 begin 462 2 26:4 49 if st_length <> 0 then 463 2 26:5 54 begin 464 2 26:6 54 what_string; 465 2 26:6 56 st_length:=0; 466 2 26:5 59 end; 467 2 26:3 59 end else begin 468 2 26:4 61 if st_length < 80 then 469 2 26:5 68 st_length:=st_length+1; (* truncate to 80 characters *) 470 2 26:4 73 temp[st_length]:=sink[i]; 471 2 26:3 84 end; 472 2 26:1 84 until i>=sink_pointer; 473 2 26:1 92 if st_length <> 0 then what_string; 474 2 26:1 99 (*$R+*) 475 2 26:1 99 476 2 1:0 0 end; (* decypher *) 477 2 1:0 0 478 2 1:d 1 Procedure Mop_Up(inch:char); { simply gathers everything from host into sink} 479 2 1:d 1 (*---------1--------------*) 480 2 28:d 1 var 481 2 28:d 1 i,j:integer; ch:char; 482 2 28:d 4 stars,timed_out:boolean; 483 2 28:0 0 begin {mop-up} 484 2 28:1 0 timed_out:=false; 485 2 28:1 2 sink_pointer:=1; (* collect everything up to next prompt *) 486 2 28:1 6 (* have allowed 255 chars at present *) 487 2 28:1 6 sink[sink_pointer]:=inch; (* could be a NUL *) 488 2 28:1 20 489 2 28:1 20 j:=0; 490 2 28:1 22 while not rempress AND (j<>TimeOutUnits) do 491 2 28:2 34 begin {not r & t 1} 492 2 28:3 34 i:=0; 493 2 28:3 36 while not rempress AND (i<>maxint) do i:=(i+1-1+1)*1; 494 2 28:3 57 j:=j+1; 495 2 28:2 60 end; {not r & t 1} 496 2 28:2 62 497 2 28:1 62 while rempress do 498 2 28:2 68 begin {not rempress} 499 2 28:3 68 remread(ch); 500 2 28:3 71 if sink_pointer < sink_size then sink_pointer:=sink_pointer+1; 501 2 28:3 87 sink[sink_pointer]:=chr(ord(ch) MOD 128); (* strip top bit *) 502 2 28:3 108 i:=0; 503 2 28:3 110 while not rempress and (i < waittime) do i:=i+1; (* short timeout *) 504 2 28:3 128 if not rempress then 505 2 28:4 133 if NOT(sink[sinkpointer] IN PromptSet) then 506 2 28:5 155 begin {not in promptset} 507 2 28:5 155 508 2 28:6 155 j:=0; 509 2 28:6 157 while not rempress AND (j<>TimeOutUnits) do 510 2 28:7 169 begin {not r & t 2} 511 2 28:8 169 i:=0; 512 2 28:8 171 while not rempress AND (i<>maxint) do i:=(i+1-1+1)*1; Pascal Compiler IV.13 c6t-4 - TTY.MESS.TEXT 2/ 5/85 Page 11 513 2 28:8 192 j:=j+1; 514 2 28:7 195 end; {not r & t 2} 515 2 28:7 197 516 2 28:5 197 end; {not in promptset} 517 2 28:2 197 end; (* while rempress *) 518 2 28:2 200 519 2 28:1 200 decypher(stars); 520 2 28:1 203 (* look for host messages and EXIT from getfile *) 521 2 28:1 203 522 2 28:1 203 if timed_out AND not stars then put_message('* Timed out.',local); 523 2 28:1 217 524 2 1:0 0 end; (* Mop-Up *) 525 2 1:0 0 526 2 1:0 0 {-----------------------------------------------------------------------------} 527 2 1:0 0 {end TTY.MESS} 528 2 1:0 0 {-----------------------------------------------------------------------------} 529 2 1:0 0 530 2 1:0 0 Pascal Compiler IV.13 c6t-4 - TTY.WIND.X.TEXT 2/ 5/85 Page 12 531 2 1:0 0 {$P} 532 2 1:0 0 {-----------------------------------------------------------------------------} 533 2 1:0 0 {general window routines. 9-Mar-84 - TTY.WIND.G} 534 2 1:0 0 {-----------------------------------------------------------------------------} 535 2 1:0 0 536 2 1:d 1 function PartW:integer; 537 2 29:0 0 begin 538 2 29:0 0 {Window Part Revision Number} 539 2 29:1 0 PartW:=2; 540 2 1:0 0 end; 541 2 1:0 0 542 2 1:d 1 function WSCPrompt(Line:SCLongString; 543 2 1:d 2 XLeaveCursor,YLeaveCursor, 544 2 1:d 2 TopLeftX,TopLeftY:integer; 545 2 1:d 6 ReturnOnMatch:SCChSet; 546 2 1:d 22 NoCharBack:boolean; 547 2 1:d 23 BreakChar:char):char; 548 2 30:d 1 var ch:char; 549 2 30:0 0 begin 550 2 30:1 6 writeln; 551 2 30:1 13 SCClrLine(BottomLine); 552 2 30:1 18 ch:=SCPrompt(Line,XLeaveCursor,YLeaveCursor,0,BottomLine, 553 2 30:1 31 ReturnOnMatch,NoCharBack,BreakChar); 554 2 30:1 45 writeln(ch); 555 2 30:1 61 WSCPrompt:=ch; 556 2 1:0 0 end; 557 2 1:0 0 558 2 1:d 1 procedure WInit; 559 2 31:0 0 begin 560 2 31:1 0 WAtX:=0; WAtY:=0; WCurX:=0; WCurY:=0; WDepth:=0; WWidth:=0; 561 2 1:0 0 end; 562 2 1:0 0 563 2 1:d 1 procedure WTerminate; 564 2 32:0 0 begin 565 2 1:0 0 end; 566 2 1:0 0 567 2 1:d 1 procedure WFrame(Atx,Aty,Width,Depth:integer;Header:string); 568 2 33:0 0 begin 569 2 33:1 5 WAtX:=AtX+1; WAtY:=AtY+1; WWidth:=Width; WDepth:=Depth; 570 2 1:0 0 end; 571 2 1:0 0 572 2 1:d 1 procedure WUnFrame(RemoveDisplay:boolean); 573 2 34:0 0 begin 574 2 34:1 0 WAtX:=0; WAtY:=0; WCurX:=0; WCurY:=0; WDepth:=0; WWidth:=0; 575 2 1:0 0 end; 576 2 1:0 0 577 2 1:d 1 procedure WClrScreen; 578 2 35:0 0 begin 579 2 35:1 0 SCClrScreen; 580 2 35:1 2 GotoXY(0,WAtY); 581 2 1:0 0 end; 582 2 1:0 0 583 2 1:0 0 {KEYRDLN ROUTINE..USE INSTEAD OF READLN FROM KEYBOARD..} 584 2 1:d 1 PROCEDURE KEYRDLN(VAR STR:long_string ); 585 2 36:d 1 VAR I:INTEGER; 586 2 36:d 2 CH:CHAR; 587 2 36:0 0 BEGIN Pascal Compiler IV.13 c6t-4 - TTY.WIND.X.TEXT 2/ 5/85 Page 13 588 2 36:0 0 {$R-} 589 2 36:1 0 str[0]:=chr(255); 590 2 36:1 5 {$R+} 591 2 36:1 5 for i:=1 to 255 do str[i]:=space; 592 2 36:1 26 {OVERLAY ONTO A BED OF SPACES} 593 2 36:1 26 I:=0; 594 2 36:1 28 KEYREAD(CH,FALSE,FALSE); {READ..NO ECHO} 595 2 36:1 33 WHILE NOT (CH=CHR(CR)) DO 596 2 36:2 38 BEGIN { while } 597 2 36:3 38 IF (CH=CHR(DEL)) OR (CH=CHR(BS)) THEN BEGIN 598 2 36:5 48 IF I<>0 THEN BEGIN 599 2 36:7 52 I:=I-1; 600 2 36:7 55 WRITE(CHR(BS),' ',CHR(BS)); 601 2 36:6 83 END; 602 2 36:4 83 END ELSE IF CH<' ' THEN WRITE(CHR(BEL)) ELSE BEGIN 603 2 36:6 102 WRITE(CH); {ECHO} 604 2 36:6 111 I:=I+1; 605 2 36:6 114 STR[I]:=CH; 606 2 36:5 119 END; 607 2 36:3 119 KEYREAD(CH,FALSE,FALSE); 608 2 36:2 124 END; { while } 609 2 36:1 126 WRITELN; 610 2 36:1 133 {$R-} 611 2 36:1 133 STR[0]:=CHR(I); {SET LENGTH} 612 2 36:1 137 {$R+} { **RANGE CHECK BACK ON} 613 2 1:0 0 END; 614 2 1:0 0 615 2 1:d 1 FUNCTION KEYRDVAL(VAR VAL:INTEGER):BOOLEAN; 616 2 1:d 1 {READS LINE AND CONVERTS TO NUMBER} 617 2 1:d 1 {RESULT TRUE IF NUMBER OK} 618 2 1:d 1 {NUMBER ASSUMED +VE FOR NOW} 619 2 37:d 1 VAR STR:long_string; 620 2 37:d 129 I,J,K:INTEGER; 621 2 37:d 132 SUCC:BOOLEAN; 622 2 37:0 0 BEGIN 623 2 37:1 0 KEYRDLN(STR); 624 2 37:1 3 K:=0; 625 2 37:1 7 SUCC:=(LENGTH(STR)<>0); {TRUE IF STRING NOT NULL} 626 2 37:1 15 IF SUCC THEN FOR I:=1 TO LENGTH(STR) DO BEGIN 627 2 37:4 39 J:=ORD(STR[I])-ORD('0'); 628 2 37:4 51 IF (J<0) OR (J>9) THEN SUCC:=FALSE; 629 2 37:4 70 IF SUCC THEN K:=K*10+J; 630 2 37:3 87 END; 631 2 37:1 96 IF SUCC THEN VAL:=K; 632 2 37:1 108 KEYRDVAL:=SUCC; 633 2 1:0 0 END; 634 2 1:0 0 635 2 1:d 1 PROCEDURE PUTTXT; 636 2 1:d 1 {DEFINED FORWARD..PARAMS S:STRING) } 637 2 2:0 0 BEGIN 638 2 2:1 5 WRITE(S); 639 2 1:0 0 END; 640 2 1:0 0 641 2 1:d 1 PROCEDURE PUTCH(CH:CHAR); 642 2 38:0 0 BEGIN 643 2 38:1 0 WRITE(CH); 644 2 1:0 0 END; Pascal Compiler IV.13 c6t-4 - TTY.WIND.X.TEXT 2/ 5/85 Page 14 645 2 1:0 0 646 2 1:d 1 PROCEDURE PUTINT(V,S:INTEGER); 647 2 39:0 0 BEGIN 648 2 39:1 0 WRITE(V:S); 649 2 1:0 0 END; 650 2 1:0 0 651 2 1:d 1 PROCEDURE PUTLN; 652 2 1:d 1 {DEFINED FORWARD} 653 2 3:0 0 BEGIN 654 2 3:1 0 WRITELN; 655 2 1:0 0 END; 656 2 1:0 0 657 2 1:d 1 PROCEDURE GETLN; 658 2 1:d 1 { DECLARED FORWARD..PARAMS(VAR S:long_string ); } 659 2 5:0 0 BEGIN 660 2 5:1 0 KEYRDLN(S); 661 2 1:0 0 END; 662 2 1:0 0 663 2 1:d 1 PROCEDURE GETCH; 664 2 1:d 1 { DEFINED FORWARD..PARAMS(VAR CH:CHAR; PROMPTING,ECHO:BOOLEAN); } 665 2 4:0 0 BEGIN 666 2 4:1 0 KEYREAD(CH,PROMPTING,ECHO); 667 2 1:0 0 END; 668 2 1:0 0 669 2 1:0 0 {-----------------------------------------------------------------------------} 670 2 1:0 0 {end TTY.WIND.G} 671 2 1:0 0 {-----------------------------------------------------------------------------} 672 2 1:0 0 673 2 1:0 0 Pascal Compiler IV.13 c6t-4 - TTY.PT2.TEXT 2/ 5/85 Page 15 674 2 1:0 0 {$P} 675 2 1:0 0 {-----------------------------------------------------------------------------} 676 2 1:0 0 { TTY.PT2 } 677 2 1:0 0 {-----------------------------------------------------------------------------} 678 2 1:0 0 679 2 1:0 0 { Modified 680 2 1:0 0 1-Feb-83 } 681 2 1:0 0 682 2 1:d 1 FUNCTION PART2:INTEGER; 683 2 1:d 1 (*--------1----------*) 684 2 40:0 0 BEGIN 685 2 40:0 0 (*PART 2 RELEASE VERSION*) 686 2 40:1 0 PART2:=7; 687 2 1:0 0 END; 688 2 1:0 0 689 2 1:d 1 Procedure UpperCase(Var s:string); 690 2 41:d 1 var i:integer; 691 2 41:0 0 begin 692 2 41:1 0 if length(s)>0 then 693 2 41:2 7 begin 694 2 41:3 7 for i:=1 to length(s) do 695 2 41:4 18 begin 696 2 41:5 18 if (s[i]>='a') and (s[i]<='z') then s[i]:=chr(ord(s[i])-32); 697 2 41:4 46 end; 698 2 41:2 51 end; 699 2 1:0 0 end; 700 2 1:0 0 701 2 1:d 1 FUNCTION SURE(STR:STRING):BOOLEAN; 702 2 42:d 1 VAR CH:CHAR; 703 2 42:0 0 BEGIN 704 2 42:1 6 ch:=WSCPrompt(CONCAT(str,': Y(es, N(o '), -1,0, 60,8, 705 2 42:1 35 ['Y','N'],false,','); 706 2 42:1 49 SURE:=(CH='Y'); 707 2 1:0 0 END; 708 2 1:d 1 PROCEDURE REMSINK(ECHO:BOOLEAN); 709 2 1:d 1 (* a sink for any characters received from remote *) 710 2 43:d 1 VAR Waits:INTEGER; 711 2 43:d 2 CH:CHAR; 712 2 43:0 0 BEGIN 713 2 43:1 0 Waits:=0; 714 2 43:1 2 WHILE ((Waits1) DO BEGIN 779 2 46:3 75 S:=S+1; 780 2 46:3 79 I:=I DIV 10; 781 2 46:2 83 END; 782 2 46:1 85 S:=S-5; 783 2 46:1 90 WHILE S>0 DO BEGIN 784 2 46:3 95 int_string:=concat(int_string,' '); 785 2 46:3 117 S:=S-1; 786 2 46:2 121 END; 787 2 46:2 123 (*$R-*) Pascal Compiler IV.13 c6t-4 - TTY.PT2.TEXT 2/ 5/85 Page 17 788 2 46:1 123 digit[0]:=chr(1); 789 2 46:1 127 REPEAT 790 2 46:2 127 digit[1]:=CHR(ORD('0')+X DIV I); 791 2 46:2 136 int_string:=concat(int_string,digit); 792 2 46:2 155 X:=X-(X DIV I)*I; 793 2 46:2 164 I:=I DIV 10; 794 2 46:1 168 UNTIL I=0; 795 2 46:1 172 (*$R+*) 796 2 1:0 0 END; 797 2 1:0 0 798 2 1:d 1 PROCEDURE GIVEREASON(REASON:INTEGER; VAR ST:STRING); 799 2 47:d 1 var NumSt:ShortString; 800 2 47:0 0 BEGIN 801 2 47:1 0 IF (REASON>0) AND (REASON<=18) THEN 802 2 47:2 13 BEGIN 803 2 47:3 13 CASE REASON OF 804 2 47:3 18 1: ST:='Bad Block, Parity error (CRC).'; 805 2 47:3 29 2: ST:='Bad Unit Number.'; 806 2 47:3 40 3: ST:='Illegal I/O Request.'; 807 2 47:3 51 4: ST:='Data-com timeout.'; 808 2 47:3 62 5: ST:='Volume is no longer on-line.'; 809 2 47:3 73 6: ST:='File is no longer in directory.'; 810 2 47:3 83 7: ST:='Bad file name.'; 811 2 47:3 93 8: ST:='No room, insufficient space on volume.'; 812 2 47:3 103 9: ST:='No such volume on line.'; 813 2 47:3 113 10: ST:='No such file on volume.'; 814 2 47:3 123 11: ST:='Duplicate directory entry.'; 815 2 47:3 133 12: ST:='Not closed, attempt to open an open file.'; 816 2 47:3 143 13: ST:='Not open, attempt to access a closed file.'; 817 2 47:3 153 14: ST:='Bad format, error in reading real or integer.'; 818 2 47:3 163 15: ST:='Ring buffer overflow.'; 819 2 47:3 173 16: ST:='Volume is write-protected.'; 820 2 47:3 183 17: ST:='Illegal Block Number.'; 821 2 47:3 193 18: ST:='Illegal Buffer.'; 822 2 47:3 203 END (*CASE*) 823 2 47:2 206 END 824 2 47:1 206 ELSE IF REASON<>0 THEN 825 2 47:3 213 begin 826 2 47:4 213 IntToString(Reason,0,NumST); 827 2 47:4 219 ST:=CONCAT('I/O error ',NumST); 828 2 47:3 242 end; 829 2 1:0 0 END; 830 2 1:0 0 831 2 1:d 1 PROCEDURE SETALT; 832 2 48:d 1 VAR CH:CHAR; 833 2 48:0 0 BEGIN 834 2 48:1 0 ch:=WSCPrompt('Protocol: T(ext, B(inary ',-1,0, 50, 9, 835 2 48:1 12 ['T','B'], false,','); 836 2 48:1 26 ALTFILE:=(ch='B'); 837 2 1:0 0 END; 838 2 1:0 0 839 2 1:d 1 Procedure TTYInfo; 840 2 1:d 1 {----------------} 841 2 49:d 1 var ch:char; 842 2 49:0 0 begin 843 2 49:1 0 ch:=WSCPrompt('TTY Info: F(ull mess, U(nits, B(reak Char, D(uplex, Q(uit ', 844 2 49:1 6 -1,0, 50,9, ['F','U','B','D','Q'], false,','); Pascal Compiler IV.13 c6t-4 - TTY.PT2.TEXT 2/ 5/85 Page 18 845 2 49:1 26 case ch of 846 2 49:1 30 'B': begin 847 2 49:3 30 WFrame(34,11, 39,1, ''); 848 2 49:3 43 PutTxt('Give Break Char ( for no change) '); 849 2 49:3 50 GetCh(BreakChar,false,false); 850 2 49:3 56 if Breakchar > ' ' then writeln(BreakChar) 851 2 49:3 78 else writeln; 852 2 49:3 87 WUnFrame(true); 853 2 49:2 90 end; 854 2 49:1 93 'D': BEGIN 855 2 49:3 93 ch:=WSCPrompt('Duplex: F(ull, H(alf ', -1,0, 50, 9, 856 2 49:3 105 ['H','F'], false,','); 857 2 49:3 119 HALFDUPLEX:=(CH='H') 858 2 49:2 123 END; 859 2 49:1 128 'F': DEBUG:=Sure('Full messages '); 860 2 49:1 141 'U': BEGIN 861 2 49:3 141 ch:=WSCPrompt('Wait Units: I(ncrease, D(ecrease ', -1,0, 50,9, 862 2 49:3 153 ['I','D'], false, ','); 863 2 49:3 167 if ch = 'I' then WaitTime:=WaitTime + 500 864 2 49:3 175 else WaitTime:=WaitTIme - 500; 865 2 49:3 194 IF WAITTIME<=0 THEN WAITTIME:=1; 866 2 49:3 205 TimeOutUnits:=ABS(WaitTime DIV 512) + 1; 867 2 49:2 217 END; 868 2 49:1 219 'Q': { no action }; 869 2 49:1 221 end; { case } 870 2 1:0 0 end; 871 2 1:0 0 872 2 1:d 1 PROCEDURE CONFIGURE; 873 2 50:d 1 VAR CH,ch1:CHAR; 874 2 50:d 3 FINISH:BOOLEAN; 875 2 50:0 0 BEGIN 876 2 50:1 0 FINISH:=FALSE; 877 2 50:1 2 REPEAT 878 2 50:2 2 ch:=WSCPrompt(CONCAT('Configure: P(rotocol,M(ask,T(TY Info', 879 2 50:2 16 ',H(ost info,S(td host,B(aud,Q(uit '), 880 2 50:2 27 -1,0, 45,6, ['B','H','M','P','S','T','Q'], 881 2 50:2 41 false,','); 882 2 50:2 47 CASE CH OF 883 2 50:2 51 'B': begin end; 884 2 50:2 54 'H': BEGIN 885 2 50:3 54 END; 886 2 50:2 57 'M': BEGIN 887 2 50:4 57 ch:=WSCPrompt('Mask: 8(bit, 7(bit ', -1,0, 50, 9, 888 2 50:4 69 ['7','8'], false, ','); 889 2 50:4 83 IF CH='7' THEN CHINMOD:=128 890 2 50:4 88 ELSE CHINMOD:=256; 891 2 50:3 101 END; 892 2 50:2 103 'P': SETALT; 893 2 50:2 107 'S': begin 894 2 50:4 107 ch1:=WSCPrompt('Set Std Host: P(ad, T(cp ',-1,0,50,9,['P','T'], 895 2 50:4 127 false,','); 896 2 50:4 133 if ch1='T' then 897 2 50:5 138 begin 898 2 50:6 138 Transmit(Settcp, true); remwrite(chr(CR)); 899 2 50:5 147 end else begin 900 2 50:6 149 Transmit (setpad, true);remwrite(chr(CR));remwrite(chr(CR)); 901 2 50:5 161 end; Pascal Compiler IV.13 c6t-4 - TTY.PT2.TEXT 2/ 5/85 Page 19 902 2 50:5 161 903 2 50:4 161 initmessages; MopUp(chr(NUL)); printmessages; write(HostPrompt); 904 2 50:4 180 CursorLost:=false; 905 2 50:4 184 Finish:=true; { takes us straight out of configure } 906 2 50:3 186 end; 907 2 50:2 188 'T': TTYInfo; 908 2 50:2 192 'Q': FINISH:=TRUE; 909 2 50:2 196 END (*CASE*); 910 2 50:1 199 UNTIL FINISH; 911 2 1:0 0 END; 912 2 1:0 0 913 2 1:d 1 PROCEDURE NAMECHECK(Var Name:string; Var ABORT:boolean; 914 2 1:d 3 Ask, textfile:boolean); 915 2 1:d 1 (*------------------------------1----------------------------------*) 916 2 1:d 1 (*CHECK LOCAL FILE NAME AND PRINT MESSAGES - CAN SET ABORT *) 917 2 1:d 1 (*PUT IN SEPARATE PROCEDURE TO GET MORE CODE SPACE IN MAIN PROCEDURE BODY*) 918 2 51:d 1 VAR CH:CHAR; 919 2 51:d 2 I:INTEGER; 920 2 51:d 3 DFile:file; 921 2 51:d 43 St:String; 922 2 51:d 84 BadName:boolean; 923 2 51:0 0 BEGIN 924 2 51:1 8 ABORT:=false; 925 2 51:1 13 (*REMOVE SPACES*) 926 2 51:1 13 WHILE POS(' ',name)<>0 DO DELETE(name,POS(' ',name),1); 927 2 51:1 48 IF LENGTH(name)=0 THEN 928 2 51:2 56 begin (* zero length name *) 929 2 51:3 56 ABORT:=true; 930 2 51:3 61 put_message('* Null file name.',local); 931 2 51:2 69 end 932 2 51:1 69 ELSE 933 2 51:2 72 BEGIN (* non null name *) 934 2 51:3 72 for i:=1 TO LENGTH(name) do (* convert to UpperCase *) 935 2 51:4 87 if ('a'<=name[i]) AND (name[i]<='z') then 936 2 51:5 108 name[I]:=CHR((ORD(CH)-ORD('a'))+ORD('A')); 937 2 51:3 126 IF POS(':',name)=LENGTH(name) THEN 938 2 51:4 145 BEGIN (* : at end *) 939 2 51:4 145 (*DEVICE NAME ENDS IN : - ONLY ALLOW PRINTER: *) 940 2 51:4 145 (*AS CONSOLE: AND REMOUT: USED BY X-TALK *) 941 2 51:5 145 if name<>'PRINTER:' then 942 2 51:6 156 BEGIN 943 2 51:7 156 put_message( 944 2 51:7 156 '* Only PRINTER: allowed for device output.',local); 945 2 51:7 164 ABORT:=true; 946 2 51:6 169 END; 947 2 51:4 169 END (* : at end *) 948 2 51:3 169 ELSE 949 2 51:4 172 BEGIN (* open *) 950 2 51:5 172 if textfile and (name<>'PRINTER:') then 951 2 51:6 188 if POS('.TEXT',name)=0 then name:=concat(name,'.TEXT'); 952 2 51:5 235 if POS(':',name) <> 0 then 953 2 51:6 250 begin 954 2 51:7 250 BadName:= (length(name)-POS(':',name) > 15) OR 955 2 51:7 271 (POS(':',name) > 8); 956 2 51:6 289 end 957 2 51:5 289 else 958 2 51:6 291 if POS('*',name) = 1 then Pascal Compiler IV.13 c6t-4 - TTY.PT2.TEXT 2/ 5/85 Page 20 959 2 51:7 306 begin 960 2 51:8 306 BadName:=(length(name) > 16); 961 2 51:7 316 end 962 2 51:6 316 else 963 2 51:7 318 BadName:=length(name) > 15; 964 2 51:5 328 if BadName then 965 2 51:6 332 begin 966 2 51:7 332 putmessage(CONCAT('* Illegal file name ',name,'.'),local); 967 2 51:7 372 ABORT:=true; 968 2 51:6 377 end; 969 2 51:5 377 if not ABORT then 970 2 51:6 385 begin (* name seems OK *) 971 2 51:6 385 (*$I-*) 972 2 51:7 385 RESET(DFILE,name); 973 2 51:7 394 IF IORESULT=0 THEN 974 2 51:8 402 BEGIN (* 0 *) 975 2 51:9 402 if ask then begin (* ask *) 976 2 51:1 407 ch:=WSCPrompt(CONCAT('Destroy ',name,': Y(es, N(o '), 977 2 51:1 445 -1,0, 20,15, ['Y','N'],false, ','); 978 2 51:1 464 IF CH='Y' THEN CLOSE(DFILE,PURGE) ELSE 979 2 51:2 475 BEGIN (* 1 *) 980 2 51:3 475 CLOSE(DFILE); 981 2 51:3 479 ABORT:=true; 982 2 51:2 484 END; (* 1 *) 983 2 51:0 484 end (* ask *) else begin (* error *) 984 2 51:1 486 ABORT:=true; 985 2 51:1 491 put_message 986 2 51:1 491 (CONCAT( 987 2 51:1 491 '* File ',name,' already exists.'), 988 2 51:1 528 local); 989 2 51:0 531 end; (* error *) 990 2 51:8 531 END (* 0 *) ELSE 991 2 51:8 533 IF IORESULT<>10 THEN 992 2 51:9 539 BEGIN (* 2 *) 993 2 51:0 539 Givereason(ioresult,st); 994 2 51:0 546 put_message(st,local); 995 2 51:0 552 ABORT:=true; 996 2 51:9 557 END; (* 2 *) 997 2 51:6 557 end; (* name seems... *) 998 2 51:6 557 (*$I+*) 999 2 51:4 557 end; (* open *) 1000 2 51:2 557 END; (* non null name *) 1001 2 1:0 0 END; (* namechecks *) 1002 2 1:0 0 1003 2 1:0 0 {-----------------------------------------------------------------------------} 1004 2 1:0 0 {end TTY.PT2} 1005 2 1:0 0 {-----------------------------------------------------------------------------} 1006 2 1:0 0 1007 2 1:0 0 1008 2 1:0 0 1009 2 1:d 1 PROCEDURE SENDCTRL; 1010 2 52:d 1 VAR CH:CHAR; 1011 2 52:0 0 BEGIN 1012 2 52:1 0 WFrame(35,15, 38, 1, ''); 1013 2 52:1 13 PutTxt('Type control letter ( for none):'); 1014 2 52:1 20 GetCh(ch,true,true); 1015 2 52:1 25 if ch in ['A'..'Z'] then REMWRITE(CHR((ORD(CH)-ORD('A'))+1)); Pascal Compiler IV.13 c6t-4 2/ 5/85 Page 21 1016 2 52:1 42 WUnFrame(true); 1017 2 52:1 45 CursorLost:=false; { needed to suppress the remwrite(chr(CR)) } 1018 2 1:0 0 END; 1019 2 1:0 0 1020 2 1:d 1 Function Names_Paired(str,str2:long_string):Boolean; 1021 2 1:d 1 {----------------------------1-------------------} 1022 2 1:d 1 { used by both putfile & getfile } 1023 2 53:d 1 var 1024 2 53:d 1 i,l_comma,r_comma:integer; 1025 2 53:0 0 begin 1026 2 53:1 14 if (length(str)=0) OR (length(str2)=0) then names_paired:=false 1027 2 53:1 29 else 1028 2 53:2 35 if (str[1]=BreakChar) OR (str2[1]=BreakChar) OR (str[length(str)]=BreakChar) 1029 2 53:2 62 OR (str2[length(str2)]=BreakChar) 1030 2 53:2 71 then names_paired:=false 1031 2 53:2 74 else 1032 2 53:3 80 begin 1033 2 53:4 80 l_comma:=0; r_comma:=0; 1034 2 53:4 84 for i:=1 to length(str) do 1035 2 53:5 97 if str[i]=BreakChar then l_comma:=succ(l_comma); 1036 2 53:4 114 for i:=1 to length(str2) do 1037 2 53:5 125 if str2[i]=BreakChar then r_comma:=succ(r_comma); 1038 2 53:5 140 1039 2 53:4 140 names_paired:=l_comma=r_comma; 1040 2 53:4 146 if not (lcomma=rcomma) then 1041 2 53:5 151 put_message('* File names not paired.',local); 1042 2 53:3 159 end; 1043 2 1:0 0 end; { Names_Paired } 1044 2 1:0 0 1045 2 1:d 1 Procedure Next_Name(Var list:long_string; var name:string); 1046 2 1:d 1 {---------------------------1---------------------------} 1047 2 1:d 1 { used by both putfile & getfile } 1048 2 54:d 1 var BreakString:string[1]; i:integer; 1049 2 54:0 0 begin 1050 2 54:1 0 BreakString:=' '; {$R-} BreakString[1]:=BreakChar; {$R+} 1051 2 54:1 11 name:=''; 1052 2 54:1 20 if (POS(BreakString,list)=0) AND (list<>'') then 1053 2 54:2 44 begin { last name only } 1054 2 54:3 44 name:=list; 1055 2 54:3 53 list:=''; 1056 2 54:2 62 end else 1057 2 54:2 64 begin 1058 2 54:3 64 name:=COPY(list, 1, POS(BreakString,list)-1); 1059 2 54:3 89 DELETE(list, 1, POS(BreakString,list)); { remove the name } 1060 2 54:2 104 end; 1061 2 54:2 104 (*{ make sure the name is in upper case } 1062 2 54:2 104 for i:=1 to length(name) do 1063 2 54:2 104 if ('a'<=name[i]) AND (name[i]<='z') then 1064 2 54:2 104 name[i]:=chr(ord(name[i]) - ord('a') + ord('A')); *) 1065 2 1:0 0 end; { next_name } 1066 2 1:0 0 1067 2 1:0 0 Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 22 1068 2 1:0 0 {$P} 1069 2 1:0 0 {-----------------------------------------------------------------------------} 1070 2 1:0 0 {7-Aug-84 - TTY.DOGET} 1071 2 1:0 0 {-----------------------------------------------------------------------------} 1072 2 1:0 0 1073 2 1:0 0 { modified 1-Feb-83 1074 2 1:0 0 modified 13-Aug-84 for new coding for PAD's by G. Wilkie 1075 2 1:0 0 modified 29-Nov-84 for new coding for micro-pad-network-pad-micro transfers} 1076 2 1:0 0 1077 2 1:d 1 Function PartDG:integer; 1078 2 55:0 0 begin 1079 2 55:1 0 PartDG:=4; 1080 2 1:0 0 end; 1081 2 1:0 0 1082 2 1:d 1 Procedure DoGetFile(remotename,localname:string; textfile,debug:boolean; 1083 2 1:d 6 var user_interrupt:boolean ); 1084 2 1:d 1 (*----------------------------------2-----------------------------------*) 1085 2 56:d 1 const 1086 2 56:d 1 FILLLEVEL=1024; (*ALLOW 256 CHARACTERS OF OVERRUN BY HOST AFTER XOFF*) 1087 2 56:d 1 buffer_size=1281; 1088 2 56:d 1 printer=6; (* in case file is to go to printer *) 1089 2 56:d 1 var 1090 2 56:d 1 ch:char; 1091 2 56:d 2 DFILE:file; (* using BLOCKREAD/WRITE *) 1092 2 56:d 42 Res,DOTCNT,CHARS,CHKSM,I,J,XOFCNT,PTR:INTEGER; 1093 2 56:d 50 leading_spaces,OVERRUN,STARTED,FINISHED,ESCAPE:BOOLEAN; 1094 2 56:d 55 ABORT,printer_chosen:boolean; 1095 2 56:d 57 cr_dle_32:packed array[1..3] of char; (* the start of line sequence *) 1096 2 56:d 59 buffer:PACKED ARRAY[1..buffer_size] OF CHAR; 1097 2 56:d 700 page,len,split_lines,last_CR_pos:integer; 1098 2 56:d 704 CHKSMOK: (CORRECT,WRONG,ABSENT); 1099 2 56:d 705 st:string; 1100 2 56:d 746 st_chars,st_chksm:short_string; 1101 2 56:d 760 1102 2 56:d 760 1103 2 56:d 760 PROCEDURE GETCHKSM; 1104 2 56:d 1 (*------3--------*) 1105 2 57:d 1 VAR CH:CHAR; I:INTEGER; 1106 2 57:d 3 collect:packed array[1..8] of char; 1107 2 57:d 7 EXTRA:RECORD CASE BOOLEAN OF 1108 2 57:d 7 TRUE: (DAT:PACKED ARRAY[1..8] OF 0..15); 1109 2 57:d 7 FALSE:(CHKSM,CHARS:INTEGER); 1110 2 57:d 7 END; 1111 2 57:0 0 BEGIN 1112 2 57:0 0 (* a line feed before 8 characters have been received 1113 2 57:0 0 implies no checksum is present*) 1114 2 57:1 0 if xofcnt>0 then remwrite(chr(XON)); (* may be in xoff state *) 1115 2 57:1 9 i:=8; 1116 2 57:1 11 repeat 1117 2 57:2 11 remread(ch); 1118 2 57:2 14 collect[i]:=chr(ord(ch) MOD chinmod); 1119 2 57:2 30 i:=i-1; 1120 2 57:1 33 until (i=0) OR (ch=chr(LF)); 1121 2 57:1 42 extra.chksm:=chksm; 1122 2 57:1 45 extra.chars:=chars; 1123 2 57:1 48 if ch=chr(LF) then chksmok:=absent else 1124 2 57:2 59 if i <> 0 then chksmok:=wrong Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 23 1125 2 57:2 63 else chksmok:=correct; 1126 2 57:1 75 while ch <> chr(LF) do 1127 2 57:2 79 begin (* lose some characters *) 1128 2 57:3 79 remread(ch); 1129 2 57:3 82 ch:=chr(ord(ch) MOD chinmod); 1130 2 57:2 92 end; 1131 2 57:1 94 if chksmok=correct then 1132 2 57:2 100 begin 1133 2 57:3 100 i:=8; 1134 2 57:3 102 repeat 1135 2 57:4 102 if (extra.dat[i]+ord('A')) <> ord(collect[i]) then chksmok:=wrong; 1136 2 57:4 129 i:=i-1; 1137 2 57:3 132 until (i=0) OR (chksmok=wrong); 1138 2 57:2 143 end; 1139 2 56:0 0 END; 1140 2 56:0 0 1141 2 56:0 0 1142 2 56:d 1 PROCEDURE GETCHAR; 1143 2 56:d 1 (*------3------*) 1144 2 58:d 1 VAR I:INTEGER; 1145 2 58:d 2 CH:CHAR; 1146 2 58:d 3 1147 2 58:0 0 BEGIN (* getchar *) 1148 2 58:1 0 REMREAD(CH); 1149 2 58:1 3 CH:=CHR(ORD(CH) MOD CHINMOD); (*MASK AS DIRECTED - 128 OR 256*) 1150 2 58:1 13 if leading_spaces then 1151 2 58:2 18 begin (* leading spaces *) 1152 2 58:3 18 if ch=' ' then begin (* ' ' *) 1153 2 58:5 23 buffer[ptr]:=succ(buffer[ptr]); 1154 2 58:5 52 chars:=(chars + 1) MOD 16384; 1155 2 58:5 66 chksm:=(chksm + ord(space)) MOD 16384; 1156 2 58:4 82 end (* ' ' *) 1157 2 58:3 82 else 1158 2 58:4 84 begin (* ordinary character *) 1159 2 58:5 84 leading_spaces:=false; 1160 2 58:5 88 if ch='*' then escape:=true 1161 2 58:5 93 else 1162 2 58:6 99 if started then 1163 2 58:7 103 begin (* collect *) 1164 2 58:8 103 chars:=(chars+1) MOD 16384; 1165 2 58:8 117 chksm:=(chksm+ord(ch)) MOD 16384; 1166 2 58:8 132 ptr:=ptr+1; 1167 2 58:8 138 if ch=chr(LF) then 1168 2 58:9 142 begin (* a LF *) 1169 2 58:0 142 if textfile then 1170 2 58:1 147 begin 1171 2 58:2 147 leading_spaces:=true; 1172 2 58:2 151 moveleft(CR_dle_32,buffer[ptr], 1173 2 58:2 166 3); 1174 2 58:2 169 ptr:=ptr+2; 1175 2 58:1 176 end else buffer[ptr]:=ch; 1176 2 58:9 191 end (* a LF *) else 1177 2 58:9 193 buffer[ptr]:=ch; 1178 2 58:7 206 end; (* collect *) 1179 2 58:4 206 end; (* ordinary character *) 1180 2 58:2 206 end (* leading spaces *) else 1181 2 58:2 209 if escape then Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 24 1182 2 58:3 214 begin (* escape *) 1183 2 58:4 214 escape:=false; 1184 2 58:4 218 if ch='C' then begin 1185 2 58:6 223 if started then 1186 2 58:7 227 begin 1187 2 58:8 227 ptr:=ptr+1; 1188 2 58:8 233 buffer[ptr]:='*'; 1189 2 58:8 247 chars:=(chars+1) MOD 16384; 1190 2 58:8 261 chksm:=(chksm+ord('*')) MOD 16384; 1191 2 58:7 277 end 1192 2 58:5 277 end else 1193 2 58:5 280 if ch='1' then begin 1194 2 58:7 285 if started then 1195 2 58:8 289 begin 1196 2 58:9 289 ptr:=ptr+1; 1197 2 58:9 295 buffer[ptr]:=chr(xon); 1198 2 58:9 308 chars:=(chars+1) MOD 16384; 1199 2 58:9 322 chksm:=(chksm+xon) MOD 16384; 1200 2 58:8 337 end 1201 2 58:6 337 end else 1202 2 58:6 340 if ch='3' then begin 1203 2 58:8 345 if started then 1204 2 58:9 349 begin 1205 2 58:0 349 ptr:=ptr+1; 1206 2 58:0 355 buffer[ptr]:=chr(xoff); 1207 2 58:0 368 chars:=(chars+1) MOD 16384; 1208 2 58:0 382 chksm:=(chksm+xoff) MOD 16384; 1209 2 58:9 397 end 1210 2 58:7 397 end else 1211 2 58:7 400 if ch=chr(msb1) then begin 1212 2 58:9 405 if started then 1213 2 58:0 409 begin 1214 2 58:1 409 ptr:=ptr+1; 1215 2 58:1 415 buffer[ptr]:=chr(xonmsb); 1216 2 58:1 429 chars:=(chars+1) MOD 16384; 1217 2 58:1 443 chksm:=(chksm+xonmsb) MOD 16384; 1218 2 58:0 459 end 1219 2 58:8 459 end else 1220 2 58:8 462 if ch=chr(msb3) then begin 1221 2 58:0 467 if started then 1222 2 58:1 471 begin 1223 2 58:2 471 ptr:=ptr+1; 1224 2 58:2 477 buffer[ptr]:=chr(xoffmsb); 1225 2 58:2 491 chars:=(chars+1) MOD 16384; 1226 2 58:2 505 chksm:=(chksm+xoffmsb) MOD 16384; 1227 2 58:1 521 end 1228 2 58:9 521 end else 1229 2 58:9 523 if ch='B' then started:=true 1230 2 58:9 528 else 1231 2 58:0 534 if ch='E' then begin 1232 2 58:2 539 if started then 1233 2 58:3 543 begin (* started *) 1234 2 58:4 543 finished:=true; 1235 2 58:4 547 getchksm; 1236 2 58:4 549 if textfile then (* add an extra CR for UCSD *) 1237 2 58:5 554 begin (* textfile *) 1238 2 58:6 554 ptr:=ptr+1; Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 25 1239 2 58:6 560 buffer[ptr]:=chr(CR); 1240 2 58:5 573 end (* textfile *) else 1241 2 58:5 575 (* odd block for binary ? *) 1242 2 58:5 575 if ptr<=512 then page:=1; 1243 2 58:3 588 end (* started *) 1244 2 58:1 588 end 1245 2 58:0 588 else begin 1246 2 58:0 590 (* message in sink *) 1247 2 58:2 590 Mop_Up(ch); 1248 2 58:2 593 (*$I-*) close(dfile); (*$I+*) 1249 2 58:2 599 exit(dogetfile); 1250 2 58:1 605 end; 1251 2 58:3 605 end (* escape *) else 1252 2 58:3 607 if ch='*' then escape:=true 1253 2 58:3 612 else 1254 2 58:4 618 if started then 1255 2 58:5 622 begin (* collect *) 1256 2 58:6 622 chars:=(chars+1) MOD 16384; 1257 2 58:6 636 chksm:=(chksm+ord(ch)) MOD 16384; 1258 2 58:6 651 ptr:=ptr+1; 1259 2 58:6 657 if ch=chr(LF) then 1260 2 58:7 661 begin (* a LF *) 1261 2 58:8 661 if textfile then 1262 2 58:9 666 begin 1263 2 58:0 666 leading_spaces:=true; 1264 2 58:0 670 moveleft(CR_dle_32,buffer[ptr], 1265 2 58:0 685 3); 1266 2 58:0 688 ptr:=ptr+2; 1267 2 58:9 695 end else buffer[ptr]:=ch; 1268 2 58:7 710 end (* a LF *) else 1269 2 58:7 712 buffer[ptr]:=ch; 1270 2 58:5 725 end; (* collect *) 1271 2 56:0 0 END;(* getchar *) 1272 2 56:0 0 1273 2 56:0 0 1274 2 56:d 1 Procedure Prepare; 1275 2 56:d 1 (*-------3------*) 1276 2 59:d 1 var Res:Integer; 1277 2 59:0 0 begin 1278 2 59:1 0 init_messages; (* do this here *) 1279 2 59:1 2 ABORT:=false; started:=false; finished:=false; escape:=false; 1280 2 59:1 18 user_interrupt:=false; split_lines:=0; 1281 2 59:1 28 if textfile then (* textfile *) leading_spaces:=true 1282 2 59:1 33 else (* binary *) leading_spaces:=false; 1283 2 59:1 43 page:=2; chars:=0; chksm:=0; 1284 2 59:1 56 printer_chosen:=false; overrun:=false; 1285 2 59:1 64 cr_dle_32[1]:=chr(CR); cr_dle_32[2]:=chr(DLE); 1286 2 59:1 84 cr_dle_32[3]:=space; (* the special end of line sequence *) 1287 2 59:1 95 namecheck(localname,ABORT,false,textfile); 1288 2 59:1 108 if ABORT then exit(dogetfile); 1289 2 59:1 118 (*$I-*) (* try open the file *) 1290 2 59:1 118 if localname = 'PRINTER:' then printer_chosen:=true 1291 2 59:1 130 else 1292 2 59:2 136 begin (* not the Printer: *) 1293 2 59:3 136 rewrite(dfile,localname); 1294 2 59:3 148 if ioresult<>0 then 1295 2 59:4 154 begin (* can't open file *) Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 26 1296 2 59:5 154 Res:=ioresult; 1297 2 59:5 158 close(dfile); 1298 2 59:5 164 givereason(Res,st); 1299 2 59:5 171 put_message(st,local); 1300 2 59:5 179 exit(dogetfile); 1301 2 59:4 185 end (* can't... *) 1302 2 59:2 185 end; (* not the .... *) 1303 2 59:2 185 (*$I+*) 1304 2 56:0 0 end; (* prepare *) 1305 2 56:0 0 1306 2 56:d 1 Procedure Tidy_Up; 1307 2 56:d 1 (*-------3------*) 1308 2 60:d 1 var Res:integer; 1309 2 60:0 0 begin 1310 2 60:1 0 if ABORT and (xofcnt<>0) then remwrite (chr(XON)); 1311 2 60:1 12 If ABORT then transmit(escape_sequence,false); 1312 2 60:1 22 (* Note that an XON may be needed first if XOFFed - not needed for EMAS *) 1313 2 60:1 22 (*$I-*) 1314 2 60:1 22 CLOSE(DFILE,LOCK); 1315 2 60:1 28 IF IORESULT<>0 THEN BEGIN 1316 2 60:3 34 Res:=ioresult; 1317 2 60:3 38 give_reason(Res,st); 1318 2 60:3 45 put_message(st,local); 1319 2 60:2 53 END; 1320 2 60:2 53 (*$I+*) 1321 2 60:1 53 remsink(false); (* a short timeout to lose prompt - if there ! *) 1322 2 60:1 56 remwrite(chr(CR)); 1323 2 60:1 59 mop_up(chr(NUL)); 1324 2 60:1 62 writeln; (* do this here to cater for part lines *) 1325 2 60:1 69 if chksmok=WRONG then put_message('* Checksum faulty.',local); 1326 2 60:1 83 if overrun then 1327 2 60:2 87 put_message('* Overrun occurred - increase UNITS.',local) 1328 2 60:1 93 else 1329 2 60:2 97 begin (* not overrun *) 1330 2 60:3 97 if chksmok=absent then put_message('* No checksum.',local); 1331 2 60:3 111 if DEBUG then 1332 2 60:4 116 begin (* debug *) 1333 2 60:5 116 int_to_string(chars,6,st_chars);int_to_string(chksm,6,st_chksm); 1334 2 60:5 134 put_message(concat('* ',st_chars, 1335 2 60:5 155 ' characters received. Checksum:', 1336 2 60:5 165 st_chksm,'.'),debugging); 1337 2 60:4 189 end; (* debug *) 1338 2 60:2 189 end; (* not overrun *) 1339 2 56:0 0 end; (* tidy-up *) 1340 2 56:0 0 1341 2 56:d 1 Procedure Interrupted; 1342 2 56:d 1 (*----------3-------*) 1343 2 61:0 0 begin 1344 2 61:1 0 keyread(ch,false,false); 1345 2 61:1 7 if ch=chr(ESC) then 1346 2 61:2 12 begin 1347 2 61:3 12 user_interrupt:=sure('Curtail?'); 1348 2 61:3 24 ABORT:=ABORT or user_interrupt; 1349 2 61:2 34 end; 1350 2 56:0 0 end; 1351 2 56:0 0 (* ********* *) 1352 2 56:0 0 begin (* dogetfile *) Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 27 1353 2 56:0 0 (* ********* *) 1354 2 56:1 24 prepare; (* does all the initailising & checking prior to transfer *) 1355 2 56:1 26 1356 2 56:1 26 fillchar(buffer,buffer_size,0); (* null fill the buffers *) 1357 2 56:1 35 ptr:=0; dotcnt:=0; 1358 2 56:1 41 if textfile and not(printer_chosen) then 1359 2 56:2 50 begin 1360 2 56:2 50 (*$I-*) 1361 2 56:3 50 j:=blockwrite(dfile,buffer[1],2); 1362 2 56:3 69 (*$I+*) 1363 2 56:3 69 (* write 2 blocks of NULs as textfile header. 1364 2 56:3 69 Note no RELBLOCK parameter as blocks will 1365 2 56:3 69 be written sequentially throughout *) 1366 2 56:3 69 if ioresult <> 0 then 1367 2 56:4 75 begin (* something wrong *) 1368 2 56:5 75 Res:=ioresult; 1369 2 56:5 80 ABORT:=true; 1370 2 56:5 83 givereason(Res,st); 1371 2 56:5 90 put_message(st,local); 1372 2 56:4 97 end; 1373 2 56:2 97 end; 1374 2 56:2 97 1375 2 56:1 97 if not ABORT then 1376 2 56:2 103 begin (* not ABORT *) 1377 2 56:3 103 transmit('GIVEFILE',false); 1378 2 56:3 111 remwrite(chr(CR)); 1379 2 56:3 114 Mop_Up(chr(NUL)); 1380 2 56:3 117 if prompt_verify('e:') then (* looking for Givefile: *) 1381 2 56:4 127 init_messages 1382 2 56:3 127 else 1383 2 56:4 131 begin 1384 2 56:5 131 put_message('* Incorrect prompt from host.',local); 1385 2 56:5 139 close(dfile); 1386 2 56:5 145 exit(dogetfile); 1387 2 56:4 151 end; 1388 2 56:3 151 transmit(remotename,false); 1389 2 56:3 158 remwrite(chr(CR)); 1390 2 56:3 161 1391 2 56:3 161 repeat (* until finished or ABORT *) 1392 2 56:4 161 xofcnt:=0; (* go into Getchar in XONed state *) 1393 2 56:4 164 1394 2 56:4 164 repeat getchar until finished or (ptr > fill_level); 1395 2 56:4 178 1396 2 56:4 178 if not finished then 1397 2 56:5 182 begin 1398 2 56:6 182 remwrite(chr(xoff)); 1399 2 56:6 185 xofcnt:=1; 1400 2 56:6 188 repeat 1401 2 56:7 188 j:=0; 1402 2 56:7 191 while (j=40 then begin 1409 2 56:6 252 dotcnt:=0; (* roughly a buffer full *) Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 28 1410 2 56:6 255 writeln; 1411 2 56:5 262 end; 1412 2 56:5 262 (* do we have more than a buffer full *) 1413 2 56:4 262 if not textfile then 1414 2 56:5 267 begin (* binary case *) 1415 2 56:6 267 if ptr > fill_level then 1416 2 56:7 275 begin 1417 2 56:8 275 last_CR_pos:=fill_level; ptr:=ptr-fill_level; 1418 2 56:8 289 len:=ptr; 1419 2 56:7 294 end else 1420 2 56:7 296 begin 1421 2 56:8 296 last_CR_pos:=ptr; ptr:=0; 1422 2 56:8 304 fillchar(buffer[last_CR_pos+1],1024-last_CR_pos,0); 1423 2 56:7 326 end; 1424 2 56:5 326 end (* binary ... *) 1425 2 56:4 326 else 1426 2 56:5 329 begin (* text *) 1427 2 56:6 329 if ptr>fill_level then (* limit is 1024 *) 1428 2 56:7 339 begin (* find last LF *) 1429 2 56:8 339 last_CR_pos:=ptr; 1430 2 56:8 344 repeat last_CR_pos:=last_CR_pos-1 1431 2 56:8 347 until ((buffer[last_CR_pos]=chr(CR)) AND 1432 2 56:8 365 (last_CR_pos < fill_level)) 1433 2 56:8 374 OR (last_CR_pos=1); 1434 2 56:8 382 (* < fill_level as last char on page must be NUL *) 1435 2 56:8 382 if buffer[last_CR_pos] <> chr(CR) then 1436 2 56:9 397 begin 1437 2 56:0 397 ABORT:=true; 1438 2 56:0 400 put_message('* Line longer than 1024 chars.',local); 1439 2 56:9 408 end else 1440 2 56:9 411 begin 1441 2 56:0 411 len:=ptr-last_CR_pos; 1442 2 56:0 420 if len > 256 then 1443 2 56:1 429 begin 1444 2 56:2 429 split_lines:=split_lines+1; 1445 2 56:2 436 len:=ptr-1023; (* -1024+1 *) 1446 2 56:2 445 moveright(buffer[1024],buffer[1025],len); 1447 2 56:2 472 buffer[1024]:=chr(CR); 1448 2 56:2 485 last_CR_pos:=1024; 1449 2 56:1 491 end else 1450 2 56:1 493 begin 1451 2 56:2 493 moveright(buffer[last_CR_pos+1],buffer[1025],len); 1452 2 56:2 521 if last_CR_pos <> 1024 then 1453 2 56:3 529 fillchar(buffer[last_CR_pos+1],1024-last_CR_pos,0); 1454 2 56:1 551 end; 1455 2 56:1 551 (* now update the pointer *) 1456 2 56:0 551 ptr:=len; 1457 2 56:9 556 end; 1458 2 56:7 556 end (* last LF *) else 1459 2 56:7 558 begin (* less then 1024 *) 1460 2 56:8 558 fillchar(buffer[ptr+1],1024-ptr,0); 1461 2 56:8 578 last_CR_pos:=ptr; ptr:=0; 1462 2 56:7 586 end; (* may be finished *) 1463 2 56:5 586 end; (* text *) 1464 2 56:5 586 1465 2 56:5 586 (* Do no more if ABORT *) 1466 2 56:4 586 if not ABORT then Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 29 1467 2 56:5 592 begin 1468 2 56:5 592 (* now write it away *) 1469 2 56:6 592 if printer_chosen then unitwrite(printer,buffer,last_CR_pos) 1470 2 56:6 607 else 1471 2 56:7 609 begin 1472 2 56:7 609 (*$I-*) 1473 2 56:8 609 j:=blockwrite(dfile,buffer[1],page); 1474 2 56:8 630 (*$I+*) 1475 2 56:8 630 if (j<>page) OR (ioresult<>0) then 1476 2 56:9 644 begin (* no RELBLOCK parameter *) 1477 2 56:0 644 ABORT:=true; 1478 2 56:0 647 put_message('* Unable to write page.',local); 1479 2 56:9 655 end; 1480 2 56:7 655 end; 1481 2 56:7 655 1482 2 56:6 655 if ptr <> 0 then moveleft(buffer[1025],buffer[1],len); 1483 2 56:6 685 1484 2 56:6 685 if finished AND (ptr<>0) then 1485 2 56:7 694 begin (* finished but some left yet *) 1486 2 56:8 694 fillchar(buffer[len+1],1024-len,0); 1487 2 56:8 716 if printer_chosen then unitwrite(printer,buffer,last_CR_pos) 1488 2 56:8 731 else 1489 2 56:9 733 begin 1490 2 56:9 733 (*$I-*) 1491 2 56:0 733 j:=blockwrite(dfile,buffer[1],page); 1492 2 56:0 754 (*$I+*) 1493 2 56:0 754 if (j<>page) OR (ioresult <> 0) then 1494 2 56:1 768 begin (* no RELBLOCK parameter *) 1495 2 56:2 768 ABORT:=true; 1496 2 56:2 771 put_message('* Unable to write page.',local); 1497 2 56:1 779 end; 1498 2 56:9 779 end; 1499 2 56:7 779 end; (* finished but...*) 1500 2 56:7 779 1501 2 56:6 779 while keypress and not ABORT do 1502 2 56:7 788 interrupted; 1503 2 56:7 792 1504 2 56:6 792 if not ABORT then 1505 2 56:7 796 begin (* not ABORT *) 1506 2 56:8 796 if xofcnt<>0 then remwrite(chr(xon)); 1507 2 56:8 804 if not finished then 1508 2 56:9 808 begin (* not finished *) 1509 2 56:0 808 if rempress then 1510 2 56:1 813 begin (* rempress *) 1511 2 56:2 813 overrun:=true; 1512 2 56:2 816 writeln; 1513 2 56:2 823 writeln('Overrun, characters from remote lost!'); 1514 2 56:2 843 (* give message in case of premature exit - *E lost *) 1515 2 56:2 843 remwrite(chr(CR)); 1516 2 56:2 846 (* CR to host in case *E lost *) 1517 2 56:2 846 (* ** of host will cause exit in GETCHAR *) 1518 2 56:1 846 end; (* rempress *) 1519 2 56:9 846 end; (* not finished *) 1520 2 56:7 846 end; (* not ABORT *) 1521 2 56:5 846 end; (* previous not ABORT *) 1522 2 56:3 846 until finished or ABORT; 1523 2 56:2 854 end; (* not ABORT *) Pascal Compiler IV.13 c6t-4 - TTY.DOGET.TEXT 2/ 5/85 Page 30 1524 2 56:1 854 tidy_up; 1525 2 1:0 0 end; (* dogetfile *) 1526 2 1:0 0 1527 2 1:0 0 {------------------------------------------------------------------------------} 1528 2 1:0 0 {END TTY.DOGET} 1529 2 1:0 0 {------------------------------------------------------------------------------} 1530 2 1:0 0 1531 2 1:0 0 Pascal Compiler IV.13 c6t-4 - TTY.GET.TEXT 2/ 5/85 Page 31 1532 2 1:0 0 {$P} 1533 2 1:0 0 {-----------------------------------------------------------------------------} 1534 2 1:0 0 {17-Aug-84 - TTY.GET } 1535 2 1:0 0 {-----------------------------------------------------------------------------} 1536 2 1:0 0 1537 2 1:0 0 { last modified 17-Aug-84 uppercase and lower case filenames sent to host 1538 2 1:0 0 previous 1-Feb-83 } 1539 2 1:0 0 1540 2 1:d 1 Function PartG:integer; 1541 2 62:0 0 begin 1542 2 62:1 0 PartG:=2; 1543 2 1:0 0 end; 1544 2 1:0 0 1545 2 1:0 0 (* CHECKSUM COMPUTATION 1546 2 1:0 0 8 letters made up as follows:- 1547 2 1:0 0 a) keep a sum of ordinal values of characters in the transfer 1548 2 1:0 0 rounded MOD 16384 in a 16 bit integer. 1549 2 1:0 0 b) keep a count of number of characters in the transfer rounded 1550 2 1:0 0 MOD 16384 in a 16 bit integer. 1551 2 1:0 0 c) for each nibble (4 bits) in the 16 bit quantities kept above 1552 2 1:0 0 (starting with the most significant nibble of the ordinal values 1553 2 1:0 0 sum and ending with the least significant nibble of the character 1554 2 1:0 0 count) add the ordinal code for the letter 'A' and send the 1555 2 1:0 0 resulting code as a character. This means that 8 letters between 1556 2 1:0 0 'A' and 'O' are sent. 1557 2 1:0 0 *) 1558 2 1:0 0 1559 2 1:d 1 PROCEDURE GETFILE; 1560 2 1:d 1 (*------1-------*) 1561 2 63:d 1 CONST FILLLEVEL=1024; (*ALLOW 256 CHARACTERS OF OVERRUN BY HOST AFTER XOFF*) 1562 2 63:d 1 buffer_size=1281; 1563 2 63:d 1 printer=6; (* in case file is to go to printer *) 1564 2 63:d 1 VAR STR,STR2:long_string; 1565 2 63:d 257 DFILE:file; (* using BLOCKREAD/WRITE *) 1566 2 63:d 297 r_name,l_name:string; CH:CHAR; 1567 2 63:d 380 user_interrupt,ABORT:BOOLEAN; 1568 2 63:d 382 st:string; 1569 2 63:d 423 1570 2 63:d 423 1571 2 63:d 423 Function GET_Checks(list:long_string):Boolean; 1572 2 63:d 1 (*--------------------2---------------------*) 1573 2 64:d 1 Var 1574 2 64:d 1 ABORT:boolean; 1575 2 64:d 2 name:string; i:integer; 1576 2 64:d 44 temp_list:long_string; 1577 2 64:0 0 begin 1578 2 64:1 8 temp_list:=list; 1579 2 64:1 16 get_checks:=true; ABORT:=false; 1580 2 64:1 22 while (temp_list<>'') AND not ABORT do 1581 2 64:2 36 begin 1582 2 64:3 36 next_name(temp_list,name); 1583 2 64:3 41 namecheck(name,ABORT,true,textfile); 1584 2 64:2 49 end; 1585 2 64:1 51 get_checks:=ABORT; 1586 2 63:0 0 end; (* get_checks *) 1587 2 63:0 0 1588 2 63:0 0 Pascal Compiler IV.13 c6t-4 - TTY.GET.TEXT 2/ 5/85 Page 32 1589 2 63:0 0 BEGIN (* GETFILE *) 1590 2 63:0 0 1591 2 63:1 10 WRITELN; 1592 2 63:1 17 WRITE('--- Get file '); 1593 2 63:1 30 if textfile then begin 1594 2 63:3 35 write('(Text, '); 1595 2 63:3 48 if chinmod=128 then write('7') else write('8'); 1596 2 63:3 77 writeln(' bit codes) ---') 1597 2 63:2 97 end 1598 2 63:1 97 else writeln('(Binary) ---'); 1599 2 63:1 119 WRITELN; 1600 2 63:1 126 WRITE('Give remote file(s):'); 1601 2 63:1 139 KEYRDLN(STR); 1602 2 63:1 144 WRITE('Give local file(s):'); 1603 2 63:1 157 KEYRDLN(STR2); 1604 2 63:1 160 UPPERCASE (str2); 1605 2 63:1 163 init_messages; (* initialise messages for name checking *) 1606 2 63:1 165 if names_paired(str,str2) then 1607 2 63:2 177 begin 1608 2 63:3 177 if not get_checks(str2) then (* check LOCAL names - true if ABORT *) 1609 2 63:4 186 begin (* local checks OK *) 1610 2 63:5 186 writeln; 1611 2 63:5 193 while str2<>'' do 1612 2 63:6 204 begin (* tranfers *) 1613 2 63:7 204 ABORT:=false; 1614 2 63:7 208 next_name(str,r_name); (* remote *) 1615 2 63:7 216 next_name(str2,l_name);(* local *) 1616 2 63:7 222 if textfile AND (POS(':',l_name) <> length(l_name)) 1617 2 63:7 243 then if (POS('.TEXT',l_name)=0) 1618 2 63:8 260 then l_name:=CONCAT(l_name,'.TEXT'); 1619 2 63:7 297 writeln(r_name,' --> ',l_name); 1620 2 63:7 341 DoGetFile(r_name, l_name, textfile,debug,user_interrupt); 1621 2 63:7 360 if not user_interrupt then 1622 2 63:8 365 begin 1623 2 63:9 365 print_messages; 1624 2 63:9 367 if str2 <> '' then writeln; 1625 2 63:8 383 end 1626 2 63:7 383 else writeln; 1627 2 63:6 392 end (* transfers *) 1628 2 63:4 392 end (* local... *) else print_messages; 1629 2 63:2 399 end 1630 2 63:1 399 else printmessages; 1631 2 63:1 403 writeln; writeln('--- Get file finished ---',chr(BEL)); 1632 2 1:0 0 end; (* getfile *) 1633 2 1:0 0 1634 2 1:0 0 {------------------------------------------------------------------------------} 1635 2 1:0 0 {end TTY.GET} 1636 2 1:0 0 {------------------------------------------------------------------------------} 1637 2 1:0 0 1638 2 1:0 0 Pascal Compiler IV.13 c6t-4 - TTY.DOPUT.TEXT 2/ 5/85 Page 33 1639 2 1:0 0 {$P} 1640 2 1:0 0 {-----------------------------------------------------------------------------} 1641 2 1:0 0 {7-Aug-84 - TTY.DOPUT for PAD's } 1642 2 1:0 0 {-----------------------------------------------------------------------------} 1643 2 1:0 0 1644 2 1:0 0 { modified 1-Feb-83 1645 2 1:0 0 modified 7-Aug-84 by G.Wilkie for coding for PAD's 1646 2 1:0 0 modified 17-Dec-84 by G.Wilkie for abandoning all transfers if no 1647 2 1:0 0 Take file: prompt and fix flow control 1648 2 1:0 0 modified 20-Dec-84 by G.Wilkie for extra "if rempress then remcheck" before 1649 2 1:0 0 disk read for apple and also extra calls of mop_up at termination phase } 1650 2 1:0 0 1651 2 1:d 1 Function PartDP:integer; 1652 2 65:0 0 begin 1653 2 65:1 0 PartDP:=7; 1654 2 1:0 0 end; 1655 2 1:0 0 1656 2 1:d 1 Procedure DoPutFile(localname,remotename:string; textfile,debug:boolean; 1657 2 1:d 6 var user_interrupt,abortall:boolean); 1658 2 1:d 1 (*----------------------------------1------------------------------------*) 1659 2 66:d 1 CONST TERM=63; (* TERMINATOR=? *) 1660 2 66:d 1 var 1661 2 66:d 1 ch:char; 1662 2 66:d 2 ABORT:boolean; 1663 2 66:d 3 pad:boolean; { whether communicating with a PAD or TCP } 1664 2 66:d 4 block:packed array[1..1024] of char; 1665 2 66:d 516 filler:integer; (* this is a 2 byte overflow for block *) 1666 2 66:d 517 Res,page,blanks,relblock:integer; 1667 2 66:d 521 fill_level,j,chord:integer; 1668 2 66:d 524 DFILE:file; (* untyped for a reason *) 1669 2 66:d 564 chars,chksm,dotcnt,totxof,maxxof,xofocc:integer; 1670 2 66:d 570 st:string; 1671 2 66:d 611 st_chars,st_chksm,st_totxof,st_maxxof,st_xofocc:short_string; 1672 2 66:d 646 1673 2 66:d 646 PROCEDURE PUTCHKSM; 1674 2 66:d 1 (*-------2-------*) 1675 2 67:d 1 VAR I:INTEGER; 1676 2 67:d 2 EXTRA:RECORD CASE BOOLEAN OF 1677 2 67:d 2 TRUE: (DAT:PACKED ARRAY[0..7] OF 0..15); 1678 2 67:d 2 FALSE:(CHKSM,CHARS:INTEGER); 1679 2 67:d 2 END; 1680 2 67:0 0 BEGIN 1681 2 67:1 0 EXTRA.CHKSM:=CHKSM; 1682 2 67:1 4 EXTRA.CHARS:=CHARS; 1683 2 67:1 8 FOR I:=7 DOWNTO 0 DO REMWRITE(CHR(ORD('A')+EXTRA.DAT[I] MOD chinmod)); 1684 2 67:1 44 remsink(false); (* lose the echo *) 1685 2 67:1 47 REMWRITE(CHR(CR)); 1686 2 66:0 0 END; 1687 2 66:0 0 1688 2 66:0 0 1689 2 66:d 1 PROCEDURE REMCHECK; 1690 2 66:d 1 (*------2--------*) 1691 2 68:d 1 VAR i,XOFCNT:INTEGER; 1692 2 68:d 3 CH:CHAR; 1693 2 68:d 4 1694 2 68:0 0 BEGIN 1695 2 68:1 0 XOFCNT:=0; Pascal Compiler IV.13 c6t-4 - TTY.DOPUT.TEXT 2/ 5/85 Page 34 1696 2 68:1 2 REPEAT 1697 2 68:2 2 REMREAD(CH); 1698 2 68:2 5 CH:=CHR(ORD(CH) MOD 128); (* Explicit 7 bit Parity Mask *) 1699 2 68:2 14 if (xofcnt=0) and (ord(ch)=0) then EXIT (REMCHECK); {To handle PAD ??} 1700 2 68:2 29 IF CH=CHR(XOFF) THEN XOFCNT:=XOFCNT+1 (* An XOFF so bump count *) 1701 2 68:2 34 ELSE IF (CH<>CHR(XON)) and (ch<>chr(0)) THEN 1702 2 68:4 47 begin 1703 2 68:5 47 Mop_Up(ch); 1704 2 68:5 50 close(dfile); 1705 2 68:5 59 if DEBUG then put_message 1706 2 68:6 64 ('* Expected XON or | from host not char.', 1707 2 68:6 69 debugging); 1708 2 68:5 72 exit(doputfile); 1709 2 68:4 78 end; 1710 2 68:1 78 UNTIL (CH=CHR(XON)) OR ABORT; (* flow control resume *) 1711 2 68:1 86 TOTXOF:=TOTXOF+XOFCNT; (* running XOFF total *) 1712 2 68:1 95 IF XOFCNT>MAXXOF THEN MAXXOF:=XOFCNT; (* the biggest yet? *) 1713 2 68:1 107 XOFOCC:=XOFOCC+1 (* register this occurence *) 1714 2 66:0 0 END; (* remcheck *) 1715 2 66:0 0 1716 2 66:d 1 Procedure Case_Check; 1717 2 66:d 1 (*--------2--------*) 1718 2 69:d 1 var i:integer; 1719 2 69:0 0 begin 1720 2 69:1 0 case chord of 1721 2 69:1 6 CR:if textfile then begin 1722 2 69:4 11 chord:=newline; 1723 2 69:4 16 ch:=chr(newline); (* may be m/c dependent *) 1724 2 69:3 20 end else if pad then begin 1725 2 69:5 26 if rempress then remcheck; 1726 2 69:5 33 remwrite (chr(DLE)); 1727 2 69:5 36 ch:=chr(CRMSB); {chord left as CR for checksum} 1728 2 69:4 41 end; 1729 2 69:1 44 DLE:if textfile then 1730 2 69:3 50 begin 1731 2 69:3 50 (*$R-*) (* j may overflow into filler bytes *) 1732 2 69:4 50 j:=j+1; 1733 2 69:4 58 blanks:=ord(block[j]) -33;(* 32 offset -1 *) 1734 2 69:4 73 (*$R+*) (* j may be 1025, hence filler area *) 1735 2 69:4 73 ch:=space; (* this is why the -1 appears above *) 1736 2 69:4 78 chord:=ord(space); 1737 2 69:4 84 if blanks > 0 then 1738 2 69:5 91 begin (* range check *) 1739 2 69:6 91 for i:=1 to blanks do 1740 2 69:7 102 begin 1741 2 69:8 102 if rempress then remcheck; 1742 2 69:8 109 remwrite(space); 1743 2 69:7 113 end; 1744 2 69:6 118 chars:=(chars + blanks) MOD 16384; 1745 2 69:6 137 chksm:=(chksm + blanks*ord(space)) MOD 16384; 1746 2 69:5 159 end (* range... *) 1747 2 69:4 159 else 1748 2 69:5 161 if blanks = -1 then 1749 2 69:6 168 begin (* zero DLE indent - get next char *) 1750 2 69:6 168 (*$R-*) (* j may point past limit *) 1751 2 69:7 168 j:=j+1; 1752 2 69:7 176 chord:=ord(block[j]) MOD chinmod; Pascal Compiler IV.13 c6t-4 - TTY.DOPUT.TEXT 2/ 5/85 Page 35 1753 2 69:7 192 ch:=chr(chord); 1754 2 69:7 198 case_check; 1755 2 69:7 200 (*$R+*) (* j may be 1026 *) 1756 2 69:6 200 end 1757 2 69:5 200 else 1758 2 69:6 202 if blanks < -1 then 1759 2 69:7 210 begin (* an error *) 1760 2 69:8 210 ABORT:=true; (* local message here *) 1761 2 69:8 214 put_message('* DLE expansion error.',local); 1762 2 69:7 222 end; 1763 2 69:7 222 (* note that if blanks = 0 then ch 1764 2 69:7 222 has already been set to *) 1765 2 69:3 222 end (* DLE_case *) else (* binary *) 1766 2 69:3 224 begin 1767 2 69:4 224 if rempress then remcheck; 1768 2 69:4 231 remwrite(chr(DLE)); 1769 2 69:3 234 end; 1770 2 69:1 236 XON:if pad then begin 1771 2 69:4 240 if rempress then remcheck; 1772 2 69:4 247 remwrite (chr(DLE)); 1773 2 69:4 250 ch:='1'; {chord left as XON for checksum} 1774 2 69:3 255 end; 1775 2 69:1 257 XOFF:if pad then begin 1776 2 69:4 261 if rempress then remcheck; 1777 2 69:4 268 remwrite (chr(DLE)); 1778 2 69:4 271 ch:='3'; {chord left as XOFF for checksum} 1779 2 69:3 276 end; 1780 2 69:1 278 XONMSB:if pad then begin 1781 2 69:4 282 if rempress then remcheck; 1782 2 69:4 289 remwrite (chr(DLE)); 1783 2 69:4 292 ch:=chr(128+ord('1')); {chord left as XONMSB 1784 2 69:4 300 for checksum} 1785 2 69:3 300 end; 1786 2 69:1 302 XOFFMSB:if pad then begin 1787 2 69:4 306 if rempress then remcheck; 1788 2 69:4 313 remwrite (chr(DLE)); 1789 2 69:4 316 ch:=chr(128+ord('3')); {chord left as XOFFMSB 1790 2 69:4 324 for checksum} 1791 2 69:3 324 end; 1792 2 69:1 326 TERM:begin 1793 2 69:3 326 if rempress then remcheck; 1794 2 69:3 333 remwrite(chr(TransparenCh)); (* special character *) 1795 2 69:2 336 end; 1796 2 69:1 338 end; (* case *) 1797 2 66:0 0 end; (* case check *) 1798 2 66:0 0 1799 2 66:d 1 Procedure Prepare; 1800 2 66:d 1 (*------2-------*) 1801 2 70:d 1 var Res:integer; 1802 2 70:d 2 Name:string; 1803 2 70:0 0 begin 1804 2 70:1 0 init_messages; (* message area should be empty *) 1805 2 70:1 2 (*$I-*) (* check for file OK *) 1806 2 70:1 2 {get correct name} 1807 2 70:1 2 Name:=LocalName; 1808 2 70:1 10 if textfile AND (POS('.TEXT',Name)=0) 1809 2 70:1 25 then Name:=CONCAT(Name,'.TEXT'); Pascal Compiler IV.13 c6t-4 - TTY.DOPUT.TEXT 2/ 5/85 Page 36 1810 2 70:1 56 1811 2 70:1 56 reset(dfile,Name); 1812 2 70:1 66 Res:=IOResult; 1813 2 70:1 70 if Res <> 0 then 1814 2 70:2 74 begin (* something wrong *) 1815 2 70:3 74 close(dfile); 1816 2 70:3 81 givereason(Res,st); 1817 2 70:3 88 put_message(st,local); 1818 2 70:3 96 exit(doputfile); 1819 2 70:2 102 end; (* something wrong *) 1820 2 70:2 102 (*$I+*) 1821 2 70:2 102 1822 2 70:2 102 (* do some initialisation *) 1823 2 70:1 102 totxof:=0; maxxof:=0; xofocc:=0; 1824 2 70:1 117 chksm:=0; chars:=0; dotcnt:=0; 1825 2 70:1 132 user_interrupt:=false; ABORT:=false; 1826 2 70:1 141 page:=2; (* but we may have odd number of blocks *) 1827 2 66:0 0 end; (* prepare *) 1828 2 66:0 0 1829 2 66:0 0 1830 2 66:0 0 (* ********* *) 1831 2 66:0 0 begin (* doputfile *) 1832 2 66:0 0 (* ********* *) 1833 2 66:1 26 prepare; (* does all the initialising & checking before transfers *) 1834 2 66:1 28 (*$R-*) 1835 2 66:1 28 transmit('TAKEFILE',false); 1836 2 66:1 36 remwrite(chr(CR)); 1837 2 66:1 39 Mop_Up(chr(NUL)); (* collect any response *) 1838 2 66:1 42 if prompt_verify('e:') (* looking for Takefile: *) 1839 2 66:1 48 then init_messages 1840 2 66:1 52 else begin 1841 2 66:3 56 if DEBUG then 1842 2 66:4 61 put_message('* Incorrect prompt from host.',debugging); 1843 2 66:3 69 close(dfile); 1844 2 66:3 77 abortall :=true; 1845 2 66:3 82 exit(doputfile); 1846 2 66:2 88 end; 1847 2 66:2 88 1848 2 66:1 88 transmit(remotename,false); (* invoke EMAS TakeFile *) 1849 2 66:1 95 remwrite(chr(CR)); 1850 2 66:1 98 (*$R+*) 1851 2 66:1 98 repeat 1852 2 66:2 98 remread(ch); 1853 2 66:2 101 ch:=chr(ord(ch) MOD 128); {explicit 7 bit mask} 1854 2 66:1 110 until not (ch in [chr(NUL), CHR(CR), chr(LF)]); (* skip the junk *) 1855 2 66:1 125 1856 2 66:1 125 if not (ch in [chr(XON), PADXON]) then 1857 2 66:2 139 begin 1858 2 66:3 139 Mop_Up(ch); 1859 2 66:3 142 close(dfile); 1860 2 66:3 150 if DEBUG then 1861 2 66:4 155 put_message('* XON to start transfer not received.',debugging); 1862 2 66:3 163 exit(doputfile); 1863 2 66:2 169 end; 1864 2 66:2 169 1865 2 66:1 169 pad:=ch=PADXON; { needed for encoding of XON and XOFF } 1866 2 66:1 174 filler:=0; (* NULs in the overflow block *) Pascal Compiler IV.13 c6t-4 - TTY.DOPUT.TEXT 2/ 5/85 Page 37 1867 2 66:1 178 if textfile then relblock:=2 (* skip 2 blocks of text file *) 1868 2 66:1 183 else relblock:=0; 1869 2 66:1 193 repeat (* until EOF or ABORT *) 1870 2 66:2 193 (*$I-*) j:=blockread(dfile, block, page, relblock); (*$I+*) 1871 2 66:2 211 if j <> page then 1872 2 66:3 219 begin 1873 2 66:4 219 if (j=1) AND not textfile then page:=1 1874 2 66:4 231 else 1875 2 66:5 237 begin 1876 2 66:6 237 ABORT:=true; 1877 2 66:6 239 put_message('* Unable to read page.',local); 1878 2 66:5 247 end; 1879 2 66:3 247 end; 1880 2 66:2 247 if ioresult<>0 then 1881 2 66:3 253 begin (* something wrong *) 1882 2 66:4 253 Res:=ioresult; 1883 2 66:4 259 givereason(Res,st); 1884 2 66:4 267 put_message(st,local); 1885 2 66:3 274 end; 1886 2 66:2 274 if not ABORT then 1887 2 66:3 279 begin (* blockread ok *) 1888 2 66:4 279 write('.'); 1889 2 66:4 289 relblock:=relblock + page; (* point to next block *) 1890 2 66:4 299 (* do a backwards scan over NULs *) 1891 2 66:4 299 fill_level:=page*512; 1892 2 66:4 309 if textfile then 1893 2 66:5 314 begin (* textfile *) 1894 2 66:6 314 while (block[fill_level]=chr(NUL)) AND (fill_level>1) 1895 2 66:6 333 do fill_level:=fill_level-1; 1896 2 66:6 345 if EOF(dfile) then 1897 2 66:7 355 begin 1898 2 66:8 355 if block[fill_level]=chr(CR) then fill_level:=fill_level-1; 1899 2 66:8 376 (* remove very last CR *) 1900 2 66:8 376 if (fill_level>2) then 1901 2 66:9 383 begin 1902 2 66:0 383 if (ord(block[fill_level])>=ord(space)) AND 1903 2 66:0 397 (block[fill_level-1]=chr(DLE)) 1904 2 66:0 411 then fill_level:=fill_level-2; 1905 2 66:0 422 (* remove DLE sequence if at end *) 1906 2 66:9 422 end; 1907 2 66:7 422 end; (* eof *) 1908 2 66:5 422 end; (* textfile *) 1909 2 66:4 422 if fill_level > 0 then 1910 2 66:5 429 begin (* not a block of NULs in textfile mode *) 1911 2 66:6 429 j:=1; 1912 2 66:6 433 repeat 1913 2 66:7 433 ch:=block[j]; chord:=ord(ch); 1914 2 66:7 449 case_check; 1915 2 66:7 451 (* always get here - but may do one of the above *) 1916 2 66:7 451 chars:=(chars + 1) MOD 16384; 1917 2 66:7 466 chksm:=(chksm + chord) MOD 16384; {chord used because if PAD 1918 2 66:7 484 is true XON(XOFF) need to be sent as '1'('3'), but 1919 2 66:7 484 for should be XON(XOFF) for checksum, 1920 2 66:7 484 NEEDs MORE ELEGANT SOLUTION ?? } 1921 2 66:7 484 if rempress then remcheck; 1922 2 66:7 491 remwrite(chr(ord(ch) MOD chinmod)); { mod done after for 8 bits } 1923 2 66:7 502 (* this was the character we first thought of *) Pascal Compiler IV.13 c6t-4 - TTY.DOPUT.TEXT 2/ 5/85 Page 38 1924 2 66:7 502 j:=j + 1; (* point to the next character *) 1925 2 66:6 509 until j > fill_level; (* a buffer full *) 1926 2 66:5 518 end; (* not a block of NULs *) 1927 2 66:3 518 end; (* blockread ok *) 1928 2 66:3 518 1929 2 66:2 518 if rempress then remcheck; { added 19-12-84 for Apple, since if Xoff 1930 2 66:2 525 followed by xon sent now, this is lost 1931 2 66:2 525 due to no buffering } 1932 2 66:2 525 1933 2 66:2 525 write('.'); 1934 2 66:2 535 dotcnt:=dotcnt + 2; 1935 2 66:2 543 if dotcnt>= 40 then begin 1936 2 66:4 551 dotcnt:=0; 1937 2 66:4 555 writeln; 1938 2 66:3 562 end; 1939 2 66:2 562 while keypress and not ABORT do 1940 2 66:3 570 begin 1941 2 66:4 570 keyread(ch,false,false); 1942 2 66:4 575 if ch = chr(ESC) then 1943 2 66:5 579 begin 1944 2 66:6 579 user_interrupt:=sure('Curtail?'); 1945 2 66:6 591 ABORT:=ABORT or user_interrupt; 1946 2 66:5 598 end; 1947 2 66:3 598 end; 1948 2 66:1 600 until EOF(dfile) or ABORT; 1949 2 66:1 613 (*$I-*) 1950 2 66:1 613 CLOSE(DFILE); 1951 2 66:1 619 (*$I+*) 1952 2 66:1 619 if ioresult<>0 then 1953 2 66:2 625 begin 1954 2 66:3 625 Res:=ioresult; givereason(Res,st); 1955 2 66:3 639 put_message(st,local); 1956 2 66:2 646 end; 1957 2 66:1 646 IF REMPRESS THEN REMCHECK; 1958 2 66:1 653 REMWRITE(chr(TERM)); 1959 2 66:1 657 MOP_UP(chr(NUL)); { added 20-12-84 for filestore problems } 1960 2 66:1 660 PUTCHKSM; (*PUT OUT CHECKSUM TO HOST*) 1961 2 66:1 662 mop_up(chr(NUL)); { added 18-12-84 } 1962 2 66:1 665 remwrite(chr(CR)); 1963 2 66:1 668 mop_up(chr(NUL)); 1964 2 66:1 671 writeln; (* to cater for part lines *) 1965 2 66:1 678 if DEBUG then 1966 2 66:2 684 begin 1967 2 66:3 684 int_to_string(chars,6,st_chars); int_to_string(chksm,6,st_chksm); 1968 2 66:3 702 put_message(concat('* ',st_chars, 1969 2 66:3 730 ' characters sent. Checksum:',st_chksm,'.'), 1970 2 66:3 766 debugging); 1971 2 66:3 769 int_to_string(xofocc,0,st_xofocc); 1972 2 66:3 778 int_to_string(maxxof,0,st_maxxof); 1973 2 66:3 787 int_to_string(totxof,0,st_totxof); 1974 2 66:3 796 put_message(concat('* XOFF occurred ',st_xofocc,' times, Max ', 1975 2 66:3 836 st_maxxof,', Total ',st_totxof,'.'),debugging); 1976 2 66:2 886 end; 1977 2 1:0 0 end; (* doputfile *) 1978 2 1:0 0 1979 2 1:0 0 {-----------------------------------------------------------------------------} 1980 2 1:0 0 {end TTY.DOPUT} Pascal Compiler IV.13 c6t-4 - TTY.DOPUT.TEXT 2/ 5/85 Page 39 1981 2 1:0 0 {-----------------------------------------------------------------------------} 1982 2 1:0 0 1983 2 1:0 0 1984 2 1:0 0 Pascal Compiler IV.13 c6t-4 - TTY.PUT.TEXT 2/ 5/85 Page 40 1985 2 1:0 0 {$p} 1986 2 1:0 0 {-----------------------------------------------------------------------------} 1987 2 1:0 0 { - TTY.PUT - } 1988 2 1:0 0 {-----------------------------------------------------------------------------} 1989 2 1:0 0 1990 2 1:0 0 { modified 1991 2 1:0 0 3-Aug-84 Gordon Wilkie PAD changes 1992 2 1:0 0 20-Aug-84 Gordon Wilkie uppercase and lower case allowed for remote names 1993 2 1:0 0 18-Dec-84 Gordon Wilkie change to allow abort all param } 1994 2 1:0 0 1995 2 1:d 1 Function PartP:integer; 1996 2 71:0 0 begin 1997 2 71:1 0 PartP:=3; 1998 2 1:0 0 end; 1999 2 1:0 0 2000 2 1:0 0 (* CHECKSUM COMPUTATION 2001 2 1:0 0 8 letters made up as follows:- 2002 2 1:0 0 a) keep a sum of ordinal values of characters in the transfer 2003 2 1:0 0 rounded MOD 16384 in a 16 bit integer. 2004 2 1:0 0 b) keep a count of number of characters in the transfer rounded 2005 2 1:0 0 MOD 16384 in a 16 bit integer. 2006 2 1:0 0 c) for each nibble (4 bits) in the 16 bit quantities kept above 2007 2 1:0 0 (starting with the most significant nibble of the ordinal values 2008 2 1:0 0 sum and ending with the least significant nibble of the character 2009 2 1:0 0 count) add the ordinal code for the letter 'A' and send the 2010 2 1:0 0 resulting code as a character. This means that 8 letters between 2011 2 1:0 0 'A' and 'O' are sent. 2012 2 1:0 0 *) 2013 2 1:0 0 2014 2 1:d 1 Procedure PutFile; 2015 2 1:d 1 (*======1=======*) 2016 2 72:d 1 VAR l_name,r_name:STRING; 2017 2 72:d 83 STR,STR2:long_string; 2018 2 72:d 339 abortall,BadName,user_interrupt,ABORT:BOOLEAN; 2019 2 72:d 343 CH:CHAR; 2020 2 72:d 344 2021 2 72:d 344 Function PUT_Checks_OK(name_list:long_string):Boolean; 2022 2 72:d 1 (*-------------------------2------------------------*) 2023 2 73:d 1 Var 2024 2 73:d 1 dfile:file; (* used to test local files *) 2025 2 73:d 41 OK:boolean; 2026 2 73:d 42 st,name:string; Res,i:integer; 2027 2 73:0 0 Begin 2028 2 73:1 16 put_checks:=true; OK:=true; 2029 2 73:1 23 (*$I-*) 2030 2 73:1 23 while (name_list <> '') AND OK do 2031 2 73:2 39 begin (* while *) 2032 2 73:3 39 next_name(name_list,name); 2033 2 73:3 46 if length(name) <> 0 then 2034 2 73:4 55 begin (* non zero name *) 2035 2 73:5 55 if textfile then 2036 2 73:6 60 if POS('.TEXT',name) = 0 then name:=concat(name,'.TEXT'); 2037 2 73:5 104 if POS(':',name) <> 0 then 2038 2 73:6 118 begin 2039 2 73:7 118 BadName:= (length(name)-POS(':',name) > 15) OR 2040 2 73:7 137 (POS(':',name) > 8); 2041 2 73:6 156 end Pascal Compiler IV.13 c6t-4 - TTY.PUT.TEXT 2/ 5/85 Page 41 2042 2 73:5 156 else 2043 2 73:6 158 if POS('*',name) = 1 then 2044 2 73:7 172 begin 2045 2 73:8 172 BadName:=(length(name) > 16); 2046 2 73:7 183 end 2047 2 73:6 183 else 2048 2 73:7 185 BadName:=length(name) > 15; 2049 2 73:5 196 if BadName then 2050 2 73:6 201 begin 2051 2 73:7 201 OK:=false; 2052 2 73:7 204 put_message(CONCAT( 2053 2 73:7 204 '* Illegal file name ',name,'.'),local); 2054 2 73:6 243 end else 2055 2 73:6 245 begin (* name OK *) 2056 2 73:7 245 reset(dfile,name); 2057 2 73:7 253 if ioresult <> 0 then 2058 2 73:8 259 begin 2059 2 73:9 259 Res:=ioresult; 2060 2 73:9 264 OK:=false; 2061 2 73:9 267 put_message(concat('* Unable to open local file ', 2062 2 73:9 282 name),local); 2063 2 73:9 295 if DEBUG then begin 2064 2 73:1 300 givereason(Res,st); 2065 2 73:1 306 put_message(st,debugging); 2066 2 73:0 312 end; 2067 2 73:8 312 end; 2068 2 73:7 312 close(dfile); 2069 2 73:6 316 end;(* name OK *) 2070 2 73:4 316 end (* non zero... *) 2071 2 73:3 316 else begin (* null name *) 2072 2 73:5 318 OK:=false; 2073 2 73:5 321 put_message('* Null file name.',local); 2074 2 73:4 329 end; (* nul name *) 2075 2 73:2 329 end; (* while *) 2076 2 73:1 332 put_checks_OK:=OK; 2077 2 72:0 0 end; (* put_checks *) 2078 2 72:0 0 2079 2 72:0 0 BEGIN (* PutFile *) 2080 2 72:1 0 WRITELN; 2081 2 72:1 5 WRITE('--- Put file '); 2082 2 72:1 16 if textfile then begin 2083 2 72:3 21 write('(Text, '); 2084 2 72:3 32 if chinmod=128 then write('7') else write('8'); 2085 2 72:3 57 writeln(' bit codes) ---') 2086 2 72:2 73 end 2087 2 72:1 73 else writeln('(Binary) ---'); 2088 2 72:1 91 WRITELN; 2089 2 72:1 96 WRITE('Give local file(s):'); 2090 2 72:1 107 KEYRDLN(STR); 2091 2 72:1 112 UPPERCASE (str); 2092 2 72:1 117 WRITE('Give remote file(s):'); 2093 2 72:1 128 KEYRDLN(STR2); 2094 2 72:1 132 init_messages; (* initialise messages for namechecking procedures *) 2095 2 72:1 134 2096 2 72:1 134 if names_paired(str,str2) then (* paired names *) 2097 2 72:2 147 begin 2098 2 72:3 147 if put_checks_OK(str) then (* local files appear to be there *) Pascal Compiler IV.13 c6t-4 - TTY.PUT.TEXT 2/ 5/85 Page 42 2099 2 72:4 157 begin 2100 2 72:5 157 writeln; 2101 2 72:5 162 while str2<>'' do 2102 2 72:6 174 begin (* transfers *) 2103 2 72:7 174 next_name(str, l_name); 2104 2 72:7 181 next_name(str2, r_name); 2105 2 72:7 186 {next_name returns name in capitals} 2106 2 72:7 186 if textfile AND (POS('.TEXT',l_name)=0) 2107 2 72:7 202 then l_name:=CONCAT(l_name,'.TEXT'); 2108 2 72:7 239 writeln(l_name,' --> ',r_name); 2109 2 72:7 272 abortall:=false; 2110 2 72:7 276 doputfile(l_name,r_name,textfile,debug,user_interrupt, 2111 2 72:7 290 abortall); 2112 2 72:7 295 if abortall then str2:=''; {abandon all transfers} 2113 2 72:7 308 print_messages; (*ENDING MESSAGES*) 2114 2 72:7 310 if str2<>'' then writeln; 2115 2 72:7 325 if abortall then writeln('Transfer abandoned'); 2116 2 72:6 346 end (* transfers *) 2117 2 72:4 346 end 2118 2 72:3 349 else print_messages; 2119 2 72:2 353 end 2120 2 72:1 353 else print_messages; 2121 2 72:1 357 writeln; writeln('--- Put file finished ---',chr(BEL)); 2122 2 1:0 0 end; (* putfile *) 2123 2 1:0 0 2124 2 1:0 0 {------------------------------------------------------------------------------} 2125 2 1:0 0 {end TTY.PUT} 2126 2 1:0 0 {------------------------------------------------------------------------------} 2127 2 1:0 0 2128 2 1:0 0 Pascal Compiler IV.13 c6t-4 - TTY.FLR.TEXT 2/ 5/85 Page 43 2129 2 1:0 0 {$P} 2130 2 1:0 0 {-----------------------------------------------------------------------------} 2131 2 1:0 0 {1-Feb-83 - TTY.FLR} 2132 2 1:0 0 {-----------------------------------------------------------------------------} 2133 2 1:0 0 { Modified 4-Dec-84 by G.Wilkie to check valid directory } 2134 2 1:0 0 2135 2 1:d 1 FUNCTION PARTF:INTEGER; 2136 2 74:0 0 BEGIN 2137 2 74:0 0 {FILER REVISION NUMBER} 2138 2 74:1 0 PARTF:=7; 2139 2 1:0 0 END; 2140 2 1:0 0 2141 2 1:0 0 {$I-} 2142 2 1:d 1 PROCEDURE FILEH(CODE:CHAR); 2143 2 1:d 1 2144 2 1:d 1 { Assume all input through } 2145 2 1:d 1 { GETCH input character from source stream } 2146 2 1:d 1 { GETLN input string from source stream up to NL } 2147 2 1:d 1 { } 2148 2 1:d 1 {Assume all output through } 2149 2 1:d 1 { PUTCH output character to destination stream } 2150 2 1:d 1 { PUTTXT output string to destination stream } 2151 2 1:d 1 { PUTINT output integer to destination stream } 2152 2 1:d 1 { PUTLN output a newline to destination stream } 2153 2 1:d 1 { } 2154 2 1:d 1 {There are calls to windowing routines - could be null} 2155 2 1:d 1 { WFRAME set a text port for the output } 2156 2 1:d 1 { WUNFRAME reset the text port to the entire screen } 2157 2 1:d 1 { WCLRSCREEN clears the text port and goes to 0,0 } 2158 2 1:d 1 2159 2 75:d 1 CONST VIDLENG=7; {NUMBER OF CHARS IN A VOLUME ID} 2160 2 75:d 1 TIDLENG=15; {NUMBER OR CHARS IN A TITLE ID} 2161 2 75:d 1 MAXDIR=77; {MAX NUMBER OF ENTRIES IN A DIRECTORY} 2162 2 75:d 1 2163 2 75:d 1 TYPE DATEREC = PACKED RECORD 2164 2 75:d 1 MONTH: 0..12; {0 IMPLIES DATE NOT MEANINGFUL} 2165 2 75:d 1 DAY: 0..31; {DAY OF MONTH} 2166 2 75:d 1 YEAR: 0..100 {100 IS TEMP DISK FILE FLAG} 2167 2 75:d 1 END {DATEREC} ; 2168 2 75:d 1 VID = STRING[VIDLENG]; 2169 2 75:d 1 DIRRANGE = 0..MAXDIR; 2170 2 75:d 1 TID = STRING[TIDLENG]; 2171 2 75:d 1 2172 2 75:d 1 FILEKIND = (UNTYPEDFILE,XDSKFILE,CODEFILE,TEXTFILE, 2173 2 75:d 1 INFOFILE,DATAFILE,GRAFFILE,FOTOFILE); 2174 2 75:d 1 2175 2 75:d 1 DIRENTRY = RECORD 2176 2 75:d 1 DFIRSTBLK: INTEGER; {FIRST PHYSICAL DISK ADDR} 2177 2 75:d 1 DLASTBLK: INTEGER; {POINTS AT BLOCK FOLLOWING} 2178 2 75:d 1 CASE DFKIND: FILEKIND OF 2179 2 75:d 1 UNTYPEDFILE: {ONLY IN DIR[0]...VOLUME INFO} 2180 2 75:d 1 (DVID: VID; {NAME OF DISK VOLUME} 2181 2 75:d 1 DEOVBLK: INTEGER; {LASTBLK OF VOLUME} 2182 2 75:d 1 DNUMFILES: DIRRANGE; {NUM FILES IN DIR} 2183 2 75:d 1 DLOADTIME: INTEGER; {TIME OF LAST ACCESS} 2184 2 75:d 1 DLASTBOOT: DATEREC); {MOST RECENT DATE SETTING} 2185 2 75:d 1 XDSKFILE,CODEFILE,TEXTFILE,INFOFILE, Pascal Compiler IV.13 c6t-4 - TTY.FLR.TEXT 2/ 5/85 Page 44 2186 2 75:d 1 DATAFILE,GRAFFILE,FOTOFILE: 2187 2 75:d 1 (DTID: TID; {TITLE OF FILE} 2188 2 75:d 1 DLASTBYTE: 1..512; {NUM BYTES IN LAST BLOCK} 2189 2 75:d 1 DACCESS: DATEREC) {LAST MODIFICATION DATE} 2190 2 75:d 1 END {DIRENTRY} ; 2191 2 75:d 1 2192 2 75:d 1 VAR DI: RECORD CASE BOOLEAN OF 2193 2 75:d 1 TRUE: (RECTORY: ARRAY [DIRRANGE] OF DIRENTRY); 2194 2 75:d 1 FALSE:(RBLOCKS: packed ARRAY[1..4] OF packed ARRAY[1..512] OF CHAR) 2195 2 75:d 1 END; 2196 2 75:d 1025 2197 2 75:d 1025 2198 2 75:d 1025 PROCEDURE SPACES(V:INTEGER); 2199 2 76:0 0 BEGIN 2200 2 76:1 0 FOR V:=V DOWNTO 1 DO PUTCH(' '); 2201 2 75:0 0 END; 2202 2 75:0 0 2203 2 75:d 1 PROCEDURE DIRINIT(UNITNUM:INTEGER); 2204 2 77:0 0 BEGIN 2205 2 77:1 0 UNITREAD(UNITNUM,DI.RBLOCKS[1],2048,2); {LOAD DIR} 2206 2 75:0 0 END {DIRINIT} ; 2207 2 75:0 0 2208 2 75:d 1 PROCEDURE DIRECTORY(DETAIL:BOOLEAN); 2209 2 78:d 1 VAR LINES,I,UNITNUM,LARGEST,FREEBLKS,USEDAREA,USEDBLKS: INTEGER; 2210 2 78:d 8 GS: STRING; 2211 2 78:d 49 MONTHS: ARRAY [0..15] OF STRING[3]; 2212 2 78:d 81 ScreensUsed:integer; 2213 2 78:d 82 2214 2 78:d 82 FUNCTION GETUNIT:BOOLEAN; 2215 2 79:d 1 VAR I:INTEGER; 2216 2 79:d 2 GOOD:BOOLEAN; 2217 2 79:d 3 INSTRING:LONG_STRING; { necessary in TTY } 2218 2 79:d 131 UNAMES:ARRAY[4..16] OF STRING[3]; 2219 2 79:0 0 BEGIN 2220 2 79:1 0 UNAMES[4]:='#4'; 2221 2 79:1 17 UNAMES[5]:='#5'; 2222 2 79:1 34 UNAMES[6]:=''; 2223 2 79:1 51 UNAMES[7]:=''; 2224 2 79:1 68 UNAMES[8]:=''; 2225 2 79:1 85 UNAMES[9]:='#9'; 2226 2 79:1 102 UNAMES[10]:='#10'; 2227 2 79:1 119 UNAMES[11]:='#11'; 2228 2 79:1 136 UNAMES[12]:='#12'; 2229 2 79:1 153 UNAMES[13]:='#13'; 2230 2 79:1 170 UNAMES[14]:='#14'; 2231 2 79:1 187 UNAMES[15]:='#15'; 2232 2 79:1 204 UNAMES[16]:='#16'; 2233 2 79:1 221 PUTTXT('Unit: '); GETLN(INSTRING); 2234 2 79:1 231 while pos(' ',instring)<>0 do delete(instring,pos(' ',instring),1); 2235 2 79:1 260 IF INSTRING<>'' THEN IF INSTRING[LENGTH(INSTRING)]=':' THEN BEGIN 2236 2 79:1 279 {$R-} 2237 2 79:4 279 INSTRING[0]:=PRED(INSTRING[0]); 2238 2 79:4 286 {$R+} 2239 2 79:3 286 END; 2240 2 79:1 286 UpperCase(InString); 2241 2 79:1 289 IF INSTRING='*' THEN INSTRING:='#4'; 2242 2 79:1 305 GOOD:=FALSE; Pascal Compiler IV.13 c6t-4 - TTY.FLR.TEXT 2/ 5/85 Page 45 2243 2 79:1 307 IF INSTRING<>'' THEN BEGIN 2244 2 79:3 318 UNITNUM:=3; 2245 2 79:3 322 REPEAT 2246 2 79:4 322 UNITNUM:=UNITNUM+1; 2247 2 79:4 328 IF INSTRING[1]='#' THEN BEGIN 2248 2 79:6 336 IF INSTRING=UNAMES[UNITNUM] THEN BEGIN 2249 2 79:8 354 DIRINIT(UNITNUM); 2250 2 79:8 358 GOOD:=(IORESULT=0) and {$R-} (di.rectory[0].dvid[0]>=chr(1)) and 2251 2 79:8 376 (di.rectory[0].dvid[0]<=chr(7));{$R+} 2252 2 79:7 390 END; 2253 2 79:5 390 END ELSE BEGIN 2254 2 79:6 392 IF UNAMES[UNITNUM]<>'' THEN BEGIN 2255 2 79:8 412 DIRINIT(UNITNUM); 2256 2 79:8 416 GOOD:=(IORESULT=0) and {$R-} (di.rectory[0].dvid[0]>=chr(1)) and 2257 2 79:8 434 (di.rectory[0].dvid[0]<=chr(7));{$R+} 2258 2 79:8 448 if good then GOOD:=(DI.RECTORY[0].DVID=INSTRING); 2259 2 79:7 468 END; 2260 2 79:5 468 END; 2261 2 79:3 468 UNTIL GOOD OR (UNITNUM=16); 2262 2 79:2 477 END; 2263 2 79:1 477 IF NOT GOOD THEN BEGIN 2264 2 79:3 480 PUTTXT('Unit not on-line.'); 2265 2 79:3 487 PUTLN; 2266 2 79:2 489 END; 2267 2 79:1 489 GETUNIT:=GOOD; 2268 2 78:0 0 END; 2269 2 78:0 0 2270 2 78:d 1 PROCEDURE SENDLN; 2271 2 80:d 1 VAR CH:CHAR; 2272 2 80:0 0 BEGIN 2273 2 80:1 0 PUTLN; 2274 2 80:1 2 LINES:=LINES+1; 2275 2 80:1 8 IF LINES=19 THEN BEGIN 2276 2 80:3 13 PUTTXT('Press to continue'); 2277 2 80:3 20 REPEAT 2278 2 80:4 20 GETCH(CH,FALSE,FALSE); 2279 2 80:3 25 UNTIL CH=' '; 2280 2 80:3 30 if not(Detail) and (ScreensUsed<2) then 2281 2 80:4 41 begin 2282 2 80:5 41 WUnFrame(false); {leave image on screen} 2283 2 80:5 44 ScreensUsed:=ScreensUsed+1; {don't let it go over right margin} 2284 2 80:5 50 WFrame(15+ScreensUsed*16,0,34,20,''); 2285 2 80:4 67 end; 2286 2 80:4 67 {or just put WClrScreen for simplicity} 2287 2 80:3 67 WClrScreen; 2288 2 80:3 69 LINES:=0; 2289 2 80:2 73 END; 2290 2 78:0 0 END; 2291 2 78:0 0 2292 2 78:d 1 PROCEDURE FREECHECK(FIRSTOPEN,NEXTUSED: INTEGER); 2293 2 81:d 1 VAR FREEAREA: INTEGER; 2294 2 81:0 0 BEGIN 2295 2 81:1 0 FREEAREA := NEXTUSED-FIRSTOPEN; 2296 2 81:1 4 IF FREEAREA > LARGEST THEN LARGEST := FREEAREA; 2297 2 81:1 14 IF FREEAREA > 0 THEN 2298 2 81:2 19 BEGIN FREEBLKS := FREEBLKS+FREEAREA; 2299 2 81:3 26 IF DETAIL THEN Pascal Compiler IV.13 c6t-4 - TTY.FLR.TEXT 2/ 5/85 Page 46 2300 2 81:4 30 BEGIN 2301 2 81:5 30 PUTTXT('< UNUSED > '); 2302 2 81:5 37 PUTINT(FREEAREA,4); 2303 2 81:5 41 SPACES(11); 2304 2 81:5 44 PUTINT(FIRSTOPEN,6); 2305 2 81:5 48 SENDLN; 2306 2 81:4 50 END 2307 2 81:2 50 END; 2308 2 78:0 0 END {FREECHECK} ; 2309 2 78:0 0 2310 2 78:0 0 BEGIN 2311 2 78:1 0 if DETAIL then WFrame(15,0,63,20,'') else WFrame(15,0,34,20,''); 2312 2 78:1 30 IF GETUNIT THEN 2313 2 78:2 36 begin 2314 2 78:3 36 MONTHS[ 0] := '???'; MONTHS[ 1] := 'Jan'; 2315 2 78:3 64 MONTHS[ 2] := 'Feb'; MONTHS[ 3] := 'Mar'; 2316 2 78:3 92 MONTHS[ 4] := 'Apr'; MONTHS[ 5] := 'May'; 2317 2 78:3 120 MONTHS[ 6] := 'Jun'; MONTHS[ 7] := 'Jul'; 2318 2 78:3 148 MONTHS[ 8] := 'Aug'; MONTHS[ 9] := 'Sep'; 2319 2 78:3 176 MONTHS[10] := 'Oct'; MONTHS[11] := 'Nov'; 2320 2 78:3 204 MONTHS[12] := 'Dec'; MONTHS[13] := '???'; 2321 2 78:3 232 MONTHS[14] := '???'; MONTHS[15] := '???'; 2322 2 78:3 260 FREEBLKS := 0; USEDBLKS := 0; 2323 2 78:3 264 LARGEST := 0; 2324 2 78:3 266 WITH DI.RECTORY[0] DO 2325 2 78:4 278 BEGIN 2326 2 78:5 278 WClrScreen; 2327 2 78:5 280 ScreensUsed:=0; 2328 2 78:5 283 PUTTXT(DVID); 2329 2 78:5 290 PUTTXT(':'); 2330 2 78:5 297 PUTLN; 2331 2 78:4 299 END; 2332 2 78:3 299 LINES:=1; 2333 2 78:3 301 FOR I := 1 TO DI.RECTORY[0].DNUMFILES DO 2334 2 78:4 324 WITH DI.RECTORY[I] DO 2335 2 78:5 336 BEGIN 2336 2 78:6 336 FREECHECK(DI.RECTORY[I-1].DLASTBLK,DFIRSTBLK); 2337 2 78:6 353 USEDAREA := DLASTBLK-DFIRSTBLK; 2338 2 78:6 361 USEDBLKS := USEDBLKS+USEDAREA; 2339 2 78:6 365 IF DACCESS.YEAR IN [1..99] THEN 2340 2 78:7 382 BEGIN 2341 2 78:8 382 PUTTXT(DTID); 2342 2 78:8 389 SPACES(TIDLENG-LENGTH(DTID)+1); 2343 2 78:8 400 PUTINT(USEDAREA,4); 2344 2 78:8 404 IF DACCESS.MONTH > 0 THEN 2345 2 78:9 415 SPACES(2); 2346 2 78:8 418 PUTINT(DACCESS.DAY,2); 2347 2 78:8 428 PUTCH('-'); 2348 2 78:8 432 PUTTXT(MONTHS[DACCESS.MONTH]); 2349 2 78:8 449 PUTCH('-'); 2350 2 78:8 453 PUTINT(DACCESS.YEAR,2); 2351 2 78:8 463 IF DETAIL THEN 2352 2 78:9 467 BEGIN 2353 2 78:0 467 IF DACCESS.MONTH = 0 THEN SPACES(11); 2354 2 78:0 480 PUTINT(DFIRSTBLK,6); 2355 2 78:0 486 PUTINT(DLASTBYTE,6); 2356 2 78:0 493 GS := ' file'; Pascal Compiler IV.13 c6t-4 - TTY.FLR.TEXT 2/ 5/85 Page 47 2357 2 78:0 500 CASE DFKIND OF 2358 2 78:0 505 XDSKFILE: GS := 'Bad block'; 2359 2 78:0 514 CODEFILE: GS := 'Code file'; 2360 2 78:0 523 TEXTFILE: GS := 'Text file'; 2361 2 78:0 532 INFOFILE: GS := 'Info file'; 2362 2 78:0 541 DATAFILE: GS := 'Data file'; 2363 2 78:0 550 GRAFFILE: GS := 'Graf file'; 2364 2 78:0 559 FOTOFILE: GS := 'Foto file' 2365 2 78:0 560 END; 2366 2 78:0 571 SPACES(2); 2367 2 78:0 574 PUTTXT(GS) 2368 2 78:9 576 END; 2369 2 78:8 578 SENDLN; END; 2370 2 78:5 580 END; 2371 2 78:3 586 FREECHECK(DI.RECTORY[I-1].DLASTBLK,DI.RECTORY[0].DEOVBLK); 2372 2 78:3 611 PUTINT(DI.RECTORY[0].DNUMFILES,0); 2373 2 78:3 626 PUTTXT(' files, '); 2374 2 78:3 633 PUTINT(USEDBLKS,0); 2375 2 78:3 637 PUTTXT(' blks used, '); 2376 2 78:3 644 PUTINT(FREEBLKS,0); 2377 2 78:3 648 PUTTXT(' free'); 2378 2 78:3 655 IF DETAIL THEN BEGIN 2379 2 78:5 659 PUTTXT(', '); 2380 2 78:5 666 PUTINT(LARGEST,0); 2381 2 78:5 670 PUTTXT(' in largest area'); 2382 2 78:4 677 END; 2383 2 78:3 677 PUTLN; {not SEND so screen not cleared} 2384 2 78:2 679 end; 2385 2 78:1 679 WUnFrame(false) {leave display on screen} 2386 2 75:0 0 END; {DIRECTORY} 2387 2 75:0 0 2388 2 75:d 1 PROCEDURE VOLS; 2389 2 82:d 1 VAR UNITNUM:INTEGER; 2390 2 82:0 0 BEGIN 2391 2 82:1 0 WFrame(24,4,14,7,'Volumes'); 2392 2 82:1 11 FOR UNITNUM:=4 TO 16 DO 2393 2 82:2 20 IF UNITNUM IN [4,5,9,10,11,12,13,14,15,16] THEN BEGIN 2394 2 82:4 30 DIRINIT(UNITNUM); 2395 2 82:4 33 IF (IORESULT=0) and {$R-} (di.rectory[0].dvid[0]>=chr(1)) and 2396 2 82:4 51 (di.rectory[0].dvid[0]<=chr(7)){$R+} 2397 2 82:4 63 THEN BEGIN 2398 2 82:6 66 PUTLN; 2399 2 82:6 68 PUTINT(UNITNUM,3); 2400 2 82:6 72 SPACES(2); 2401 2 82:6 75 PUTTXT(DI.RECTORY[0].DVID); 2402 2 82:6 90 PUTCH(':'); 2403 2 82:5 94 END; 2404 2 82:3 94 END; 2405 2 82:1 99 PUTLN; 2406 2 82:1 101 WUnFrame(false); {leave window on screen} 2407 2 75:0 0 END; 2408 2 75:0 0 2409 2 75:d 1 PROCEDURE REMOVEFILE; 2410 2 83:d 1 VAR STR:LONG_STRING; { necessary in TTY } 2411 2 83:d 129 DFILE:FILE; 2412 2 83:0 0 BEGIN 2413 2 83:1 10 WFrame(24,4,35,2,''); Pascal Compiler IV.13 c6t-4 - TTY.FLR.TEXT 2/ 5/85 Page 48 2414 2 83:1 22 PUTTXT('Remove filename:'); 2415 2 83:1 29 GETLN(STR); 2416 2 83:1 32 RESET(DFILE,STR); 2417 2 83:1 41 IF IORESULT<>0 THEN 2418 2 83:2 47 PUTTXT('File does not exist.') 2419 2 83:1 52 ELSE BEGIN 2420 2 83:3 56 CLOSE(DFILE,PURGE); 2421 2 83:3 62 PUTTXT('File '); 2422 2 83:3 69 PUTTXT(STR); 2423 2 83:3 73 PUTTXT(' removed.'); 2424 2 83:2 80 END; 2425 2 83:1 80 PUTLN; 2426 2 83:1 82 WUnFrame(false); {leave window on screen} 2427 2 75:0 0 END; 2428 2 75:0 0 2429 2 75:0 0 BEGIN 2430 2 75:1 0 CASE CODE OF 2431 2 75:1 5 'E':DIRECTORY(TRUE); 2432 2 75:1 10 'L':DIRECTORY(FALSE); 2433 2 75:1 15 'V':VOLS; 2434 2 75:1 19 'R':REMOVEFILE; 2435 2 75:1 23 END; 2436 2 1:0 0 END; 2437 2 1:0 0 2438 2 1:0 0 {$I+} 2439 2 1:0 0 2440 2 1:0 0 {-----------------------------------------------------------------------------} 2441 2 1:0 0 {end TTY.FLR} 2442 2 1:0 0 {-----------------------------------------------------------------------------} 2443 2 1:0 0 2444 2 1:0 0 2445 2 1:0 0 {FILE HANDLING ROUTINES} 2446 2 1:0 0 2447 2 1:d 1 PROCEDURE FILELEVEL; 2448 2 84:d 1 VAR FINISH:BOOLEAN; 2449 2 84:d 2 CH:CHAR; 2450 2 84:0 0 BEGIN 2451 2 84:1 0 FINISH:=FALSE; 2452 2 84:1 2 REPEAT 2453 2 84:2 2 ch:=WSCPrompt('Filer: L(istdir, E(xtdir, V(olumes, R(emove, Q(uit ', 2454 2 84:2 8 -1,0, 45,8, ['L','E','V','R','Q'],false,','); 2455 2 84:2 28 if ch = 'Q' then finish:=true 2456 2 84:2 33 else fileh(ch); 2457 2 84:1 40 UNTIL FINISH; 2458 2 1:0 0 END; 2459 2 1:d 1 PROCEDURE HELPTEXT; 2460 2 85:0 0 BEGIN 2461 2 85:1 0 WFrame(38, 1, 40,17,''); 2462 2 85:1 13 WClrScreen; 2463 2 85:1 15 PutTxt('CTRL/L causes entry to local mode.'); PutLn; 2464 2 85:1 24 PutTxt('In this mode there are several commands.');PutLn; 2465 2 85:1 33 PutLn; 2466 2 85:1 35 PutTxt('P(ut file) is used to transfer a file'); PutLn; 2467 2 85:1 44 PutTxt(' from this system to the remote.'); PutLn; 2468 2 85:1 53 PutTxt('G(et file) is used to transfer a file'); PutLn; 2469 2 85:1 62 PutTxt(' from the remote to this system.'); PutLn; 2470 2 85:1 71 PutTxt('F(iler) is used to obtain a directory'); PutLn; Pascal Compiler IV.13 c6t-4 2/ 5/85 Page 49 2471 2 85:1 80 PutTxt(' listing of files on line on this'); PutLn; 2472 2 85:1 89 PutTxt(' system, and remove unwanted files.'); PutLn; 2473 2 85:1 98 PutTxt('C(onfigure is used to set parameters to'); PutLn; 2474 2 85:1 107 PutTxt(' interface and program, and set host'); PutLn; 2475 2 85:1 116 PutTxt(' or local values.'); PutLn; 2476 2 85:1 125 PutTxt('^(control) is used to send a control'); PutLn; 2477 2 85:1 134 PutTxt(' character to the host.'); PutLn; 2478 2 85:1 143 PutTxt('E(xit TTY) stops the TTY utility.'); PutLn; 2479 2 85:1 152 PutTxt('Q(uit local) returns to terminal mode.'); 2480 2 85:1 159 WUnFrame(false); 2481 2 1:0 0 END; 2482 2 1:0 0 2483 2 1:d 1 PROCEDURE TTYTITLE; 2484 2 86:0 0 BEGIN 2485 2 86:1 0 SC_ClrScreen; 2486 2 86:1 2 SC_GotoXY(0,2); 2487 2 86:1 6 WRITELN('----------------------------------------------------------------'); 2488 2 86:1 26 WRITELN('ERCC X-Talk Communications - ',mcname,' - TTY - ',version ); 2489 2 86:1 83 WRITELN('----------------------------------------------------------------'); 2490 2 86:1 103 WRITELN('Micro acts as a normal terminal.'); 2491 2 86:1 123 WRITE ('CTRL/L enters local mode.'); 2492 2 86:1 136 SC_GotoXY(0, 9); 2493 2 1:0 0 END; 2494 2 1:0 0 2495 2 1:d 1 PROCEDURE INITDATA; 2496 2 87:0 0 BEGIN 2497 2 87:0 0 { set up the host specific parts } 2498 2 87:1 0 CRSTRING:=' '; 2499 2 87:1 9 CRSTRING[1]:=CHR(CR); 2500 2 87:1 16 CTRLASTRING:=' '; 2501 2 87:1 25 CTRLASTRING[1]:=CHR(CTRLA); 2502 2 87:1 32 SETTCP:=CONCAT(CTRLASTRING,'P 5'); {CR SENT AFTER SETMODE} 2503 2 87:1 57 ctrlPstring:=' '; 2504 2 87:1 66 ctrlPstring[1]:=CHR(dle); 2505 2 87:1 73 setpad:=CONCAT(ctrlPstring,'ALFPAD=5 ');setpad[10]:=chr(cr); 2506 2 87:1 104 REPEATCH:=18; {CTRL/R BY DEFAULT - CH TO REPEAT CURRENT LINE FROM} 2507 2 87:1 108 {HOST. SET TO 0 IF THIS FACILITY IS NOT AVAILABLE } 2508 2 87:1 108 escape_sequence:=' '; { length 3 for EMAS } 2509 2 87:1 116 escape_sequence[1]:=chr(ESC); escape_sequence[2]:='A'; 2510 2 87:1 129 escape_sequence[3]:=chr(CR); 2511 2 87:1 135 HALFDUPLEX:=FALSE; 2512 2 87:1 139 { now the non host specific parts } 2513 2 87:1 139 WAITTIME:=1500; 2514 2 87:1 145 TimeOutUnits:=ABS(WaitTime DIV 512) + 1; 2515 2 87:1 157 { Determined by WaitTime - but should always be > 0. } 2516 2 87:1 157 ALTFILE:=FALSE; 2517 2 87:1 161 CHINMOD:=256; { assume 8 bit codes are the default } 2518 2 87:1 167 PROMPTSET:=[':','$']; 2519 2 87:1 180 BreakChar:=','; { the list separator } 2520 2 87:1 184 DEBUG:=FALSE; 2521 2 1:0 0 END; 2522 2 1:0 0 2523 2 1:0 0 BEGIN 2524 2 1:1 0 INITDATA; 2525 2 1:1 2 REMSETUP; 2526 2 1:1 4 TERMINAL:=FALSE; 2527 2 1:1 8 TTYTITLE; Pascal Compiler IV.13 c6t-4 2/ 5/85 Page 50 2528 2 1:1 10 WInit; 2529 2 1:1 12 REMWRITE(CHR(CR)); 2530 2 1:1 15 {ALLOW HOST TO REPEAT PROMPT IF ALREADY LOGGED IN} 2531 2 1:1 15 2532 2 1:1 15 REPEAT 2533 2 1:2 15 RemFlush; {version IV change} 2534 2 1:2 17 2535 2 1:2 17 IF KEYPRESS THEN 2536 2 1:3 23 BEGIN 2537 2 1:4 23 KEYREAD(CH,FALSE,FALSE); 2538 2 1:4 29 IF (CH=CHR(CTRLL)) THEN 2539 2 1:5 35 BEGIN {LOCAL MODE} 2540 2 1:6 35 CursorLost:=true; 2541 2 1:6 39 {explicitly set CursorLost to true for special cases 2542 2 1:6 39 where cursor is at correct position after action} 2543 2 1:6 39 ch:=WSCPrompt( 2544 2 1:6 40 'TTY: P(ut,G(et,F(iler,C(onfigure,H(elp,^(ctrl,B(reak,E(xit TTY,Q(uit local ', 2545 2 1:6 45 -1,0, 40,7, [' ','C','^','E','F','G','H','P','B','R','Q'],false,','); 2546 2 1:6 66 CASE CH OF 2547 2 1:6 70 '^': SENDCTRL; 2548 2 1:6 75 'C': Configure; 2549 2 1:6 80 'E': begin TERMINAL:=true; CursorLost:=false; end; 2550 2 1:6 91 'F': FILELEVEL; 2551 2 1:6 96 'B': begin writeln; BREAKCONDITION; CursorLost:=false; end; 2552 2 1:6 112 'P', 2553 2 1:6 112 'G': BEGIN 2554 2 1:8 112 if not CursorLost then writeln; 2555 2 1:8 124 { if at end of prompt go to next line } 2556 2 1:8 124 textfile:=(altfile=false); 2557 2 1:8 132 if ch='G' then 2558 2 1:9 137 begin 2559 2 1:0 137 if altfile then 2560 2 1:1 142 begin { binary } 2561 2 1:2 142 x_chinmod:=chinmod; 2562 2 1:2 148 chinmod:=256; 2563 2 1:2 154 getfile; 2564 2 1:2 156 chinmod:=x_chinmod; 2565 2 1:1 162 end 2566 2 1:0 162 else getfile; 2567 2 1:9 166 end 2568 2 1:8 166 else 2569 2 1:9 168 if altfile then 2570 2 1:0 173 begin { binary } 2571 2 1:1 173 x_chinmod:=chinmod; 2572 2 1:1 179 chinmod:=256; 2573 2 1:1 185 putfile; 2574 2 1:1 187 chinmod:=x_chinmod; 2575 2 1:0 193 end 2576 2 1:9 193 else putfile; 2577 2 1:8 197 CursorLost:=true; { explicit setting to get Command: } 2578 2 1:7 201 END; 2579 2 1:6 204 'H': HelpText; 2580 2 1:6 209 'R': begin 2581 2 1:8 209 writeln; 2582 2 1:8 216 WRITE ('TTY Revision: ',Version,', 2.',PART2); 2583 2 1:8 266 WRITE (', M.',PARTM,' MD.',MessDVersion); 2584 2 1:8 312 WRITE (', W.',PARTW); Pascal Compiler IV.13 c6t-4 2/ 5/85 Page 51 2585 2 1:8 336 WRITE (', G.',PARTG,' DG.',PARTDG); 2586 2 1:8 384 WRITE (', P.',PARTP,' DP.',PARTDP); 2587 2 1:8 432 WRITELN(', F.',PARTF, 2588 2 1:8 456 ', X.',PARTX1,PARTX2,'.'); 2589 2 1:8 508 CursorLost:=true; 2590 2 1:7 512 end; 2591 2 1:6 514 ' ': { do nothing }; 2592 2 1:6 516 'Q': { do nothing }; 2593 2 1:6 518 END {CASE }; 2594 2 1:6 521 IF CH=' ' THEN 2595 2 1:7 526 begin 2596 2 1:8 526 if RepeatCh <> 0 then REMWRITE(CHR(REPEATCH)); 2597 2 1:8 537 {REPEAT PRESENT LINE} 2598 2 1:7 537 end 2599 2 1:6 537 ELSE IF CursorLost THEN 2600 2 1:8 544 BEGIN 2601 2 1:9 544 IF HALFDUPLEX THEN GotoXY(0,BottomLine) 2602 2 1:9 555 else GotoXY(0,BottomLine-1); 2603 2 1:9 564 REMWRITE(CHR(CR)); 2604 2 1:8 567 END; 2605 2 1:5 567 END 2606 2 1:4 567 ELSE 2607 2 1:5 569 BEGIN 2608 2 1:6 569 IF HALFDUPLEX THEN BEGIN 2609 2 1:8 574 IF CH=CHR(BS) THEN WRITE(CHR(BS),' ',CHR(BS)) 2610 2 1:8 606 ELSE IF CH=CHR(CR) THEN WRITELN 2611 2 1:9 612 ELSE IF (CH<' ') THEN WRITE(CHR(BEL)) 2612 2 1:0 636 ELSE WRITE(CH); 2613 2 1:7 647 END; 2614 2 1:6 647 IF CH=CHR(BS) THEN CH:=CHR(BS_Map_Ch); { map in required eraser } 2615 2 1:6 655 REMWRITE(CH) 2616 2 1:5 656 END 2617 2 1:3 658 END; 2618 2 1:3 658 2619 2 1:2 658 RemFlush; {version IV change} 2620 2 1:2 660 2621 2 1:1 660 UNTIL TERMINAL; 2622 2 1:1 666 2623 2 1:1 666 WTerminate; { tidy up after use of windowing routines if needed } 2624 2 1:1 668 2625 2 1:1 668 REMCLOSE; 2626 2 :0 0 END.