⟦0377eaee4⟧

TextFile

PROGRAM CONFIG; æ$A+,C-,R-,W1å
LABEL EXIT;
TYPE
  STR4 = STRINGÆ4Å;
  STR5 = STRINGÆ5Å;
  STR8 = STRINGÆ8Å;
  STR12 = STRINGÆ12Å;
  STR16 = STRINGÆ16Å;
  STR24 = STRINGÆ24Å;
  STR32 = STRINGÆ32Å;
  STR36 = STRINGÆ36Å;
  CHARSET = SET OF CHAR;
  DATAREC = RECORD
	      WIDTH,HEIGHT: BYTE;
	      SCROLLF: BOOLEAN;
	      GXYLS: STR8;
	      GXYSS,GXYTS: STR4;
	      LINB4COL: BOOLEAN;
	      COOROFS,COORFMT: BYTE;
	      CESS,CELS: STR8;
	      GXYR,CESR,CELR: INTEGER;
	      PATCH: ARRAYÆ0..127Å OF BYTE;
	      CONFNAME: STR32;
	      BACKUPF,AUTOF: BOOLEAN;
	      KDELAY: INTEGER;
	      KEYS: ARRAYÆ1..2,1..24Å OF STR8;
	      ILNS,DLNS,RONS,ROFS: STR8;
	    END;
VAR
  CF: FILE;
  DF: FILE OF DATAREC;
  CFN: STR16;
  DATA,DBUF: DATAREC;
  LIST: ARRAYÆ1..50Å OF STR32;
  B1: ARRAYÆ0..255Å 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(YES: BOOLEAN): STR4;
BEGIN
  IF YES THEN YESNO:='YES' ELSE YESNO:='NO';
END;

FUNCTION KEYSEQ(KS: STR8): STR32;
VAR
  I: INTEGER;
  S: STR32;
BEGIN
  IF KS='' THEN KEYSEQ:='Undefined' ELSE
  BEGIN
    S:='';
    FOR I:=1 TO LEN(KS) DO
    CASE KSÆIÅ OF
      @32..@126,@128..@255: S:=S+'"'+KSÆIÅ+'" ';
      @8: S:=S+'BS ';
      @13: S:=S+'CR ';
      @27: S:=S+'ESC ';
      @127: S:=S+'DEL ';
    OTHERWISE
      S:=S+'^'+CHR(ORD(KSÆIÅ)+64)+' ';
    END;
    KEYSEQ:=COPY(S,1,LEN(S)-1);
  END;
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: BOOLEAN;
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');
  READYN:=S='YES'; WRITELN;
END;

FUNCTION SELECT(PROMPT: STR36; 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;

æ$I CFIGIF.PASå

PROCEDURE LSCONFIG(LOAD: BOOLEAN);
VAR
  I,C,CC: INTEGER;
  CH: CHAR;
  DONE: BOOLEAN;
  LS: STR4;

PROCEDURE LOADC;
VAR
  CH: CHAR;
BEGIN
  IF LISTÆ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(DF,C-1); WRITE(DF,DATA);
  LISTÆCÅ:=DATA.CONFNAME; 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),'. ',LISTÆ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>50 THEN CC:=1;
	  END;
    END;
  UNTIL DONE;
END;

PROCEDURE GETDATA;
VAR
  A,I,J: INTEGER;

PROCEDURE LVECT(VAR V: INTEGER; A: INTEGER);
BEGIN
  IF B1ÆAÅ=0 THEN V:=0 ELSE V:=B1ÆA+1Å+SWAP(B1ÆA+2Å);
END;

BEGIN
  WITH DATA DO
  BEGIN
    SEEK(CF,0); BLOCKREAD(CF,B1,2);
    A:=B1Æ1Å+SWAP(B1Æ2Å);
    B2S:=(A-$100) DIV 128; B2A:=(A-$100) MOD 128;
    SEEK(CF,B2S); BLOCKREAD(CF,B2,4);
    WIDTH:=B1Æ10Å;
    HEIGHT:=B1Æ11Å;
    SCROLLF:=B1Æ12Å=0;
    MOVE(B1Æ13Å,GXYLS,9);
    MOVE(B1Æ22Å,GXYSS,5);
    MOVE(B1Æ27Å,GXYTS,5);
    LINB4COL:=B1Æ32Å=0;
    COOROFS:=B1Æ33Å;
    COORFMT:=B1Æ34Å;
    MOVE(B1Æ35Å,CESS,9);
    MOVE(B1Æ44Å,CELS,9);
    LVECT(GXYR,53);
    LVECT(CESR,56);
    LVECT(CELR,59);
    MOVE(B1Æ64Å,PATCH,128);
    MOVE(B1Æ192Å,CONFNAMEÆ1Å,32);
    I:=223; WHILE (I>=192) AND (B1ÆIÅ=32) DO I:=I-1;
    CONFNAMEÆ0Å:=CHR(I-191);
    BACKUPF:=B2ÆB2A+5Å<>0;
    AUTOF:=B2ÆB2A+6Å<>0;
    KDELAY:=B2ÆB2A+7Å+SWAP(B2ÆB2A+8Å);
    A:=B2A+9;
    FOR I:=1 TO 2 DO FOR J:=1 TO 24 DO
    BEGIN
      MOVE(B2ÆAÅ,KEYSÆI,JÅ,B2ÆAÅ+1);
      A:=A+B2ÆAÅ+1;
    END;
    MOVE(B2ÆB2A+265Å,ILNS,9);
    MOVE(B2ÆB2A+274Å,DLNS,9);
    MOVE(B2ÆB2A+283Å,RONS,9);
    MOVE(B2ÆB2A+292Å,ROFS,9);
  END;
