DataMuseum.dk

top - download

    Length: 5888 (0x1700)
    Types: TextFile
    Names: »MASTERM.PAS«

└─⟦692ac107c⟧ Bits:30005923 PolyPascal-80 V3.10 arbejdsdiskette 1
    └─ ⟦this⟧ »MASTERM.PAS« 

TextFile

 (*$R-,S+,A+,W0*) 
PROGRAM MASTERMIND;
TYPE
  STR4 = STRING(.4.);
  STR5 = STRING(.5.);
  STR50 = STRING(.50.);
  
CONST
 ESC = @27;
  
VAR
  VUNDET: BOOLEAN;
  GEMT: STR4;
  NR: INTEGER;

PROCEDURE SLET(N: INTEGER);
VAR
  I: INTEGER;
BEGIN
  FOR I:=1 TO N DO WRITE(CHR(8)+' '+CHR(8));
END;

PROCEDURE DANSK;
BEGIN
END;

PROCEDURE CLREOL; 
BEGIN
  WRITE(ESC,CHR($2A));
END;

PROCEDURE CLREOS;
BEGIN
  WRITE(ESC,CHR($25)); 
END;

PROCEDURE CLEARSC;
BEGIN
  WRITE(CHR($1A));
END;

PROCEDURE INVON;
BEGIN
  WRITE(ESC,'A');
END;

PROCEDURE INVOFF;
BEGIN
  WRITE(ESC,'N');
END;

FUNCTION JANEJ(ST:STR50): BOOLEAN;
VAR
  S: CHAR;
BEGIN
  WRITE(ST,' J)A , N)EJ ? ');
  REPEAT
    BUFLEN:=1; READ(S);
    IF NOT(S IN (.'J','j','N','n'.)) THEN SLET(1);
  UNTIL (S IN (.'N','n','J','j'.));
  JANEJ:=S IN (.'J','j'.);
  SLET(LEN(ST)+15)
END;

FUNCTION MINMAX(CIF,MIN,MAX: INTEGER): INTEGER;
LABEL EXIT;
VAR
  N,P: INTEGER;
  OK: BOOLEAN;
  S: STR5;
BEGIN
  REPEAT
    BUFLEN:=CIF; READ(S);
    IF S='0' THEN BEGIN
      IF CIF=4 THEN BEGIN
        IF JANEJ('    SKAL AFBRYDES') THEN BEGIN
          IF NOT VUNDET THEN BEGIN
            GOTOXY(0,23); CLREOL; GOTOXY(0,21);
            WRITE('...DET VAR...  '+GEMT); WRITELN;
            BDOS(0);
          END;
        END
        ELSE WRITE('');
      END;
    END;
    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 SLET(LEN(S));
  UNTIL OK;
  MINMAX:=N;
END;

PROCEDURE SPIL;
VAR LINIE,I,MAX,NR:INTEGER;
    GAET:STR4;

PROCEDURE START;
BEGIN
  INVON;
  GOTOXY(13,0); WRITELN(' * C R  M A S T E R M I N D  V.1.2   * ');
  INVOFF;
  WRITELN('':13,'BENYT CIFRENE 0..9 TIL AT GAETTE ET TAL MED.');
  WRITELN;
  WRITE('':13,'HVOR MANGE FORS0G (1..100) 0NSKES: ');
  MAX:=MINMAX(3,1,100);
  GOTOXY(0,3); CLREOS;
  GOTOXY(9,4); WRITE('X X X X');
END;

PROCEDURE INIT(VAR GEMME:STR4);
VAR I:INTEGER;
    ST:STRING(.1.);
BEGIN
  GEMME:='';
  RANDOMIZE;
  REPEAT
    I:=RANDOM(9);
  UNTIL I<>0;
  STR(I,ST);
  GEMT(.1.):=ST;
  GEMME:=CONCAT(GEMME,GEMT(.1.));
  REPEAT
    STR(RANDOM(9),ST);
    GEMT(.2.):=ST;
  UNTIL (GEMT(.2.)<>GEMT(.1.));
  GEMME:=CONCAT(GEMME,GEMT(.2.));
  REPEAT
    STR(RANDOM(9),ST);
    GEMT(.3.):=ST;
  UNTIL POS(GEMT(.3.),GEMME)=0;
  GEMME:=CONCAT(GEMME,GEMT(.3.));
  REPEAT
    STR(RANDOM(9),ST);
    GEMT(.4.):=ST;
  UNTIL POS(GEMT(.4.),GEMME)=0;
  GEMME:=CONCAT(GEMME,GEMT(.4.));
END;

PROCEDURE KONTROL(VAR OK1:INTEGER; VAR OK2:INTEGER);
VAR
  OKTAL,OKPLADS,I:INTEGER;
  CH:CHAR;
