PROGRAM CUBE; {By Ed Reed Tailored Computer Solutions 1919 S. Newport Kennewick, WA 99336 This program allows the user to manipulate Rubik's Cube without the hazards of Cuber's Thumb, but somehow I can't imagine going blind at one's screen being any better. There is a companion program, CUBESOLV, which can be chained to or started independently which solves any mess a person can create here which still represents a legitimate cube.} LABEL 1, 2; TYPE ROW = STRING[7]; {Length of seven is chosen for ease of output, which} FACE = {is unfolded so that all faces are visible. Positions} RECORD {1, 4, and 7 are the colors and the rest are blank.} A : ROW; B : ROW; C : ROW END; VAR U : ABSOLUTE [$7000] FACE; {Up (top)} {Faces are left in core where} D : ABSOLUTE [$7020] FACE; {Down (bottom)} {CUBESOLV can access them.} F : ABSOLUTE [$7040] FACE; {Front} B : ABSOLUTE [$7060] FACE; {Back} L : ABSOLUTE [$7080] FACE; {Left} R : ABSOLUTE [$70A0] FACE; {Right} S : FACE; {Spare} ESC, OPTN, HOME, COLOR : CHAR; MOVES, XPOS, YPOS : INTEGER; CHAINFIL : FILE; MSTORE : ARRAY [-80 .. 400] OF CHAR; { \NP } {The repertoire of legal moves is as follows. Anything else is ignored. R -- Rotate right face clockwise. r -- Rotate right face counterclockwise. L -- Rotate left face clockwise. l -- Rotate left face counterclockwise. U -- Rotate up face clockwise. u -- Rotate up face counterclockwise. D -- Rotate down face clockwise. d -- Rotate down face counterclockwise. F -- Rotate front face clockwise. f -- Rotate front face counterclockwise. B -- Rotate back face clockwise. b -- Rotate back face counterclockwise. V -- Rotate vertical slice up. v -- Rotate vertical slice down. H -- Rotate horizontal slice right. h -- Rotate horizontal slice left. I -- Rotate invisible slice clockwise i -- Rotate invisible slice counterclockwise. X -- Rotate whole cube on X axis, front face to top. x -- Rotate whole cube on X axis, front face to bottom. Y -- Rotate whole cube on Y axis, top face to right. y -- Rotate whole cube on Y axis, top face to left. Z -- Rotate whole cube on Z axis, front face to right. z -- Rotate whole cube on Z axis, front face to left. Backspace -- Reverse the last move. / -- Start over. ? -- Quit. > -- Proceed to CUBESOLV, which solves the mess you made. Ctrl/E -- Enter your own pattern, any 6 characters for colors, except do not use upper and lower case of the same letter. Crtl/Z -- Loop forever (sorry about that). Note: A slice is a plane through the center of the cube containing four face-center cubelets. Horizontal, vertical, and invisible are as viewed from the front. \NP } PROCEDURE ENTER; LABEL 3; VAR NF, I, J : INTEGER; BEGIN 3: FOR NF := 1 TO 6 DO BEGIN CASE NF OF 1 : FIL_FACE (U, 12, 1); 2 : FIL_FACE (L, 1, 8); 3 : FIL_FACE (F, 12, 8); 4 : FIL_FACE (R, 23, 8); 5 : FIL_FACE (B, 34, 8); 6 : FIL_FACE (D, 12, 15); END; END; GOTOXY (1, 21); WRITE (ESC, 'YHit return or blank if all O.K., ', 'otherwise any other character.'); READ (OPTN); IF OPTN <> ' ' THEN GOTO 3; WRITE (HOME, ESC, 'Y'); FOR I := 1 TO 6 DO BEGIN CASE I OF 1 : BEGIN COLOR := U.B[4]; OPTN := 'U' END; 2 : BEGIN COLOR := L.B[4]; OPTN := 'L' END; 3 : BEGIN COLOR := F.B[4]; OPTN := 'F' END; 4 : BEGIN COLOR := R.B[4]; OPTN := 'R' END; 5 : BEGIN COLOR := B.B[4]; OPTN := 'P' END; 6 : BEGIN COLOR := D.B[4]; OPTN := 'D' END; END; FOR J := 1 TO 6 DO BEGIN CASE J OF 1 : REPAINT (U); 2 : REPAINT (L); 3 : REPAINT (F); 4 : REPAINT (R); 5 : REPAINT (B); 6 : REPAINT (D); END END END END; { \NP } PROCEDURE FIL_FACE (VAR X : FACE; XX, YY : INTEGER); VAR I, ROW : INTEGER; BEGIN WITH X DO FOR ROW := 0 TO 2 DO FOR I := 0 TO 2 DO BEGIN GOTOXY ((3 * I) + XX, (2 * ROW) + YY); READ (OPTN); CASE ROW OF 0 : IF OPTN <> ' ' THEN A[(3 * I) + 1] := LCASE (OPTN); 1 : IF OPTN <> ' ' THEN B[(3 * I) + 1] := LCASE (OPTN); 2 : IF OPTN <> ' ' THEN C[(3 * I) + 1] := LCASE (OPTN) END END END; PROCEDURE REPAINT (VAR X : FACE); BEGIN WITH X DO BEGIN IF A[1] = COLOR THEN A[1] := OPTN; IF A[4] = COLOR THEN A[4] := OPTN; IF A[7] = COLOR THEN A[7] := OPTN; IF B[1] = COLOR THEN B[1] := OPTN; IF B[4] = COLOR THEN B[4] := OPTN; IF B[7] = COLOR THEN B[7] := OPTN; IF C[1] = COLOR THEN C[1] := OPTN; IF C[4] = COLOR THEN C[4] := OPTN; IF C[7] = COLOR THEN C[7] := OPTN; END; END; FUNCTION LCASE (CC : CHAR) : CHAR; BEGIN IF CC IN ['A' .. 'Z'] THEN LCASE := CHR (ORD (CC) + 32) ELSE LCASE := CC END; {$I B:CUBEUTIL} {Include the text of file CUBEUTIL.} { \NP } BEGIN {CUBE} HOME := CHR ($1E); ESC := CHR ($1B); 1: WRITE (HOME, CHR ($1B), 'Y'); {Initialize the cube.} U.A := 'U U U'; U.B := 'U U U'; U.C := 'U U U'; D.A := 'D D D'; D.B := 'D D D'; D.C := 'D D D'; L.A := 'L L L'; L.B := 'L L L'; L.C := 'L L L'; R.A := 'R R R'; R.B := 'R R R'; R.C := 'R R R'; F.A := 'F F F'; F.B := 'F F F'; F.C := 'F F F'; B.A := 'B B B'; B.B := 'B B B'; B.C := 'B B B'; 2: OPTN := ' '; FOR MOVES := -80 TO 400 DO MSTORE[MOVES] := ' '; MOVES := -1; {Run it.} WHILE OPTN <> '?' DO BEGIN DISPLAY; MOVES := MOVES + 1; XPOS := (MOVES MOD 80) + 1; YPOS := (MOVES DIV 80) + 21; GOTOXY (XPOS, YPOS); READ (OPTN); IF ORD (OPTN) = 8 THEN BEGIN OPTN := MSTORE[MOVES - 1]; IF OPTN IN ['A' .. 'Z'] THEN OPTN := CHR (ORD (OPTN) + 32) ELSE OPTN := CHR (ORD (OPTN) - 32); MOVES := MOVES - 2 END ELSE IF ORD (OPTN) = 5 THEN BEGIN ENTER; GOTO 2; END ELSE MSTORE[MOVES] := OPTN; { \NP } CASE OPTN OF 'R' : BEGIN CW (R); VUP (7) END; 'r' : BEGIN CCW (R); VDOWN (7) END; 'L' : BEGIN CW (L); VDOWN (1) END; 'l' : BEGIN CCW (L); VUP (1) END; 'U' : BEGIN CW (U); HLEFT (1) END; 'u' : BEGIN CCW (U); HRIGHT (1) END; 'D' : BEGIN CW (D); HRIGHT (3) END; 'd' : BEGIN CCW (D); HLEFT (3) END; 'F' : BEGIN CW (F); ICW (1) END; 'f' : BEGIN CCW (F); ICCW (1) END; 'B' : BEGIN CW (B); ICCW (3) END; 'b' : BEGIN CCW (B); ICW (3) END; 'V' : BEGIN VUP (4) END; 'v' : BEGIN VDOWN (4) END; 'H' : BEGIN HRIGHT (2) END; 'h' : BEGIN HLEFT (2) END; 'I' : BEGIN ICW (2) END; 'i' : BEGIN ICCW (2) END; 'X' : BEGIN CW (R); VUP (1); VUP (4); VUP (7); CCW (L) END; 'x' : BEGIN CCW (R); VDOWN (1); VDOWN (4); VDOWN (7); CW (L) END; 'Y' : BEGIN CW (F); ICW (1); ICW (2); ICW (3); CCW (B) END; 'y' : BEGIN CCW (F); ICCW (1); ICCW (2); ICCW (3); CW (B) END; 'Z' : BEGIN CCW (U); HRIGHT (1); HRIGHT (2); HRIGHT (3); CW (D) END; 'z' : BEGIN CW (U); HLEFT (1); HLEFT (2); HLEFT (3); CCW (D) END; '/' : GOTO 1; '>' : BEGIN ASSIGN (CHAINFIL, 'A:CUBESOLV.COM'); RESET (CHAINFIL); IF IORESULT = 255 THEN BEGIN ASSIGN (CHAINFIL, 'B:CUBESOLV.COM'); RESET (CHAINFIL); IF IORESULT = 255 THEN BEGIN WRITELN ('Error opening solution program file.'); EXIT END; END; CHAIN (CHAINFIL); END; ELSE MOVES := MOVES - 1 END END; END.