|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 29312 (0x7280)
Types: TextFile
Names: »INSTALL.PAS«
└─⟦c96461903⟧ Bits:30002787 SW1602 COMPAS Pascal Version 3.07 Release 1.1
└─ ⟦this⟧ »INSTALL.PAS«
PROGRAM INSTALL; (*$C-,K-,R-*)
CONST
MAXTERM = 40;
TYPE
STR2 = STRINGÆ2Å;
STR3 = STRINGÆ3Å;
STR4 = STRINGÆ4Å;
STR5 = STRINGÆ5Å;
STR8 = STRINGÆ8Å;
STR12 = STRINGÆ12Å;
STR16 = STRINGÆ16Å;
STR24 = STRINGÆ24Å;
STR31 = STRINGÆ31Å;
STR36 = STRINGÆ36Å;
STR48 = STRINGÆ48Å;
CHARSET = SET OF CHAR;
TNAMSTR = STRINGÆ31Å;
DATAREC = RECORD
TERMNAME: TNAMSTR;
WIDTH,HEIGHT: BYTE;
GXYLS: STR8;
GXYSS,GXYTS: STR4;
COLB4LIN,COOROFS,COORFMT: BYTE;
CLHS,CESS,CELS,ILNS,DLNS,RONS,ROFS: STR8;
PDATA: ARRAYÆ0..669Å OF BYTE;
BACKF,INSMF,AUTOF,TABSF: BYTE;
RDELAY: INTEGER;
ALTKEY: ARRAYÆ0..255Å OF BYTE;
END;
VAR
CF: FILE;
TF: FILE OF TNAMSTR;
DF: FILE OF DATAREC;
CFN: STR16;
DATA: DATAREC;
DSMIN,DSMAX: INTEGER;
TNAM: ARRAYÆ1..MAXTERMÅ OF STR31;
B1: ARRAYÆ0..1023Å OF BYTE;
B2: ARRAYÆ0..511Å OF BYTE;
I,B2S,B2A: INTEGER;
CH: CHAR;
FUNCTION UPCASE(S: STR24): STR24;
VAR
I: INTEGER;
U: STR24;
BEGIN
U:='';
FOR I:=1 TO LEN(S) DO
IF (SÆIÅ>='a') AND (SÆIÅ<='z') THEN
U:=U+CHR(ORD(SÆIÅ)-32) ELSE U:=U+SÆIÅ;
UPCASE:=U;
END;
FUNCTION HEX(NUMBER,DIGITS: INTEGER): STR4;
CONST
HEXDIGITS: ARRAYÆ0..15Å OF CHAR = '0123456789ABCDEF';
VAR
D: INTEGER;
H: STR4;
BEGIN
HÆ0Å:=CHR(DIGITS);
FOR D:=DIGITS DOWNTO 1 DO
BEGIN
HÆDÅ:=HEXDIGITSÆNUMBER AND 15Å;
NUMBER:=NUMBER SHR 4;
END;
HEX:=H;
END;
FUNCTION HEXSEQ(SEQ: STR8): STR24;
VAR
I: INTEGER;
S: STR24;
BEGIN
IF SEQ='' THEN HEXSEQ:='Unconfigured' ELSE
BEGIN
S:='';
FOR I:=1 TO LEN(SEQ) DO S:=S+HEX(ORD(SEQÆIÅ),2)+' ';
HEXSEQ:=COPY(S,1,LEN(S)-1);
END;
END;
FUNCTION YESNO(FLAG: INTEGER): STR4;
BEGIN
IF FLAG<>0 THEN YESNO:='YES' ELSE YESNO:='NO';
END;
PROCEDURE BACKSP(N: INTEGER);
VAR
I: INTEGER;
BEGIN
FOR I:=1 TO N DO WRITE(^H' '^H);
END;
FUNCTION READNUM(MIN,MAX: INTEGER): INTEGER;
VAR
N,P: INTEGER;
OK: BOOLEAN;
S: STR5;
BEGIN
REPEAT
BUFLEN:=5; READ(S);
IF S='' THEN OK:=FALSE ELSE
BEGIN
VAL(S,N,P);
OK:=(P=0) AND (N>=MIN) AND (N<=MAX);
END;
IF NOT OK THEN BACKSP(LEN(S));
UNTIL OK;
WRITELN; READNUM:=N;
END;
FUNCTION READSEQ(MAXLEN: INTEGER): STR8;
CONST
HEXDIGITS: SET OF '0'..'f' = Æ'0'..'9','A'..'F','a'..'f'Å;
VAR
D,H,N,P: INTEGER;
ERROR: BOOLEAN;
SEQ: STR8;
S: STR24;
BEGIN
REPEAT
BUFLEN:=23; READ(S); S:=S+^M;
ERROR:=FALSE; P:=1; N:=0;
REPEAT
WHILE SÆPÅ=' ' DO P:=P+1;
IF (SÆPÅ IN HEXDIGITS) AND (N<MAXLEN) THEN
BEGIN
H:=0;
REPEAT
IF SÆPÅ IN Æ'0'..'9'Å THEN D:=ORD(SÆPÅ)-48 ELSE
IF SÆPÅ IN Æ'A'..'F'Å THEN D:=ORD(SÆPÅ)-55 ELSE
D:=ORD(SÆPÅ)-87;
H:=H*16+D; P:=P+1;
UNTIL NOT(SÆPÅ IN HEXDIGITS);
N:=N+1; SEQÆNÅ:=CHR(H);
END;
IF NOT(SÆPÅ IN Æ^M,' 'Å) THEN ERROR:=TRUE;
UNTIL (SÆPÅ=^M) OR ERROR;
IF ERROR THEN BACKSP(LEN(S)-1);
UNTIL NOT ERROR;
SEQÆ0Å:=CHR(N); WRITELN;
READSEQ:=SEQ;
END;
FUNCTION READYN: INTEGER;
VAR
S: STR4;
BEGIN
REPEAT
BUFLEN:=3; READ(S); S:=UPCASE(S);
IF (S<>'YES') AND (S<>'NO') THEN BACKSP(LEN(S));
UNTIL (S='YES') OR (S='NO');
IF S='YES' THEN READYN:=255 ELSE READYN:=0;
WRITELN;
END;
FUNCTION SELECT(PROMPT: STR48; OKCH: CHARSET): CHAR;
VAR
CH: CHAR;
BEGIN
WRITE(PROMPT,': ');
REPEAT
READ(KBD,CH);
IF (CH>='a') AND (CH<='z') THEN CH:=CHR(ORD(CH)-32);
UNTIL CH IN OKCH;
IF CH=^M THEN BACKSP(LEN(PROMPT)+2) ELSE
BEGIN
WRITELN(CH); WRITELN;
END;
SELECT:=CH;
END;
PROCEDURE PRESSRETURN;
VAR
CH: CHAR;
BEGIN
WRITE('Press RETURN...');
REPEAT READ(KBD,CH) UNTIL CH=^M;
BACKSP(15);
END;
PROCEDURE RESETDISKS;
TYPE
REGPACK = RECORD
AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: INTEGER;
END;
VAR
REGS: REGPACK;
BEGIN
REGS.CX:=37; REGS.DX:=$FFFF; SWINT(224,REGS);
END;
PROCEDURE CONFIGURE;
VAR
CH: CHAR;
PROCEDURE CRT;
CONST
PA1: STR36 = 'A. Screen width (in characters)...: ';
PB1: STR36 = 'B. Screen height (in lines).......: ';
PC1: STR36 = 'C. GOTOXY lead-in sequence........: ';
PD1: STR36 = 'D. GOTOXY separator sequence......: ';
PE1: STR36 = 'E. GOTOXY terminator sequence.....: ';
PF1: STR36 = 'F. Line before column (YES/NO)....: ';
PG1: STR36 = 'G. Coordinate offset..............: ';
PH1: STR36 = 'H. Coordinate format (0/2/3)......: ';
PA2: STR36 = 'A. CLRHOM sequence................: ';
PB2: STR36 = 'B. CLREOS sequence................: ';
PC2: STR36 = 'C. CLREOL sequence................: ';
PD2: STR36 = 'D. INSLIN sequence................: ';
PE2: STR36 = 'E. DELLIN sequence................: ';
PF2: STR36 = 'F. RVSON sequence.................: ';
PG2: STR36 = 'G. RVSOFF sequence................: ';
VAR
SEC: INTEGER;
CH,MC,FIRST,LAST: CHAR;
PROCEDURE HELPS;
BEGIN
WRITELN('Character sequences are entered as sequences of hex values be-');
WRITELN('tween 00 and FF. Each hex value must be separated from the sur-');
WRITELN('rounding ones by at least one blank. To enter an empty sequence');
WRITELN('simply enter a blank line.');
WRITELN;
END;
PROCEDURE HELP1;
BEGIN
WRITELN('All fields on this submenu must be filled in for COMPAS to ope-');
WRITELN('rate correctly.');
WRITELN;
WRITELN('SCREEN WIDTH. This field defines the number of characters per');
WRITELN('line on your video display. If the display scrolls when writing');
WRITELN('a character to the bottom right character position, then specify');
WRITELN('the screen width less one.');
WRITELN;
WRITELN('SCREEN HEIGHT. This field defines the number of lines per screen');
WRITELN('on your video display. Always specify the exact value.');
WRITELN;
HELPS;
PRESSRETURN;
WRITELN('GOTOXY LEAD-IN SEQUENCE. The character sequence sent prior to');
WRITELN('the coordinates. The maximum length is 8.');
WRITELN;
WRITELN('GOTOXY SEPARATOR SEQUENCE. The character sequence sent between');
WRITELN('the coordinates. The maximum length is 4.');
WRITELN;
WRITELN('GOTOXY TERMINATOR SEQUENCE. The character sequence sent after');
WRITELN('the coordinates. The maximum length is 4.');
WRITELN;
WRITELN('LINE BEFORE COLUMN. This field should be set to YES if your');
WRITELN('video display requires the line coordinate (Y) to be sent');
WRITELN('before the column coordinate (X). Otherwise it should be set');
WRITELN('to NO.');
WRITELN;
PRESSRETURN;
WRITELN('COORDINATE OFFSET. This field defines the value (in decimal)');
WRITELN('to be added to the coordinates before they are transmitted.');
WRITELN('If the coordinate format (see below) is 0, then 32 is normally');
WRITELN('used. If the coordinate format is 2 or 3, then 0 or 1 is nor-');
WRITELN('mally used.');
WRITELN;
WRITELN('COORDINATE FORMAT. A value of 0 in this field indicates that');
WRITELN('the coordinates are to be transmitted as single bytes using');
WRITELN('binary format. Other values (2 or 3) indicate that the coor-');
WRITELN('dinates are to be transmitted as decimal character strings of');
WRITELN('2 or 3 characters.');
WRITELN;
PRESSRETURN;
END;
PROCEDURE HELP2;
BEGIN
HELPS;
WRITELN('CLRHOM SEQUENCE. The function sequence which clears the screen');
WRITELN('and returns the cursor to the top left corner. The maximum');
WRITELN('is 8. This function sequence must be specified for COMPAS to');
WRITELN('operate correctly');
WRITELN;
WRITELN('All of the following function sequences are optional. The maxi-');
WRITELN('mum length is 8 for all sequences.');
WRITELN;
WRITELN('CLREOS SEQUENCE. The function sequence which clears all charac-');
WRITELN('ter positions from the cursor to the end of the screen.');
WRITELN;
PRESSRETURN;
WRITELN('CLREOL SEQUENCE. The function sequence which clears all charac-');
WRITELN('ter positions from the cursor to the end of the current line.');
WRITELN;
WRITELN('INSLIN SEQUENCE. The function sequence which scrolls the current');
WRITELN('line, and all lines below it, down, and clears the current line.');
WRITELN;
WRITELN('DELLIN SEQUENCE. The function sequence which deletes the current');
WRITELN('line, and scrolls up all lines below it, with a blank line ap-');
WRITELN('pearing at the bottom. The maximum length is 8.');
WRITELN;
WRITELN('RVSON SEQUENCE. The function sequence which turns on reverse vi-');
WRITELN('deo (or increased intensity). If this function is specified, the');
WRITELN('editor will use it to highlight the status line.');
WRITELN;
WRITELN('RVSOFF SEQUENCE. The function sequence which turns off the at-');
WRITELN('tribute activated by the sequence above.');
WRITELN;
PRESSRETURN;
END;
BEGIN (*CRT*)
SEC:=1;
WITH DATA DO
REPEAT
WRITELN('CRT CONFIGURATION TABLE (SECTION ',SEC,'):');
WRITELN;
CASE SEC OF
1: BEGIN
WRITELN(PA1,WIDTH);
WRITELN(PB1,HEIGHT);
WRITELN(PC1,HEXSEQ(GXYLS));
WRITELN(PD1,HEXSEQ(GXYSS));
WRITELN(PE1,HEXSEQ(GXYTS));
WRITELN(PF1,YESNO(255-COLB4LIN));
WRITELN(PG1,COOROFS);
WRITELN(PH1,COORFMT);
END;
2: BEGIN
WRITELN(PA2,HEXSEQ(CLHS));
WRITELN(PB2,HEXSEQ(CESS));
WRITELN(PC2,HEXSEQ(CELS));
WRITELN(PD2,HEXSEQ(ILNS));
WRITELN(PE2,HEXSEQ(DLNS));
WRITELN(PF2,HEXSEQ(RONS));
WRITELN(PG2,HEXSEQ(ROFS));
END;
END;
WRITELN;
WRITELN('Press RETURN to view more');
WRITELN;
IF SEC=1 THEN MC:='H' ELSE MC:='G';
CH:=SELECT('Edit(A-'+MC+'), All(Z), Exit(X), Help(Y)',
Æ'A'..MC,'Z','X','Y',^MÅ);
IF CH=^M THEN SEC:=3-SEC ELSE
BEGIN
IF CH='Z' THEN
BEGIN
FIRST:='A'; LAST:=MC;
END ELSE
BEGIN
FIRST:=CH; LAST:=CH;
END;
FOR CH:=FIRST TO LAST DO
CASE SEC OF
1: CASE CH OF
'A': BEGIN
WRITE(PA1); WIDTH:=READNUM(40,255);
END;
'B': BEGIN
WRITE(PB1); HEIGHT:=READNUM(8,255);
END;
'C': BEGIN
WRITE(PC1); GXYLS:=READSEQ(8);
END;
'D': BEGIN
WRITE(PD1); GXYSS:=READSEQ(4);
END;
'E': BEGIN
WRITE(PE1); GXYTS:=READSEQ(4);
END;
'F': BEGIN
WRITE(PF1); COLB4LIN:=255-READYN;
END;
'G': BEGIN
WRITE(PG1); COOROFS:=READNUM(0,255);
END;
'H': BEGIN
WRITE(PH1); COORFMT:=READNUM(0,3);
END;
'Y': HELP1;
END;
2: CASE CH OF
'A': BEGIN
WRITE(PA2); CLHS:=READSEQ(8);
END;
'B': BEGIN
WRITE(PB2); CESS:=READSEQ(8);
END;
'C': BEGIN
WRITE(PC2); CELS:=READSEQ(8);
END;
'D': BEGIN
WRITE(PD2); ILNS:=READSEQ(8);
END;
'E': BEGIN
WRITE(PE2); DLNS:=READSEQ(8);
END;
'F': BEGIN
WRITE(PF2); RONS:=READSEQ(8);
END;
'G': BEGIN
WRITE(PG2); ROFS:=READSEQ(8);
END;
'Y': HELP2;
END;
END;
IF CH IN Æ'A'..MCÅ THEN WRITELN;
END;
UNTIL CH='X';
END;
PROCEDURE KEYBOARD;
TYPE
KEYREC = RECORD
VAL: BYTE; STR: STR12;
END;
CONST
STDKEY: ARRAYÆ1..40Å OF STR2 =
(^J,^S,^D,^A,^F,^Q^S,^Q^D,^E,^X,^Q^E,^Q^X,^R,^C,^Q^R,^Q^C,
@127,^G,^Q@127,^Q^Y,^T,^Y,^M,^I,^N,^V,^Z,^B,^W,^Q^F,^Q^A,
^L,^K^B,^K^K,^K^Y,^K^C,^K^V,^K^P,^K^H,^K^D,^K^X);
VAR
C,I,N,M: INTEGER;
CH,MC: CHAR;
S: STR12;
AKEY: ARRAYÆ1..40Å OF KEYREC;
FUNCTION KEYSTR(CH: CHAR): STR3;
BEGIN
CASE CH OF
@32..@126,@128..@255: KEYSTR:='"'+CH+'"';
@8: KEYSTR:='BS';
@13: KEYSTR:='CR';
@27: KEYSTR:='ESC';
@127: KEYSTR:='DEL';
OTHERWISE
KEYSTR:='^'+CHR(ORD(CH)+64);
END;
END;
FUNCTION KEYSEQ(KS: STR12): STR48;
VAR
I: INTEGER;
S: STR48;
BEGIN
S:='';
FOR I:=1 TO LEN(KS) DO S:=S+KEYSTR(KSÆIÅ)+' ';
KEYSEQ:=COPY(S,1,LEN(S)-1);
END;
PROCEDURE DELAKEY(I: INTEGER);
VAR
P: INTEGER;
BEGIN
FOR P:=I+1 TO N DO AKEYÆP-1Å:=AKEYÆPÅ; N:=N-1;
END;
PROCEDURE ADDAKEY;
VAR
I,L: INTEGER;
CH: CHAR;
S: STR12;
BEGIN
L:=0; FOR I:=1 TO N DO L:=L+LEN(AKEYÆNÅ.STR)+2;
IF (N=40) OR (L>240) THEN
WRITELN('No room for further definitions') ELSE
BEGIN
WRITE('Standard: ');
REPEAT
READ(KBD,CH);
I:=1; WHILE (I<40) AND (CH<>STDKEYÆIÅÆ1Å) DO I:=I+1;
IF STDKEYÆIÅÆ1Å=CH THEN
BEGIN
S:=CH; WRITE(KEYSEQ(CH),' '); L:=LEN(KEYSEQ(CH))+1;
IF LEN(STDKEYÆIÅ)=2 THEN
BEGIN
READ(KBD,CH); S:=S+CH;
I:=1; WHILE (I<40) AND (S<>STDKEYÆIÅ) DO I:=I+1;
IF S=STDKEYÆIÅ THEN
BEGIN
S:=S+CH; WRITE(KEYSEQ(CH),' '); L:=L+LEN(KEYSEQ(CH))+1;
END ELSE
BEGIN
S:=''; BACKSP(L);
END;
END;
END ELSE S:='';
UNTIL S<>'';
WRITE('':9-L,'Alternate: ');
S:='';
REPEAT
READ(KBD,CH);
IF (LEN(S)<12) AND (CH<>^M) THEN
BEGIN
IF LEN(S)>=1 THEN IF CH IN Æ^A..^ZÅ THEN CH:=CHR(ORD(CH)+64);
WRITE(KEYSTR(CH),' '); S:=S+CH;
END;
UNTIL CH=^M;
N:=N+1; AKEYÆNÅ.VAL:=I; AKEYÆNÅ.STR:=S;
WRITELN;
END;
WRITELN;
END;
PROCEDURE HELP;
BEGIN
WRITELN('To be able to benefit fully from the special keys offered by');
WRITELN('your terminal''s keyboard, COMPAS allows you to define alternate');
WRITELN('keys to invoke selected editor functions. A typical example of');
WRITELN('alternate keys is defining your cursor arrows to do the same as');
WRITELN('^S, ^D, ^E and ^X');
WRITELN;
WRITELN('To add an alternate key definition, you must first select the');
WRITELN('function for which you want to create an alternative. This you');
WRITELN('do by entering the standard key sequence, i.e. the sequence lis-');
WRITELN('ted in the manual. Once you have selected a function, you will');
WRITELN('be prompted for an alternate key sequence, to which you must an-');
WRITELN('swer by entering the alternate sequence. To end the alternate');
WRITELN('sequence, press RETURN.');
WRITELN;
WRITELN('Note that it is actually possible to override the standard key');
WRITELN('sequences. If you for instance define ^J to be an alternate key');
WRITELN('for the ^X function, the original ^J function will become inac-');
WRITELN('cessible unless you define an alternate sequence for it as well.');
WRITELN;
PRESSRETURN;
END;
BEGIN (*KEYBOARD*)
WITH DATA DO
BEGIN
I:=0; N:=0; C:=1;
WHILE ALTKEYÆIÅ<>0 DO
BEGIN
N:=N+1;
MOVE(ALTKEYÆIÅ,AKEYÆNÅ,ALTKEYÆI+1Å+2);
I:=I+ALTKEYÆI+1Å+2;
END;
REPEAT
WRITELN('ALTERNATE KEY DEFINITIONS:');
WRITELN;
IF N=0 THEN
BEGIN
WRITELN('No alternate keys defined'); WRITELN;
CH:=SELECT('Add(Z), Exit(X), Help(Y)',Æ'Z','X','Y'Å);
END ELSE
BEGIN
IF C+9>N THEN M:=N-C ELSE M:=9;
FOR I:=0 TO M DO
BEGIN
S:=KEYSEQ(STDKEYÆAKEYÆC+IÅ.VALÅ);
WRITE(CHR(I+65),'. Standard: ',S,'':9-LEN(S));
WRITELN('Alternate: ',KEYSEQ(AKEYÆC+IÅ.STR));
END;
IF N>10 THEN
BEGIN
WRITELN; WRITELN('Press RETURN to view more');
END;
WRITELN;
MC:=CHR(M+65);
CH:=SELECT('Delete(A-'+MC+'), Add(Z), Exit(X), Help(Y)',
Æ'A'..MC,'Z','X','Y',^MÅ);
END;
CASE CH OF
'A'..'J': DELAKEY(C+ORD(CH)-65);
'Z': ADDAKEY;
'Y': HELP;
^M: BEGIN
C:=C+10; IF C>N THEN C:=1;
END;
END;
UNTIL CH='X';
I:=0;
FOR N:=1 TO N DO
BEGIN
MOVE(AKEYÆNÅ,ALTKEYÆIÅ,LEN(AKEYÆNÅ.STR)+2);
I:=I+LEN(AKEYÆNÅ.STR)+2;
END;
FILL(ALTKEYÆIÅ,256-I,0);
END;
END;
PROCEDURE MISC;
CONST
PA: STR36 = 'A. Use BAK files (YES/NO).........: ';
PB: STR36 = 'B. Insert mode on (YES/NO)........: ';
PC: STR36 = 'C. Auto-indent on (YES/NO)........: ';
PD: STR36 = 'D. TABS mode on (YES/NO)..........: ';
PE: STR36 = 'E. Replace prompt delay...........: ';
PF: STR36 = 'F. Configuration name.............: ';
VAR
CH: CHAR;
PROCEDURE HELP;
BEGIN
WRITELN('USE BAK FILES. This field must be either YES or NO. If it is');
WRITELN('set to YES, duplicate files will have their type changed to');
WRITELN('BAK when the SAVE command is used to save a file. Otherwise,');
WRITELN('such files are simply deleted.');
WRITELN;
WRITELN('INSERT MODE ON. This field defined the initial state of the');
WRITELN('INSERT mode when COMPAS is cold-started. YES means on and NO');
WRITELN('means off.');
WRITELN;
WRITELN('AUTO-INDENT ON. This field defines the initial state of the');
WRITELN('auto-indent tabulator when COMPAS is cold-started.');
WRITELN;
WRITELN('TABS MODE ON. This field defines the initial state of the TABS');
WRITELN('mode when COMPAS is cold-started.');
WRITELN;
PRESSRETURN;
WRITELN('REPLACE PROMPT DELAY. This field is used only by the find/re-');
WRITELN('place function in the editor. It defines the delay used when mo-');
WRITELN('ving the cursor alternately between the replace prompt and the');
WRITELN('text. Experiment to find a suitable value (typical values range');
WRITELN('from 200 to 1000).');
WRITELN;
WRITELN('CONFIGURATION NAME. This field defines the name of the current');
WRITELN('configuration (usually, it is the name of your computer). Up to');
WRITELN('31 characters may be entered.');
WRITELN;
PRESSRETURN;
END;
BEGIN (*MISC*)
WITH DATA DO
REPEAT
WRITELN('MISCELLANEOUS DATA:');
WRITELN;
WRITELN(PA,YESNO(BACKF));
WRITELN(PB,YESNO(INSMF));
WRITELN(PC,YESNO(AUTOF));
WRITELN(PD,YESNO(TABSF));
WRITELN(PE,RDELAY);
WRITELN(PF,TERMNAME);
WRITELN;
CH:=SELECT('Edit(A-F), Exit(X), Help(Y)',Æ'A'..'F','X','Y'Å);
CASE CH OF
'A': BEGIN
WRITE(PA); BACKF:=READYN; WRITELN;
END;
'B': BEGIN
WRITE(PB); INSMF:=READYN; WRITELN;
END;
'C': BEGIN
WRITE(PC); AUTOF:=READYN; WRITELN;
END;
'D': BEGIN
WRITE(PD); TABSF:=READYN; WRITELN;
END;
'E': BEGIN
WRITE(PE); RDELAY:=READNUM(0,32767); WRITELN;
END;
'F': BEGIN
WRITE(PF); BUFLEN:=31; READLN(TERMNAME); WRITELN;
END;
'Y': HELP;
END;
UNTIL CH='X';
END;
PROCEDURE CLEAR;
BEGIN
WRITE('Clear configuration data (YES/NO)? ');
IF READYN<>0 THEN
BEGIN
FILL(DATA,SIZE(DATA),0);
WITH DATA DO
BEGIN
WIDTH:=79; HEIGHT:=24; GXYLS:=@27'=';
COOROFS:=32; CLHS:=@26; BACKF:=255;
INSMF:=255; AUTOF:=255; RDELAY:=1000;
END;
END;
WRITELN;
END;
PROCEDURE HELP;
BEGIN
WRITELN('To do a complete installation of COMPAS you should go through');
WRITELN('all functions of this menu (the order in which you do it is of');
WRITELN('no importance, as long as you make sure that all fields within');
WRITELN('all menus have be inspected and modified if necessary).');
WRITELN;
WRITELN('CRT CONFIGURATION. This function is used to view and/or modify');
WRITELN('the CRT configuration table and the user patch area.');
WRITELN;
WRITELN('KEYBOARD CONFIGURATION. This function is used to view and/or');
WRITELN('modify alternate key definitions.');
WRITELN;
WRITELN('MISCELLANEOUS DATA. This function allows you to view and/or');
WRITELN('modify various system informations.');
WRITELN;
WRITELN('CLEAR CONFIGURATION DATA. This function will initialize all con-');
WRITELN('figuration data fields to some appropriate default values. If');
WRITELN('you are about to install a new terminal, use this function be-');
WRITELN('fore the above ones - this will save you the trouble of manually');
WRITELN('removing the existing values.');
WRITELN;
PRESSRETURN;
END;
BEGIN (*CONFIGURE*)
WITH DATA DO
REPEAT
WRITELN('MAIN CONFIGURATION MENU:');
WRITELN;
WRITELN('1. CRT configuration');
WRITELN('2. Keyboard configuration');
WRITELN('3. Miscellaneous data');
WRITELN('4. Clear configuration data');
WRITELN;
CH:=SELECT('Function(1-4), Exit(X), Help(Y)',Æ'1'..'4','X','Y'Å);
CASE CH OF
'1': CRT;
'2': KEYBOARD;
'3': MISC;
'4': CLEAR;
'Y': HELP;
END;
UNTIL CH='X';
END;
PROCEDURE LSCONFIG(LOAD: BOOLEAN);
VAR
I,C,CC: INTEGER;
CH: CHAR;
DONE: BOOLEAN;
LS: STR4;
PROCEDURE LOADC;
VAR
CH: CHAR;
BEGIN
IF TNAMÆCÅ<>'' THEN
BEGIN
SEEK(DF,C-1); READ(DF,DATA); DONE:=TRUE;
END ELSE
BEGIN
WRITE('ERROR: Undefined configuration. Press RETURN...');
REPEAT READ(KBD,CH) UNTIL CH=^M;
BACKSP(47);
END;
END;
PROCEDURE SAVEC;
BEGIN
SEEK(TF,C-1); WRITE(TF,DATA.TERMNAME);
SEEK(DF,C-1); WRITE(DF,DATA);
TNAMÆCÅ:=DATA.TERMNAME; DONE:=TRUE;
END;
PROCEDURE LOADH;
BEGIN
WRITELN('To load a standard configuration, simply press the letter de-');
WRITELN('noting that configuration. If none of the standard configura-');
WRITELN('tions mentioned match your computer system, you will have to');
WRITELN('install COMPAS manually (using function 2 on the main menu).');
WRITELN;
PRESSRETURN;
END;
PROCEDURE SAVEH;
BEGIN
WRITELN('To save the current configuration as a standard configuration,');
WRITELN('use the RETURN key to move to a section that contains an empty');
WRITELN('entry, and enter the letter of that entry. You may, if you wish');
WRITELN('save the current configuration on top of an existing configura-');
WRITELN('tion, in which case that cofiguration is lost. Note that if the');
WRITELN('terminal name of the configuration you save is empty, you will');
WRITELN('not be able to load the configuration again.');
WRITELN;
PRESSRETURN;
END;
BEGIN (*LSCONFIG*)
CC:=1; DONE:=FALSE; IF LOAD THEN LS:='Load' ELSE LS:='Save';
REPEAT
WRITELN('STANDARD CONFIGURATIONS (MENU ',(CC+9) DIV 10,'):');
WRITELN;
FOR I:=0 TO 9 DO
WRITELN(CHR(I+65),'. ',TNAMÆCC+IÅ);
WRITELN;
WRITELN('Press RETURN to view more');
WRITELN;
CH:=SELECT(LS+'(A-J), Exit(X), Help(Y)',Æ'A'..'J','X','Y',^MÅ);
CASE CH OF
'A'..'J': BEGIN
C:=CC+ORD(CH)-65; IF LOAD THEN LOADC ELSE SAVEC;
END;
'X': DONE:=TRUE;
'Y': IF LOAD THEN LOADH ELSE SAVEH;
^M: BEGIN
CC:=CC+10; IF CC>MAXTERM THEN CC:=1;
END;
END;
UNTIL DONE;
END;
PROCEDURE MEMORY;
CONST
PA: STR36 = 'A. Minimum memory size in Kbytes..: ';
PB: STR36 = 'B. Maximum memory size in Kbytes..: ';
VAR
CH: CHAR;
PROCEDURE HELP;
BEGIN
WRITELN('MINIMUM MEMORY SIZE. This field defines the minimum number of');
WRITELN('bytes you want allocated for the COMPAS workspace. Note that if');
WRITELN('this amount of memory is not available, COMPAS cannot be run.');
WRITELN('The minimum memory size cannot be less than 8K.');
WRITELN;
WRITELN('MAXIMUM MEMORY SIZE. This field defines the maximum number of');
WRITELN('bytes you want allocated for the COMPAS workspace. When COMPAS');
WRITELN('is invoked, CP/M-86 will never allocate more memory for it than');
WRITELN('this field requests. If you want as much memory as possible,');
WRITELN('enter a number which is larger than the total amount of memory');
WRITELN('in your system.');
WRITELN;
END;
BEGIN (*MEMORY*)
REPEAT
WRITELN('MEMORY ALLOCATION PARAMETERS:');
WRITELN;
WRITELN(PA,DSMIN);
WRITELN(PB,DSMAX);
WRITELN;
CH:=SELECT('Edit(A-B), Exit(X), Help(Y)',Æ'A','B','X','Y'Å);
CASE CH OF
'A': BEGIN
WRITE(PA); DSMIN:=READNUM(8,900); WRITELN;
IF DSMAX<DSMIN THEN DSMAX:=DSMIN;
END;
'B': BEGIN
WRITE(PB); DSMAX:=READNUM(DSMIN,900); WRITELN;
END;
'Y': HELP;
END;
UNTIL CH='X';
END;
PROCEDURE GETDATA;
VAR
A: INTEGER;
BEGIN
SEEK(CF,0); BLOCKREAD(CF,B1,8);
A:=B1Æ$81Å+SWAP(B1Æ$82Å)+6;
B2S:=A DIV 128+1; B2A:=A MOD 128;
SEEK(CF,B2S); BLOCKREAD(CF,B2,4);
MOVE(B1Æ$A0Å,DATA.TERMNAME,$315);
MOVE(B2ÆB2AÅ,DATA.BACKF,$106);
DSMIN:=(B1Æ$0EÅ+SWAP(B1Æ$0FÅ)) SHR 6;
DSMAX:=(B1Æ$10Å+SWAP(B1Æ$11Å)) SHR 6;
END;
PROCEDURE PUTDATA;
VAR
I: INTEGER;
BEGIN
MOVE(DATA.TERMNAME,B1Æ$A0Å,$315);
MOVE(DATA.BACKF,B2ÆB2AÅ,$106);
I:=DSMIN SHL 6; B1Æ$0EÅ:=LO(I); B1Æ$0FÅ:=HI(I);
I:=DSMAX SHL 6; B1Æ$10Å:=LO(I); B1Æ$11Å:=HI(I);
SEEK(CF,0); BLOCKWRITE(CF,B1,8);
SEEK(CF,B2S); BLOCKWRITE(CF,B2,4);
END;
PROCEDURE HELP;
BEGIN
WRITELN('LOAD STANDARD CONFIGURATION. This function is used to load a');
WRITELN('standard configuration, i.e. to load all the parameters that');
WRITELN('define a specific computer system. If your computer system is');
WRITELN('among the standard configurations, then all you need to do to');
WRITELN('install COMPAS is to load that configuration and exit. If it');
WRITELN('is not, you must define your computer system manually, using');
WRITELN('the function described below.');
WRITELN;
WRITELN('EDIT CONFIGURATION PARAMETERS. This function is used to set up');
WRITELN('new configurations and to edit an existing configuration. It');
WRITELN('allows you to view and/or modify all parameters that define a');
WRITELN('specific computer system. If your computer is not mentioned in');
WRITELN('the list of standard configurations (see above), you must use');
WRITELN('this function to define it manually.');
WRITELN;
PRESSRETURN;
WRITELN('EDIT MEMORY ALLOCATION PARAMETERS. When the standard version of');
WRITELN('COMPAS is executed, it allocates all available memory for its');
WRITELN('workspace, since this is usually what you would want. If you are');
WRITELN('running Concurrent CP/M-86, this will however prevent you from');
WRITELN('activating other programs, since there is no memory for them,');
WRITELN('and you may then want to adjust the memory allocation parameters');
WRITELN('using this function.');
WRITELN;
WRITELN('SAVE A STANDARD CONFIGURATION. This function is used to add');
WRITELN('an entry to the list of standard configurations. Normally, you');
WRITELN('will not need to use this function.');
WRITELN;
PRESSRETURN;
END;
BEGIN
WRITELN;
WRITELN(' COMPAS-86 V3.07 INSTALL PROGRAM');
WRITELN(' CP/M-86 version');
WRITELN;
WRITELN(' Copyright (C) 1983 by');
WRITELN(' Poly-Data microcenter ApS');
WRITELN;
WRITELN;
WRITELN('This program is used to view and/or modify the configuration');
WRITELN('parameters of COMPAS. If you have bought an unconfigured copy');
WRITELN('of COMPAS, you should use this program to define your computer');
WRITELN('system before running COMPAS. If your copy is already set up');
WRITELN('for a specific computer system, there is no need to run this');
WRITELN('program, unless you wish to make changes to suit your indivi-');
WRITELN('dual needs.');
WRITELN;
WRITE('Do you wish to proceed (YES/NO)? ');
IF READYN=0 THEN HALT;
WRITELN;
ASSIGN(TF,'INSTALL.TRM'); ASSIGN(DF,'INSTALL.DAT');
(*$I-*) RESET(TF); RESET(DF); (*$I+*)
IF IORES=0 THEN
FOR I:=1 TO MAXTERM DO READ(TF,TNAMÆIÅ) ELSE
BEGIN
WRITELN('The INSTALL.TRM and INSTALL.DAT files are not present on the');
WRITELN('current drive. The INSTALL program cannot be run without these');
WRITELN('files, so copy them onto your disk, and run INSTALL again.');
HALT;
END;
REPEAT
WRITE('Input file name (RETURN for COMPAS.CMD)? ');
BUFLEN:=14; READLN(CFN); WRITELN;
IF CFN='' THEN CFN:='COMPAS.CMD';
ASSIGN(CF,CFN); (*$I-*) RESET(CF) (*$I+*);
I:=IORES;
IF I>0 THEN
BEGIN
WRITELN('That file does not exist. Please specify another file name.');
WRITELN('You may insert another disk if you wish.');
WRITELN;
RESETDISKS;
END;
UNTIL I=0;
GETDATA;
REPEAT
WRITELN('COMPAS-86 INSTALL PROGRAM MAIN MENU:');
WRITELN;
WRITELN('1. Load a standard configuration');
WRITELN('2. Edit configuration parameters');
WRITELN('3. Edit memory allocation parameters');
WRITELN('4. Save a standard configuration');
WRITELN;
WRITE('CURRENT CONFIGURATION: ');
IF DATA.TERMNAME<>'' THEN
WRITELN(DATA.TERMNAME) ELSE WRITELN('No terminal selected');
WRITELN;
CH:=SELECT('Function(1-4), Exit(X), Help(Y)',Æ'1'..'4','X','Y'Å);
CASE CH OF
'1': LSCONFIG(TRUE);
'2': CONFIGURE;
'3': MEMORY;
'4': LSCONFIG(FALSE);
'Y': HELP;
END;
UNTIL CH='X';
WRITE('Save configuration in ',CFN,' (YES/NO)? ');
IF READYN<>0 THEN
BEGIN
PUTDATA; CLOSE(CF);
END;
CLOSE(TF); CLOSE(DF);
END.
«eof»