home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol9n04.zip / CONCEN.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-20  |  3KB  |  107 lines
  1. PROGRAM Concentration;
  2. USES crt, cards;
  3.  
  4. TYPE
  5.   concen = OBJECT (game)
  6.     places : array[0..51] of CardP;
  7.     mrk, cur, removed, guesses : Word;
  8.     CONSTRUCTOR Init;
  9.     DESTRUCTOR Done; virtual;
  10.     PROCEDURE Play;
  11.   END;
  12.  
  13.   CONSTRUCTOR concen.Init;
  14.   VAR N : Byte;
  15.   BEGIN
  16.     game.Init($1E);
  17.     D := New(DeckP, Init(0, 0, TableColor)); D^.shuffle;
  18.     TextAttr := TableColor;
  19.     ClrScr;
  20.     FOR N := 0 to 51 DO
  21.       BEGIN
  22.     places[N] := CardP(D^.FromTop);
  23.         places[N]^.PutInPlace(6*(N MOD 13)+1, 6*(N DIV 13)+1);
  24.         places[N]^.Display;
  25.       END;
  26.     mrk := 52; cur := 0; removed := 0; guesses := 0;
  27.   END;
  28.  
  29.   DESTRUCTOR Concen.Done; BEGIN game.done; END;
  30.  
  31.   PROCEDURE Concen.Play;
  32.   VAR
  33.     CH : Char;
  34.  
  35.     PROCEDURE BkwdNonNIL;
  36.     BEGIN WHILE Places[cur] = NIL DO cur := (cur+51) MOD 52; END;
  37.  
  38.     PROCEDURE FwrdNonNIL;
  39.     BEGIN WHILE Places[cur] = NIL DO cur := (cur+1) MOD 52; END;
  40.  
  41.     PROCEDURE PressedEnter;
  42.     BEGIN
  43.       IF mrk = 52 THEN {nothing marked, flip it}
  44.        BEGIN
  45.          mrk := cur; Inc(Guesses);
  46.          WITH Places[mrk]^ DO BEGIN TurnUp; Display; END;
  47.        END
  48.      ELSE
  49.        BEGIN
  50.          IF mrk = cur THEN Beep
  51.          ELSE
  52.            BEGIN
  53.              Inc(Guesses);
  54.              WITH Places[cur]^ DO BEGIN TurnUp; Display; END;
  55.              IF Places[cur]^.GetRank = Places[mrk]^.GetRank THEN
  56.                BEGIN
  57.                  Happy; Delay(1000);
  58.                  Inc(removed, 2);
  59.                  Places[cur]^.hide; Places[mrk]^.Hide;
  60.                  dispose(Places[cur], done); Places[cur] := NIL;
  61.                  dispose(Places[mrk], done); Places[mrk] := NIL;
  62.                  mrk := 52;
  63.                  IF removed < 52 THEN FwrdNonNIL;
  64.                END
  65.              ELSE
  66.                BEGIN
  67.                  Sad; Delay(1000);
  68.                  WITH Places[cur]^ DO BEGIN TurnDown; Display; END;
  69.                  WITH Places[mrk]^ DO BEGIN TurnDown; Display; END;
  70.                  mrk := 52;
  71.                END;
  72.            END;
  73.        END;
  74.     END;
  75.  
  76.   BEGIN
  77.     REPEAT
  78.       Places[cur]^.PointT(dn); 
  79.       CH := ReadKey;
  80.       Places[cur]^.UnPoin(dn);
  81.       CASE CH OF
  82.         #0 : CASE ReadKey OF
  83.                #$48 : BEGIN cur := (cur+39) MOD 52; BkwdNonNIL; END;
  84.                #$50 : BEGIN cur := (cur+13) MOD 52; FwrdNonNIL; END;
  85.                #$4B : BEGIN cur := (cur+51) MOD 52; BkwdNonNIL; END;
  86.                #$4D : BEGIN cur := (cur+ 1) MOD 52; FwrdNonNIL; END;
  87.              END;
  88.         #13 : PressedEnter;
  89.         #27 : ;
  90.       END;
  91.     UNTIL (removed = 52) OR (CH = #27);
  92.     GotoXY(1, 25);
  93.     TextAttr := $70;
  94.     IF CH = #27 THEN Write('You quit after ', guesses, ' guesses.')
  95.     ELSE
  96.       BEGIN
  97.         Happy; Happy; Happy;
  98.         Write('You WON!  You used ', guesses, ' guesses.'); 
  99.       END; 
  100.   END; 
  101.  
  102. VAR cgame : concen;
  103. BEGIN
  104.   cgame.Init;
  105.   cgame.Play;
  106. END.
  107.