END;

PROCEDURE PUTDATA;
VAR
  A,I,J: INTEGER;

PROCEDURE SVECT(V,A: INTEGER);
BEGIN
  IF V=0 THEN
  BEGIN
    B1ÆAÅ:=$00; B1ÆA+1Å:=$B7; B1ÆA+2Å:=$C9;
  END ELSE
  BEGIN
    B1ÆAÅ:=$C3; B1ÆA+1Å:=LO(V); B1ÆA+2Å:=HI(V);
  END;
END;

BEGIN
  WITH DATA DO
  BEGIN
    B1Æ10Å:=WIDTH;
    B1Æ11Å:=HEIGHT;
    IF SCROLLF THEN B1Æ12Å:=0 ELSE B1Æ12Å:=255;
    MOVE(GXYLS,B1Æ13Å,9);
    MOVE(GXYSS,B1Æ22Å,5);
    MOVE(GXYTS,B1Æ27Å,5);
    IF LINB4COL THEN B1Æ32Å:=0 ELSE B1Æ32Å:=255;
    B1Æ33Å:=COOROFS;
    B1Æ34Å:=COORFMT;
    MOVE(CESS,B1Æ35Å,9);
    MOVE(CELS,B1Æ44Å,9);
    SVECT(GXYR,53);
    SVECT(CESR,56);
    SVECT(CELR,59);
    MOVE(PATCH,B1Æ64Å,128);
    MOVE(CONFNAMEÆ1Å,B1Æ192Å,LEN(CONFNAME));
    FOR I:=LEN(CONFNAME) TO 31 DO B1ÆI+192Å:=32;
    IF BACKUPF THEN B2ÆB2A+5Å:=255 ELSE B2ÆB2A+5Å:=0;
    IF AUTOF THEN B2ÆB2A+6Å:=255 ELSE B2ÆB2A+6Å:=0;
    B2ÆB2A+7Å:=LO(KDELAY);
    B2ÆB2A+8Å:=HI(KDELAY);
    A:=B2A+9;
    FOR I:=1 TO 2 DO FOR J:=1 TO 24 DO
    BEGIN
      MOVE(KEYSÆI,JÅ,B2ÆAÅ,LEN(KEYSÆI,JÅ)+1);
      A:=A+LEN(KEYSÆI,JÅ)+1;
    END;
    MOVE(ILNS,B2ÆB2A+265Å,9);
    MOVE(DLNS,B2ÆB2A+274Å,9);
    MOVE(RONS,B2ÆB2A+283Å,9);
    MOVE(ROFS,B2ÆB2A+292Å,9);
    SEEK(CF,0); BLOCKWRITE(CF,B1,2);
    SEEK(CF,B2S); BLOCKWRITE(CF,B2,4);
  END;
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;
  PRESSRETURN;
  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;
  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 V2.20 CONFIGURATION PROGRAM');
  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 NOT READYN THEN GOTO EXIT;
  WRITELN;
  ASSIGN(DF,'CONFIG.DAT'); æ$I-å RESET(DF) æ$I+å;
  IF IORES=0 THEN
  FOR I:=1 TO 50 DO
  BEGIN
    READ(DF,DBUF); LISTÆIÅ:=DBUF.CONFNAME;
  END ELSE
  BEGIN
    WRITELN('The CONFIG.DAT file is missing from the current drive. The');
    WRITELN('CONFIG program cannot be run without this file, so copy it');
    WRITELN('onto your disk, and run CONFIG again.');
    GOTO EXIT;
  END;
  REPEAT
    WRITE('Input file name (RETURN for COMPAS.COM)? ');
    BUFLEN:=14; READLN(CFN); WRITELN;
    IF CFN='' THEN CFN:='COMPAS.COM';
    ASSIGN(CF,CFN); æ$I-å RESET(CF) æ$I+å;
    I:=IORES;
    IF I>0 THEN
    BEGIN
      WRITELN('That file does not exist. Please specify another file');
      WRITELN('name. You may insert another disk if you wish.');
      WRITELN;
      BDOS(37,-1);
    END;
  UNTIL I=0;
  GETDATA;
  REPEAT
    WRITELN('CONFIGURATION PROGRAM MAIN MENU:');
    WRITELN;
    WRITELN('1. Load a standard configuration');
    WRITELN('2. Edit configuration parameters');
    WRITELN('3. Save a standard configuration');
    WRITELN;
    WRITELN('CURRENT CONFIGURATION: ',DATA.CONFNAME);
    WRITELN;
    CH:=SELECT('Function(1-3), Exit(X), Help(Y)',Æ'1'..'3','X','Y'Å);
    CASE CH OF
      '1': LSCONFIG(TRUE);
      '2': CONFIGURE;
      '3': LSCONFIG(FALSE);
      'Y': HELP;
    END;
  UNTIL CH='X';
  WRITE('Save configuration in ',CFN,' (YES/NO)? ');
  IF READYN THEN
  BEGIN
    PUTDATA; CLOSE(CF);
  END;
  CLOSE(DF);
  EXIT:
END.
«eof»
DataMuseum.dk

CP/M

⟦0377eaee4⟧ TextFile

Derivation

TextFile
