home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / games / volume4 / rubik.shr / cube.pas
Pascal/Delphi Source File  |  1988-05-20  |  26KB  |  879 lines
  1. [INHERIT ('SYS$LIBRARY:STARLET.PEN')]
  2. (* Rubik's cube simulator for VAX/VMS and ReGIS graphics *)
  3. (*        by Bud Crittendon             *)
  4.  
  5. PROGRAM CUBE(INPUT,OUTPUT,OUTFILE);
  6.  
  7. Const
  8.   CubeSize = 35;
  9.   CubeSep =   CubeSize + 6;
  10.   CubeCornerX = 200;  
  11.   CubeCornerY = 200;  
  12.   TiltAngle = 0.5235987;
  13.   ColorRed = 1;
  14.   ColorBlue = 2;
  15.   ColorYellow = 3;
  16.  
  17. TYPE
  18.   Iword       = [WORD] 0..65535;
  19.   ShortString = PACKED ARRAY [1..12] OF CHAR;
  20.   Rotate      = (NONE,LEFT,RIGHT,UP,DOWN,FRONT,BACK);
  21.   Where       = (TILTFRONT,TILTTOP,TILTRIGHT,TILTLEFT,TILTDOWN,TILTBACK);
  22.   Colors      = (YELLOW,WHITE,BLUE,GREEN,RED,ORANGE);
  23.   CUBITS = PACKED ARRAY [1..9] OF COLORS;
  24.   CUBES = PACKED ARRAY [LEFT..BACK] OF CUBITS;
  25.  
  26. VAR 
  27.   X,
  28.   Y,
  29.   L,
  30.   C1,
  31.   C2,
  32.   CUBESEPX,
  33.   CUBESEPY,
  34.   CUBEADJX,
  35.   CUBEADJY,
  36.   SCORE,
  37.   MIXES,
  38.   MOVES,
  39.   CUBEADJUST,
  40.   DIR,
  41.   I:INTEGER;
  42.   QUIT,
  43.   DONE:BOOLEAN;
  44.   CUBEARRAY:CUBES;
  45.   CCOLOR,
  46.   COLOR:COLORS;
  47.   CTYPE,
  48.   CUBEPLACE:WHERE;
  49.   TURN:ROTATE;
  50.   KEY:CHAR;
  51.   IOCHAN:IWORD;
  52.   OUTFILE:TEXT;
  53.  
  54. (******************************************************************************)
  55.  
  56. [INITIALIZE]
  57. PROCEDURE InitializeCubeParams;
  58.   BEGIN
  59.     WRITELN(CHR(27),'P1p');
  60.     WRITELN('S(M0(AD)M1(AR)M2(AB)M3(AY))');
  61.     WRITELN('l(a2)"A"55aa55aa55aa55aa55aa;');
  62.     WRITELN(CHR(27),'\');
  63.  
  64.     FOR I := 1 TO 9 DO BEGIN
  65.       CUBEARRAY[RIGHT][I] := YELLOW;
  66.       CUBEARRAY[LEFT][I]  := WHITE;
  67.       CUBEARRAY[UP][I]    := BLUE;
  68.       CUBEARRAY[DOWN][I]  := GREEN;
  69.       CUBEARRAY[FRONT][I] := RED;
  70.       CUBEARRAY[BACK][I]  := ORANGE;
  71.       END;
  72.     DONE  := FALSE;
  73.     QUIT  := FALSE;
  74.     MOVES := 0;
  75.     MIXES := 0;
  76.     SCORE := 0;
  77.     CubeAdjX := round(CubeSize * cos(TiltAngle));
  78.     CubeAdjY := round(CubeSize * sin(TiltAngle));
  79.     CubeSepX := round(CubeSep  * cos(TiltAngle));
  80.     CubeSepY := round(CubeSep  * sin(TiltAngle));
  81.   END;
  82.  
  83. (******************************************************************************)
  84.  
  85. PROCEDURE Initialize(VAR CUBEARRAY:CUBES;VAR MIXES,MOVES,SCORE:INTEGER);
  86.  
  87. BEGIN
  88.     FOR I := 1 TO 9 DO BEGIN
  89.       CUBEARRAY[RIGHT][I] := YELLOW;
  90.       CUBEARRAY[LEFT][I]  := WHITE;
  91.       CUBEARRAY[UP][I]    := BLUE;
  92.       CUBEARRAY[DOWN][I]  := GREEN;
  93.       CUBEARRAY[FRONT][I] := RED;
  94.       CUBEARRAY[BACK][I]  := ORANGE;
  95.       END;
  96.     MOVES := 0;
  97.     MIXES := 0;
  98.     SCORE := 0;
  99.   END;
  100.  
  101. (******************************************************************************)
  102.  
  103. PROCEDURE REGIS;
  104.  
  105. BEGIN
  106.   WRITELN(CHR(27),'Pp');
  107. END;
  108.  
  109. (******************************************************************************)
  110.  
  111. PROCEDURE ASCII;
  112.  
  113. BEGIN
  114.   WRITELN(CHR(27),'[;H');
  115.   WRITELN(CHR(27),'\');
  116. END;
  117.  
  118. (******************************************************************************)
  119.  
  120. PROCEDURE POSITION(ROW,COL:INTEGER);
  121.  
  122. BEGIN
  123.   WRITELN('P[',COL:1,',',ROW:1,']');
  124. END;
  125.  
  126. (******************************************************************************)
  127.  
  128. PROCEDURE RANDOMNUMBER(VAR RANDOM:INTEGER;MINVALUE,MAXVALUE:INTEGER);
  129.  
  130. TYPE
  131.   STRING = PACKED ARRAY [1..11] OF CHAR;
  132.  
  133. VAR
  134.   CURTIME : STRING;
  135.   SEED : INTEGER;
  136.  
  137. BEGIN
  138.   CURTIME := '00:00:00.00';
  139.   TIME(CURTIME);
  140.   RANDOM := 0;
  141.   SEED := 0;
  142.   SEED := SEED + 1 * (ORD(CURTIME[10])-48);
  143.   SEED := SEED + 10 * (ORD(CURTIME[11])-48);
  144.   RANDOM := ROUND((SEED/99) * (MAXVALUE - MINVALUE)) + MINVALUE;
  145. END;
  146.  
  147. (******************************************************************************)
  148.  
  149. PROCEDURE Coords ( VAR CubeNumber: integer;  VAR CubeType: Where);
  150.   VAR bx,by,ccx,ccy:integer;
  151.   BEGIN
  152.     bx := (CubeNumber-1) MOD 3;
  153.     by := (CubeNumber-1) DIV 3;
  154.     CASE CubeType OF
  155.       TILTFRONT,
  156.       TILTRIGHT,
  157.       TILTTOP: BEGIN
  158.                  ccx := CubeCornerX;
  159.                  ccy := CubeCornerY;
  160.                END;
  161.       TILTBACK: BEGIN
  162.                   ccx := CubeCornerX + CubeSepX*7;
  163.                   ccy := CubeCornerY - CubeSepy*7;
  164.                 END;
  165.       TILTLEFT: BEGIN
  166.                   ccx := CubeCornerX - CubeSepX*7;
  167.                   ccy := CubeCornerY;
  168.                 END;
  169.       TILTDOWN: BEGIN
  170.                   ccx := CubeCornerX;
  171.                   ccy := CubeCornerY + CubeSepY*10;
  172.                 END;
  173.       OTHERWISE;
  174.       END;
  175.     CASE CubeType OF
  176.       TILTFRONT,TILTBACK: 
  177.              BEGIN
  178.                x := ccx + bx * CubeSep  ;
  179.                y := ccy + by * CubeSep  ;
  180.              END;
  181.       TILTRIGHT,TILTLEFT:
  182.              BEGIN
  183.                x := ccx + (CubeSep  * 3) + (bx * CubeSepX);
  184.                y := ccy + (CubeSep  * by) - (bx * CubeSepY); 
  185.              END;
  186.       TILTTOP,TILTDOWN:
  187.              BEGIN
  188.                x := ccx + (CubeSepX *3) + (bx*CubeSep) - (by*CubeSepX);
  189.                y := ccy - (CubeSepY *3) + (by*CubeSepY);
  190.              END;
  191.       END;
  192.   END;
  193.  
  194. (******************************************************************************)
  195.  
  196. PROCEDURE SetColor(VAR Color: Colors);
  197.   BEGIN
  198.     CASE Color OF
  199.       RED : BEGIN
  200.               c1 := ColorRed;
  201.               c2 := ColorRed;
  202.             END;
  203.       YELLOW: 
  204.             BEGIN
  205.               c1 := ColorYellow;
  206.               c2 := ColorYellow;
  207.             END;
  208.       BLUE:
  209.             BEGIN
  210.               c1 := ColorBlue;
  211.               c2 := ColorBlue;
  212.             END;
  213.       ORANGE:
  214.             BEGIN 
  215.               c1 := ColorRed;
  216.               c2 := ColorYellow;
  217.             END;
  218.       WHITE:
  219.             BEGIN
  220.               c1 := ColorBlue;
  221.               c2 := ColorYellow;
  222.             END;
  223.       GREEN:
  224.             BEGIN
  225.               c1 := ColorBlue;
  226.               c2 := ColorRed;
  227.             END;
  228.       END;
  229.   END;
  230.  
  231. (******************************************************************************)
  232.  
  233. PROCEDURE SetFill(VAR CubeType: Where);
  234.   VAR solid : boolean;
  235.   BEGIN
  236.     solid := (c1 = c2);
  237.     Write('w(r,i',c1:1,',s');
  238.     IF solid 
  239.       THEN
  240.         BEGIN
  241.           CASE CubeType OF
  242.             TILTBACK,TILTLEFT,TILTFRONT,TILTRIGHT: Writeln('1)');
  243.                                  TILTDOWN,TILTTOP: Writeln('1(x))');
  244.             END;
  245.         END
  246.       ELSE
  247.         BEGIN
  248.           CASE CubeType OF
  249.              TILTBACK,TILTLEFT,TILTFRONT,TILTRIGHT: Writeln('"A")s(i',c2:1,')');
  250.                                TILTDOWN,TILTTOP: Writeln('"A"(x))s(i',c2:1,')');
  251.              END;
  252.         END;
  253.   END;
  254.  
  255. (******************************************************************************)
  256.  
  257. PROCEDURE Square (CubeNumber: integer;
  258.                   CubeType: Where; Color: Colors);
  259.  
  260.   BEGIN
  261.     Coords(CubeNumber,CubeType);  (* Compute X,Y *)
  262.     Writeln('p[',x,',',y,']t(a2)');   (* Place cursor at x,y *)
  263.     SetColor(Color);             (* Select c1 and c2 *)
  264.     CASE CubeType OF
  265.           TILTFRONT,TILTBACK:
  266.             BEGIN
  267.               SetFill(CubeType);
  268.               Writeln('v[,+',cubesize,'][+',cubesize,']');
  269.             END;
  270.       TILTRIGHT,TILTLEFT:
  271.           BEGIN
  272.              SetFill(CubeType);
  273.              Writeln('v[,+',cubesize,'][+',CubeAdjX,
  274.                      ',-',CubeAdjY,']');
  275.              Writeln('v[,-',cubesize,'][-',CubeAdjX,
  276.                      ',+',CubeAdjY,']')
  277.           END;
  278.         TILTTOP,TILTDOWN:
  279.           BEGIN
  280.              SetFill(CubeType);
  281.              Writeln('v[-',CubeAdjX,',+',CubeAdjY,
  282.                      '][+',Cubesize,']');
  283.              Writeln('v[+',CubeAdjX,',-',CubeadjY,']');
  284.            END;
  285.     END;
  286.   Writeln('w(s0)s(i0)t(a0)');
  287.  END;
  288.  
  289. (******************************************************************************)
  290.  
  291. PROCEDURE OPENKEY;
  292.   VAR
  293.     STAT : IWORD;
  294.     DEVNAME: SHORTSTRING;
  295.   BEGIN
  296.     DEVNAME := 'TT:';
  297.     STAT := $ASSIGN(DEVNAME,IOCHAN);
  298.   END;
  299.  
  300. (******************************************************************************)
  301.  
  302. PROCEDURE SHUTKEY;
  303.   VAR 
  304.     STAT : IWORD;
  305.   BEGIN
  306.     STAT := $DASSGN(IOCHAN);
  307.   END;
  308.  
  309. (******************************************************************************)
  310.   
  311. FUNCTION GETKEY:CHAR;
  312.   VAR
  313.     FUNC,STAT : IWORD;
  314.     CH : CHAR;
  315.   BEGIN
  316.     FUNC := IO$_READVBLK + IO$M_NOECHO + IO$M_NOFILTR;
  317.     STAT := $QIOW (,IOCHAN,FUNC,,,,CH,1);
  318.     GETKEY := CH;
  319.   END;
  320.  
  321. (******************************************************************************)
  322.  
  323. PROCEDURE SIDES(TURN:ROTATE);
  324.  
  325. BEGIN
  326.   CASE TURN OF 
  327.     FRONT : FOR I := 1 TO 3 DO BEGIN
  328.               SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
  329.               SQUARE(I+3,TILTFRONT,CUBEARRAY[FRONT][I+3]);
  330.               SQUARE(I+6,TILTFRONT,CUBEARRAY[FRONT][I+6]);
  331.               SQUARE((I+6),TILTTOP,CUBEARRAY[UP][I+6]);
  332.               SQUARE(((I*3)-2),TILTRIGHT,CUBEARRAY[RIGHT][((I*3)-2)]);
  333.               SQUARE((I+6),TILTDOWN,CUBEARRAY[DOWN][I]);
  334.               SQUARE(((I*3)-2),TILTLEFT,CUBEARRAY[LEFT][(I*3)]);
  335.               END;
  336.     RIGHT : FOR I := 1 TO 3 DO BEGIN
  337.               SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
  338.               SQUARE(I+3,TILTRIGHT,CUBEARRAY[RIGHT][I+3]);
  339.               SQUARE(I+6,TILTRIGHT,CUBEARRAY[RIGHT][I+6]);
  340.               SQUARE((I*3),TILTTOP,CUBEARRAY[UP][I*3]);
  341.               SQUARE((I*3),TILTFRONT,CUBEARRAY[FRONT][(I*3)]);
  342.               SQUARE((I*3),TILTDOWN,CUBEARRAY[DOWN][((4-I)*3)]);
  343.               SQUARE((I*3),TILTBACK,CUBEARRAY[BACK][((I*3)-2)]);
  344.               END;
  345.     UP    : FOR I := 1 TO 3 DO BEGIN
  346.               SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
  347.               SQUARE(I+3,TILTTOP,CUBEARRAY[UP][I+3]);
  348.               SQUARE(I+6,TILTTOP,CUBEARRAY[UP][I+6]);
  349.               SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
  350.               SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
  351.               SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
  352.               SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
  353.               END;
  354.     BACK  : FOR I := 1 TO 3 DO BEGIN
  355.               SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
  356.               SQUARE(I+3,TILTBACK,CUBEARRAY[BACK][(4-I)+3]);
  357.               SQUARE(I+6,TILTBACK,CUBEARRAY[BACK][(4-I)+6]);
  358.               SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
  359.               SQUARE((I*3),TILTRIGHT,CUBEARRAY[RIGHT][(I*3)]);
  360.               SQUARE((I*3),TILTLEFT,CUBEARRAY[LEFT][((I*3)-2)]);
  361.               SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][(I+6)]);
  362.               END;
  363.     LEFT  : FOR I := 1 TO 3 DO BEGIN
  364.               SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
  365.               SQUARE(I+3,TILTLEFT,CUBEARRAY[LEFT][(4-I)+3]);
  366.               SQUARE(I+6,TILTLEFT,CUBEARRAY[LEFT][(4-I)+6]);
  367.               SQUARE(((I*3)-2),TILTTOP,CUBEARRAY[UP][((I*3)-2)]);
  368.               SQUARE(((I*3)-2),TILTFRONT,CUBEARRAY[FRONT][((I*3)-2)]);
  369.               SQUARE(((I*3)-2),TILTBACK,CUBEARRAY[BACK][(I*3)]);
  370.               SQUARE(((I*3)-2),TILTDOWN,CUBEARRAY[DOWN][(((4-I)*3)-2)]);
  371.               END;
  372.     DOWN  : FOR I := 1 TO 3 DO BEGIN
  373.               SQUARE(I+6,TILTDOWN,CUBEARRAY[DOWN][I]);
  374.               SQUARE(I+3,TILTDOWN,CUBEARRAY[DOWN][I+3]);
  375.               SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][(I+6)]);
  376.               SQUARE((I+6),TILTFRONT,CUBEARRAY[FRONT][(I+6)]);
  377.               SQUARE((I+6),TILTRIGHT,CUBEARRAY[RIGHT][(I+6)]);
  378.               SQUARE((I+6),TILTBACK,CUBEARRAY[BACK][((4-I)+6)]);
  379.               SQUARE((I+6),TILTLEFT,CUBEARRAY[LEFT][((4-I)+6)]);
  380.               END;
  381.     END;
  382. END;
  383.  
  384. (******************************************************************************)
  385.  
  386. PROCEDURE TURNSIDE(TURN:ROTATE;DIR:INTEGER);
  387.  
  388. VAR
  389.   NUMBER:INTEGER;
  390.   TEMP:COLORS;
  391.  
  392. BEGIN
  393.   FOR NUMBER := 1 TO DIR DO BEGIN
  394.     TEMP               := CUBEARRAY[TURN][1];
  395.     CUBEARRAY[TURN][1] := CUBEARRAY[TURN][7];
  396.     CUBEARRAY[TURN][7] := CUBEARRAY[TURN][9];
  397.     CUBEARRAY[TURN][9] := CUBEARRAY[TURN][3];
  398.     CUBEARRAY[TURN][3] := TEMP;
  399.     TEMP               := CUBEARRAY[TURN][2];
  400.     CUBEARRAY[TURN][2] := CUBEARRAY[TURN][4];
  401.     CUBEARRAY[TURN][4] := CUBEARRAY[TURN][8];
  402.     CUBEARRAY[TURN][8] := CUBEARRAY[TURN][6];
  403.     CUBEARRAY[TURN][6] := TEMP;
  404.     END;
  405. END;
  406.  
  407. (******************************************************************************)
  408.  
  409. PROCEDURE CHANGEARRAY(VAR CUBEARRAY:CUBES;TURN:ROTATE;DIR:INTEGER);
  410.  
  411. VAR
  412.   TEMPARRAY : PACKED ARRAY [1..3] OF COLORS;
  413.   TEMP:COLORS;
  414.   J,
  415.   X,
  416.   Y:INTEGER;
  417.  
  418. BEGIN
  419.   TURNSIDE(TURN,DIR);
  420.   FOR X := 1 TO DIR DO BEGIN
  421.     IF (TURN = UP) THEN
  422.       FOR J := 1 TO 3 DO BEGIN
  423.         TEMP                := CUBEARRAY[FRONT][J];
  424.         CUBEARRAY[FRONT][J] := CUBEARRAY[RIGHT][J];
  425.         CUBEARRAY[RIGHT][J] := CUBEARRAY[BACK][J];
  426.         CUBEARRAY[BACK][J]  := CUBEARRAY[LEFT][J];
  427.         CUBEARRAY[LEFT][J]  := TEMP;
  428.         END;
  429.     IF (TURN = DOWN) THEN
  430.       FOR J := 1 TO 3 DO BEGIN
  431.         TEMP                  := CUBEARRAY[FRONT][J+6];
  432.         CUBEARRAY[FRONT][J+6] := CUBEARRAY[LEFT][J+6];
  433.         CUBEARRAY[LEFT][J+6]  := CUBEARRAY[BACK][J+6];
  434.         CUBEARRAY[BACK][J+6]  := CUBEARRAY[RIGHT][J+6];
  435.         CUBEARRAY[RIGHT][J+6] := TEMP;
  436.         END;
  437.     IF (TURN = RIGHT) THEN
  438.       FOR J := 1 TO 3 DO BEGIN
  439.         TEMP                      := CUBEARRAY[FRONT][(4-J)*3];
  440.         CUBEARRAY[FRONT][(4-J)*3] := CUBEARRAY[DOWN][(4-J)*3];
  441.         CUBEARRAY[DOWN][(4-J)*3]  := CUBEARRAY[BACK][(J*3)-2];
  442.         CUBEARRAY[BACK][(J*3)-2]  := CUBEARRAY[UP][(4-J)*3];
  443.         CUBEARRAY[UP][(4-J)*3]    := TEMP;
  444.         END;
  445.     IF (TURN = LEFT) THEN 
  446.       FOR J := 1 TO 3 DO BEGIN
  447.         TEMP                       := CUBEARRAY[FRONT][(J*3)-2];
  448.         CUBEARRAY[FRONT][(J*3)-2]  := CUBEARRAY[UP][(J*3)-2];
  449.         CUBEARRAY[UP][(J*3)-2]     := CUBEARRAY[BACK][(4-J)*3];
  450.         CUBEARRAY[BACK][(4-J)*3]   := CUBEARRAY[DOWN][(J*3)-2];
  451.         CUBEARRAY[DOWN][(J*3)-2]   := TEMP;
  452.         END;
  453.     IF (TURN = FRONT) THEN 
  454.       FOR J := 1 TO 3 DO BEGIN
  455.         TEMP                       := CUBEARRAY[UP][J+6];
  456.         CUBEARRAY[UP][J+6]         := CUBEARRAY[LEFT][(4-J)*3];
  457.         CUBEARRAY[LEFT][(4-J)*3]   := CUBEARRAY[DOWN][(4-J)];
  458.         CUBEARRAY[DOWN][(4-J)]     := CUBEARRAY[RIGHT][(J*3)-2];
  459.         CUBEARRAY[RIGHT][(J*3)-2]  := TEMP
  460.         END;
  461.     IF (TURN = BACK) THEN
  462.       FOR J := 1 TO 3 DO BEGIN
  463.         TEMP                      := CUBEARRAY[UP][4-J];
  464.         CUBEARRAY[UP][4-J]        := CUBEARRAY[RIGHT][(4-J)*3];
  465.         CUBEARRAY[RIGHT][(4-J)*3] := CUBEARRAY[DOWN][J+6];
  466.         CUBEARRAY[DOWN][J+6]      := CUBEARRAY[LEFT][(J*3)-2];
  467.         CUBEARRAY[LEFT][(J*3)-2]  := TEMP
  468.         END;
  469.     END;
  470. END;
  471.  
  472. (******************************************************************************)
  473.  
  474. PROCEDURE DRAWCUBE;
  475.  
  476. VAR
  477.   I : INTEGER;
  478.  
  479. BEGIN
  480.   FOR I := 1 TO 3 DO BEGIN
  481.     SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
  482.     SQUARE(I+3,TILTTOP,CUBEARRAY[UP][I+3]);
  483.     SQUARE(I+6,TILTTOP,CUBEARRAY[UP][I+6]);
  484.     SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
  485.     SQUARE(I+3,TILTFRONT,CUBEARRAY[FRONT][I+3]);
  486.     SQUARE(I+6,TILTFRONT,CUBEARRAY[FRONT][I+6]);
  487.     SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
  488.     SQUARE(I+3,TILTRIGHT,CUBEARRAY[RIGHT][I+3]);
  489.     SQUARE(I+6,TILTRIGHT,CUBEARRAY[RIGHT][I+6]);
  490.     SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
  491.     SQUARE(I+3,TILTBACK,CUBEARRAY[BACK][(4-I)+3]);
  492.     SQUARE(I+6,TILTBACK,CUBEARRAY[BACK][(4-I)+6]);
  493.     SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
  494.     SQUARE(I+3,TILTLEFT,CUBEARRAY[LEFT][(4-I)+3]);
  495.     SQUARE(I+6,TILTLEFT,CUBEARRAY[LEFT][(4-I)+6]);
  496.     SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][I+6]);
  497.     SQUARE(I+3,TILTDOWN,CUBEARRAY[DOWN][I+3]);
  498.     SQUARE(I+6,TILTDOWN,CUBEARRAY[DOWN][I]);
  499.     END;
  500. END;
  501.  
  502. (******************************************************************************)
  503.  
  504. PROCEDURE TURNCUBE(VAR CUBEARRAY:CUBES;TURN:ROTATE);
  505.  
  506. VAR
  507.   TEMPARRAY : PACKED ARRAY [1..9] OF COLORS;
  508.   J:INTEGER;
  509.  
  510. BEGIN
  511.   CASE TURN OF 
  512.     UP    : BEGIN
  513.               TURNSIDE(RIGHT,1);
  514.               TURNSIDE(LEFT,3);
  515.               FOR J := 1 TO 9 DO BEGIN
  516.                 TEMPARRAY[J]          := CUBEARRAY[UP][J];
  517.                 CUBEARRAY[UP][J]      := CUBEARRAY[FRONT][J];
  518.                 CUBEARRAY[FRONT][J]   := CUBEARRAY[DOWN][J];
  519.                 CUBEARRAY[DOWN][J]    := CUBEARRAY[BACK][10-J];
  520.                 CUBEARRAY[BACK][10-J] := TEMPARRAY[J];
  521.                 END;
  522.               END;
  523.     DOWN  : BEGIN
  524.               TURNSIDE(RIGHT,3);
  525.               TURNSIDE(LEFT,1);
  526.               FOR J := 1 TO 9 DO BEGIN
  527.                 TEMPARRAY[J]          := CUBEARRAY[UP][J];
  528.                 CUBEARRAY[UP][J]      := CUBEARRAY[BACK][10-J];
  529.                 CUBEARRAY[BACK][10-J] := CUBEARRAY[DOWN][J];
  530.                 CUBEARRAY[DOWN][J]    := CUBEARRAY[FRONT][J];
  531.                 CUBEARRAY[FRONT][J]   := TEMPARRAY[J];
  532.                 END;
  533.               END;
  534.     RIGHT : BEGIN
  535.               TURNSIDE(UP,3);
  536.               TURNSIDE(DOWN,1);
  537.               FOR J := 1 TO 9 DO BEGIN
  538.                 TEMPARRAY[J]          := CUBEARRAY[FRONT][J];
  539.                 CUBEARRAY[FRONT][J]   := CUBEARRAY[LEFT][J];
  540.                 CUBEARRAY[LEFT][J]    := CUBEARRAY[BACK][J];
  541.                 CUBEARRAY[BACK][J]    := CUBEARRAY[RIGHT][J];
  542.                 CUBEARRAY[RIGHT][J]   := TEMPARRAY[J];
  543.                 END;
  544.               END;
  545.     LEFT  : BEGIN
  546.               TURNSIDE(UP,1);
  547.               TURNSIDE(DOWN,3);
  548.               FOR J := 1 TO 9 DO BEGIN
  549.                 TEMPARRAY[J]          := CUBEARRAY[FRONT][J];
  550.                 CUBEARRAY[FRONT][J]   := CUBEARRAY[RIGHT][J];
  551.                 CUBEARRAY[RIGHT][J]   := CUBEARRAY[BACK][J];
  552.                 CUBEARRAY[BACK][J]    := CUBEARRAY[LEFT][J];
  553.                 CUBEARRAY[LEFT][J]    := TEMPARRAY[J];
  554.                 END;
  555.               END;
  556.     END;
  557.   DRAWCUBE;
  558. END;
  559.  
  560. (******************************************************************************)
  561.  
  562. PROCEDURE LOADCUBE(VAR CUBEARRAY:CUBES;VAR MOVES,MIXES:INTEGER);
  563.  
  564. BEGIN
  565.   OPEN (FILE_NAME     := 'SYS$LOGIN:CUBE.DAT',
  566.         FILE_VARIABLE := OUTFILE,
  567.         HISTORY       := OLD,
  568.         ACCESS_METHOD := SEQUENTIAL);
  569.   RESET(OUTFILE);
  570.   FOR I := 1 TO 9 DO BEGIN
  571.     READLN(OUTFILE,CUBEARRAY[RIGHT][I]);
  572.     READLN(OUTFILE,CUBEARRAY[LEFT][I]);
  573.     READLN(OUTFILE,CUBEARRAY[UP][I]);
  574.     READLN(OUTFILE,CUBEARRAY[DOWN][I]);
  575.     READLN(OUTFILE,CUBEARRAY[FRONT][I]);
  576.     READLN(OUTFILE,CUBEARRAY[BACK][I]);
  577.     END;
  578.     READLN(OUTFILE,MOVES,MIXES);
  579.   CLOSE(OUTFILE);
  580. END;
  581.  
  582. (******************************************************************************)
  583.  
  584. PROCEDURE SAVECUBE;
  585.  
  586. BEGIN
  587.   OPEN (FILE_NAME     := 'SYS$LOGIN:CUBE.DAT',
  588.         FILE_VARIABLE := OUTFILE,
  589.         HISTORY       := NEW,
  590.         ACCESS_METHOD := SEQUENTIAL);
  591.   REWRITE(OUTFILE);
  592.   FOR I := 1 TO 9 DO BEGIN
  593.     WRITELN(OUTFILE,CUBEARRAY[RIGHT][I]);
  594.     WRITELN(OUTFILE,CUBEARRAY[LEFT][I]);
  595.     WRITELN(OUTFILE,CUBEARRAY[UP][I]);
  596.     WRITELN(OUTFILE,CUBEARRAY[DOWN][I]);
  597.     WRITELN(OUTFILE,CUBEARRAY[FRONT][I]);
  598.     WRITELN(OUTFILE,CUBEARRAY[BACK][I]);
  599.     END;
  600.    WRITELN(OUTFILE,MOVES,MIXES);
  601.    CLOSE(OUTFILE);
  602. END;
  603.  
  604. (******************************************************************************)
  605.  
  606. PROCEDURE WRITEMOVES(MOVES:INTEGER);
  607.  
  608. BEGIN
  609.   POSITION(50,50);
  610.   WRITELN('T''Moves : ',MOVES:1,' '' ');
  611. END;
  612.  
  613. (******************************************************************************)
  614.  
  615. PROCEDURE WRITEMIXES(MIXES:INTEGER);
  616.  
  617. BEGIN
  618.   POSITION(70,50);
  619.   WRITELN('T''Mixes : ',MIXES:1,' '' ');
  620. END;
  621.  
  622. (******************************************************************************)
  623.  
  624. PROCEDURE DRAWSCREEN;
  625.  
  626. BEGIN
  627.   REGIS;
  628.   Writeln('s(m0(ad)m1(ar)m2(ab)m3(ay))');
  629.   WRITELN('S(C0)');
  630.   WRITELN('S(E)');
  631.   POSITION(50,600);
  632.   WRITELN('T''Side to move : '' ');
  633.   POSITION(70,620);
  634.   WRITELN('T''U = Up'' ');
  635.   POSITION(90,620);
  636.   WRITELN('T''D = Down'' ');
  637.   POSITION(110,620);
  638.   WRITELN('T''R = Right'' ');
  639.   POSITION(130,620);
  640.   WRITELN('T''L = Left'' ');
  641.   POSITION(150,620);
  642.   WRITELN('T''F = Front'' ');
  643.   POSITION(170,620);
  644.   WRITELN('T''B = Back'' ');
  645.   POSITION(200,600);
  646.   WRITELN('T''Direction : '' ');
  647.   POSITION(220,620);
  648.   WRITELN('T''+ = +  90 Degrees'' ');
  649.   POSITION(240,620);
  650.   WRITELN('T''- = -  90 Degrees'' ');
  651.   POSITION(260,620);
  652.   WRITELN('T''2 =   180 Degrees'' ');
  653.   POSITION(290,600);
  654.   WRITELN('T''Other Commands : '' ');
  655.   POSITION(310,620);
  656.   WRITELN('T''CTRL-F = Fix Cube'' ');
  657.   POSITION(330,620);
  658.   WRITELN('T''CTRL-J = Jumble Cube'' ');
  659.   POSITION(350,620);
  660.   WRITELN('T''CTRL-L = Load Game'' ');
  661.   POSITION(370,620);
  662.   WRITELN('T''CTRL-H = Save Game'' ');
  663.   POSITION(390,620);
  664.   WRITELN('T''CTRL-W = Screen Refresh'' ');
  665.   POSITION(410,620);
  666.   WRITELN('T''CTRL-Z = Quit Game'' ');
  667.   POSITION(430,620);
  668.   WRITELN('T''Arrow Keys = Rotate'' ');
  669.   WRITEMIXES(MIXES);
  670.   WRITEMOVES(MOVES);
  671.   DRAWCUBE;
  672. END;
  673.  
  674. (******************************************************************************)
  675.  
  676. PROCEDURE CHECKCUBE(VAR DONE:BOOLEAN);
  677.  
  678. VAR
  679.   I:INTEGER;
  680.  
  681. BEGIN
  682.   DONE := TRUE;
  683.   FOR I := 1 TO 9 DO BEGIN
  684.     IF (CUBEARRAY[UP][I]    <> CUBEARRAY[UP][5])    THEN DONE := FALSE;
  685.     IF (CUBEARRAY[DOWN][I]  <> CUBEARRAY[DOWN][5])  THEN DONE := FALSE;
  686.     IF (CUBEARRAY[RIGHT][I] <> CUBEARRAY[RIGHT][5]) THEN DONE := FALSE;
  687.     IF (CUBEARRAY[LEFT][I]  <> CUBEARRAY[LEFT][5])  THEN DONE := FALSE;
  688.     IF (CUBEARRAY[FRONT][I] <> CUBEARRAY[FRONT][5]) THEN DONE := FALSE;
  689.     IF (CUBEARRAY[BACK][I]  <> CUBEARRAY[BACK][5])  THEN DONE := FALSE;
  690.     END;
  691. END;
  692.  
  693. (******************************************************************************)
  694.  
  695. PROCEDURE ESCAPE(VAR KEY:CHAR);
  696.  
  697. VAR 
  698.   KEY2,
  699.   KEY3:CHAR;
  700.  
  701. BEGIN
  702.   KEY2 := ' ';
  703.   KEY3 := ' ';
  704.   KEY2 := GETKEY;
  705.   IF (KEY2 = CHR(63)) OR (KEY2 = CHR(79)) THEN 
  706.     BEGIN
  707.       KEY3 := GETKEY;
  708.       CASE KEY3 OF 
  709.         CHR(108) : KEY := ',';
  710.         CHR(109) : KEY := '-';
  711.         CHR(112) : KEY := '0';
  712.         CHR(113) : KEY := '1';
  713.         CHR(114) : KEY := '2';
  714.         CHR(115) : KEY := '3';
  715.         CHR(116) : KEY := '4';
  716.         CHR(117) : KEY := '5';
  717.         CHR(118) : KEY := '6';
  718.         CHR(119) : KEY := '7';
  719.         CHR(120) : KEY := '8';
  720.         CHR(121) : KEY := '9';
  721.         END;
  722.       END;
  723.     IF (KEY2 = CHR(91)) THEN BEGIN
  724.       KEY3 := GETKEY;
  725.       CASE KEY3 OF
  726.         CHR(65) : TURNCUBE(CUBEARRAY,UP);
  727.         CHR(66) : TURNCUBE(CUBEARRAY,DOWN);
  728.         CHR(67) : TURNCUBE(CUBEARRAY,RIGHT);
  729.         CHR(68) : TURNCUBE(CUBEARRAY,LEFT);
  730.         END;
  731.       END;
  732. END;
  733.  
  734. (******************************************************************************)
  735.  
  736. PROCEDURE MESSCUBE(VAR CUBEARRAY:CUBES);
  737.  
  738. VAR
  739.   DONE:BOOLEAN;
  740.   TEMP,
  741.   RANDOM2,
  742.   RANDOM3:INTEGER;
  743.   RANDOMTURN:ROTATE;
  744.  
  745. BEGIN
  746.   FOR I := 1 TO 40 DO BEGIN
  747.     DONE := FALSE;
  748.     REPEAT
  749.       RANDOMNUMBER(RANDOM2,1,6);
  750.       CASE RANDOM2 OF
  751.         1 : BEGIN
  752.               IF (RANDOM2 <> TEMP) AND (TEMP <> 2) THEN
  753.                 RANDOMTURN := FRONT;
  754.               DONE := TRUE;
  755.               END;
  756.         2 : BEGIN
  757.               IF (RANDOM2 <> TEMP) AND (TEMP <> 1) THEN
  758.                 RANDOMTURN := BACK;
  759.               DONE := TRUE;
  760.               END;
  761.         3 : BEGIN
  762.               IF (RANDOM2 <> TEMP) AND (TEMP <> 4) THEN
  763.                 RANDOMTURN := LEFT;
  764.               DONE := TRUE;
  765.               END;
  766.         4 : BEGIN
  767.               IF (RANDOM2 <> TEMP) AND (TEMP <> 3) THEN
  768.                 RANDOMTURN := RIGHT;
  769.               DONE := TRUE;
  770.               END;
  771.         5 : BEGIN
  772.               IF (RANDOM2 <> TEMP) AND (TEMP <> 6) THEN
  773.                 RANDOMTURN := UP;
  774.               DONE := TRUE;
  775.               END;
  776.         6 : BEGIN
  777.               IF (RANDOM2 <> TEMP) AND (TEMP <> 5) THEN
  778.                 RANDOMTURN := DOWN;
  779.               DONE := TRUE;
  780.               END;
  781.         END
  782.       UNTIL DONE;
  783.     RANDOMNUMBER(RANDOM3,1,2);
  784.     IF RANDOM3 = 2 THEN
  785.       RANDOM3 := 3;
  786.     CHANGEARRAY(CUBEARRAY,RANDOMTURN,RANDOM3);
  787.     TEMP := RANDOM2;
  788.     END;
  789. END;
  790.  
  791. (******************************************************************************)
  792.  
  793. PROCEDURE TYPED(VAR TURN:ROTATE;VAR DIR:INTEGER;VAR DONE:BOOLEAN;VAR 
  794.                 MOVES:INTEGER);
  795.  
  796. BEGIN
  797.   TURN := NONE;
  798.   REPEAT
  799.     KEY := GETKEY;
  800.     IF (KEY = CHR(27)) THEN ESCAPE(KEY);
  801.     CASE KEY OF
  802.       CHR(6)       : BEGIN
  803.                        TURN := NONE;
  804.                        INITIALIZE(CUBEARRAY,MIXES,MOVES,SCORE);
  805.                        DRAWCUBE;
  806.                        END;
  807.       CHR(10)      : BEGIN
  808.                       MESSCUBE(CUBEARRAY);
  809.                       MESSCUBE(CUBEARRAY);
  810.                       MIXES := MIXES +1;
  811.                       DRAWCUBE;
  812.                       WRITEMIXES(MIXES);
  813.                       TURN := NONE;
  814.                       END;
  815.       CHR(8)      : BEGIN
  816.                       SAVECUBE;
  817.                       END;
  818.       CHR(12)     : BEGIN
  819.                       LOADCUBE(CUBEARRAY,MOVES,MIXES);
  820.                       DRAWCUBE;
  821.                       WRITEMOVES(MOVES);
  822.                       WRITEMIXES(MIXES);
  823.                       TURN := NONE;
  824.                       END;
  825.       CHR(26)     : DONE := TRUE;
  826.       CHR(23)     : DRAWSCREEN;
  827.       'R','r','6' : TURN := RIGHT;
  828.       'L','l','4' : TURN := LEFT;
  829.       'F','f','5' : TURN := FRONT;
  830.       'B','b','9' : TURN := BACK;
  831.       'U','u','8' : TURN := UP;
  832.       'D','d','2' : TURN := DOWN
  833.     OTHERWISE
  834.       TURN := NONE;
  835.       END;
  836.   UNTIL (TURN <> NONE) OR (KEY = CHR(23)) OR (KEY = CHR(26)) OR 
  837.         (KEY = CHR(8)) OR (KEY = CHR(12));
  838.   DIR := 0;
  839.   IF (KEY <> CHR(23)) AND (KEY <> CHR(26))  AND 
  840.      (KEY <> CHR(8)) AND (KEY <> CHR(12)) THEN REPEAT
  841.     KEY := GETKEY;
  842.     IF (KEY = CHR(27)) THEN ESCAPE(KEY);
  843.     CASE KEY OF
  844.       '+',',' : DIR := 1;
  845.       '2'     : DIR := 2;
  846.       '-'     : DIR := 3
  847.     OTHERWISE
  848.       DIR := 0;
  849.       END
  850.     UNTIL (DIR <> 0);  
  851.   IF (DIR <> 0) THEN MOVES := MOVES + 1;
  852. END;
  853.  
  854. (******************************************************************************)
  855.  
  856. (* MAIN *)
  857.  
  858. BEGIN
  859.   OPENKEY;
  860.   KEY   := ' ';
  861.   I := 0;
  862.     REGIS;
  863.     WRITELN('T(A0)');
  864.     DRAWSCREEN;
  865.     QUIT := FALSE;
  866.     WHILE NOT(DONE) AND NOT(QUIT) DO BEGIN
  867.       I := 0;
  868.       TYPED(TURN,DIR,QUIT,MOVES);
  869.       CHANGEARRAY(CUBEARRAY,TURN,DIR);
  870.       SIDES(TURN);
  871.       WRITEMOVES(MOVES);
  872.   (*    CHECKCUBE(DONE);*)
  873.       END;
  874.   IF DONE THEN BEGIN
  875.     END;
  876.   SHUTKEY;
  877.   ASCII;
  878. END.
  879.