Trailing-Edge
-
PDP-10 Archives
-
tops10_tools_bb-fp64b-sb
-
10,7/amis/term.pas
There are no other files named term.pas in the archive.
(* AMIS terminal driver. *) (* -*- 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-,S3000 *)
(****************************************************************)
(* *)
(* 1980-09-21 Birth of AMIS *)
(* *)
(****************************************************************)
module term;
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; (* Length of a string in AMIS *)
(*@VMS: DskSize = 512; *) (* number of chars in a disk block *)
(*@TOPS: DskSize = 640; *)
dskwarning = -1; (* Error code for not found or end of file *)
dskerror = -2; (* Other strange disk errors *)
dsk_init_file = 1; (* Internal number for user init file *)
sys_init_file = 2; (* Internal number for system init file *)
type
string = packed array [1..strsize] of char;
charset = set of char;
sixbytes = packed array[1..6] of char;
long_string = record
len: integer;
c: packed array [1..40] of char;
end;
cop = record
len: integer;
c: array[1..10] of char;
end;
actions = (up,down,left,right,eol,home,dca,tab,clear,idchar,idline,hilite);
features = set of actions;
dskblock = packed array [1..dsksize] of char;
dskbp = ^dskblock;
var
name : sixbytes; (* Terminal name *)
c_up : cop; (* Cursor up. *)
c_down : cop; (* Cursor down. *)
c_left : cop; (* Cursor left. *)
c_right : cop; (* Cursor right. *)
c_home : cop; (* Cursor home. *)
e_screen : cop; (* Erase screen. *)
e_scr_ft : integer; (* Fill time for above. *)
e_eol : cop; (* Erase to end of current line. *)
e_eol_ft : integer; (* Fill time for above. *)
ic_on : cop; (* Insert character mode on/off *)
ic_off : cop;
dc : cop; (* Delete character function *)
idch_ft : integer;
idln_ft : integer;
hi_on : cop; (* High-light mode on/off *)
hi_off : cop;
visibell : cop; (* non-^G beep. *)
e_eol_fc : integer; (* Number of fillers to send for *)
e_scr_fc : integer; (* different operations. *)
idch_fc : integer;
idln_fc : integer;
xpos : integer; (* Current cursor position *)
ypos : integer;
cursor : boolean; (* True if known the cursor position *)
hastab : boolean; (* local feature flags *)
hasdca : boolean;
lines : integer; (* Physical size of video screen *)
width : integer;
wrap : boolean;
unknown : boolean; (* Known wrap behavour? *)
UseReturn : boolean; (* Can we use CR to go to left margin? *)
Feat : features;
FillCharacter : char;
(* Behaviourism: *)
BeepStyle : char; (* 'A', 'N', or 'V'. *)
(* Initialization and deactivation strings. *)
InitString : long_string;
ExitString : long_string;
(* DCA control variables. *)
DcaLeadIn : cop;
DcaInter : cop;
DcaTrailing : cop;
decflag : boolean; (* DCA addresses in decimal? *)
colfirst : boolean;
rownegate : boolean;
colnegate : boolean;
exrange : boolean; (* Are there column exceptions? *)
rowoffset : integer;
coloffset : integer;
cxbegin : integer;
cxend : integer;
cxoffset : integer;
(* Region scroll control variables. *)
VT100Scroll : boolean; (* VT100 region scroll useable? *)
ILBegin : cop;
ILEnd : cop;
DLBegin : cop;
DLEnd : cop;
IDLmulti : boolean;
IDLdecimal : boolean;
IDLoffset : integer;
(* External procedures called from TERM *)
(* terminal routines from module TTYIO *)
procedure GetFSpec(var FileName: string; FileNumber: integer); external;
procedure SaveTerminalName(name: sixbytes); external;
procedure BadTTY; external;
PROCEDURE bug (bugstr: string); external;
PROCEDURE ttywrite (ch: char); external;
procedure TTyForce; external;
FUNCTION ttytype(var t: sixbytes): boolean; external;
FUNCTION ttywidth: integer; external;
procedure TtyLength(var l: integer); external;
FUNCTION ttyspeed: integer; external;
function TTyEight: boolean; external;
procedure TtyPrintable(var Printable: charset); external;
PROCEDURE ttyactivation (var is,es: long_string); external;
PROCEDURE monitor; external;
(* File handling functions from DSKIO *)
function DskOpen(FileName: string; Access: char): integer; external;
function DskRead(var p: dskbp): integer; external;
function DskClose: integer; external;
(* Utility routines from UTILITY *)
PROCEDURE putdec (var t: string; val,pos,size: integer); external;
(* Needed forward declarations ..*)
(*@VMS: [global] *)
PROCEDURE trmpos (row,col: integer); forward;
(* Local routines *)
PROCEDURE SendCursorOp (var s: cop); (* Send a cursor control *)
var (* string to terminal *)
i: integer;
begin
with s do for i := 1 to len do ttywrite (c[i]);
end;
procedure fill(n: integer); (* Send "n" fillers *)
var i: integer;
begin
for i := 1 to n do ttywrite(FillCharacter);
end;
procedure outcoord (n: integer); (* Prints integer *)
begin
if n>9 then begin (* if more than one digit *)
outcoord (n div 10); (* recursive call *)
end;
ttywrite (chr((n mod 10)+ord('0'))) (* write a digit *)
end; (* of outcoord *)
procedure trmhome; (* Set cursor at home pos *)
begin
SendCursorOp(c_home);
xpos := 0; ypos := 0;
cursor := true
end;
PROCEDURE trmup (n: integer); (* Move cursor up *)
var
i: integer;
begin
if n>0 then begin
ypos := ypos-n;
if ypos >= 0 then begin
for i:=1 to n do SendCursorOp (c_up);
end
else cursor := false;
end;
end;
PROCEDURE trmdown (n: integer); (* Move cursor down *)
var
i: integer;
begin
if n > 0 then begin
ypos := ypos+n;
if ypos < lines then begin
for i:=1 to n do SendCursorOp (c_down);
end
else cursor := false;
end;
end;
PROCEDURE trmright (n: integer); (* Move cursor forward *)
var
i: integer;
begin
if n>0 then begin
xpos := xpos+n;
if xpos < width then begin
for i:=1 to n do SendCursorOp (c_right);
end
else cursor := false;
end;
end;
PROCEDURE trmleft (n: integer); (* Move cursor backward *)
var
i: integer;
begin
if n > 0 then begin
xpos := xpos-n;
if xpos >= 0 then begin
for i:=1 to n do SendCursorOp (c_left);
end
else cursor := false;
end;
end;
procedure SetDefaultTerminal;
begin
with c_up do begin
c[1] := chr(escape);
c[2] := '[';
c[3] := 'A';
len := 3
end;
with c_down do begin
c[1] := chr(linefeed);
len := 1;
end;
with c_left do begin
c[1] := chr(ctrlH);
len := 1;
end;
with c_right do begin
c[1] := chr(escape);
c[2] := '[';
c[3] := 'C';
len := 3;
end;
with c_home do begin
c[1] := chr(escape);
c[2] := '[';
c[3] := 'H';
len := 3;
end;
with e_eol do begin
c[1] := chr(escape);
c[2] := '[';
c[3] := 'K';
len := 3;
end;
with e_screen do begin
c[1] := chr(escape);
c[2] := '[';
c[3] := 'H';
c[4] := chr(escape);
c[5] := '[';
c[6] := 'J';
len := 6;
end;
e_scr_ft := 100;
with DcaLeadIn do begin
c[1] := chr(escape);
c[2] := '[';
len := 2;
end;
with DcaInter do begin
c[1] := ';';
len := 1;
end;
with DcaTrailing do begin
c[1] := 'H';
len := 1;
end;
decflag := true;
colfirst := false;
rownegate := false;
colnegate := false;
exrange := false;
rowoffset := 1;
coloffset := 1;
InitString.len := 0;
ExitString.len := 0;
ic_on.len := 0;
ic_off.len := 0;
dc.len := 0;
width := 80;
lines := 24;
FillCharacter := chr(rubout);
UseReturn := true;
Feat := [up,down,left,right,eol,home,dca,clear];
wrap := false;
unknown := true;
end;
PROCEDURE settermdescr; (* Set all terminal dependant*)
var (* variables in the t_descr. *)
t_name: sixbytes;
n: integer;
found: boolean;
dskcode: integer;
endfile: boolean;
bufsize: integer;
diskbuffer: dskbp;
index: integer;
baudrate: integer;
default: boolean;
PROCEDURE parse; (* this proc parses one disk block of *)
var (* ASCII characters into a terminal descr *)
i: integer; (* The correct format is generated by the *)
c: char; (* MAKTRM program *)
dummy: cop;
dcaalg: integer;
scralg: integer;
FUNCTION getchar: char; (* This function returns the next character *)
label 9;
begin (* from the disk buffer *)
if not endfile then begin
if bufsize = 0 then begin (* check if empty buffer *)
dskcode := dskread (diskbuffer);
if dskcode = dskerror (* Read error *)
then bug('TERM: Disk read error in AMIS.TRM ');
if dskcode <= 0 then begin
endfile := true; (* end of file reached *)
getchar := ' '; (* return a space *)
goto 9; (* exit from procedure *)
end;
bufsize := dskcode; (* Set new buffer size *)
index := 1;
end;
getchar := diskbuffer^[index]; (* return next character *)
index := index + 1; bufsize := bufsize - 1;
end
else getchar := ' ';
9:
end;
FUNCTION getint (len: integer): integer; (* Read an integer that *)
var (* consists of len digits *)
n,i: integer;
begin
n := 0;
for i:=1 to len do n := 10 * n + (ord(getchar) - ord('0'));
getint := n;
end;
PROCEDURE get_cop (var t: cop);
var (* fill a record of type cop *)
i: integer; (* with data from the disk block *)
begin
with t do begin
len := getint (2);
for i:=1 to len do c[i] := getchar;
end;
end;
PROCEDURE get_long_string (var ls: long_string);
var (* fill a long_string with characters*)
i: integer;
begin
with ls do begin
len := getint (2);
for i:=1 to len do c[i] := getchar;
end;
end;
procedure getf(a: actions);
begin
if getchar = '1' then Feat := Feat + [a];
end;
procedure getflag(var b: boolean);
begin
b := (getchar = '1');
end;
begin (* Parse *)
for i:=1 to 6 do name[i] := getchar; (* this is the name *)
if not endfile then begin
SaveTerminalName(name);
get_cop (c_up);
get_cop (c_down);
get_cop (c_left);
get_cop (c_right);
get_cop (c_home);
get_cop (e_eol);
e_eol_ft := getint (4);
get_cop (e_screen);
e_scr_ft := getint (4);
get_cop (dummy);
dcaalg := getint (2);
get_cop (ic_on);
get_cop (ic_off);
get_cop (dc);
idch_ft := getint (4);
get_cop (dummy); (* ins_line *)
get_cop (dummy); (* del_line *)
idln_ft := getint (4);
scralg := getint (2);
get_cop (hi_on);
get_cop (hi_off);
get_long_string (InitString);
get_long_string (ExitString);
Feat := [];
getf(up);
getf(down);
getf(left);
getf(right);
getf(eol);
getf(home);
getf(dca);
getf(tab);
getf(clear);
getf(idchar);
getf(idline);
getf(hilite);
width := getint (3);
lines := getint (2);
c := getchar;
unknown := c = 'U';
wrap := c = 'T';
FillCharacter := chr(getint (3));
UseReturn := false; (* Just to be sure... *)
if (dca in Feat) and (dcaalg = 0)
then begin
get_cop(DcaLeadIn);
get_cop(DcaInter);
get_cop(DcaTrailing);
getflag(decflag);
getflag(colfirst);
getflag(rownegate);
getflag(colnegate);
getflag(exrange);
getflag(UseReturn);
rowoffset := getint(3);
coloffset := getint(3);
cxbegin := getint(3);
cxend := getint(3);
cxoffset := getint(3);
c := getchar;
end;
if (idline in Feat) and (scralg = 0)
then begin
getflag(VT100Scroll);
get_cop(ILBegin);
get_cop(ILEnd);
get_cop(DLBegin);
get_cop(DLEnd);
getflag(IDLmulti);
getflag(IDLdecimal);
IDLoffset := getint(3);
c := getchar;
end;
if dcaalg <> 0 then Feat := Feat - [dca];
if scralg <> 0 then Feat := Feat - [idline]
end;
c := getchar; c := getchar; (* skip CRLF between recs *)
end;
procedure ParseFile(Number: integer);
var
FileName: string;
begin (* ParseFile *)
GetFSpec(FileName, Number); (* Translate file number to name *)
DskCode := DskOpen(FileName, 'R');
Found := false; (* Indicate not found type *)
if DskCode = 0 then begin (* open succeded *)
BufSize := 0; (* Buffer is empty *)
EndFile := false; (* we have not seen end file *)
repeat
Parse;
Found := name = t_name;
until Found or EndFile;
DskCode := DskClose; (* Close file *)
end;
end; (* ParseFile *)
begin (* SetTermDescr *)
default := ttytype(t_name); (* get terminal model from monitor *)
ParseFile(Dsk_Init_File);
if not Found then ParseFile(Sys_Init_File);
if not Found then begin
if default (* Last chance: VT100 is built-in *)
then SetDefaultTerminal
else Badtty; (* We did not find it *)
end;
TtyLength(lines); (* Select length from OS, or use default. *)
n := ttywidth; (* get logical line length *)
if n <> width then begin (* check if smaller than physical *)
width := n; (* Use logical length anyway *)
wrap := false; (* this will make this work *)
end;
TtyActivation(InitString, ExitString); (* Setup init and exit strings *)
baudrate := ttyspeed; (* Get baud rate from monitor *)
e_eol_fc := (e_eol_ft * baudrate + 9999) div 10000;
e_scr_fc := (e_scr_ft * baudrate + 9999) div 10000;
idch_fc := (idch_ft * baudrate + 9999) div 10000;
idln_fc := (idln_ft * baudrate + 9999) div 10000;
end; (* of Set_term_descr *)
procedure DcaCoord(i: integer);
begin
if decflag
then outcoord(i)
else ttywrite(chr(i MOD 128));
end;
procedure XXXDCA(row, col: integer);
var
r, c : integer;
begin
if rownegate
then r := rowoffset - row
else r := rowoffset + row;
c := coloffset;
if exrange then begin
if (col >= cxbegin) and (col <= cxend)
then c := cxoffset;
end;
if colnegate
then c := c - col
else c := c + col;
SendCursorOp(DcaLeadIn);
if colfirst then DcaCoord(c) else DcaCoord(r);
SendCursorOp(DcaInter);
if colfirst then DcaCoord(r) else DcaCoord(c);
SendCursorOp(DcaTrailing);
end;
procedure stupid(row,col: integer);
begin
if abs(row-ypos)>row then trmhome;
if row>ypos then
trmdown (row-ypos)
else
trmup (ypos-row);
if (abs(col-xpos))>col then
if xpos<>0 then begin
ttywrite (chr(carriagereturn)); xpos := 0
end;
while xpos<>col do
if col>xpos then
if (xpos+8-(xpos mod 8)<=col) and hastab then begin
ttywrite (chr(ctrlI)); xpos := xpos+8-(xpos mod 8);
end
else
trmright (col-xpos)
else
trmleft (xpos-col);
end; (* of STUPID *)
procedure SetCursor(row,col: integer); (* Position the cursor *)
begin
if not hasdca
then stupid(row, col)
else begin
XXXDCA(row, col);
xpos := col;
ypos := row;
cursor := true;
end;
end;
procedure IDLarg(k: integer);
begin
if IDLdecimal
then outcoord(k + IDLoffset)
else ttywrite(chr((k + IDLoffset) MOD 128));
end;
procedure inslines (n, k: integer); (* Insert k lines at pos n *)
var
i: integer;
begin
trmpos(n,0); (* position the cursor *)
if IDLmulti then begin
SendCursorOp(ILBegin);
IDLarg(k);
SendCursorOp(ILEnd);
Fill(k * idln_fc);
end else for i := 1 to k do begin
SendCursorOp(ILBegin);
Fill(idln_fc);
end;
cursor := false;
end; (* of INSLINES *)
procedure dellines (n, k: integer); (* Delete k lines at pos n *)
var
i: integer;
begin
trmpos(n,0); (* position the cursor *)
if IDLmulti then begin
SendCursorOp(DLBegin);
IDLarg(k);
SendCursorOp(DLEnd);
Fill(k * idln_fc);
end else for i := 1 to k do begin
SendCursorOp(DLBegin);
Fill(idln_fc);
end;
cursor := false;
end; (* of DELLINES *)
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trmsize(var row, col: integer);
begin
row := lines;
col := width;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trmclr;
begin
SendCursorOp(e_screen);
xpos := 0;
ypos := 0;
cursor := true;
fill(e_scr_fc);
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trmeol;
begin
SendCursorOp(e_eol);
fill(e_eol_fc);
end;
(*---------------------------------------------------------------------------*)
procedure trmpos;
label 17;
var errmsg: string;
begin
if (row<0) or (row>=lines) or (col<0) or (col>=width) then begin
errmsg := 'TERM: TrmPos Row,Col= , ';
putdec (errmsg,row,22,3);
putdec (errmsg,col,26,3);
bug (errmsg)
end;
if not cursor then begin
if not hasdca then trmhome;
SetCursor(row,col); goto 17;
end;
if (row=ypos) and (col=xpos) then goto 17;
if col = 0 then begin
if row = 0 then begin
trmhome;
goto 17
end;
if UseReturn then begin
if row=ypos+1 then begin
ttywrite (chr(carriagereturn)); trmdown (1);
ypos := row; xpos := 0;
goto 17;
end;
if row=ypos then begin
ttywrite (chr(carriagereturn)); xpos := 0;
goto 17
end;
end; (* Use Return *)
end; (* col = 0 *)
if abs(row-ypos)+abs(col-xpos)<2 then begin
if col>xpos then
trmright (col-xpos)
else
trmleft (xpos-col);
if row>ypos then
trmdown (row-ypos)
else
trmup (ypos-row);
goto 17
end;
SetCursor(row,col);
17:
end; (* TrmPos *)
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure TrmWhere(var row, col: integer);
begin
row := ypos;
col := xpos;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure TrmBeep;
begin
if (BeepStyle = 'A') or ((BeepStyle = 'V') and (visibell.len = 0))
then begin
TTyWrite(Chr(Bell));
TTyForce;
end;
if (BeepStyle = 'V') and (visibell.len > 0)
then begin
SendCursorOp(visibell);
TTyForce;
end;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trmout(c: char);
begin
ttywrite(c);
xpos := xpos+1;
if xpos=width then begin
xpos := 0;
ypos := ypos+1;
if not wrap then begin
if unknown then begin
Cursor := false;
TrmPos(ypos,xpos);
end else begin
ttywrite(chr(carriagereturn));
ttywrite(chr(linefeed))
end;
end;
end;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trmich(c: char); (* Insert a character *)
begin
SendCursorOp(ic_on);
trmout(c);
SendCursorOp(ic_off);
fill(idch_fc);
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trmdch; (* Delete a character *)
begin
SendCursorOp(dc);
fill(idch_fc);
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure TrmFreeze;
begin
if VT100Scroll then begin (* Is this a VT100 or equiv? *)
ttywrite(chr(escape)); ttywrite('[');
ttywrite('1'); ttywrite('3'); ttywrite(';');
ttywrite('2'); ttywrite('4'); ttywrite('r');
cursor := false;
trmpos(ypos, xpos);
end;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trmscr(first,last,n: integer);
var
k: integer;
errmes: string;
begin
if (first<0) or (last>=lines) or (abs(n)>last-first+1) then begin
errmes := 'TERM: TrmScr Y1,Y2,N= , , ';
putdec (errmes,first,22,3);
putdec (errmes,last,26,3);
putdec (errmes,n,30,3);
bug (errmes)
end;
if VT100Scroll then begin
TtyWrite(chr(escape)); TtyWrite('[');
if first>0 then outcoord (first+1); (* Top margin *)
ttywrite (';');
outcoord (last+1); (* Bottom margin *)
ttywrite ('r');
xpos := 0; ypos := 0;
cursor := true;
if n<0 then begin (* Scroll down *)
trmpos (first,0);
for k:= -1 downto n do begin
ttywrite (chr(escape)); ttywrite ('M');
fill(idln_fc);
end;
end;
if n>0 then begin (* Scroll up *)
trmpos (last,0);
for k:= 1 to n do begin
ttywrite (chr(escape)); ttywrite ('D');
fill(idln_fc);
end;
end;
ttywrite(chr(escape)); ttywrite('['); (* Restore margins *)
ttywrite('r');
xpos := 0; ypos := 0;
cursor := true;
end else begin
if n < 0 then begin
DelLines(last + n + 1, -n);
InsLines(first, -n);
end;
if n > 0 then begin
DelLines(first, n);
InsLines(last - n + 1, n);
end;
end;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trmfeatures(var xyflag, eolflag, scrflag: boolean);
begin
xyflag := hasdca;
eolflag := eol in feat;
scrflag := idline in feat;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure TrmPrintable(var Printable: charset);
begin
TTyPrintable(printable);
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure trminv; (* Inverse video *)
begin
SendCursorOp(hi_on);
end;
(*@VMS: [global] *)
procedure trmniv; (* Normal video *)
begin
SendCursorOp(hi_off);
end;
(*---------------------------------------------------------------------------*)
(* Give terminalspecific estimate of cost for doing scroll *)
(* or character insert/delete. Cost is number of outputted *)
(* characters. *)
(*@VMS: [global] *)
procedure trmcst(var scrollcost, idcharcost: integer);
begin
scrollcost := 4 + 2 * idln_fc;
idcharcost := 4 + idch_fc;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure TrmFlags(flags: string);
var c: char;
begin
c := flags[9]; (* "Beep Style" *)
if c in ['A', 'N', 'V'] then BeepStyle := c;
end;
(*---------------------------------------------------------------------------*)
(*@VMS: [global] *)
procedure TrmInit;
begin (* Called by MAIN on start *)
SetTermDescr; (* Load term descriptor *)
hastab := tab in Feat; (* Get us some info locally *)
hasdca := dca in Feat;
xpos := 0; (* Reset internal positions to *)
ypos := 0; (* Something sensible *)
cursor := false; (* We dont know where the cursor is *)
BeepStyle := 'A'; (* Normally we beep user. *)
visibell.len := 0; (* Until... *)
end;
(*---------------------------------------------------------------------------*)
(*@TOPS: begin end. *)
(*@VMS: end. *)