BEGIN
  OKTAL:=0; OKPLADS:=0;
  FOR I:=1 TO 4 DO
  BEGIN
    CH:=GEMT(.I.);
    IF (CH IN (.GAET(.1.),GAET(.2.),GAET(.3.),GAET(.4.).)) THEN
     BEGIN
       IF GEMT(.I.)=GAET(.I.) THEN OKPLADS:=OKPLADS+1
       ELSE
       OKTAL:=OKTAL+1
     END;
  END;
  OK1:=OKTAL; OK2:=OKPLADS
END;

PROCEDURE INDTAST;
LABEL IGEN;
VAR T:INTEGER;
BEGIN
  NR:=NR+1;
  IGEN:
  GOTOXY(10,23); CLREOL;
  WRITE('INDTAST FIRE ');
  INVON; WRITE(' forskellige '); INVOFF; WRITE(' CIFRE : ');
  STR(MINMAX(4,0,9999),GAET);
  FOR T:=2 TO 4 DO
    IF GAET(.1.)=GAET(.T.) THEN GOTO IGEN;
  FOR T:=3 TO 4 DO
   IF GAET(.2.)=GAET(.T.) THEN GOTO IGEN;
   IF GAET(.3.)=GAET(.4.) THEN GOTO IGEN;
END;

PROCEDURE SVAR;
VAR I,OKTAL,OKPLADS:INTEGER;
BEGIN
  OKTAL:=0; OKPLADS:=0;
  KONTROL(OKTAL,OKPLADS);
  GOTOXY(0,LINIE);
  CLREOL;
  WRITE(NR:3,':');
  GOTOXY(9,LINIE);
  FOR I:=1 TO 4 DO WRITE(GAET(.I.),' ');
  IF GAET<>GEMT THEN
   BEGIN
     GOTOXY(30,LINIE);
     FOR I:=1 TO OKTAL DO WRITE('O ');
     GOTOXY(50,LINIE);
     FOR I:=1 TO OKPLADS DO WRITE('O ');
   END;
  LINIE:=LINIE+1;
  IF LINIE>21 THEN LINIE:=6;
END;

BEGIN (*SPIL*)
  LINIE:=6; NR:=0;
  START;
  GOTOXY(24,4); WRITE('RIGTIGT CIFFER  *');
  GOTOXY(44,4); WRITE('RIGTIG PLACERING');
  INIT(GEMT);
  REPEAT
    INDTAST;
    SVAR;
    VUNDET:=GEMT=GAET;
  UNTIL VUNDET OR (NR=MAX);
  WRITELN;
  IF VUNDET THEN
  BEGIN
    CASE NR OF
    1..5:       WRITE('*** F A N T A S T I S K ***');
    6..10:      WRITE('***    F L O T   ***');
    11..16:     WRITE('***    K 0 N T   ***');
    17..23:     WRITE('*** R I M E L I G T ***');
    24..30:     WRITE('*** A C C E P T A B E L T ***');
    31..37:     WRITE('***  VÆR IKKE KED AF DET  ***');
    38..46:     WRITE('***  BEDRE HELD NAESTE GANG ***');
    47..53:     WRITE('***  TJA.. SAADAN KAN DET GAA ***');
    54..60:     WRITE('***  0VELSE G0R MESTER  ***');
    61..100:    WRITE('***  DET VAR VIST EN DR0J OMGANG  ***');
    END;
  END
  ELSE
  BEGIN
    GOTOXY(0,3); WRITE('DET RIGTIGE TAL: ');
    GOTOXY(9,4);
    FOR I:=1 TO 4 DO WRITE(GEMT(.I.),' ');
    GOTOXY(0,LINIE+1);
    WRITE('DU GÆTTEDE DET IKKE!');
  END;
  WRITELN
END; (*SPIL*)

PROCEDURE INSTRUKS;
VAR CH:CHAR;
BEGIN
  CLEARSC;
  INVON;
  GOTOXY(13,0); WRITELN(' * C R  M A S T E R M I N D  V.1.1  . * ');
  INVOFF;
  WRITELN; GOTOXY(13,2);
  IF JANEJ('0NSKES INSTRUKTION') THEN
   BEGIN
     WRITELN;
     WRITELN('NAAR DER ER GAETTET ET TAL, VISES DELS ANTALLET AF RIGTIGE CIFRE');
     WRITELN('DELS ANTALLET AF RIGTIGT PLACEREDE/RIGTIGE CIFRE.');
     WRITELN;
     WRITELN('ANTALLET AF "GAET" OPTÆLLES OG VISES.');
     WRITELN;
    WRITELN('0NSKES "OPGIVET", SAA INDTAST NUL OG TRYK RETURN.');
    GOTOXY(0,23);
    WRITE('TRYK RETURN..');
    REPEAT
      READ(KBD,CH);
     UNTIL CH=CHR(13);
   END;
END;

BEGIN (*MAIN*)
  INSTRUKS;
  REPEAT
    VUNDET:=FALSE;
    CLEARSC;
    SPIL;
    GOTOXY(0,23); CLREOL;
  UNTIL NOT JANEJ('EN GANG TIL..');
    GOTOXY(0,22); CLREOS;
  WRITE('':50,'OK.. TAK FOR SPILLET.');
END.
«eof»