home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 25 / CD_ASCQ_25_1095.iso / dos / prg / cpe50 / cpesetup.pas < prev    next >
Pascal/Delphi Source File  |  1995-09-01  |  9KB  |  294 lines
  1. PROGRAM CPE_Setup;
  2.  
  3. USES CRT;
  4.  
  5. {$L joystick.obj}
  6.  
  7. CONST pcnt = 24;
  8. CONST hexnums: ARRAY[0..15] OF CHAR = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  9.  
  10. VAR f: FILE OF WORD;
  11.     a: STRING;
  12.     c: CHAR;
  13.     i: INTEGER;
  14.     j: INTEGER;
  15.     jx,jy:LONGINT;
  16.     fault: BOOLEAN;
  17.  
  18. TYPE preftype = (prefhex, prefyesno, prefcpc, prefprt, prefsound, prefjoy);
  19.      prefgroup= (general, cpe, cpe2);
  20.  
  21. CONST prefs: ARRAY[0..pcnt] OF
  22.                    RECORD
  23.                      text:   STRING[80];
  24.                      mode:   preftype;
  25.                      defval: WORD;
  26.                      ptype:  prefgroup;
  27.                      value:  WORD;
  28.                    END
  29.     = ( (text: 'Soundblaster delay (0x23)'; mode: prefhex; defval: $23; ptype: general),
  30.         (text: 'Overscan graphics mode'; mode: prefhex; defval: $6A; ptype: cpe),
  31.         (text: 'Double lines in overscan mode'; mode: prefyesno; defval: 1; ptype: cpe),
  32.         (text: 'Installed sound card'; mode: prefsound; defval: 0; ptype: general),
  33.         (text: 'Soundcard base address (0x220)'; mode: prefhex; defval: $220; ptype: general),
  34.         (text: 'Printer port'; mode: prefprt; defval: 1; ptype: general),
  35.         (text: 'Screen length in 50Hz mode (0x6E)'; mode: prefhex; defval: $6E; ptype: cpe),
  36.         (text: 'CPC model'; mode: prefcpc; defval: 3; ptype: general),
  37.         (text: 'Screen refresh rate'; mode: prefhex; defval: 1; ptype: cpe2),
  38.         (text: 'Use VESA mode 800x600'; mode: prefyesno; defval: 0; ptype: cpe2),
  39.         (text: 'Use only a small screen in VESA mode'; mode: prefyesno; defval: 0; ptype: cpe2),
  40.         (text: 'Use graphical menus VESA mode'; mode: prefyesno; defval: $FFFF; ptype: cpe2),
  41.         (text: 'Enable EMS'; mode: prefyesno; defval: $FFFF; ptype: general),
  42.         (text: 'Soundcard interrupt'; mode: prefhex; defval: 11; ptype: general),
  43.         (text: 'Quiet cassette mode'; mode: prefyesno; defval: $FFFF; ptype: general),
  44.         (text: 'Use borders in 800x600 VESA mode'; mode: prefyesno; defval: $FFFF; ptype: cpe2),
  45.         (text: 'Green monitor'; mode: prefyesno; defval: 0; ptype: general),
  46.         (text: 'Use sound'; mode: prefyesno; defval: 0; ptype: general),
  47.         (text: 'Use Soundblaster noise generator'; mode: prefyesno; defval: $FFFF; ptype: general),
  48.         (text: 'Use german keyboard'; mode: prefyesno; defval: 0; ptype: general),
  49.         (text: 'Use joystick'; mode: prefyesno; defval: 0; ptype: general),
  50.         (text: 'Calibrate joystick'; mode: prefjoy; defval: 1; ptype: general),
  51.         (text: 'dummy'; mode: prefjoy; defval: 1; ptype: general),
  52.         (text: 'dummy'; mode: prefjoy; defval: 1; ptype: general),
  53.         (text: 'dummy'; mode: prefjoy; defval: 1; ptype: general)
  54.       );
  55.  
  56. VAR setupmode: prefgroup;
  57.     menuchar: CHAR;
  58.  
  59. FUNCTION Hex(i: WORD): STRING;
  60. VAR s: STRING;
  61. BEGIN
  62.   s := '';
  63.   REPEAT
  64.     s := hexnums[i AND 15] + s; i := i shr 4;
  65.   UNTIL i = 0;
  66.   Hex := '0x' + s;
  67. END;
  68.  
  69. FUNCTION YesNo(i: WORD):STRING;
  70. BEGIN
  71.   IF i = 0 THEN YesNo := 'No' ELSE YesNo := 'Yes';
  72. END;
  73.  
  74. FUNCTION CPC(i: WORD): STRING;
  75. BEGIN
  76.   CASE i OF
  77.     1: CPC := '464';
  78.     2: CPC := '664';
  79.     3: CPC := '6128';
  80.   END;
  81. END;
  82.  
  83. PROCEDURE GetCPC(VAR w: WORD);
  84. BEGIN
  85.   REPEAT
  86.     Write('Enter 1 for 464, 2 for 664 or 3 for 6128: ');
  87.     Readln(w);
  88.   UNTIL (w>=1) AND (w<=3);
  89. END;
  90.  
  91. FUNCTION SoundCard(i: WORD): STRING;
  92. BEGIN
  93.   CASE i OF
  94.     0: SoundCard := 'None';
  95.     1: SoundCard := 'SoundBlaster';
  96.     2: SoundCard := 'GUS';
  97.   END;
  98. END;
  99.  
  100. PROCEDURE GetSound(VAR w: WORD);
  101. BEGIN
  102.   REPEAT
  103.     Write('Enter 0 for none, 1 for SoundBlaster and 2 for GUS: ');
  104.     Readln(w);
  105.   UNTIL (w>=0) AND (w<=2);
  106. END;
  107.  
  108. PROCEDURE GetJoy; far; external;
  109.  
  110. PROCEDURE GetHex(VAR w: WORD);
  111. VAR a: STRING;
  112.     v: BYTE;
  113.     err: BOOLEAN;
  114. BEGIN
  115.   writeln;
  116.   REPEAT
  117.     err := TRUE;
  118.     write('Enter new value in hexadecimal notation: 0x');
  119.     readln(a);
  120.     IF Length(a) > 4 THEN writeln('Illegal value!') ELSE BEGIN
  121.       w := 0;
  122.       err := FALSE;
  123.       WHILE Length(a) > 0 DO BEGIN
  124.         v := Ord(a[1]);
  125.         IF (v>=97) AND (v<=102) THEN v := v - 32;
  126.         IF (v>=65) AND (v<=70) THEN v := v - 55;
  127.         IF (v>=Ord('0')) AND (v<=Ord('9')) THEN v := v - Ord('0');
  128.         IF v > 15 THEN BEGIN err := TRUE; writeln('Illegal character!'); END;
  129.         w := w*16+v; a:= Copy(a,2,Length(a)-1);
  130.       END;
  131.     END;
  132.   UNTIL NOT err;
  133. END;
  134.  
  135. PROCEDURE GetYesNo(VAR w: WORD);
  136. VAR a: STRING;
  137. BEGIN
  138.   writeln;
  139.   write('Type Y if you want to enable this option: '); readln(a);
  140.   w := 0;
  141.   IF a[1] = 'Y' THEN w := $FFFF;
  142.   IF a[1] = 'y' THEN w := $FFFF;
  143. END;
  144.  
  145. PROCEDURE Calibrate;
  146. VAR x,y: WORD;
  147. BEGIN
  148.   ASM
  149.     MOV AX,8400h
  150.     MOV DX,1
  151.     INT 15h
  152.     MOV x,AX
  153.     OR  x,BX
  154.   END;
  155.   IF x = 0 THEN BEGIN
  156.     writeln('No joystick connected! Press a key');
  157.     REPEAT UNTIL KeyPressed;
  158.   END ELSE BEGIN
  159.     writeln('Move joystick to upper left and push button 0!');
  160.     REPEAT
  161.       ASM
  162.         MOV AH,84h
  163.         XOR DX,DX
  164.         INT 15h
  165.         AND AX,30h
  166.         MOV x,AX
  167.       END;
  168.     UNTIL x = 32;
  169.     writeln('Getting coordinates');
  170.     GetJoy;
  171.     REPEAT
  172.       ASM
  173.         MOV AH,84h
  174.         XOR DX,DX
  175.         INT 15h
  176.         AND AX,30h
  177.         MOV x,AX
  178.       END;
  179.     UNTIL x = 48;
  180.     prefs[pcnt-3].value := jx; prefs[pcnt-2].value := jy;
  181.     writeln('JX: ',jx,' JY: ',jy);
  182.     writeln('Move joystick to lower right and push button 1!');
  183.     REPEAT
  184.       ASM
  185.         MOV AH,84h
  186.         XOR DX,DX
  187.         INT 15h
  188.         AND AX,30h
  189.         MOV x,AX
  190.       END;
  191.     UNTIL x = 16;
  192.     writeln('Getting coordinates');
  193.     GetJoy;
  194.     writeln('JX: ',jx,' JY: ',jy);
  195.     prefs[pcnt-1].value := jx; prefs[pcnt].value := jy;
  196.     x := prefs[pcnt-1].value-prefs[pcnt-3].value; x := x DIV 10;
  197.     prefs[pcnt-3].value := prefs[pcnt-3].value+x;
  198.     prefs[pcnt-1].value := prefs[pcnt-1].value-x;
  199.     y := prefs[pcnt].value-prefs[pcnt-2].value; y := y DIV 10;
  200.     prefs[pcnt-2].value := prefs[pcnt-2].value+y;
  201.     prefs[pcnt].value := prefs[pcnt].value-y;
  202.   END;
  203. END;
  204.  
  205. PROCEDURE WriteTab(s: STRING);
  206. VAR i: INTEGER;
  207. BEGIN
  208.   Write(s); FOR i := Length(s) TO 40 DO Write(' ');
  209. END;
  210.  
  211. BEGIN
  212.   ClrScr;
  213.   {$I-}
  214.   Assign(f,'PREFS.CPE'); Reset(f);
  215.   fault := TRUE;
  216.   IF IOResult = 0 THEN BEGIN
  217.     fault := FALSE;
  218.     FOR j := 0 TO pcnt DO BEGIN
  219.       Read(f,prefs[j].value);
  220.       IF IOResult <> 0 THEN BEGIN
  221.         WriteLN('Couldn''t read prefs file, old version? Using defaults.');
  222.         fault := TRUE; j := pcnt;
  223.       END;
  224.     END;
  225.     Close(f);
  226.   END;
  227.   IF fault THEN FOR j := 0 TO pcnt DO prefs[j].value := prefs[j].defval;
  228.   Rewrite(f);
  229.   REPEAT
  230.     ClrScr;
  231.     writeln(' CPE Setup'); writeln;
  232.     writeln('Do you want to '); writeln;
  233.     writeln('1. Edit general setup');
  234.     writeln('2. Edit setup for CPE.EXE');
  235.     writeln('3. Edit setup for CPE2.EXE');
  236.     writeln('0. Exit and save');
  237.  
  238.     writeln; write('Your choice: '); readln(c);
  239.     CASE c OF
  240.     '1': setupmode := general;
  241.     '2': setupmode := cpe;
  242.     '3': setupmode := cpe2;
  243.     END;
  244.     IF c IN ['1','2','3'] THEN BEGIN
  245.       REPEAT
  246.         ClrScr;
  247.         writeln(' CPE Setup'); writeln;
  248.         menuchar := '1';
  249.  
  250.         FOR i := 0 TO pcnt-3 DO BEGIN
  251.           IF prefs[i].ptype = setupmode THEN BEGIN
  252.             Write(menuchar,'. ');
  253.             WriteTab(prefs[i].text+':');
  254.             CASE prefs[i].mode OF
  255.               prefhex:   WriteLn(Hex(prefs[i].value));
  256.               prefyesno: WriteLn(YesNo(prefs[i].value));
  257.               prefsound: WriteLn(SoundCard(prefs[i].value));
  258.               prefprt:   WriteLn('LPT',Chr(Ord('0')+prefs[i].value));
  259.               prefcpc:   WriteLn(CPC(prefs[i].value));
  260.               prefjoy:   WriteLn;
  261.             END;
  262.             IF menuchar = '9'
  263.               THEN menuchar := 'A'
  264.               ELSE menuchar := Chr(Ord(menuchar)+1);
  265.           END;
  266.         END;
  267.         WriteLn; writeln('Type 0 to return to main menu!'); writeln;
  268.         write('Which option do you want to change: '); readln(c);
  269.         c := UpCase(c);
  270.         menuchar := '1';
  271.         FOR i := 0 TO pcnt-3 DO BEGIN
  272.           IF (prefs[i].ptype = setupmode) THEN BEGIN
  273.             IF c = menuchar THEN BEGIN
  274.               CASE prefs[i].mode OF
  275.                 prefhex,
  276.                 prefprt  :   GetHex(prefs[i].value);
  277.                 prefyesno: GetYesNo(prefs[i].value);
  278.                 prefsound: GetSound(prefs[i].value);
  279.                 prefcpc:   GetCPC(prefs[i].value);
  280.                 prefjoy:   Calibrate;
  281.               END;
  282.             END;
  283.             IF menuchar = '9'
  284.               THEN menuchar := 'A'
  285.               ELSE menuchar := Chr(Ord(menuchar)+1);
  286.           END;
  287.         END;
  288.       UNTIL c = '0';
  289.       c := '.';
  290.     END;
  291.   UNTIL c = '0';
  292.   FOR j:= 0 TO pcnt DO write(f,prefs[j].value);
  293.   Close(f);
  294. END.