github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-28 17:09:15 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/amis/screen.pas
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1776 lines
50 KiB
ObjectPascal
Raw Permalink Blame History

(* AMIS screen handler. *) (* -*- PASCAL -*- *)
(****************************************************************************)
(* *)
(* Copyright (C) 1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987 by *)
(* Stacken, Royal Institute Of Technology, Stockholm, Sweden. *)
(* All rights reserved. *)
(* *)
(* This software is furnished under a license and may be used and copied *)
(* only in accordance with the terms of such license and with the *)
(* inclusion of the above copyright notice. This software or any other *)
(* copies thereof may not be provided or otherwise made available to any *)
(* other person. No title to and ownership of the software is hereby *)
(* transferred. *)
(* *)
(* The information in this software is subject to change without notice *)
(* and should not be construed as a commitment by Stacken. *)
(* *)
(* Stacken assumes no responsibility for the use or reliability of its *)
(* software on equipment which is not supported by Stacken. *)
(* *)
(****************************************************************************)
(*$E+*)(*$T-*)
(**********************************************************************)
(* Module SCREEN of AMIS *)
(* *)
(* This module is responsible for the screen that shows a section of *)
(* the buffer, the mode area and the echo area. *)
(* *)
(* Author: Anders Str|m *)
(* *)
(* Last update: 1982-01-26 /AS *)
(* *)
(**********************************************************************)
module screen;
const
CtrlAtSign = 0; CtrlA = 1; CtrlB = 2;
CtrlC = 3; CtrlD = 4; CtrlE = 5;
CtrlF = 6; CtrlG = 7; CtrlH = 8;
CtrlI = 9; CtrlJ = 10; CtrlK = 11;
CtrlL = 12; CtrlM = 13; CtrlN = 14;
CtrlO = 15; CtrlP = 16; CtrlQ = 17;
CtrlR = 18; CtrlS = 19; CtrlT = 20;
CtrlU = 21; CtrlV = 22; CtrlW = 23;
CtrlX = 24; CtrlY = 25; CtrlZ = 26;
CtrlLeftBracket = 27; CtrlBackSlash = 28; CtrlRightBracket = 29;
CtrlUpArrow = 30; CtrlUnderScore = 31; RubOut = 127;
Null = CtrlAtSign; Bell = CtrlG; BackSpace = CtrlH;
HorizontalTab = CtrlI; LineFeed = CtrlJ; FormFeed = CtrlL;
CarriageReturn = CtrlM; Escape = CtrlLeftBracket;
HelpChar = CtrlUnderScore;
strsize= 40;
maxwidth= 132;
maxheight= 72;
modemaxheight= 1;
echomaxheight= 1;
pcntwidth= 9;
rrbeg= 0;
type
string= packed array[1..strsize] of char;
bufpos= integer;
charset = set of char;
states= (newline, oldline, control, noline);
linetext= packed array [0..maxwidth] of char;
(* Window line status *)
line= record
show: linetext; showlen: integer; showpos: bufpos;
updated: boolean;
end;
lstate= record
bfpos: bufpos; state: states;
end;
statearr= array [0..maxheight] of lstate;
(* Status for percent field *)
pcmode= record
mode: (bad, none, top, bot, pcent);
val: integer;
modif: boolean;
end;
CharImage = packed array [1..4] of char; (* What a character looks like. *)
bmodes= (ok, pos, nopos);
var
lines: array [0..maxheight] of line;
curstate: statearr;
(* Flag indicating vlidity of curstate *)
(* OK - is OK, but changes might have happend *)
(* pos - the position of winstart might be good *)
(* nopos - need a wrepos followed by a build *)
built: bmodes;
(* Current size of screen *)
screenheight, screenwidth: integer;
(* Flag indicating that entire screen is blank *)
csflg: boolean;
(* Flag indicating that we should do a refresh *)
dorefresh: boolean;
(* Mark of where changes have occured *)
first, last, count: bufpos;
(* Total height of window *)
winheight: integer;
(* Top and bottom of selected window *)
winfirst, winlast: integer;
(* What we show in the window *)
winstart, winend: bufpos;
(* Current position in window *)
hpos, vpos: integer; knownpos: boolean;
(* Flag indicating that we may have simple case of updating *)
simplep, noprelude: boolean; scount, spos: integer;
(* Information about two window mode *)
splitline: integer; (* Where to split window *)
nwins: integer; (* Number of window *)
curwin: integer; (* Current window (base 1) *)
new_window, new_buffer: integer;
xwinstart, xwinend, xdot: array [1..2] of bufpos;
xbuilt: array [1..2] of bmodes;
xok: array [1..2] of boolean;
(* Currently selected buffer, and shown buffer *)
curbuffer, showbuffer: array [1..2] of integer;
(* Buffer values, as we know them *)
rrdot, rrz: bufpos;
modelines: array [0..modemaxheight] of linetext;
(* Current top and height of mode area *)
modetop, modeheight: integer;
(* Current position in mode area *)
moderow, modecol: integer;
echolines: array [0..echomaxheight] of linetext;
(* Current top and height of echo area *)
echotop, echoheight: integer;
(* Current position in echo area *)
echorow, echocol: integer;
(* Data for mode line clock *)
ClockIsOn: boolean; (* Knows if the clock is on or not *)
ClockRow, ClockCol: integer; (* Knows where in mode line clock is *)
(* Percent field status *)
pcfld: pcmode;
(* Overwrite variables *)
orow, ocol: integer;
ovmode, ovflush: boolean;
(* Cost for different operations, used to select an optimal *)
(* update strategy, wrt these cost. The reference for costs *)
(* are the cost of outputting one character, which costs 1. *)
linecost: integer; (* Cost for updating one line *)
scrollcost: integer; (* Cost for scrolling one line *)
idcharcost: integer; (* Cost for inserting or deleting one character *)
(* Flags telling what terminal features we can use. *)
xyflag : boolean; (* We have Direct Cursor Adressing. *)
eolflag : boolean; (* We have Erase to End Of Line. *)
scrflag : boolean; (* We have Region Scroll. *)
printable : set of char; (* What chars are printable. *)
chrview : array [char] of CharImage;
chrvlen : array [char] of 0..4;
EolFirst : char; (* First char of EOL. *)
EolLineFeed : boolean; (* TRUE if single Line Feed is EOL too. *)
blanktext, messedtext: linetext;
(****************************************)
(* *)
(* External procedures used *)
(* *)
(****************************************)
(* Module TTYIO *)
procedure ttyforce; external;
procedure bug(n: string); external;
procedure GetClock(var Hours, Minutes: integer); external;
(* Module BUFFER *)
function getdot: bufpos; external;
procedure setdot(pt: bufpos); external;
function getsize: bufpos; external;
function bgetchar(i: bufpos): char; external;
function getmodified: boolean; external;
function getlines(i: bufpos): bufpos; external;
procedure isetbuf(n: integer); external;
function ateol(i: bufpos; d: integer): boolean; external;
function eolsize: integer; external;
procedure EolString(var s: string; var i: integer); external;
(* Module TERM *)
procedure TrmSize(var rows, col: integer); external;
procedure TrmFeatures(var xyflag, eolflag, scrflag: boolean); external;
procedure TrmPrintable(var printable: charset); external;
procedure trmpos(row, col: integer); external;
procedure trmeol; external;
procedure trmout(c: char); external;
procedure trmscr(y1, y2, n: integer); external;
procedure trmclr; external;
procedure trminv; external;
procedure trmniv; external;
procedure trmich(c: char); external;
procedure trmdch; external;
procedure trmcst(var scrollcost, idcharcost: integer); external;
procedure TrmWhere(var row, col: integer); external;
(* Module INPUT *)
function kbdrunning: boolean; external;
function readc: char; external;
function check(t: integer): boolean; external;
procedure reread; external;
(* Module UTILITY *)
function StrLength(var Str: string): integer; external;
(****************************************)
(* *)
(* Utilities in this module *)
(* *)
(****************************************)
procedure markmessed(i: integer);
begin
with lines[i] do begin
show:= messedtext; showlen:= screenwidth;
updated:= false;
end;
end;
procedure markblank(i: integer);
begin
with lines[i] do begin
showpos:= -1; show:= blanktext;
showlen:= 0; updated:= false;
end;
end;
(**** STARTOFLINE ****)
function startofline(p: bufpos): bufpos;
(* Find where the line containing p starts. *)
(* If the line is more than a screenful, just get a pointer about *)
(* a screen backwards *)
label 1;
var stop: integer;
begin (* startofline *)
stop:= p-winheight*screenwidth;
if stop<rrbeg then stop:= rrbeg;
while p>stop do begin
if ateol(p, -1) then goto 1;
p:= p-1;
end;
1:
startofline:= p;
end (* startofline *);
(**** WDOWNLINES ****)
function wdownlines(pt: bufpos; n: integer): bufpos;
(* Starting at pt move n screen lines down, returning new position *)
label 1;
var h: integer; ch: char;
begin (* wdownlines *)
h:= 0;
if n<=0 then goto 1;
while pt<rrz do begin
ch:= bgetchar(pt);
if EolLineFeed and (ch=chr(LineFeed)) then begin
pt:= pt+1; h:= 0; n:= n-1;
if n<=0 then goto 1;
end else if ateol(pt, 1) then begin
pt:= pt+eolsize; h:= 0; n:= n-1;
if n<=0 then goto 1;
end else begin
if h>=(screenwidth-1) then begin
h:= 0; n:= n-1;
if n<=0 then goto 1;
end;
if ch in printable then begin
h:= h+1;
end else if ch=chr(HorizontalTab) then begin
h:= (h div 8)*8+8;
if h>=screenwidth then begin
h:= 0; n:= n-1;
if n<=0 then goto 1;
end;
end else if ch=chr(Escape) then begin
h:= h+1;
end else begin
h:= h+2;
if h>=screenwidth then begin
h:= h-screenwidth+1; n:= n-1;
if n<=0 then goto 1;
end;
end;
pt:= pt+1;
end;
end;
1:
wdownlines:= pt;
end (* wdownlines *);
(**** WNLINES ****)
function wnlines(pt: bufpos): integer;
(* computes number of window lines a text line needs *)
(* starting at pt *)
label 1;
var h, v: integer; ch: char;
begin (* wnlines *)
h:= 0; v:= 1;
while pt<rrz do begin
ch:= bgetchar(pt);
if EolLineFeed then begin
if ch = chr(LineFeed) then goto 1;
end;
if ch = EolFirst then begin
if ateol(pt, 1) then goto 1;
end;
if h>=(screenwidth-1) then begin
h:= 0; v:= v+1;
end;
if ch in printable then begin
h:= h+1;
end else if ch=chr(HorizontalTab) then begin
h:= (h div 8)*8+8;
if h>=screenwidth then begin
h:= 0; v:= v+1;
end;
end else if ch=chr(Escape) then begin
h:= h+1;
end else begin
h:= h+2;
if h>=screenwidth then begin
h:= h-screenwidth+1; v:= v+1;
end;
end;
pt:= pt+1;
end;
1:
wnlines:= v;
end (* wnlines *);
(**** WXNLINES ****)
function wxnlines(pt, pe: bufpos): integer;
(* computes number of window lines needed for a text line, *)
(* from pt to pe *)
var h, v: integer; ch: char;
begin (* wxnlines *)
h:= 0; v:= 1;
for pt:= pt to pe-1 do begin
ch:= bgetchar(pt);
if (h+1)>=screenwidth then begin
h:= h-screenwidth+1; v:= v+1;
end;
if ch in printable then begin
h:= h+1;
end else if ch=chr(HorizontalTab) then begin
h:= (h div 8)*8+8;
if h>=screenwidth then begin
h:= 0; v:= v+1;
end;
end else if ch=chr(Escape) then begin
h:= h+1;
end else begin
h:= h+2;
if h>=screenwidth then begin
h:= h-screenwidth+1; v:= v+1;
end;
end;
end;
wxnlines:= v;
end (* wxnlines *);
(**** WUPLINES ****)
function wuplines(pt: bufpos; n: integer): integer;
(* Starting at pt move n screen-lines up, returning new position *)
var p: bufpos;
begin (* wuplines *)
p:= startofline(pt);
n:= n+1-wxnlines(p, pt);
while (p>rrbeg) and (n>0) do begin
p:= startofline(p-2); n:= n-wnlines(p);
end;
if n<0 then p:= wdownlines(p, -n);
wuplines:= p;
end (* wuplines *);
(**** WREPOS ****)
procedure wrepos(goalline: integer);
(* Reposition the window, gives new value to WINSTART *)
begin (* wrepos *)
winstart:= wuplines(rrdot, goalline-winfirst);
built:= pos;
end (* wrepos *);
(**** BUILDLINE ****)
procedure buildline(v: integer);
label 1;
var ch: char; h: integer; sflg: states; pt: bufpos;
begin (* buildline *)
with curstate[v] do begin
sflg:= state; pt:= bfpos;
end;
h:= 0; if sflg=control then h:= 1;
while true do begin
(* loop over characters *)
if pt=rrdot then begin
hpos:= h; vpos:= v; knownpos:= true;
end;
if pt>=rrz then begin
pt:= rrz+1; sflg:= noline; goto 1;
end;
ch:= bgetchar(pt);
if EolLineFeed then begin
if ch = chr(LineFeed) then begin
pt:= pt+1; sflg:= newline; goto 1;
end;
end;
if ch = EolFirst then begin
if ateol(pt, 1) then begin
pt:= pt+eolsize; sflg:= newline; goto 1;
end;
end;
if h=(screenwidth-1) then begin
sflg:= oldline; goto 1;
end else if ch in printable then begin
h:= h+1; pt:= pt+1;
end else if ch=chr(HorizontalTab) then begin
h:= (h div 8)*8+8; pt:=pt+1;
if h>=screenwidth then begin
sflg:= oldline; goto 1;
end;
end else if ch=chr(Escape) then begin
h:= h+1; pt:= pt+1;
end else begin
h:= h+2; pt:= pt+1;
if h>=screenwidth then begin
sflg:= control; goto 1;
end;
end;
end (* WHILE loop over characters*);
1:
with curstate[v+1] do begin
state:= sflg; bfpos:= pt;
end;
if v=winlast then winend:= pt-1;
lines[v].updated:= false;
end (* buildline *);
(**** WBUILD ****)
procedure wbuild;
var i: integer;
begin (* wbuild *)
knownpos:= false;
with curstate[winfirst] do begin
bfpos:= winstart; state:= newline;
end;
for i:= winfirst to winlast do buildline(i);
built:= ok;
end (* wbuild *);
(**** TryScroll ****)
procedure tryscroll(v: integer);
(* Try to get things better by scrolling *)
label 1, 9;
var v0, i: integer; pt: bufpos;
begin (* tryscroll *)
(* 1. If we are at end of buffer, do nothing *)
(* 2. Try scrolling up or down *)
pt:= curstate[v].bfpos; if pt>=rrz then goto 9;
if v>winlast then goto 9;
for v0:= winfirst to winlast do begin
if lines[v0].showpos=pt then goto 1;
end;
v0:= v;
pt:= lines[v0].showpos; if pt>=rrz then goto 9;
for v:= winfirst to winlast do begin
if curstate[v].bfpos=pt then goto 1;
end;
goto 9;
1:
if v0>v then begin (* Scroll up *)
if (v0-v)*scrollcost>(winlast+1-v0)*linecost then goto 9;
trmscr(v, winlast, v0-v);
for i:= v to winlast+v-v0 do begin
lines[i]:= lines[i+v0-v];
lines[i].updated:= false;
end;
for i:= winlast+1+v-v0 to winlast do markblank(i);
end else if v0<v then begin (* Scroll down *)
if (v-v0)*scrollcost>(winlast+1-v)*linecost then goto 9;
trmscr(v0, winlast, v0-v);
for i:= winlast downto v do begin
with lines[i] do begin
showpos:= lines[i+v0-v].showpos;
show:= lines[i+v0-v].show;
showlen:= lines[i+v0-v].showlen;
updated:= false;
end;
end;
for i:= v0 to v-1 do markblank(i);
end;
9:
end (* tryscroll *);
(**** PARTBUILD ****)
procedure partbuild;
label 1, 2, 3, 9;
var
v, v1, v2: integer; bp: bufpos;
oldstate: statearr;
begin
(* Copy curstate to oldstate, updating values *)
(* to use new buffer positons. *)
for v:= winfirst to winlast+1 do begin
oldstate[v].state:= curstate[v].state;
bp:= curstate[v].bfpos;
if bp>=first then begin
bp:= bp+count;
if bp<last then bp:= -1
end;
oldstate[v].bfpos:= bp;
end;
(* Find first line after first change *)
for v1:= winfirst+1 to winlast+1 do begin
if curstate[v1].bfpos>=first then goto 1;
(* The predicate:
(bfpos>first) or ((bfpos=first) and (state<>newline))
gives a cheaper computation below, but more cost for
the predicate. *)
end;
(* Change is entirely after window. *)
goto 9;
1:
if curstate[v1].bfpos>first then begin
v1:= v1-1;
end else if curstate[v1].state<>newline then begin
v1:= v1-1;
end;
(* Build lines past last change *)
for v2:= v1 to winlast do begin
with curstate[v2] do begin
if bfpos>=last then begin
if (state=newline) or (state=noline) then goto 2;
end;
end;
buildline(v2);
end;
(* Change extends after window. *)
goto 9;
2:
(* Test if rest of window can be left as it is. *)
if ((curstate[v2].bfpos = oldstate[v2].bfpos) and
(curstate[v2].state = oldstate[v2].state)) then begin
for v:= v2+1 to winlast+1 do curstate[v]:= oldstate[v];
goto 9;
end;
(* Could not, thats bad. Try find how much it changed. *)
for v:= v1 to winlast+1 do begin
if ((curstate[v2].bfpos = oldstate[v].bfpos) and
(curstate[v2].state = oldstate[v].state)) then goto 3;
end;
(* Could not find any match, try our last chance *)
(* Maybe position after last wasn't start of a line before *)
if curstate[v2].bfpos=last then begin
buildline(v2); v2:= v2+1; goto 2;
end;
(* do it really hard. *)
for v2:= v2 to winlast+1 do buildline(v2);
goto 9;
3:
(* Screen is shifted. *)
v1:= v-v2;
if v1>0 then begin
(* Shifted up, so shift information up. *)
for v:= v2 to winlast+1-v1 do begin
curstate[v]:= oldstate[v+v1];
lines[v].updated:= false;
end;
(* Then build rest of window the hard way. *)
for v:= winlast+1-v1 to winlast do buildline(v);
end else begin
(* Shifted down, so shift information down. *)
for v:= v2 to winlast+1 do begin
curstate[v]:= oldstate[v+v1];
lines[v].updated:= false;
end;
end;
if scrflag then tryscroll(v2);
9:
(* Window end might have moved. *)
winend:= curstate[winlast+1].bfpos-1;
end (* partbuild *);
(**** UPDATELINE ****)
procedure updateline(v: integer; var newline: linetext);
label 1;
var
len, h, hmax: integer; ch, ch0, ch1: char;
begin (* updateline *)
len:= 0;
for h:= 0 to screenwidth-1 do if newline[h] <> ' ' then len:= h+1;
hmax:= -1; ch0:= ' '; ch1:= ' ';
with lines[v] do begin
if xyflag then begin
for h:=0 to len-1 do begin
ch:= newline[h];
if ch<>show[h] then begin
if (hmax=-1) or (h-hmax>3) then begin
trmpos(v, h);
end else begin
if (h-hmax)>2 then trmout(ch1);
if (h-hmax)>1 then trmout(ch0);
end;
trmout(ch); hmax:= h;
end;
ch1:= ch0; ch0:= ch;
end;
end else begin
h:= 0;
while newline[h]=show[h] do begin
h:= h+1; if h>=len then goto 1;
end;
trmpos(v, h);
for h:= h to len-1 do trmout(newline[h]);
end;
1:
if len<showlen then begin
trmpos(v, len);
if eolflag then begin
trmeol;
end else begin
for h:= len to showlen-1 do trmout(' ');
end;
end;
end;
with lines[v] do begin
updated:= true; showlen:= len; show:= newline;
end;
end (* updateline *);
(**** WUPDL ****)
procedure wupdl(v: integer);
(* Update a line in the window section. *)
label 1, 2, 9;
var
newline: linetext; len: integer;
h, hmax: integer; ch, ch0, ch1: char;
pt: bufpos;
begin (* wupdl *)
if v>=winheight then bug('Internal error V>=WINHEIGHT in SCREEN/AS');
if (nwins=2) and (v=splitline) then begin
newline:= blanktext;
for h:= 0 to (screenwidth-10) do newline[h]:= '-';
end else if (v<winfirst) or (v>winlast) then begin
goto 9;
end else begin
newline:= blanktext;
h:= 0; pt:= curstate[v].bfpos;
if curstate[v].state=control then begin
ch:= bgetchar(pt-1);
if ch=chr(RubOut) then begin
newline[0]:= '?';
(*@VMS: end else if ch>chr(RubOut) then begin newline[0]:= '*'; *)
end else begin
newline[0]:= chr(ord(ch)+64);
end;
h:= 1; len:= 1;
end;
while (pt<rrz) do begin
ch:= bgetchar(pt);
if EolLineFeed then begin
if ch = chr(LineFeed) then goto 2;
end;
if ch = EolFirst then begin
if ateol(pt, 1) then goto 2;
end;
pt:= pt+1;
if h>=(screenwidth-1) then goto 1;
if ch in printable then begin
newline[h]:= ch; h:= h+1;
if ch<>' ' then len:= h;
end else if ch=chr(HorizontalTab) then begin
h:= (h div 8)*8+8;
if h>=screenwidth then goto 1;
end else if ch=chr(Escape) then begin
newline[h]:= '$'; h:= h+1; len:= h;
end else begin
newline[h]:= '^'; h:= h+1;
if h>=(screenwidth-1) then goto 1;
if ch=chr(RubOut) then begin
newline[h]:= '?';
(*@VMS: END ELSE IF ch>chr(RubOut) THEN BEGIN newline[h]:= '*'; *)
end else begin
newline[h]:= chr(ord(ch)+64);
end;
h:= h+1; len:= h;
end;
end (* WHILE *);
goto 2;
1:
newline[screenwidth-1]:= '!';
len:= screenwidth;
2:
lines[v].showpos:= curstate[v].bfpos;
end;
updateline(v, newline);
9:
end (* wupdl *);
(**** WSETPOS ****)
procedure wsetpos;
var ch: char; p: bufpos;
begin (* wsetpos *)
vpos:= winfirst+1;
while (rrdot>=curstate[vpos].bfpos) and (vpos<=winlast) do vpos:= vpos+1;
if rrdot>=curstate[vpos].bfpos then begin
bug('WSETPOS outside window (in SCREEN)/AS ');
end;
vpos:= vpos-1; hpos:= 0;
with curstate[vpos] do begin
p:= bfpos;
if state=control then hpos:= 1;
end;
while p<rrdot do begin
ch:= bgetchar(p);
if EolLineFeed and (ch=chr(LineFeed)) then begin
hpos:= 0; p:= p+1;
end else if ateol(p, 1) then begin
hpos:= 0; p:= p+eolsize;
end else begin
p:= p+1;
if ch in printable then begin
hpos:= hpos+1;
end else if ch=chr(HorizontalTab) then begin
hpos:= (hpos div 8)*8+8;
end else if ch=chr(Escape) then begin
hpos:= hpos+1
end else begin
hpos:= hpos+2;
end;
end;
end;
knownpos:= true;
end (* wsetpos *);
(**** WUPD1 ****)
procedure wupd1;
(* Make sure all information about what should be in window is correct. *)
var i: integer;
begin (* wupd1 *)
if curbuffer[curwin]<>showbuffer[curwin] then begin
built:= nopos;
rrdot:= getdot; rrz:= getsize;
first:= rrbeg; last:= rrz; count:= 0;
showbuffer[curwin]:= curbuffer[curwin];
end;
for i:= winfirst to winlast do begin
with lines[i] do begin
if showpos>=first then begin
showpos:= showpos+count;
if showpos<last then showpos:= -1
end;
end;
end;
if built=pos then begin
if rrdot>=winstart then wbuild;
end else if (built=ok) and (last>=first) then begin
partbuild;
end;
if (rrdot<winstart) or (rrdot>winend) or (built=nopos) then begin
if (not eolflag) and (nwins=1) then dorefresh:= true;
wrepos((winfirst+winlast) div 2); wbuild;
if (rrdot<winstart) or (rrdot>winend) then begin
bug('Dot outside window in WUPD1 (SCREEN)/AS ');
end;
end;
last:= rrbeg; first:= rrz; count:= 0;
end (* wupd1 *);
(**** PCNTUPDATE ****)
procedure pcntupdate;
(* Update percent field *)
var npcfld: pcmode; pcntrow, pcntcol: integer;
begin (* pcntupdate *)
with npcfld do begin
pcntrow:= modeheight-1;
pcntcol:= screenwidth-pcntwidth-1; val:= 0;
if winend=rrz then begin
if winstart=rrbeg then begin
mode:= none;
end else begin
mode:= bot;
end;
end else if winstart=rrbeg then begin
mode:= top;
end else begin
mode:= pcent;
val:= (100*winstart) div rrz;
end;
modif:= getmodified;
end;
if ((npcfld.mode<>pcfld.mode) or (npcfld.val<>pcfld.val)
or (npcfld.modif<>pcfld.modif)) then begin
lines[modetop+pcntrow].updated:= false;
with npcfld do begin
if mode<>none then begin
modelines[pcntrow][pcntcol ]:= '-';
modelines[pcntrow][pcntcol+1]:= '-';
case mode of
pcent:
begin
modelines[pcntrow][pcntcol+2]:= chr((val div 10)+ord('0'));
modelines[pcntrow][pcntcol+3]:= chr((val mod 10)+ord('0'));
modelines[pcntrow][pcntcol+4]:= '%';
end;
top:
begin
modelines[pcntrow][pcntcol+2]:= 'T';
modelines[pcntrow][pcntcol+3]:= 'O';
modelines[pcntrow][pcntcol+4]:= 'P';
end;
bot:
begin
modelines[pcntrow][pcntcol+2]:= 'B';
modelines[pcntrow][pcntcol+3]:= 'O';
modelines[pcntrow][pcntcol+4]:= 'T';
end;
end (* case *);
modelines[pcntrow][pcntcol+5]:= '-';
modelines[moderow][pcntcol+6]:= '-';
pcntcol:= pcntcol+7;
end;
if modif then begin
modelines[pcntrow][pcntcol ]:= ' ';
modelines[pcntrow][pcntcol+1]:= '*';
pcntcol:= pcntcol+2;
end;
for pcntcol:= pcntcol to screenwidth-1 do begin
modelines[pcntrow][pcntcol]:= ' ';
end;
end;
pcfld:= npcfld;
end;
end (* pcntupdate *);
(**** NEWOWLINE ****)
procedure newowline(row: integer);
var i, morerow, morecol: integer; c: char;
begin (* newowline *)
ocol:= 0; orow:= row;
if orow > winlast then begin
pcfld.mode:= bad;
morerow:= modeheight-1;
morecol:= screenwidth-pcntwidth-1;
modelines[morerow][morecol ]:= '-';
modelines[morerow][morecol+1]:= '-';
modelines[morerow][morecol+2]:= 'M';
modelines[morerow][morecol+3]:= 'O';
modelines[morerow][morecol+4]:= 'R';
modelines[morerow][morecol+5]:= 'E';
modelines[morerow][morecol+6]:= '-';
modelines[morerow][morecol+7]:= '-';
modelines[morerow][morecol+8]:= ' ';
updateline(modetop+morerow, modelines[morerow]);
trmpos(modetop+morerow, screenwidth-1);
c:= readc; (* Wait for the user to type something *)
if c<>' ' then begin (* If he didn't type a space *)
ovflush:= true; (* Set flushed flag *)
modelines[morerow][morecol ]:= 'F';
modelines[morerow][morecol+1]:= 'L';
modelines[morerow][morecol+2]:= 'U';
modelines[morerow][morecol+3]:= 'S';
modelines[morerow][morecol+4]:= 'H';
modelines[morerow][morecol+5]:= 'E';
modelines[morerow][morecol+6]:= 'D';
modelines[morerow][morecol+7]:= ' ';
modelines[morerow][morecol+8]:= ' ';
updateline(modetop+morerow, modelines[morerow]);
ttyforce; (* Force the line out *)
if c<>chr(RubOut) then reread; (* Reread all flush chars except rubout *)
end else begin
orow:= winfirst;
end;
end;
if not ovflush then begin
trmpos(orow, 0);
if eolflag then begin
trmeol;
end else begin
for i:= 1 to lines[orow].showlen do trmout(' ');
trmpos(orow, 0);
end;
markblank(orow);
end;
end (* newowline *);
procedure wupd0;
label
9;
var
i: integer;
begin
if scrflag then tryscroll(winfirst);
if check(0) then goto 9;
if not knownpos then wsetpos;
if not lines[vpos].updated then wupdl(vpos);
if csflg then begin
csflg:= false;
for i:= 1 to winheight do begin
if vpos+i<winheight then begin
if not lines[vpos+i].updated then begin
wupdl(vpos+i);
if check(0) then goto 9
end;
end;
if vpos-i>=0 then begin
if not lines[vpos-i].updated then begin
wupdl(vpos-i);
if check(0) then goto 9;
end;
end;
end;
end else begin
for i:= 0 to winheight-1 do begin
if not lines[i].updated then begin
wupdl(i);
if check(0) then goto 9;
end;
end;
end;
9:
end;
procedure winprelude(unsimplify: boolean);
label
9;
var
i: integer;
begin
if noprelude then goto 9;
noprelude:= true;
(* Four cases: *)
(* 0/ Same window and same buffer *)
(* 1/ Same window with other buffer *)
(* 2/ Other window with same buffer as last in this window *)
(* 3/ Other window with changed buffer *)
(* Case 0 is ignored, case 1 requires just a reset of variables, *)
(* case 3 is like case 1 after switching window, *)
(* case 2 requires resetting dot to same position as last time *)
if (new_window<>curwin) or (new_buffer<>curbuffer[curwin]) then begin
unsimplify:= true;
if new_window<>curwin then begin
xwinstart[curwin]:= winstart; xwinend[curwin]:= winend;
xbuilt[curwin]:= built; xdot[curwin]:= rrdot;
if (first<=last) or (built<>ok) then xok[curwin]:= false;
curwin:= new_window;
if curwin=1 then begin
winfirst:= 0; winlast:= splitline-1;
end else begin
winfirst:= splitline+1; winlast:= winheight-1;
end;
winstart:= xwinstart[curwin]; winend:= xwinend[curwin];
built:= xbuilt[curwin]; knownpos:= false;
rrdot:= xdot[curwin]; rrz:= getsize;
(* Case 3 done, check for case 2 *)
if curbuffer[curwin]=new_buffer then begin
if rrdot>rrz then rrdot:= rrz;
setdot(rrdot);
if built<pos then built:= pos;
end else begin
rrdot:= getdot; built:= nopos;
end;
end;
curbuffer[curwin]:= new_buffer;
rrz:= getsize; rrdot:= getdot;
end;
if unsimplify then begin
if scount>0 then begin
for i:= spos+1 to winlast+1 do begin
with lines[i] do showpos:= showpos+scount;
with curstate[i] do bfpos:= bfpos+scount;
end;
end;
simplep:= false; scount:= 0;
end;
noprelude:= false;
9:
end;
procedure wswitch;
(* Switch window, including switch of buffer *)
begin
new_window:= 3-new_window; new_buffer:= curbuffer[new_window];
if new_buffer=0 then bug('No buffer selected for this window /AS ');
isetbuf(new_buffer);
winprelude(true);
end;
procedure UpdModeLines;
var i: integer;
begin
for i:= 0 to modeheight-1 do begin
if not lines[modetop+i].updated then begin
updateline(modetop+i, modelines[i]);
(*** IF check(0) THEN GOTO 9; ***)
end;
end;
end (* UpdModeLines *);
(****************************************)
(* *)
(* Entries to this module *)
(* *)
(****************************************)
(**** WININSERT ****)
(*@VMS: [global] *)
procedure wininsert(n: bufpos);
(* n characters inserted at dot *)
begin (* wininsert *)
winprelude(false);
if first>rrdot then first:= rrdot;
rrdot:= rrdot+n; rrz:= rrz+n;
last:= last+n;
if rrdot>last then last:= rrdot;
count:= count+n;
knownpos:= false;
end (* wininsert *);
(**** WINDELETE ****)
(*@VMS: [global] *)
procedure windelete(n: bufpos);
(* n characters deleted at dot *)
begin (* windelete *)
winprelude(true);
if first>rrdot then first:= rrdot;
rrz:= rrz-n;
last:= last-n;
if rrdot>last then last:= rrdot;
count:= count-n;
knownpos:= false;
end (* windelete *);
(**** WINSETDOT ****)
(*@VMS: [global] *)
procedure winsetdot(pt: bufpos);
(* Dot is set to pt *)
begin (* winsetdot *)
winprelude(true);
rrdot:= pt;
knownpos:= false;
end (* winsetdot *);
(**** WINPOS ****)
(*@VMS: [global] *)
procedure winpos(row: integer);
(* Position window so that dot is on specified row *)
begin (* winpos *)
winprelude(true);
if row<0 then begin
row:= winlast+1+row;
if row>=winfirst then wrepos(row);
end else begin
row:= winfirst+row;
if row<=winlast then wrepos(row);
end;
end (* winpos *);
(**** WINSCROLL ****)
(*@VMS: [global] *)
procedure winscroll(n: integer);
(* Scroll window n lines up or down *)
begin (* winscroll *)
winprelude(true);
wupd1; (* Make sure Winstart and Winend are OK *)
if not knownpos then wsetpos;
if n<0 then begin
winstart:= wuplines(winstart, -n);
if vpos-n>winlast then setdot(winstart);
end else begin
winstart:= wdownlines(winstart, n);
if vpos-n<winfirst then setdot(winstart);
end;
built:= pos;
end (* winscroll *);
(**** WINSELECT ****)
(*@VMS: [global] *)
procedure winselect(n: integer);
var cb: integer;
begin (* winselect *)
if nwins=2 then begin
if n=0 then begin
new_window:= 3-new_window;
end else begin
new_window:= n;
end;
(* This seems to have "interesting" effects. Therefore, figure *)
(* out something else. Later, that is... *)
(* winprelude(true); *)
end;
end (* winselect *);
(**** WINBUF ****)
(*@VMS: [global] *)
procedure winbuf(n: integer);
(* This is to inform us that current buffer has changed. *)
begin (* winbuf *)
new_buffer:= n;
end (* winbuf *);
(**** WINGROW ****)
(*@VMS: [global] *)
procedure wingrow(n: integer);
(* Grow (or shrink) current window *)
var i, o: integer;
begin (* wingrow *)
winprelude(true);
if curwin=2 then begin
n:= splitline-n;
end else begin
n:= splitline+n;
end;
if n<1 then n:= 1;
if n>(winheight-2) then n:= winheight-2;
o:= splitline; splitline:= n;
if nwins=2 then begin
if curwin=1 then begin
winlast:= n-1;
end else begin
winfirst:= n+1;
end;
if built<pos then built:= pos;
xok[1]:= false; xok[2]:= false;
with lines[n] do begin
updated:= false; showpos:= -1;
end;
if curwin=1 then begin
wswitch;
winscroll(o-n);
wswitch;
end else begin
winscroll(n-o);
end;
end;
end (* wingrow *);
(**** WINNO ****)
(*@VMS: [global] *)
procedure winno(n: integer);
(* Tells us how many windows to use, current maximum 2 *)
var
i: integer;
begin (* winno *)
winprelude(true);
if n=1 then begin
if curwin<>1 then bug('Window one not selected /as ');
nwins:= 1; winfirst:= 0; winlast:= winheight-1;
if built<pos then built:= pos;
end else if n=2 then begin
if nwins<>2 then begin
xwinstart[2]:= 0; xwinend[2]:= 0;
xbuilt[2]:= nopos; xdot[2]:= 0;
nwins:= 2; new_window:= 2;
if splitline<1 then splitline:= 1;
if splitline>(winheight-2) then splitline:= winheight-2;
winlast:= splitline-1;
if built<pos then built:= pos;
xok[1]:= false; xok[2]:= false;
with lines[splitline] do begin
updated:= false; showpos:= -1;
end;
end;
end else begin
bug('Illegal argument to WINNO /as ');
end;
end (* winno *);
(**** WINCUR ****)
(*@VMS: [global] *)
function wincur: integer;
begin (* wincur *)
wincur:= curwin;
end (* wincur *);
(**** WINREFRESH ****)
(*@VMS: [global] *)
procedure winrefresh;
(* Tells us that it is time to refresh the window *)
(* It is our responsibility to position the window *)
var i: integer;
begin (* winrefresh *)
winprelude(true);
rrdot:= getdot; rrz:= getsize;
if not dorefresh then wrepos((winfirst+winlast) div 2);
trmclr;
pcfld.mode:= bad; csflg:= true;
for i:= 0 to screenheight do markblank(i);
xok[1]:= false; xok[2]:= false;
end (* winrefresh *);
(**** WINREWRITE ****)
(*@VMS: [global] *)
procedure winrewrite(n: integer);
(* Rewrite n lines around current line *)
var i, low, high: integer;
begin (* winrewrite *)
winprelude(true);
if built=ok then begin
if (rrdot>=winstart) and (rrdot<=winend) then begin
if not knownpos then wsetpos;
if n<1 then n:= 1;
low:= vpos-((n-1) div 2);
if low<0 then low:= 0;
high:= low+n-1;
if high>winlast then high:= winlast;
for i:= low to high do markmessed(i);
end;
end;
end (* winrewrite *);
(**** WINUPDATE ****)
(*@VMS: [global] *)
procedure winupdate;
(* here we are allowed to do updating *)
label 1, 9;
var i: integer; c: char;
begin (* winupdate *)
winprelude(false);
if simplep then begin
trmpos(vpos, hpos);
while first<last do begin
c:= bgetchar(first);
if not (c in printable) then goto 1;
if hpos>=screenwidth-1 then goto 1;
trmout(c);
with lines[vpos] do begin
show[hpos]:= c; showlen:= hpos+1;
end;
hpos:= hpos+1; spos:= vpos;
first:= first+1; count:= count-1; scount:= scount+1;
end;
knownpos:= true; ttyforce; goto 9;
1:
winprelude(true);
end;
if ovmode then begin
(* Wait for the user to type something *)
c:= readc;
if c<>' ' then reread;
end;
orow:= winfirst; (* Reset overwrite lines *)
ovmode:= false; ovflush:= false;
if check(0) then goto 9;
xok[curwin]:= false;
wupd1;
if dorefresh then begin
winrefresh; dorefresh:= false;
end;
for i:= 0 to echoheight-1 do begin
if not lines[echotop+i].updated then begin
updateline(echotop+i, echolines[i]);
if check(0) then goto 9;
end;
end;
pcntupdate;
UpdModeLines;
if check(0) then goto 9;
wupd0;
if check(0) then goto 9;
xok[curwin]:= true;
if nwins=2 then begin
if not xok[3-curwin] then begin
wswitch;
if built<pos then built:= pos;
wupd1; wupd0;
wswitch;
last:= rrbeg; first:= rrz; count:= 0;
if check(0) then goto 9;
xok[3-curwin]:= true;
end;
end;
if not knownpos then wsetpos;
trmpos(vpos, hpos); ttyforce; (* Force, just like Echoupdate. / JMR *)
simplep:= (ateol(rrdot, 1) or (rrdot=rrz)) and pcfld.modif;
9:
end (* winupdate *);
(**** WINOVTOP ***)
(*@VMS: [global] *)
procedure winovtop;
(* Starts new overwrite at top left cornet *)
begin (* winovtop *)
winprelude(true);
if not ovflush then begin
ovmode:= true;
newowline(winfirst);
end;
end (* winovtop *);
(**** WINOVERWRITE ****)
(*@VMS: [global] *)
procedure winoverwrite(ch: char);
(* overwrites text in buffer with garbage *)
label 9;
begin (* winoverwrite *)
winprelude(true);
if ovflush then goto 9;
if not ovmode then begin
ovmode:= true;
newowline(orow);
end;
if (ch<' ') or (ch=chr(RubOut)) then begin
if ch=chr(LineFeed) then begin
newowline(orow+1);
end else if ch=chr(CarriageReturn) then begin
ocol:= 0;
end else if ch=chr(HorizontalTab) then begin
ocol:= (ocol div 8)*8+8;
end else begin
winoverwrite('^');
if ch=chr(RubOut) then begin
winoverwrite('?');
end else begin
winoverwrite(chr(ord(ch)+64));
end;
end;
end else begin
if ocol>screenwidth-1 then begin
newowline(orow+1);
end;
trmpos(orow, ocol);
with lines[orow] do begin
show[ocol]:= ch;
trmout(ch);
ocol:= ocol+1;
if ocol>showlen then showlen:= ocol;
end;
end;
9:
end (* winoverwrite *);
(**** WINOVCLEAR ****)
(*@VMS: [global] *)
procedure winovclear;
(* Reset overwritemode *)
begin (* winovclear *)
winprelude(true);
ovmode:= false; ovflush:= false;
end (* winovclear *);
(**** PCNTMESSED ****)
(*@VMS: [global] *)
procedure pcntmessed;
(* Indicate that percent field is messed *)
begin (* pcntmessed *)
winprelude(true);
pcfld.mode:= bad;
end (* pcntmessed *);
(**** WINTOP ****)
(*@VMS: [global] *)
function wintop: bufpos;
(* Returns the position of the beginning of the window *)
begin (* wintop *)
wintop:= winstart;
end (* wintop *);
(**** WINSIZE ****)
(*@VMS: [global] *)
procedure winsize(var height, width: integer);
(* Returns the size of the window *)
begin (* winsize *)
height:= winlast-winfirst+1; width:= screenwidth;
end (* winsize *);
(**** DOTPOS ****)
(*@VMS: [global] *)
procedure dotpos(var row, col: integer);
(* Return screen position of dot *)
begin (* dotpos *)
winprelude(true);
wupd1;
if not knownpos then wsetpos;
row:= vpos+winfirst; col:= hpos;
end (* dotpos *);
(**** POSDOT ****)
(*@VMS: [global] *)
function posdot(x: integer): bufpos;
label 9;
var pt: bufpos; pos: integer; ch: char;
begin (* posdot *)
pt:= rrdot; pos:= 0;
while (pt<rrz) and (pos<x) do begin
ch:= bgetchar(pt);
if ch in printable then begin
pos:= pos+1;
end else begin
if ch=chr(HorizontalTab) then begin
pos:= ((pos+8) div 8) * 8;
end else if ch=chr(Escape) then begin
pos:= pos+1;
end else begin
pos:= pos+2;
end;
if ateol(pt, 1) then goto 9;
if pos>x then goto 9;
end;
pt:= pt+1;
end;
9:
posdot:= pt;
end (* posdot *);
(**** MODEWRITE ****)
(*@VMS: [global] *)
procedure modewrite(ch: char);
begin
winprelude(true);
if (moderow<modeheight-1) and (modecol=screenwidth-1) then begin
lines[modetop+moderow].updated:= false;
modelines[moderow][modecol]:= '!';
moderow:= moderow+1; modecol:= 0;
end;
if (moderow<modeheight-1) and (modecol<=screenwidth-1)
or (moderow=modeheight-1) and (modecol<=screenwidth-pcntwidth-2) then begin
lines[modetop+moderow].updated:= false;
modelines[moderow][modecol]:= ch; modecol:= modecol+1;
end;
end (* modewrite *);
(*---------------------------------------------------------------------------*)
(* ModeArrow writes a character in the mode area. Control characters are *)
(* written in the uparrow form. *)
procedure ModeArrow(c: char);
var
i: integer;
begin
if c in printable then begin
modewrite(c)
end else begin
for i := 1 to chrvlen[c]
do modewrite(chrview[c, i]);
end;
end;
(*---------------------------------------------------------------------------*)
(* ModeString writes a string in the mode area, followed by one space. *)
(*@VMS: [global] *)
procedure ModeString(Str: string);
var
pos: integer;
begin
for pos := 1 to StrLength(Str)
do ModeArrow(Str[pos]);
modewrite(' ');
end;
(**** MODEPOS ****)
(*@VMS: [global] *)
procedure modepos(row, col: integer);
begin
moderow:= row; modecol:= col;
end (* modepos *);
(**** MODEWHERE ****)
(*@VMS: [global] *)
procedure modewhere(var row, col: integer);
begin
row:= moderow; col:= modecol;
end (* modewhere *);
(**** MODESIZE ****)
(*@VMS: [global] *)
procedure modesize(var height, width: integer);
begin
height:= modeheight; width:= screenwidth;
end (* modesize *);
(**** MODECLEAR ****)
(*@VMS: [global] *)
procedure modeclear;
var row, col: integer;
begin
winprelude(true);
for row:= modetop to modetop+modeheight-1 do lines[row].updated:= false;
for row:= 0 to modeheight-2 do modelines[row]:= blanktext;
for col:= 0 to screenwidth-10-1 do modelines[modeheight-1][col]:= ' ';
moderow:= 0; modecol:= 0;
ClockIsOn:= false; (* The clock is off now. *)
end (* modeclear *);
(**** TimeOut ****)
(*@VMS: [global] *)
procedure TimeOut(Hours, Minutes: integer);
begin
modewrite(chr((Hours div 10) + ord('0')));
modewrite(chr((Hours mod 10) + ord('0')));
modewrite(':');
modewrite(chr((Minutes div 10) + ord('0')));
modewrite(chr((Minutes mod 10) + ord('0')));
end (* TimeOut *);
(**** TIMESTAMP ****)
(*@VMS: [global] *)
procedure TimeStamp;
var
MRow, MCol: integer;
TRow, TCol: integer;
Hour, Minute: integer;
Void: boolean;
begin
if ClockIsOn then begin (* Only update if the clock is on *)
TrmWhere(TRow, TCol); (* Get position on physical screen *)
modewhere(MRow, MCol); (* Save mode line position *)
GetClock(Hour, Minute); (* Get current time *)
if Minute = 0 (* Even hour? *)
then begin
modepos(ClockRow, ClockCol); (* Go to clock field *)
modewrite('P');
modewrite('l');
modewrite('i');
modewrite('n');
modewrite('g');
UpdModeLines; (* Update the mode line *)
ttyforce; (* Force all output *)
Void := check(1); (* Wait a second. *)
end;
modepos(ClockRow, ClockCol); (* Go to clock field *)
TimeOut(Hour, Minute); (* Put new time in mode line *)
modepos(MRow, MCol); (* Restore old mode line pos *)
UpdModeLines; (* Update the mode line *)
trmpos(TRow, TCol); (* Restore physical position *)
ttyforce; (* Force out all buffers *)
end;
end (* TimeStamp *);
(**** MODETIME ****)
(*@VMS: [global] *)
procedure ModeTime;
var
Hour, Minute: integer;
begin
ClockIsOn:= true; (* The clock just got turned on... *)
ClockRow := moderow;
ClockCol := modecol;
GetClock(Hour, Minute);
TimeOut(Hour, Minute); (* Get the clock going... *)
end (* ModeTime *);
(**** ECHOUPDATE ****)
(*@VMS: [global] *)
procedure echoupdate;
var row: integer;
begin
simplep:= false;
if not kbdrunning then begin
for row:= echotop to echotop+echoheight-1 do
if not lines[row].updated then updateline(row, echolines[row-echotop]);
trmpos(echotop+echorow, echocol); ttyforce;
end;
end (* echoupdate *);
(**** ECHOEOL ****)
(*@VMS: [global] *)
procedure echoeol;
var col: integer;
begin
winprelude(true);
lines[echotop+echorow].updated:= false;
for col:= echocol to screenwidth-1 do echolines[echorow][col]:= ' ';
end (* echoeol *);
(**** ECHOWRITE ****)
(*@VMS: [global] *)
procedure echowrite(ch: char);
begin
winprelude(true);
if (echorow<echoheight-1) and (echocol=screenwidth-1) then begin
lines[echotop+echorow].updated:=false;
echolines[echorow][echocol]:= '!';
echorow:= echorow+1; echocol:= 0;
end;
if (echorow<echoheight) and (echocol<=screenwidth-1) then begin
lines[echotop+echorow].updated:= false;
if (echorow=echoheight-1) and (echocol>=screenwidth-2) then begin
echocol:= 0; echoeol;
end;
echolines[echorow][echocol]:= ch; echocol:= echocol+1;
end;
end (* echowrite *);
(*@VMS: [global] *)
procedure echopos(row, col: integer);
begin
echorow:= row; echocol:= col;
end (* echopos *);
(**** ECHOWHERE ****)
(*@VMS: [global] *)
procedure echowhere(var row, col: integer);
begin
row:= echorow; col:= echocol;
end (* echowhere *);
(**** ECHOSIZE ****)
(*@VMS: [global] *)
procedure echosize(var height, width: integer);
begin
height:= echoheight; width:= screenwidth;
end (* echosize *);
(*---------------------------------------------------------------------------*)
(* EchoArrow writes a character in the echo area. Control characters are *)
(* written in the uparrow form. *)
(*@VMS: [global] *)
procedure EchoArrow(c: char);
var
i: integer;
begin
if c in printable then begin
echowrite(c)
end else begin
for i := 1 to chrvlen[c]
do echowrite(chrview[c, i]);
end;
end;
(*---------------------------------------------------------------------------*)
(* EchoString writes a string in the echo area, followed by one space. *)
(*@VMS: [global] *)
procedure EchoString(Str: string);
var
pos: integer;
begin
for pos := 1 to StrLength(Str)
do EchoArrow(Str[pos]);
echowrite(' ');
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure WinFlags(flags: string);
var c: char;
begin
c := flags[3]; (* "Display line feed as EOL" *)
if c = '+' then EolLineFeed := true;
if c = '-' then EolLineFeed := false;
c := flags[4]; (* "Display Escape as $" *)
if c = '+' then begin
chrview[chr(Escape)] := '$ ';
chrvlen[chr(Escape)] := 1;
end;
if c = '-' then begin
chrview[chr(Escape)] := '^[ ';
chrvlen[chr(Escape)] := 2;
end;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure scrinit(total: boolean);
var
i: integer;
eol: string;
begin (* wininit *)
for i:= 0 to maxwidth do begin
blanktext[i]:= ' '; messedtext[i]:= chr(RubOut);
end;
(* Initialize terminal dependent variables *)
TrmSize(screenheight, screenwidth);
TrmFeatures(xyflag, eolflag, scrflag);
TrmPrintable(printable);
for i := 0 to 31 do begin
chrview[chr(i)][1] := '^';
chrview[chr(i)][2] := chr(i + 64);
chrvlen[chr(i)] := 2;
end;
(*@TOPS: chrview[chr(Escape)] := '$ '; *)
(*@TOPS: chrvlen[chr(Escape)] := 1; *)
for i := 32 to 126 do begin
chrview[chr(i)][1] := chr(i);
chrvlen[chr(i)] := 1;
end;
chrview[chr(127)] := '^? ';
chrvlen[chr(127)] := 2;
(*@VMS:
for i := 128 to 255 do begin
chrview[chr(i)] := '^* ';
chrvlen[chr(i)] := 2;
end;
*) (* Done simple VMS set-up. *)
if screenheight > maxheight then screenheight := maxheight;
if screenwidth > maxwidth then screenwidth := maxwidth;
if screenwidth>40 then echoheight:= 1 else echoheight:= 2;
echotop:= screenheight-echoheight;
echorow:=0; echocol:= 0;
for i:= 0 to echoheight-1 do echolines[i]:= blanktext;
if screenwidth>40 then modeheight:= 1 else modeheight:= 2;
modetop:= echotop-modeheight;
moderow:= 0; modecol:= 0;
for i:= 0 to modeheight-1 do modelines[i]:= blanktext;
ClockIsOn:= false; (* The clock is not yet on *)
winheight:= modetop;
winfirst:= 0; winlast:= winheight-1;
if total then begin
splitline:= winheight div 2;
nwins:= 1; curwin:= 1;
end else begin
wingrow(0);
end;
linecost:= 20; trmcst(scrollcost, idcharcost);
(* Say complete update necessary *)
if total then begin
rrdot:= 0; rrz:= 0;
end;
first:= 0; last:= rrz; count:= rrz;
csflg:= true;
noprelude:= false;
if total then begin
built:= nopos;
winstart:= 0; winend:= 0;
xwinstart[1]:= 0; xwinend[1]:= 0;
xwinstart[2]:= 0; xwinend[2]:= 0;
curbuffer[1]:= 1; curbuffer[2]:= 0;
showbuffer[1]:= 1; showbuffer[2]:= 0;
end else begin
if built=ok then built:= pos;
xok[1]:= false; xok[2]:= false;
end;
new_buffer:= curbuffer[curwin]; new_window:= curwin;
hpos:= 0; vpos:= 0; knownpos:= false;
simplep:= false; scount:= 0; spos:= 0;
ovmode:= false; ovflush:= false; orow:= 0;
EolString(eol, i);
EolFirst := eol[1];
EolLineFeed := false;
end; (* scrinit *)
(*---------------------------------------------------------------------------*)
(*@TOPS: begin end. *)
(*@VMS: end. *)
Reference in New Issue View Git Blame Copy Permalink