(* ------------------- VERSION 4 22.04.86 ------------------- *)
PACKET konfigurieren DEFINES (* Autor: D.Heinrichs *)
ansi cursor,
baudrate ,
bits ,
cursor logic ,
elbit cursor ,
enter incode ,
enter outcode ,
flow ,
input buffer size ,
link ,
new configuration ,
new type ,
ysize :
LET max dtype nr = 5, (* maximum number of active device tables *)
device table = 32000,
ack = 0 ;
INT VAR next outstring,
next instring;
BOUND STRUCT (ALIGN space, (* umsetzcodetabelle *)
ROW 128 INT outcodes,
ROW 64 INT outstrings,
ROW 64 INT instrings) VAR x;
ROW max dtype nr DATASPACE VAR device code table;
THESAURUS VAR dtypes ;
PROC new configuration :
dtypes := empty thesaurus ;
INT VAR i ;
insert (dtypes, "psi", i) ;
insert (dtypes, "transparent", i) ;
FOR i FROM 1 UPTO max dtype nr REP
forget (device code table (i))
PER .
ENDPROC new configuration ;
PROC block out (DATASPACE CONST ds, INT CONST page, code):
INT VAR err;
block out (ds,page,0,code,err);
announce error (err)
END PROC block out;
PROC announce error (INT CONST err):
SELECT err OF
CASE 0:
CASE 1: errorstop ("unbekanntes Terminalkommando")
CASE 2: errorstop ("Nummer der Terminal-Typ-Tabelle falsch")
CASE 3: errorstop ("falsche Terminalnummer")
OTHERWISE errorstop ("blockout: unzulaessiger Kanal")
ENDSELECT
END PROC announce error;
PROC flow (INT CONST nr, INT CONST dtype):
control (6, dtype, nr)
END PROC flow;
PROC ysize (INT CONST channel ,new size, INT VAR old size) :
control (11, channel, new size, old size)
ENDPROC ysize ;
PROC input buffer size (INT CONST nr,size):
INT VAR err;
control (2,nr,size,err)
END PROC input buffer size;
PROC baudrate (INT CONST nr, rate) :
control (8, rate, nr)
ENDPROC baudrate ;
PROC bits (INT CONST channel, number, parity) :
bits (channel, number-1 + 8*parity)
ENDPROC bits ;
PROC bits (INT CONST channel, key) :
control (9, key, channel)
ENDPROC bits ;
PROC control (INT CONST function, key, channel) :
INT VAR err ;
IF key > -128 AND key < 127
THEN control (function, channel, key, err)
ELIF key = -128
THEN control (function, channel, -maxint-1, err)
FI
ENDPROC control ;
PROC new type (TEXT CONST dtype):
x := new (dtype);
type (old (dtype), device table);
next outstring := 4;
next instring := 0;
INT VAR i;
(* Defaults, damit trmpret den cursor mitfuehrt: *)
FOR i FROM 1 UPTO 6 REP
enter outcode (i,i)
PER;
enter outcode (8,8);
enter outcode (10,10);
enter outcode (13,13);
enter outcode (14,126);
enter outcode (15,126);
END PROC new type;
INT PROC activate dtype (TEXT CONST dtype):
INT VAR i := link (dtypes, dtype);
IF (exists (dtype) CAND type (old (dtype)) = device table)
THEN IF i <= 0
THEN insert (dtypes, dtype, i);
FI;
forget(device code table (i-2));
device code table (i-2) := old (dtype)
FI;
IF i > max dtype nr +2 (* 5 neue Typen erlaubt *)
THEN delete (dtypes,i);
error stop ("Anzahl Terminaltypen > "+text (i));0
ELIF i <= 0
THEN error stop ("Unbekannter Terminaltyp" + dtype); 0
ELSE i
FI.
END PROC activate dtype;
PROC link (INT CONST nr, TEXT CONST dtype):
INT VAR lst nr := activate dtype (dtype)-3;
IF lst nr < 0
THEN lst nr INCR 256 (* fuer std terminal und std device *)
ELSE blockout (device code table(lst nr+1), 2, lst nr);
FI;
INT VAR err := 0;
control (1,nr,lst nr,err) ;
announce error(err)
END PROC link;
PROC enter outcode (INT CONST eumel code, ziel code):
IF ziel code < 128
THEN simple entry (eumel code, ziel code)
ELSE enter outcode (eumel code, 0, code (ziel code))
FI .
ENDPROC enter outcode ;
PROC simple entry (INT CONST eumel code, ziel code) :
INT CONST position := eumel code DIV 2 +1,
teil := eumel code - 2*position + 2;
TEXT VAR h :=" ";
replace (h,1,out word);
replace (h,1+teil,code (ziel code));
out word := (h ISUB 1).
out word: x.outcodes (position).
END PROC simple entry ;
PROC enter outcode (INT CONST eumel code, wartezeit,
TEXT CONST sequenz):
INT VAR i;
simple entry (eumel code, next outstring + 128);
enter part (x.outstrings, next outstring, wartezeit);
FOR i FROM 1 UPTO length (sequenz) REP
enter part (x.outstrings, next outstring + i, code (sequenzSUBi))
PER;
next outstring INCR length (sequenz)+2;
abschluss.
abschluss:
enter part (x.outstrings, next outstring-1, 0)
END PROC enter outcode;
PROC enter outcode (INT CONST eumelcode, TEXT CONST wert):
enter outcode (eumelcode,code(wert))
END PROC enter outcode;
PROC enter part (ROW 64 INT VAR a,INT CONST index, wert):
INT CONST position := index DIV 2 +1,
teil := index - 2*position + 2;
IF position > 64 THEN errorstop ("Ueberlauf der Terminaltyptabelle") FI;
TEXT VAR h :=" ";
replace (h,1,out word);
replace (h,1+teil,code (wert));
out word := (h ISUB 1).
out word: a (position).
END PROC enter part;
PROC enter incode (INT CONST elan code, TEXT CONST sequenz):
IF elan code > 254 OR elan code < 0 THEN errorstop ("kein Eingabecode")
ELSE
INT VAR i;
enter part (x.instrings, next instring, elan code);
FOR i FROM 1 UPTO length (sequenz) REP
enter part (x.instrings, next instring + i, code (sequenzSUBi))
PER;
next instring INCR length (sequenz)+2;
FI
END PROC enter incode;
PROC cursor logic (INT CONST dist, TEXT CONST pre, mid, post):
cursor logic (dist,255,pre,mid,post)
END PROC cursor logic;
PROC ansi cursor (TEXT CONST pre, mid, post):
cursor logic (0, 1, pre, mid, post)
END PROC ansi cursor;
PROC cursor logic (INT CONST dist, modus, TEXT CONST pre, mid, post):
enter part (x.outstrings,2,dist);
enter part (x.outstrings,3,dist);
enter part (x.outstrings,0,modus);
enter part (x.outstrings,1,modus);
enter outcode (6,0,pre+""0"y"+mid+""0"x"+post+""0"")
END PROC cursor logic;
PROC elbit cursor:
cursor logic (0,""27"","","");
enter part (x.outstrings,0,2);
enter part (x.outstrings,1,255);
END PROC elbit cursor;
ENDPACKET konfigurieren;