|
|
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 - metrics - download
Length: 11392 (0x2c80)
Types: TextFile
Names: »CONFIG.PAS«
└─⟦a5a1ac263⟧ Bits:30003067 Diskette til vedligeholdelse af elevprogrammer på Piccolo
└─⟦this⟧ »CONFIG.PAS«
PROGRAM CONFIG; (*$A+R-*)
(* COMPAS V1.0 Reconfiguration Program *)
(* Copyright (C) 1982 by *)
(* Poly-Data microcenter ApS *)
TYPE
BYTE = 0..255;
SECTOR = ARRAYÆ0..127Å OF BYTE;
CPMFILE = FILE OF SECTOR;
CHAR = STRINGÆ1Å;
STR3 = STRINGÆ3Å;
STR16 = STRINGÆ16Å;
STR40 = STRINGÆ40Å;
VAR
I: INTEGER;
D,CH: CHAR;
MODIFY,CHANGE: BOOLEAN;
S1,S2: SECTOR;
F: CPMFILE;
FUNCTION NUMSTR(B: BYTE): STR3;
VAR
S: STR3;
BEGIN
B:=B AND $7F; S:='';
REPEAT
S:=CHR(B MOD 10+48)+S; B:=B DIV 10;
UNTIL B=0;
NUMSTR:=S;
END;
FUNCTION CHRSTR(B: BYTE): STR16;
TYPE
ASCIILIST = ARRAYÆ0..31Å OF STRINGÆ3Å;
CONST
ASCII = ASCIILIST
('NUL','SOH','STX','ETX','EOT','ENQ','ACK','BEL','BS','HT',
'LF','VT','FF','CR','SO','SI','DLE','DC1','DC2','DC3','DC4',
'NAK','SYN','ETB','CAN','EM','SUB','ESC','FS','GS','RS','US');
VAR
S: STR16;
BEGIN
B:=B AND $7F;
IF B<32 THEN CHRSTR:='CTRL/'+CHR(B+64)+' ('+ASCIIÆBÅ+')' ELSE
IF B<127 THEN CHRSTR:='"'+CHR(B)+'"' ELSE
CHRSTR:='RUBOUT (DEL)';
END;
FUNCTION ONOFF(B: BYTE): STR3;
BEGIN
IF B>=$80 THEN ONOFF:='ON' ELSE ONOFF:='OFF';
END;
FUNCTION XYORD(B: BYTE): STR3;
BEGIN
IF B>=$80 THEN XYORD:='XY' ELSE XYORD:='YX';
END;
PROCEDURE BACKSPACE(N: INTEGER);
VAR
I: INTEGER;
BEGIN
FOR I:=1 TO N DO WRITE(CHR(8),' ',CHR(8));
END;
PROCEDURE LINE(PROMPT,VALUE: STR40);
CONST
DOTS = '................................';
VAR
CH: CHAR;
BEGIN
WRITE(PROMPT,DOTSÆ1..36-LEN(PROMPT)Å,': ',VALUE);
IF MODIFY THEN
BEGIN
WRITE('Change (Y/N)? ':32-LEN(VALUE));
REPEAT GET(CH) UNTIL (CH='Y') OR (CH='N');
IF CH='Y' THEN BACKSPACE(32) ELSE BACKSPACE(14);
CHANGE:=CH='Y';
END ELSE CHANGE:=FALSE;
IF NOT CHANGE THEN WRITELN;
END;
PROCEDURE INPNUM(VAR B: BYTE; MIN,MAX,M: INTEGER);
VAR
N,P: INTEGER;
OK: BOOLEAN;
S: STR3;
BEGIN
IF CHANGE THEN
BEGIN
REPEAT
REPEAT
BUFLEN:=3; READ(S);
UNTIL S<>'';
P:=1; N:=0; OK:=TRUE;
WHILE OK AND (P<=LEN(S)) DO
BEGIN
IF (SÆPÅ>='0') AND (SÆPÅ<='9') THEN
N:=N*10+ORD(SÆPÅ)-48 ELSE
OK:=FALSE;
P:=SUCC(P);
END;
IF OK THEN OK:=(N>=MIN) AND (N<=MAX) AND (N MOD M=0);
IF NOT OK THEN BACKSPACE(LEN(S));
UNTIL OK;
B:=B AND $80 OR N;
WRITELN;
END;
END;
PROCEDURE INPCHR(VAR B: BYTE);
VAR
CH: CHAR;
BEGIN
IF CHANGE THEN
BEGIN
GET(CH); B:=B AND $80 OR ORD(CH) AND $7F;
WRITELN(CHRSTR(B));
END;
END;
PROCEDURE RONOFF(VAR B: BYTE);
BEGIN
IF CHANGE THEN
BEGIN
B:=B EXOR $80; WRITELN(ONOFF(B));
END;
END;
PROCEDURE RXYORD(VAR B: BYTE);
BEGIN
IF CHANGE THEN
BEGIN
B:=B EXOR $80; WRITELN(XYORD(B));
END;
END;
PROCEDURE WAIT;
BEGIN
WRITE('Press RETURN to continue...');
REPEAT GET(CH) UNTIL ORD(CH)=13;
BACKSPACE(27);
END;
PROCEDURE CRT;
VAR
I,J: INTEGER;
CH: CHAR;
PROCEDURE HELP;
BEGIN
WRITELN;
WRITELN('SCREEN WIDTH (IN CHARACTERS): This field defines the number');
WRITELN('of characters per line of your CRT. It must be a multiple of');
WRITELN('8 number between 8 and 120.');
WRITELN;
WRITELN('SCREEN HEIGHT (IN LINES): This field defines the number of');
WRITELN('lines per display screen of your CRT.');
WRITELN;
WRITELN('LEAD-IN CHARACTER: Some CRTs require a two-character sequence');
WRITELN('to exercise some of their functions. If the first character of');
WRITELN('all these sequences is the same, it can be set as the value of');
WRITELN('this field. The functions which require a lead-in must then');
WRITELN('have the value ON in their corresponding lead-in on/off field.');
WRITELN('Typically the lead-in character is CTRL/Æ (ESC).');
WRITELN; WAIT;
WRITELN('CLEAR TO END-OF-SCREEN CHARACTER: The character which erases');
WRITELN('the screen from the current cursor position to the end of the');
WRITELN('screen.');
WRITELN;
WRITELN('LEAD-IN AT CLEAR TO END-OF-SCREEN: ON if the above function re-');
WRITELN('quires a lead-in character, OFF otherwise.');
WRITELN;
WRITELN('CLEAR TO END-OF-LINE CHARACTER: The character which erases all');
WRITELN('characters from the current cursor position to the end of the');
WRITELN('line the cursor is on.');
WRITELN;
WRITELN('LEAD-IN AT CLEAR TO END-OF-LINE: ON if the above function re-');
WRITELN('quires a lead-in character, OFF otherwise.');
WRITELN; WAIT;
WRITELN('CURSOR ADDRESSING CHARACTER: The character which begins a random');
WRITELN('cursor addressing sequence.');
WRITELN;
WRITELN('LEAD-IN AT CURSOR ADDRESSING: ON if the above function requires');
WRITELN('a lead-in character, OFF otherwise.');
WRITELN;
WRITELN('COORDINATE OFFSET: The value to be added to each coordinate in');
WRITELN('a random cursor addressing sequence. Typically this field is set');
WRITELN('to 32 (an ASCII blank), meaning that the upper left corner is');
WRITELN('addressed by transmitting (X,Y)=(32,32).');
WRITELN;
WRITELN('COORDINATE TRANSMIT ORDER: The order in which the coordinates are');
WRITELN('transmitted in a random cursor addressing sequence. XY means X');
WRITELN('before Y.');
WRITELN; WAIT;
WRITELN('To modify a numeric value, enter the new value and press RETURN.');
WRITELN('To modify a character value, simply press the new character on');
WRITELN('the keyboard. ON/OFF values and XY/YX values will automatically');
WRITELN('revert to the opposite condition when changed.');
END;
BEGIN
I:=0; FOR J:=$2A TO $2E DO I:=I OR S1ÆJÅ;
IF I=0 THEN
BEGIN
WRITELN;
WRITELN('You are running on a non-standard version of COMPAS, and thus');
WRITELN('it is not possible to re-configure the CRT parameters. A copy');
WRITELN('of the standard version may be obtained through your dealer.');
END ELSE
BEGIN
MODIFY:=FALSE;
WRITELN; WRITELN('Current settings of CRT parameters:');
REPEAT
WRITELN;
LINE('Screen width (in characters)',NUMSTR(S1Æ$28Å));
INPNUM(S1Æ$28Å,8,80,8);
LINE('Screen height (in lines)',NUMSTR(S1Æ$29Å));
INPNUM(S1Æ$29Å,1,50,1);
LINE('Lead-in character',CHRSTR(S1Æ$2AÅ));
INPCHR(S1Æ$2AÅ);
LINE('Lead-in at clear to end-of-screen',ONOFF(S1Æ$2BÅ));
RONOFF(S1Æ$2BÅ);
LINE('Clear to end-of-screen character',CHRSTR(S1Æ$2BÅ));
INPCHR(S1Æ$2BÅ);
LINE('Lead-in at clear to end-of-line',ONOFF(S1Æ$2CÅ));
RONOFF(S1Æ$2CÅ);
LINE('Clear to end-of-line character',CHRSTR(S1Æ$2CÅ));
INPCHR(S1Æ$2CÅ);
LINE('Lead-in at cursor addressing',ONOFF(S1Æ$2DÅ));
RONOFF(S1Æ$2DÅ);
LINE('Cursor addressing character',CHRSTR(S1Æ$2DÅ));
INPCHR(S1Æ$2DÅ);
LINE('Coordinate offset',NUMSTR(S1Æ$2EÅ));
INPNUM(S1Æ$2EÅ,0,127,1);
LINE('Coordinate transmit order',XYORD(S1Æ$2EÅ));
RXYORD(S1Æ$2EÅ);
REPEAT
WRITELN;
WRITE('CRT parameters: C(hange, V(iew, H(elp, Q(uit: ');
REPEAT GET(CH) UNTIL (CH='C') OR (CH='V') OR (CH='H') OR (CH='Q');
WRITELN(CH);
IF CH='H' THEN HELP;
UNTIL CH<>'H';
MODIFY:=CH='C';
UNTIL CH='Q';
END;
END;
PROCEDURE KEYBOARD;
TYPE
KEYNAMELIST = ARRAYÆ$15..$27Å OF STRINGÆ7Å;
CONST
KEYNAME = KEYNAMELIST
('MODE','TAB','BACKSP','RETURN','CLEAR','RIGHT','LEFT',
'UP','DOWN','PREV','NEXT','BEGIN','END','FIND','CONT',
'REPLACE','RFNEXT','COPY','QUIT');
VAR
KEY: BYTE;
CH: CHAR;
PROCEDURE HELP;
BEGIN
WRITELN;
WRITELN('For a detailled explanation of each of the editor functions,');
WRITELN('please refer to the COMPAS Operating Manual, Section 3.');
WRITELN;
WRITELN('To change a character, simply type the new character on the');
WRITELN('keyboard. Note that the seven first characters are used to');
WRITELN('activate functions in both editor modes (move/edit). If one of');
WRITELN('these fields is set to a printable character it will be impos-');
WRITELN('sible to enter that character into the text using the edit mode.');
WRITELN('Therefore, the first seven characters should always be control');
WRITELN('characters (CTRL/A, CTRL/B, etc.) or special keys (RETURN, TAB,');
WRITELN('BACKSPACE, etc.). The remaining characters may be both control');
WRITELN('characters and/or printable characters.');
END;
BEGIN
MODIFY:=FALSE;
WRITELN; WRITELN('Current settings of keyboard parameters:');
REPEAT
WRITELN;
FOR KEY:=$15 TO $27 DO
BEGIN
LINE('Key for <'+KEYNAMEÆKEYÅ+'>',CHRSTR(S2ÆKEYÅ));
INPCHR(S2ÆKEYÅ);
END;
REPEAT
WRITELN;
WRITE('CRT parameters: C(hange, V(iew, H(elp, Q(uit: ');
REPEAT GET(CH) UNTIL (CH='C') OR (CH='V') OR (CH='H') OR (CH='Q');
WRITELN(CH);
IF CH='H' THEN HELP;
UNTIL CH<>'H';
MODIFY:=CH='C';
UNTIL CH='Q';
END;
PROCEDURE HELP;
BEGIN
WRITELN;
WRITELN('Press ''C'' to view/change the CRT parameters. These parameters');
WRITELN('define the size of your screen (characters per line, lines per');
WRITELN('screen), and the control character sequences used to exercise');
WRITELN('some of its functions.');
WRITELN;
WRITELN('Press ''K'' to view/change the keyboard parameters. These para-');
WRITELN('meters define the keystrokes used to command the editor.');
WRITELN;
WRITELN('Press ''Q'' to exit the CONFIG program. On exiting, you must spe-');
WRITELN('cify whether or not you want the changes you have made to be');
WRITELN('permanently recorded in the COMPAS.COM disk file.');
END;
BEGIN
WRITELN; WRITELN; WRITELN;
WRITELN(' COMPAS V1.0 Reconfiguration Program');
WRITELN;
WRITELN(' Copyright (C) 1982 by');
WRITELN(' Poly-Data microcenter ApS');
WRITELN; WRITELN;
WRITELN('This program is used to reconfigure COMPAS to operate with');
WRITELN('other terminals than the one it was originally set up for.');
WRITELN('Apart from actually modifying the tables contained in COMPAS,');
WRITELN('this program also enables you to examine CRT and keyboard');
WRITELN('interface parameters.');
REPEAT
WRITELN;
WRITE('On which drive can the COMPAS.COM file be found (A-P)? ');
REPEAT GET(D) UNTIL (D>='A') AND (D<='P');
WRITELN(D,':');
(*$I-*)
RESET(F,D+':COMPAS.COM');
(*$I+*)
I:=IORES;
IF I>0 THEN
BEGIN
WRITELN;
WRITELN('Sorry, but drive ',D,': contains no COMPAS.COM file. Please');
WRITELN('specify another drive, or insert the correct disk.');
RESET;
END;
UNTIL I=0;
SEEK(F,$00); GET(F,S1);
SEEK(F,$2E); GET(F,S2);
REPEAT
WRITELN; WRITE('Select: C(RT, K(eyboard, H(elp, Q(uit: ');
REPEAT GET(CH) UNTIL (CH='C') OR (CH='K') OR (CH='H') OR (CH='Q');
WRITELN(CH);
IF CH='C' THEN CRT ELSE
IF CH='K' THEN KEYBOARD ELSE
IF CH='H' THEN HELP;
UNTIL CH='Q';
WRITELN;
WRITE('Update disk file (Y/N)? ');
REPEAT GET(CH) UNTIL (CH='Y') OR (CH='N');
WRITELN(CH);
IF CH='Y' THEN
BEGIN
SEEK(F,$00); PUT(F,S1);
SEEK(F,$2E); PUT(F,S2);
CLOSE(F);
END;
END.
«eof»