games@tekred.TEK.COM (05/21/88)
Submitted by: uunet!bsu-cs!starcat (Bud Crittenden)
Comp.sources.games: Volume 4, Issue 14
Archive-name: rubik.shr
[I haven't tried this, so you're on your own. -br]
[[Here it is... It has some open spots for the compiler to chose (such as
the ending, and whether or not the cube is checked for being solved).]]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: cube.pas
# Wrapped by billr@saab on Fri May 20 15:02:03 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f cube.pas -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"cube.pas\"
else
echo shar: Extracting \"cube.pas\" \(25565 characters\)
sed "s/^X//" >cube.pas <<'END_OF_cube.pas'
X[INHERIT ('SYS$LIBRARY:STARLET.PEN')]
X(* Rubik's cube simulator for VAX/VMS and ReGIS graphics *)
X(* by Bud Crittendon *)
X
XPROGRAM CUBE(INPUT,OUTPUT,OUTFILE);
X
XConst
X CubeSize = 35;
X CubeSep = CubeSize + 6;
X CubeCornerX = 200;
X CubeCornerY = 200;
X TiltAngle = 0.5235987;
X ColorRed = 1;
X ColorBlue = 2;
X ColorYellow = 3;
X
XTYPE
X Iword = [WORD] 0..65535;
X ShortString = PACKED ARRAY [1..12] OF CHAR;
X Rotate = (NONE,LEFT,RIGHT,UP,DOWN,FRONT,BACK);
X Where = (TILTFRONT,TILTTOP,TILTRIGHT,TILTLEFT,TILTDOWN,TILTBACK);
X Colors = (YELLOW,WHITE,BLUE,GREEN,RED,ORANGE);
X CUBITS = PACKED ARRAY [1..9] OF COLORS;
X CUBES = PACKED ARRAY [LEFT..BACK] OF CUBITS;
X
XVAR
X X,
X Y,
X L,
X C1,
X C2,
X CUBESEPX,
X CUBESEPY,
X CUBEADJX,
X CUBEADJY,
X SCORE,
X MIXES,
X MOVES,
X CUBEADJUST,
X DIR,
X I:INTEGER;
X QUIT,
X DONE:BOOLEAN;
X CUBEARRAY:CUBES;
X CCOLOR,
X COLOR:COLORS;
X CTYPE,
X CUBEPLACE:WHERE;
X TURN:ROTATE;
X KEY:CHAR;
X IOCHAN:IWORD;
X OUTFILE:TEXT;
X
X(******************************************************************************)
X
X[INITIALIZE]
XPROCEDURE InitializeCubeParams;
X BEGIN
X WRITELN(CHR(27),'P1p');
X WRITELN('S(M0(AD)M1(AR)M2(AB)M3(AY))');
X WRITELN('l(a2)"A"55aa55aa55aa55aa55aa;');
X WRITELN(CHR(27),'\');
X
X FOR I := 1 TO 9 DO BEGIN
X CUBEARRAY[RIGHT][I] := YELLOW;
X CUBEARRAY[LEFT][I] := WHITE;
X CUBEARRAY[UP][I] := BLUE;
X CUBEARRAY[DOWN][I] := GREEN;
X CUBEARRAY[FRONT][I] := RED;
X CUBEARRAY[BACK][I] := ORANGE;
X END;
X DONE := FALSE;
X QUIT := FALSE;
X MOVES := 0;
X MIXES := 0;
X SCORE := 0;
X CubeAdjX := round(CubeSize * cos(TiltAngle));
X CubeAdjY := round(CubeSize * sin(TiltAngle));
X CubeSepX := round(CubeSep * cos(TiltAngle));
X CubeSepY := round(CubeSep * sin(TiltAngle));
X END;
X
X(******************************************************************************)
X
XPROCEDURE Initialize(VAR CUBEARRAY:CUBES;VAR MIXES,MOVES,SCORE:INTEGER);
X
XBEGIN
X FOR I := 1 TO 9 DO BEGIN
X CUBEARRAY[RIGHT][I] := YELLOW;
X CUBEARRAY[LEFT][I] := WHITE;
X CUBEARRAY[UP][I] := BLUE;
X CUBEARRAY[DOWN][I] := GREEN;
X CUBEARRAY[FRONT][I] := RED;
X CUBEARRAY[BACK][I] := ORANGE;
X END;
X MOVES := 0;
X MIXES := 0;
X SCORE := 0;
X END;
X
X(******************************************************************************)
X
XPROCEDURE REGIS;
X
XBEGIN
X WRITELN(CHR(27),'Pp');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE ASCII;
X
XBEGIN
X WRITELN(CHR(27),'[;H');
X WRITELN(CHR(27),'\');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE POSITION(ROW,COL:INTEGER);
X
XBEGIN
X WRITELN('P[',COL:1,',',ROW:1,']');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE RANDOMNUMBER(VAR RANDOM:INTEGER;MINVALUE,MAXVALUE:INTEGER);
X
XTYPE
X STRING = PACKED ARRAY [1..11] OF CHAR;
X
XVAR
X CURTIME : STRING;
X SEED : INTEGER;
X
XBEGIN
X CURTIME := '00:00:00.00';
X TIME(CURTIME);
X RANDOM := 0;
X SEED := 0;
X SEED := SEED + 1 * (ORD(CURTIME[10])-48);
X SEED := SEED + 10 * (ORD(CURTIME[11])-48);
X RANDOM := ROUND((SEED/99) * (MAXVALUE - MINVALUE)) + MINVALUE;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE Coords ( VAR CubeNumber: integer; VAR CubeType: Where);
X VAR bx,by,ccx,ccy:integer;
X BEGIN
X bx := (CubeNumber-1) MOD 3;
X by := (CubeNumber-1) DIV 3;
X CASE CubeType OF
X TILTFRONT,
X TILTRIGHT,
X TILTTOP: BEGIN
X ccx := CubeCornerX;
X ccy := CubeCornerY;
X END;
X TILTBACK: BEGIN
X ccx := CubeCornerX + CubeSepX*7;
X ccy := CubeCornerY - CubeSepy*7;
X END;
X TILTLEFT: BEGIN
X ccx := CubeCornerX - CubeSepX*7;
X ccy := CubeCornerY;
X END;
X TILTDOWN: BEGIN
X ccx := CubeCornerX;
X ccy := CubeCornerY + CubeSepY*10;
X END;
X OTHERWISE;
X END;
X CASE CubeType OF
X TILTFRONT,TILTBACK:
X BEGIN
X x := ccx + bx * CubeSep ;
X y := ccy + by * CubeSep ;
X END;
X TILTRIGHT,TILTLEFT:
X BEGIN
X x := ccx + (CubeSep * 3) + (bx * CubeSepX);
X y := ccy + (CubeSep * by) - (bx * CubeSepY);
X END;
X TILTTOP,TILTDOWN:
X BEGIN
X x := ccx + (CubeSepX *3) + (bx*CubeSep) - (by*CubeSepX);
X y := ccy - (CubeSepY *3) + (by*CubeSepY);
X END;
X END;
X END;
X
X(******************************************************************************)
X
XPROCEDURE SetColor(VAR Color: Colors);
X BEGIN
X CASE Color OF
X RED : BEGIN
X c1 := ColorRed;
X c2 := ColorRed;
X END;
X YELLOW:
X BEGIN
X c1 := ColorYellow;
X c2 := ColorYellow;
X END;
X BLUE:
X BEGIN
X c1 := ColorBlue;
X c2 := ColorBlue;
X END;
X ORANGE:
X BEGIN
X c1 := ColorRed;
X c2 := ColorYellow;
X END;
X WHITE:
X BEGIN
X c1 := ColorBlue;
X c2 := ColorYellow;
X END;
X GREEN:
X BEGIN
X c1 := ColorBlue;
X c2 := ColorRed;
X END;
X END;
X END;
X
X(******************************************************************************)
X
XPROCEDURE SetFill(VAR CubeType: Where);
X VAR solid : boolean;
X BEGIN
X solid := (c1 = c2);
X Write('w(r,i',c1:1,',s');
X IF solid
X THEN
X BEGIN
X CASE CubeType OF
X TILTBACK,TILTLEFT,TILTFRONT,TILTRIGHT: Writeln('1)');
X TILTDOWN,TILTTOP: Writeln('1(x))');
X END;
X END
X ELSE
X BEGIN
X CASE CubeType OF
X TILTBACK,TILTLEFT,TILTFRONT,TILTRIGHT: Writeln('"A")s(i',c2:1,')');
X TILTDOWN,TILTTOP: Writeln('"A"(x))s(i',c2:1,')');
X END;
X END;
X END;
X
X(******************************************************************************)
X
XPROCEDURE Square (CubeNumber: integer;
X CubeType: Where; Color: Colors);
X
X BEGIN
X Coords(CubeNumber,CubeType); (* Compute X,Y *)
X Writeln('p[',x,',',y,']t(a2)'); (* Place cursor at x,y *)
X SetColor(Color); (* Select c1 and c2 *)
X CASE CubeType OF
X TILTFRONT,TILTBACK:
X BEGIN
X SetFill(CubeType);
X Writeln('v[,+',cubesize,'][+',cubesize,']');
X END;
X TILTRIGHT,TILTLEFT:
X BEGIN
X SetFill(CubeType);
X Writeln('v[,+',cubesize,'][+',CubeAdjX,
X ',-',CubeAdjY,']');
X Writeln('v[,-',cubesize,'][-',CubeAdjX,
X ',+',CubeAdjY,']')
X END;
X TILTTOP,TILTDOWN:
X BEGIN
X SetFill(CubeType);
X Writeln('v[-',CubeAdjX,',+',CubeAdjY,
X '][+',Cubesize,']');
X Writeln('v[+',CubeAdjX,',-',CubeadjY,']');
X END;
X END;
X Writeln('w(s0)s(i0)t(a0)');
X END;
X
X(******************************************************************************)
X
XPROCEDURE OPENKEY;
X VAR
X STAT : IWORD;
X DEVNAME: SHORTSTRING;
X BEGIN
X DEVNAME := 'TT:';
X STAT := $ASSIGN(DEVNAME,IOCHAN);
X END;
X
X(******************************************************************************)
X
XPROCEDURE SHUTKEY;
X VAR
X STAT : IWORD;
X BEGIN
X STAT := $DASSGN(IOCHAN);
X END;
X
X(******************************************************************************)
X
XFUNCTION GETKEY:CHAR;
X VAR
X FUNC,STAT : IWORD;
X CH : CHAR;
X BEGIN
X FUNC := IO$_READVBLK + IO$M_NOECHO + IO$M_NOFILTR;
X STAT := $QIOW (,IOCHAN,FUNC,,,,CH,1);
X GETKEY := CH;
X END;
X
X(******************************************************************************)
X
XPROCEDURE SIDES(TURN:ROTATE);
X
XBEGIN
X CASE TURN OF
X FRONT : FOR I := 1 TO 3 DO BEGIN
X SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
X SQUARE(I+3,TILTFRONT,CUBEARRAY[FRONT][I+3]);
X SQUARE(I+6,TILTFRONT,CUBEARRAY[FRONT][I+6]);
X SQUARE((I+6),TILTTOP,CUBEARRAY[UP][I+6]);
X SQUARE(((I*3)-2),TILTRIGHT,CUBEARRAY[RIGHT][((I*3)-2)]);
X SQUARE((I+6),TILTDOWN,CUBEARRAY[DOWN][I]);
X SQUARE(((I*3)-2),TILTLEFT,CUBEARRAY[LEFT][(I*3)]);
X END;
X RIGHT : FOR I := 1 TO 3 DO BEGIN
X SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
X SQUARE(I+3,TILTRIGHT,CUBEARRAY[RIGHT][I+3]);
X SQUARE(I+6,TILTRIGHT,CUBEARRAY[RIGHT][I+6]);
X SQUARE((I*3),TILTTOP,CUBEARRAY[UP][I*3]);
X SQUARE((I*3),TILTFRONT,CUBEARRAY[FRONT][(I*3)]);
X SQUARE((I*3),TILTDOWN,CUBEARRAY[DOWN][((4-I)*3)]);
X SQUARE((I*3),TILTBACK,CUBEARRAY[BACK][((I*3)-2)]);
X END;
X UP : FOR I := 1 TO 3 DO BEGIN
X SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
X SQUARE(I+3,TILTTOP,CUBEARRAY[UP][I+3]);
X SQUARE(I+6,TILTTOP,CUBEARRAY[UP][I+6]);
X SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
X SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
X SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
X SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
X END;
X BACK : FOR I := 1 TO 3 DO BEGIN
X SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
X SQUARE(I+3,TILTBACK,CUBEARRAY[BACK][(4-I)+3]);
X SQUARE(I+6,TILTBACK,CUBEARRAY[BACK][(4-I)+6]);
X SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
X SQUARE((I*3),TILTRIGHT,CUBEARRAY[RIGHT][(I*3)]);
X SQUARE((I*3),TILTLEFT,CUBEARRAY[LEFT][((I*3)-2)]);
X SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][(I+6)]);
X END;
X LEFT : FOR I := 1 TO 3 DO BEGIN
X SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
X SQUARE(I+3,TILTLEFT,CUBEARRAY[LEFT][(4-I)+3]);
X SQUARE(I+6,TILTLEFT,CUBEARRAY[LEFT][(4-I)+6]);
X SQUARE(((I*3)-2),TILTTOP,CUBEARRAY[UP][((I*3)-2)]);
X SQUARE(((I*3)-2),TILTFRONT,CUBEARRAY[FRONT][((I*3)-2)]);
X SQUARE(((I*3)-2),TILTBACK,CUBEARRAY[BACK][(I*3)]);
X SQUARE(((I*3)-2),TILTDOWN,CUBEARRAY[DOWN][(((4-I)*3)-2)]);
X END;
X DOWN : FOR I := 1 TO 3 DO BEGIN
X SQUARE(I+6,TILTDOWN,CUBEARRAY[DOWN][I]);
X SQUARE(I+3,TILTDOWN,CUBEARRAY[DOWN][I+3]);
X SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][(I+6)]);
X SQUARE((I+6),TILTFRONT,CUBEARRAY[FRONT][(I+6)]);
X SQUARE((I+6),TILTRIGHT,CUBEARRAY[RIGHT][(I+6)]);
X SQUARE((I+6),TILTBACK,CUBEARRAY[BACK][((4-I)+6)]);
X SQUARE((I+6),TILTLEFT,CUBEARRAY[LEFT][((4-I)+6)]);
X END;
X END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE TURNSIDE(TURN:ROTATE;DIR:INTEGER);
X
XVAR
X NUMBER:INTEGER;
X TEMP:COLORS;
X
XBEGIN
X FOR NUMBER := 1 TO DIR DO BEGIN
X TEMP := CUBEARRAY[TURN][1];
X CUBEARRAY[TURN][1] := CUBEARRAY[TURN][7];
X CUBEARRAY[TURN][7] := CUBEARRAY[TURN][9];
X CUBEARRAY[TURN][9] := CUBEARRAY[TURN][3];
X CUBEARRAY[TURN][3] := TEMP;
X TEMP := CUBEARRAY[TURN][2];
X CUBEARRAY[TURN][2] := CUBEARRAY[TURN][4];
X CUBEARRAY[TURN][4] := CUBEARRAY[TURN][8];
X CUBEARRAY[TURN][8] := CUBEARRAY[TURN][6];
X CUBEARRAY[TURN][6] := TEMP;
X END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE CHANGEARRAY(VAR CUBEARRAY:CUBES;TURN:ROTATE;DIR:INTEGER);
X
XVAR
X TEMPARRAY : PACKED ARRAY [1..3] OF COLORS;
X TEMP:COLORS;
X J,
X X,
X Y:INTEGER;
X
XBEGIN
X TURNSIDE(TURN,DIR);
X FOR X := 1 TO DIR DO BEGIN
X IF (TURN = UP) THEN
X FOR J := 1 TO 3 DO BEGIN
X TEMP := CUBEARRAY[FRONT][J];
X CUBEARRAY[FRONT][J] := CUBEARRAY[RIGHT][J];
X CUBEARRAY[RIGHT][J] := CUBEARRAY[BACK][J];
X CUBEARRAY[BACK][J] := CUBEARRAY[LEFT][J];
X CUBEARRAY[LEFT][J] := TEMP;
X END;
X IF (TURN = DOWN) THEN
X FOR J := 1 TO 3 DO BEGIN
X TEMP := CUBEARRAY[FRONT][J+6];
X CUBEARRAY[FRONT][J+6] := CUBEARRAY[LEFT][J+6];
X CUBEARRAY[LEFT][J+6] := CUBEARRAY[BACK][J+6];
X CUBEARRAY[BACK][J+6] := CUBEARRAY[RIGHT][J+6];
X CUBEARRAY[RIGHT][J+6] := TEMP;
X END;
X IF (TURN = RIGHT) THEN
X FOR J := 1 TO 3 DO BEGIN
X TEMP := CUBEARRAY[FRONT][(4-J)*3];
X CUBEARRAY[FRONT][(4-J)*3] := CUBEARRAY[DOWN][(4-J)*3];
X CUBEARRAY[DOWN][(4-J)*3] := CUBEARRAY[BACK][(J*3)-2];
X CUBEARRAY[BACK][(J*3)-2] := CUBEARRAY[UP][(4-J)*3];
X CUBEARRAY[UP][(4-J)*3] := TEMP;
X END;
X IF (TURN = LEFT) THEN
X FOR J := 1 TO 3 DO BEGIN
X TEMP := CUBEARRAY[FRONT][(J*3)-2];
X CUBEARRAY[FRONT][(J*3)-2] := CUBEARRAY[UP][(J*3)-2];
X CUBEARRAY[UP][(J*3)-2] := CUBEARRAY[BACK][(4-J)*3];
X CUBEARRAY[BACK][(4-J)*3] := CUBEARRAY[DOWN][(J*3)-2];
X CUBEARRAY[DOWN][(J*3)-2] := TEMP;
X END;
X IF (TURN = FRONT) THEN
X FOR J := 1 TO 3 DO BEGIN
X TEMP := CUBEARRAY[UP][J+6];
X CUBEARRAY[UP][J+6] := CUBEARRAY[LEFT][(4-J)*3];
X CUBEARRAY[LEFT][(4-J)*3] := CUBEARRAY[DOWN][(4-J)];
X CUBEARRAY[DOWN][(4-J)] := CUBEARRAY[RIGHT][(J*3)-2];
X CUBEARRAY[RIGHT][(J*3)-2] := TEMP
X END;
X IF (TURN = BACK) THEN
X FOR J := 1 TO 3 DO BEGIN
X TEMP := CUBEARRAY[UP][4-J];
X CUBEARRAY[UP][4-J] := CUBEARRAY[RIGHT][(4-J)*3];
X CUBEARRAY[RIGHT][(4-J)*3] := CUBEARRAY[DOWN][J+6];
X CUBEARRAY[DOWN][J+6] := CUBEARRAY[LEFT][(J*3)-2];
X CUBEARRAY[LEFT][(J*3)-2] := TEMP
X END;
X END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE DRAWCUBE;
X
XVAR
X I : INTEGER;
X
XBEGIN
X FOR I := 1 TO 3 DO BEGIN
X SQUARE(I,TILTTOP,CUBEARRAY[UP][I]);
X SQUARE(I+3,TILTTOP,CUBEARRAY[UP][I+3]);
X SQUARE(I+6,TILTTOP,CUBEARRAY[UP][I+6]);
X SQUARE(I,TILTFRONT,CUBEARRAY[FRONT][I]);
X SQUARE(I+3,TILTFRONT,CUBEARRAY[FRONT][I+3]);
X SQUARE(I+6,TILTFRONT,CUBEARRAY[FRONT][I+6]);
X SQUARE(I,TILTRIGHT,CUBEARRAY[RIGHT][I]);
X SQUARE(I+3,TILTRIGHT,CUBEARRAY[RIGHT][I+3]);
X SQUARE(I+6,TILTRIGHT,CUBEARRAY[RIGHT][I+6]);
X SQUARE(I,TILTBACK,CUBEARRAY[BACK][(4-I)]);
X SQUARE(I+3,TILTBACK,CUBEARRAY[BACK][(4-I)+3]);
X SQUARE(I+6,TILTBACK,CUBEARRAY[BACK][(4-I)+6]);
X SQUARE(I,TILTLEFT,CUBEARRAY[LEFT][(4-I)]);
X SQUARE(I+3,TILTLEFT,CUBEARRAY[LEFT][(4-I)+3]);
X SQUARE(I+6,TILTLEFT,CUBEARRAY[LEFT][(4-I)+6]);
X SQUARE(I,TILTDOWN,CUBEARRAY[DOWN][I+6]);
X SQUARE(I+3,TILTDOWN,CUBEARRAY[DOWN][I+3]);
X SQUARE(I+6,TILTDOWN,CUBEARRAY[DOWN][I]);
X END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE TURNCUBE(VAR CUBEARRAY:CUBES;TURN:ROTATE);
X
XVAR
X TEMPARRAY : PACKED ARRAY [1..9] OF COLORS;
X J:INTEGER;
X
XBEGIN
X CASE TURN OF
X UP : BEGIN
X TURNSIDE(RIGHT,1);
X TURNSIDE(LEFT,3);
X FOR J := 1 TO 9 DO BEGIN
X TEMPARRAY[J] := CUBEARRAY[UP][J];
X CUBEARRAY[UP][J] := CUBEARRAY[FRONT][J];
X CUBEARRAY[FRONT][J] := CUBEARRAY[DOWN][J];
X CUBEARRAY[DOWN][J] := CUBEARRAY[BACK][10-J];
X CUBEARRAY[BACK][10-J] := TEMPARRAY[J];
X END;
X END;
X DOWN : BEGIN
X TURNSIDE(RIGHT,3);
X TURNSIDE(LEFT,1);
X FOR J := 1 TO 9 DO BEGIN
X TEMPARRAY[J] := CUBEARRAY[UP][J];
X CUBEARRAY[UP][J] := CUBEARRAY[BACK][10-J];
X CUBEARRAY[BACK][10-J] := CUBEARRAY[DOWN][J];
X CUBEARRAY[DOWN][J] := CUBEARRAY[FRONT][J];
X CUBEARRAY[FRONT][J] := TEMPARRAY[J];
X END;
X END;
X RIGHT : BEGIN
X TURNSIDE(UP,3);
X TURNSIDE(DOWN,1);
X FOR J := 1 TO 9 DO BEGIN
X TEMPARRAY[J] := CUBEARRAY[FRONT][J];
X CUBEARRAY[FRONT][J] := CUBEARRAY[LEFT][J];
X CUBEARRAY[LEFT][J] := CUBEARRAY[BACK][J];
X CUBEARRAY[BACK][J] := CUBEARRAY[RIGHT][J];
X CUBEARRAY[RIGHT][J] := TEMPARRAY[J];
X END;
X END;
X LEFT : BEGIN
X TURNSIDE(UP,1);
X TURNSIDE(DOWN,3);
X FOR J := 1 TO 9 DO BEGIN
X TEMPARRAY[J] := CUBEARRAY[FRONT][J];
X CUBEARRAY[FRONT][J] := CUBEARRAY[RIGHT][J];
X CUBEARRAY[RIGHT][J] := CUBEARRAY[BACK][J];
X CUBEARRAY[BACK][J] := CUBEARRAY[LEFT][J];
X CUBEARRAY[LEFT][J] := TEMPARRAY[J];
X END;
X END;
X END;
X DRAWCUBE;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE LOADCUBE(VAR CUBEARRAY:CUBES;VAR MOVES,MIXES:INTEGER);
X
XBEGIN
X OPEN (FILE_NAME := 'SYS$LOGIN:CUBE.DAT',
X FILE_VARIABLE := OUTFILE,
X HISTORY := OLD,
X ACCESS_METHOD := SEQUENTIAL);
X RESET(OUTFILE);
X FOR I := 1 TO 9 DO BEGIN
X READLN(OUTFILE,CUBEARRAY[RIGHT][I]);
X READLN(OUTFILE,CUBEARRAY[LEFT][I]);
X READLN(OUTFILE,CUBEARRAY[UP][I]);
X READLN(OUTFILE,CUBEARRAY[DOWN][I]);
X READLN(OUTFILE,CUBEARRAY[FRONT][I]);
X READLN(OUTFILE,CUBEARRAY[BACK][I]);
X END;
X READLN(OUTFILE,MOVES,MIXES);
X CLOSE(OUTFILE);
XEND;
X
X(******************************************************************************)
X
XPROCEDURE SAVECUBE;
X
XBEGIN
X OPEN (FILE_NAME := 'SYS$LOGIN:CUBE.DAT',
X FILE_VARIABLE := OUTFILE,
X HISTORY := NEW,
X ACCESS_METHOD := SEQUENTIAL);
X REWRITE(OUTFILE);
X FOR I := 1 TO 9 DO BEGIN
X WRITELN(OUTFILE,CUBEARRAY[RIGHT][I]);
X WRITELN(OUTFILE,CUBEARRAY[LEFT][I]);
X WRITELN(OUTFILE,CUBEARRAY[UP][I]);
X WRITELN(OUTFILE,CUBEARRAY[DOWN][I]);
X WRITELN(OUTFILE,CUBEARRAY[FRONT][I]);
X WRITELN(OUTFILE,CUBEARRAY[BACK][I]);
X END;
X WRITELN(OUTFILE,MOVES,MIXES);
X CLOSE(OUTFILE);
XEND;
X
X(******************************************************************************)
X
XPROCEDURE WRITEMOVES(MOVES:INTEGER);
X
XBEGIN
X POSITION(50,50);
X WRITELN('T''Moves : ',MOVES:1,' '' ');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE WRITEMIXES(MIXES:INTEGER);
X
XBEGIN
X POSITION(70,50);
X WRITELN('T''Mixes : ',MIXES:1,' '' ');
XEND;
X
X(******************************************************************************)
X
XPROCEDURE DRAWSCREEN;
X
XBEGIN
X REGIS;
X Writeln('s(m0(ad)m1(ar)m2(ab)m3(ay))');
X WRITELN('S(C0)');
X WRITELN('S(E)');
X POSITION(50,600);
X WRITELN('T''Side to move : '' ');
X POSITION(70,620);
X WRITELN('T''U = Up'' ');
X POSITION(90,620);
X WRITELN('T''D = Down'' ');
X POSITION(110,620);
X WRITELN('T''R = Right'' ');
X POSITION(130,620);
X WRITELN('T''L = Left'' ');
X POSITION(150,620);
X WRITELN('T''F = Front'' ');
X POSITION(170,620);
X WRITELN('T''B = Back'' ');
X POSITION(200,600);
X WRITELN('T''Direction : '' ');
X POSITION(220,620);
X WRITELN('T''+ = + 90 Degrees'' ');
X POSITION(240,620);
X WRITELN('T''- = - 90 Degrees'' ');
X POSITION(260,620);
X WRITELN('T''2 = 180 Degrees'' ');
X POSITION(290,600);
X WRITELN('T''Other Commands : '' ');
X POSITION(310,620);
X WRITELN('T''CTRL-F = Fix Cube'' ');
X POSITION(330,620);
X WRITELN('T''CTRL-J = Jumble Cube'' ');
X POSITION(350,620);
X WRITELN('T''CTRL-L = Load Game'' ');
X POSITION(370,620);
X WRITELN('T''CTRL-H = Save Game'' ');
X POSITION(390,620);
X WRITELN('T''CTRL-W = Screen Refresh'' ');
X POSITION(410,620);
X WRITELN('T''CTRL-Z = Quit Game'' ');
X POSITION(430,620);
X WRITELN('T''Arrow Keys = Rotate'' ');
X WRITEMIXES(MIXES);
X WRITEMOVES(MOVES);
X DRAWCUBE;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE CHECKCUBE(VAR DONE:BOOLEAN);
X
XVAR
X I:INTEGER;
X
XBEGIN
X DONE := TRUE;
X FOR I := 1 TO 9 DO BEGIN
X IF (CUBEARRAY[UP][I] <> CUBEARRAY[UP][5]) THEN DONE := FALSE;
X IF (CUBEARRAY[DOWN][I] <> CUBEARRAY[DOWN][5]) THEN DONE := FALSE;
X IF (CUBEARRAY[RIGHT][I] <> CUBEARRAY[RIGHT][5]) THEN DONE := FALSE;
X IF (CUBEARRAY[LEFT][I] <> CUBEARRAY[LEFT][5]) THEN DONE := FALSE;
X IF (CUBEARRAY[FRONT][I] <> CUBEARRAY[FRONT][5]) THEN DONE := FALSE;
X IF (CUBEARRAY[BACK][I] <> CUBEARRAY[BACK][5]) THEN DONE := FALSE;
X END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE ESCAPE(VAR KEY:CHAR);
X
XVAR
X KEY2,
X KEY3:CHAR;
X
XBEGIN
X KEY2 := ' ';
X KEY3 := ' ';
X KEY2 := GETKEY;
X IF (KEY2 = CHR(63)) OR (KEY2 = CHR(79)) THEN
X BEGIN
X KEY3 := GETKEY;
X CASE KEY3 OF
X CHR(108) : KEY := ',';
X CHR(109) : KEY := '-';
X CHR(112) : KEY := '0';
X CHR(113) : KEY := '1';
X CHR(114) : KEY := '2';
X CHR(115) : KEY := '3';
X CHR(116) : KEY := '4';
X CHR(117) : KEY := '5';
X CHR(118) : KEY := '6';
X CHR(119) : KEY := '7';
X CHR(120) : KEY := '8';
X CHR(121) : KEY := '9';
X END;
X END;
X IF (KEY2 = CHR(91)) THEN BEGIN
X KEY3 := GETKEY;
X CASE KEY3 OF
X CHR(65) : TURNCUBE(CUBEARRAY,UP);
X CHR(66) : TURNCUBE(CUBEARRAY,DOWN);
X CHR(67) : TURNCUBE(CUBEARRAY,RIGHT);
X CHR(68) : TURNCUBE(CUBEARRAY,LEFT);
X END;
X END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE MESSCUBE(VAR CUBEARRAY:CUBES);
X
XVAR
X DONE:BOOLEAN;
X TEMP,
X RANDOM2,
X RANDOM3:INTEGER;
X RANDOMTURN:ROTATE;
X
XBEGIN
X FOR I := 1 TO 40 DO BEGIN
X DONE := FALSE;
X REPEAT
X RANDOMNUMBER(RANDOM2,1,6);
X CASE RANDOM2 OF
X 1 : BEGIN
X IF (RANDOM2 <> TEMP) AND (TEMP <> 2) THEN
X RANDOMTURN := FRONT;
X DONE := TRUE;
X END;
X 2 : BEGIN
X IF (RANDOM2 <> TEMP) AND (TEMP <> 1) THEN
X RANDOMTURN := BACK;
X DONE := TRUE;
X END;
X 3 : BEGIN
X IF (RANDOM2 <> TEMP) AND (TEMP <> 4) THEN
X RANDOMTURN := LEFT;
X DONE := TRUE;
X END;
X 4 : BEGIN
X IF (RANDOM2 <> TEMP) AND (TEMP <> 3) THEN
X RANDOMTURN := RIGHT;
X DONE := TRUE;
X END;
X 5 : BEGIN
X IF (RANDOM2 <> TEMP) AND (TEMP <> 6) THEN
X RANDOMTURN := UP;
X DONE := TRUE;
X END;
X 6 : BEGIN
X IF (RANDOM2 <> TEMP) AND (TEMP <> 5) THEN
X RANDOMTURN := DOWN;
X DONE := TRUE;
X END;
X END
X UNTIL DONE;
X RANDOMNUMBER(RANDOM3,1,2);
X IF RANDOM3 = 2 THEN
X RANDOM3 := 3;
X CHANGEARRAY(CUBEARRAY,RANDOMTURN,RANDOM3);
X TEMP := RANDOM2;
X END;
XEND;
X
X(******************************************************************************)
X
XPROCEDURE TYPED(VAR TURN:ROTATE;VAR DIR:INTEGER;VAR DONE:BOOLEAN;VAR
X MOVES:INTEGER);
X
XBEGIN
X TURN := NONE;
X REPEAT
X KEY := GETKEY;
X IF (KEY = CHR(27)) THEN ESCAPE(KEY);
X CASE KEY OF
X CHR(6) : BEGIN
X TURN := NONE;
X INITIALIZE(CUBEARRAY,MIXES,MOVES,SCORE);
X DRAWCUBE;
X END;
X CHR(10) : BEGIN
X MESSCUBE(CUBEARRAY);
X MESSCUBE(CUBEARRAY);
X MIXES := MIXES +1;
X DRAWCUBE;
X WRITEMIXES(MIXES);
X TURN := NONE;
X END;
X CHR(8) : BEGIN
X SAVECUBE;
X END;
X CHR(12) : BEGIN
X LOADCUBE(CUBEARRAY,MOVES,MIXES);
X DRAWCUBE;
X WRITEMOVES(MOVES);
X WRITEMIXES(MIXES);
X TURN := NONE;
X END;
X CHR(26) : DONE := TRUE;
X CHR(23) : DRAWSCREEN;
X 'R','r','6' : TURN := RIGHT;
X 'L','l','4' : TURN := LEFT;
X 'F','f','5' : TURN := FRONT;
X 'B','b','9' : TURN := BACK;
X 'U','u','8' : TURN := UP;
X 'D','d','2' : TURN := DOWN
X OTHERWISE
X TURN := NONE;
X END;
X UNTIL (TURN <> NONE) OR (KEY = CHR(23)) OR (KEY = CHR(26)) OR
X (KEY = CHR(8)) OR (KEY = CHR(12));
X DIR := 0;
X IF (KEY <> CHR(23)) AND (KEY <> CHR(26)) AND
X (KEY <> CHR(8)) AND (KEY <> CHR(12)) THEN REPEAT
X KEY := GETKEY;
X IF (KEY = CHR(27)) THEN ESCAPE(KEY);
X CASE KEY OF
X '+',',' : DIR := 1;
X '2' : DIR := 2;
X '-' : DIR := 3
X OTHERWISE
X DIR := 0;
X END
X UNTIL (DIR <> 0);
X IF (DIR <> 0) THEN MOVES := MOVES + 1;
XEND;
X
X(******************************************************************************)
X
X(* MAIN *)
X
XBEGIN
X OPENKEY;
X KEY := ' ';
X I := 0;
X REGIS;
X WRITELN('T(A0)');
X DRAWSCREEN;
X QUIT := FALSE;
X WHILE NOT(DONE) AND NOT(QUIT) DO BEGIN
X I := 0;
X TYPED(TURN,DIR,QUIT,MOVES);
X CHANGEARRAY(CUBEARRAY,TURN,DIR);
X SIDES(TURN);
X WRITEMOVES(MOVES);
X (* CHECKCUBE(DONE);*)
X END;
X IF DONE THEN BEGIN
X END;
X SHUTKEY;
X ASCII;
XEND.
END_OF_cube.pas
if test 25565 -ne `wc -c <cube.pas`; then
echo shar: \"cube.pas\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of shell archive.
exit 0