Pro Pascal Compiler - Version zz 2.1 Compilation of: M:SCREEN.PAS Options: LNIAP 1 0000 program screen (input,output); 2 0000 3 0000 {read from a file and display on the screen.} 4 0000 5 0000 TYPE 6 0000 txtstorage = ARRAY [0..300] OF string[130]; 7 0000 pttext = ^ txtstorage; 8 0000 9 0000 VAR 10 0000 source,nat,temp, outfile: text; {source file} 11 0000 filename, ofn, name: string[14]; 12 0000 comm_in: string[50]; 13 0000 line: string[120]; 14 0000 screen: pttext; 15 0000 lno,vkey,row,col,i,dstart,rlen,lflag: integer; 16 0000 key: char; 17 0000 18 0000 PROCEDURE rewritescr; FORWARD; 19 0000 20 0000 FUNCTION feof(VAR fi: text): boolean; 21 0000 VAR res: boolean; 22 0000 BEGIN 23 0000 res := true; 24 0011 IF filename <> 'NUL:' THEN res := eof(fi); 25 0040 feof := res; 26 004E END; 27 0054 28 0054 PROCEDURE cursor(x,y: integer); 29 0054 BEGIN 30 0054 write(chr(1bh), 'Y', chr(y+20h), chr(x+20h)); 31 00A7 END; 32 00AD 33 00AD PROCEDURE putcursor; BEGIN cursor(col-1,row-dstart); END; 34 00DE 35 00DE PROCEDURE writerow; 36 00DE BEGIN 37 00DE cursor(0,row-dstart); writeln(screen^[row]); putcursor; 38 0133 END; 39 0139 40 0139 PROCEDURE readscreen; 41 0139 VAR max: integer; 42 0139 BEGIN 43 0139 max := lno+75; 44 015A WHILE (NOT feof(source)) AND (lno < max) DO BEGIN 45 0180 readln(source,line); screen^[lno] := line; lno := lno+1; 46 01D3 END; 47 01D5 screen^[lno] := '*** END ***'; 48 0210 END; 49 0216 50 0216 PROCEDURE clearscreen; 51 0216 BEGIN 52 0216 write(chr(1bH)); write('E'); cursor(0, 1); 53 0254 END; 54 025A 55 025A PROCEDURE lnoout; FORWARD; 56 025A 57 025A PROCEDURE eol; 58 025A BEGIN 59 025A col := rlen+1; putcursor; 60 0277 END; 61 027D 62 027D PROCEDURE upc; 63 027D BEGIN 64 027D IF row>1 THEN BEGIN 65 029D row := row-1; 66 02AF IF row <= dstart THEN BEGIN 67 02C1 dstart := dstart-1; write(chr(1bh),'L'); writerow; 68 02EE END; {ELSE write(chr(1bH),chr(41H));} 69 02EE lnoout; 70 02F6 END; 71 02F6 END; 72 02FC 73 02FC PROCEDURE testeof; FORWARD; 74 02FC 75 02FC PROCEDURE erl; 76 02FC BEGIN 77 02FC write(chr(1bh), 'K'); 78 0321 END; 79 0327 80 0327 PROCEDURE lnoout; 81 0327 BEGIN 82 0327 IF lflag <> 0 THEN BEGIN 83 033F cursor(0, 0); writeln(' Line no:', row, ' '); 84 03A1 END; putcursor; 85 03A9 END; 86 03AF 87 03AF PROCEDURE downc; 88 03AF BEGIN 89 03AF row := row+1; IF row= lno THEN testeof; 90 03D8 IF row >= lno THEN row := row-1 ELSE BEGIN 91 03FF IF row=(dstart+29) THEN BEGIN 92 0420 cursor(0, 1); erl; cursor(0, 30); 93 044E writeln; dstart:= dstart+1; writerow; 94 0469 writeln;{putcursor;} {does a scroll up} 95 0474 END; {ELSE write(chr(1bH),chr(42h));} 96 0474 lnoout; 97 047C END; 98 047C END; 99 0482 100 0482 101 0482 PROCEDURE page; 102 0482 VAR i,j: integer; 103 0482 BEGIN 104 0482 {for i := 1 to 25 do downc;} 105 0482 row := row+25; {keep current cursor position on screen} 106 04A4 dstart := dstart+25; 107 04BE rewritescr; 108 04C6 END; 109 04CC 110 04CC 111 04CC PROCEDURE rightc; 112 04CC BEGIN 113 04CC IF col<=rlen THEN BEGIN 114 04EB write(chr(1bh),chr(43h)); col := col+1; 115 0515 END; 116 0515 END; 117 051B 118 051B PROCEDURE leftc; 119 051B BEGIN 120 051B IF (col>1) THEN BEGIN 121 053B write(chr(1bh),chr(44h)); col := col-1; 122 0565 END; 123 0565 END; 124 056B 125 056B PROCEDURE delc; 126 056B BEGIN 127 056B IF col > rlen THEN BEGIN col:=rlen+1;putcursor;END; 128 059A IF col>1 THEN BEGIN 129 05B2 leftc; write(chr(1bH),'N'); delete(screen^[row],col,1); 130 05FA END; 131 05FA END; 132 0600 133 0600 PROCEDURE delr; 134 0600 BEGIN 135 0600 IF col < rlen+1 THEN BEGIN 136 0622 write(chr(1bh), 'N'); delete(screen^[row], col, 1); 137 0667 END; 138 0667 END; 139 066D 140 066D PROCEDURE cutl; 141 066D VAR i,x: integer; 142 066D BEGIN 143 066D IF row+1=lno THEN testeof; 144 0691 IF rowrow DO BEGIN 163 0834 screen^[i+1] := screen^[i]; i:= i-1; 164 0886 END; 165 0888 IF col>rlen THEN col:=rlen+1; 166 08AC line := screen^[row]; ll := rlen-col+1; 167 08EC IF ll=0 THEN BEGIN 168 08F7 screen^[row+1] := ''; 169 091B END ELSE BEGIN 170 0922 screen^[row+1] := copy(line, col, ll); delete(screen^[row],col,ll); 171 098F END; 172 098F IF row <> dstart+28 THEN write(chr(1bh),'L') ELSE BEGIN 173 09CA erl; dstart := dstart+1; writeln; writeln; writeln; 174 09F1 write(chr(1bh), 'A', chr(1bh), 'A'); 175 0A20 END; 176 0A20 write(chr(1bh),'K'); writerow; row:=row+1; writeln; write(chr(1bh),'K');writerow; 177 0A6E rlen := length(screen^[row]); col := 1; putcursor; 178 0AA6 END; 179 0AAC 180 0AAC PROCEDURE rewritescr; 181 0AAC VAR i,j: integer; 182 0AAC BEGIN 183 0AAC IF 28+dstart > lno THEN testeof; 184 0AD9 j:=28+dstart; IF j>lno THEN j := lno; 185 0B08 clearscreen; 186 0B10 for i := dstart+1 to j DO writeln(screen^[i]); 187 0B70 if row >= lno then row := lno-1; 188 0B94 putcursor; 189 0B9C END; 190 0BA2 191 0BA2 PROCEDURE testeof; 192 0BA2 VAR i,cut,j,fl: integer; 193 0BA2 BEGIN 194 0BA2 fl:=0; 195 0BB9 IF dstart+29 >= lno THEN BEGIN 196 0BDB IF NOT feof(source) THEN BEGIN 197 0BED IF lno > 350 THEN BEGIN 198 0C05 cut := lno-50; 199 0C1E FOR i:= 1 to cut DO writeln(temp, screen^[i]); 200 0C86 i := 1; j := cut+1; 201 0CA0 WHILE j < lno DO BEGIN 202 0CB6 screen^[i] := screen^[j]; i := i+1; j:=j+1; 203 0D10 END; 204 0D12 dstart := dstart-cut; row := row-cut; lno := i; fl:=1; 205 0D50 END; 206 0D50 readscreen; {IF fl=1 THEN rewritescr;} 207 0D58 END; 208 0D58 END; 209 0D58 END; 210 0D5E 211 0D5E BEGIN 212 0D5E new(screen); writeln; writeln; 213 0D83 214 0D83 getcomm(comm_in); 215 0D92 216 0D92 if comm_in <> '' then begin {files supplied on command line} 217 0DA6 i := pos(',',comm_in); 218 0DBD if i = 0 then begin {one file, so input & output} 219 0DC8 filename := comm_in; ofn := comm_in; 220 0DE9 end else begin 221 0DF0 filename := copy(comm_in, 1, i-1); 222 0E13 ofn := copy(comm_in, i+1, length(comm_in)-i); 223 0E49 end; 224 0E49 end else begin 225 0E51 write('Input file?'); readln(filename); 226 0E84 IF name='' THEN name:='NUL:'; filename := name; 227 0EB8 write('Output file?'); readln(ofn); 228 0EEC IF ofn='' THEN ofn := filename; 229 0F0D end; 230 0F0D assign(source, filename); reset(source); 231 0F2E 232 0F2E {Now read in the first screen full} 233 0F2E 234 0F2E clearscreen; 235 0F36 writeln('Input file:',filename,' Output file:',ofn); 236 0F8D cursor(0,1); lno := 1; row := 1; col := 1; vkey:=0; dstart:=0; 237 0FDC lflag := 0; readscreen; rewritescr; 238 0FF2 assign(nat, 'KBD:'); reset(nat); {get at keyboard directly} 239 1018 assign(temp,'M:SCR.TMP'); rewrite(temp); 240 1043 WHILE (vkey <> 3) AND (vkey<>27) DO 241 1076 BEGIN 242 107B rlen := length(screen^[row]); 243 10A5 IF eoln(nat) THEN BEGIN donl; key := chr(0); END ELSE 244 10BE read(nat, key); vkey := ord(key); 245 10EA 246 10EA IF vkey <> 0 THEN BEGIN 247 10F6 IF (vkey>31) AND (vkey<127) THEN BEGIN 248 1128 IF col>rlen THEN col := rlen+1; 249 114C insert(key,screen^[row],col); col := col+1; writerow; 250 1190 END ELSE BEGIN 251 1198 CASE vkey OF 252 11A5 1: leftc; 253 11B0 2: eol; 254 11BB 5: page; 255 11C6 6: rightc; 256 11D1 7: delr; 257 11DC 16: BEGIN lflag := 1-lflag; cursor(0,0); erl; putcursor; END; 258 1215 18: rewritescr; 259 1220 21: cutl; 260 122B 28: BEGIN write(col, row, rlen, lno); END; {the special minus key} 261 126D 30: downc; 262 1278 31: upc; 263 1282 127: delc; 264 128C OTHERWISE write(vkey); 265 12A6 END {case} 266 12F7 END; 267 12F7 END; 268 12F7 END; 269 12FA clearscreen; 270 1302 IF vkey = 27 THEN BEGIN 271 131A FOR i := 1 to lno-1 DO writeln(temp,screen^[i]); 272 1395 writeln('File in ', ofn); 273 13C1 WHILE NOT feof(source) DO BEGIN 274 13D2 readln(source, line); writeln(temp, line); 275 1407 END; 276 1409 assign(outfile, ofn); rewrite(outfile); reset(temp); 277 1435 WHILE NOT eof(temp) DO BEGIN 278 1446 readln(temp, line); writeln(outfile, line); 279 147B END; 280 147D END; 281 147D END.