DEFINT A-Z 'default integers
DECLARE SUB Init ()
DECLARE SUB Redraw ()
DECLARE SUB Grafic ()
DECLARE SUB MouseLimit ()
DECLARE SUB mouse (axx)
DECLARE SUB Rotate (fac, rot)
DECLARE SUB MidLayer (fac)
DECLARE SUB PrStr (st$, row)
DECLARE SUB Solve ()
DECLARE SUB RotCube ()
DECLARE SUB Rotpr (fac, rot)
DECLARE SUB Edges1 ()
DECLARE SUB Corners1 ()
DECLARE SUB Edges2 ()
DECLARE SUB Edges2a ()
DECLARE SUB Corners3 ()
DECLARE SUB Edges3 ()
DECLARE SUB Twirls ()
DECLARE SUB Flips ()
DIM SHARED face(6) AS STRING * 7
DIM SHARED ang(3) AS STRING * 3
DIM SHARED blank AS STRING * 22
DIM SHARED c(6, 3, 3), f(6, 4)
DIM SHARED x(6, 3, 3), y(6, 3, 3)
' '$INCLUDE: '\qb45\lib\qb.bi'    'QuickBasic. Remove only one '
'declares RegType & INTERRUPT()  leave this as a commented line
'DIM SHARED inregs AS RegType     'QuickBasic
'DIM SHARED outregs AS RegType    '  "
DIM SHARED a(1 TO 17)             'QBasic - 9 lines incl DATA
FOR i = 1 TO 17: READ a(i): NEXT  '  "
DATA -18288,0,13261,-23762,26
DATA -30418,7198,11776,3721,30
DATA -30418,8214,-13568,0,0,0,0
DIM b(1 TO 8)     'mouse QBasic   '  "  Note - never comment AFTER DATA lines
FOR i = 1 TO 8: READ b(i): NEXT   '  "                Causes error
DATA -18288,0,-18032,0,-17776,0
DATA 13261,203                  
DIM SHARED pause, count        'Don't comment this line by mistake
SCREEN 12          'VGA 640x480
mouse 0     'Reset mouse driver
MouseLimit
Grafic       'draw initial cube
DO            'the program loop
 mouse 1            'show mouse
 DO: mouse 3
'LOOP UNTIL outregs.bx>0    'QuickBasic   Comments appropriately
  LOOP UNTIL a(15) > 0      'QBasic
 tim! = TIMER + .33  'float tim
 DO: LOOP UNTIL TIMER > tim!
 click = a(15)              'QBasic
 cxx = a(16): dxx = a(17)   '  "
'click = outregs.bx             'QuickBasic
'cxx=outregs.cx:dxx=outregs.dx  '  "
 mouse 2            'hide mouse
 IF click < 2 THEN
  fac = INT((cxx + 8) / 56)
  rot = INT((dxx - 16) / 16)
  LOCATE 1, 1: PRINT fac; rot
  IF fac > 0 AND fac < 8 THEN
  IF rot > 0 AND rot < 5 THEN
   IF fac = 7 THEN
    IF rot = 1 THEN Init 'Reset
    IF rot > 2 THEN Solve
    IF rot = 2 THEN
     pause = 1 - pause
     IF pause = 1 THEN
	PrStr "Pause ON ", 1
     ELSE
	PrStr "Pause OFF", 1
     END IF
    END IF
   ELSE
    IF rot < 4 THEN
     Rotate fac, rot  'rotate face
    ELSE           'rotate cube
     IF fac < 3 THEN opp = 3 - fac
     IF fac > 2 THEN opp = 7 - fac
     IF fac > 4 THEN opp = 11 - fac
     Rotate fac, 1'face clock
     Rotate opp, 3'opp. anti
     MidLayer fac 'middle,clock
    END IF
   END IF
  END IF
  END IF
  Redraw  'recolour all squares
 END IF
LOOP UNTIL click = 2
CLS : SCREEN 0    'back to text

SUB Corners1
'Rotate cube about vertical to 4 positions.
'At each, note correct u/f/r, find it (8 poss.
'locations) and moves it to d/f/r initially.
 PrStr "Top layer corners", 3: uc = c(1, 2, 2)
 FOR n = 1 TO 4: fc = c(5, 2, 2): rc = c(4, 2, 2)
  'U & F & R centre colours.    u/f/r corner
  'must have same 3 colours, i, j & k.
  'Even if u/f/r is correct , move it to d/f/r
  i = c(1, 3, 1): j = c(5, 1, 3): k = c(4, 3, 3)
  IF i = uc OR j = uc OR k = uc THEN    '|copy
   IF i = fc OR j = fc OR k = fc THEN   '|
    IF i = rc OR j = rc OR k = rc THEN  '|
      PrStr "Move u/f/r to d/f/r  ", 4
      PrStr "ie.  R-1DR            ", 5
      Rotpr 4, 3: Rotpr 2, 1: Rotpr 4, 1
    END IF                              '|copy
   END IF                               '|
  END IF                                '|
  'if u/b/r is correct u/f/r, move it to d/f/r
  i = c(1, 3, 3): j = c(6, 1, 3): k = c(4, 3, 1)
  'copy 3 IF statements
  IF i = uc OR j = uc OR k = uc THEN    '|copy
   IF i = fc OR j = fc OR k = fc THEN   '|
    IF i = rc OR j = rc OR k = rc THEN  '|
      PrStr "Move u/b/r to d/f/r  ", 4
      PrStr "ie.  B-1D-1B          ", 5
      Rotpr 6, 3: Rotpr 2, 3: Rotpr 6, 1
  'copy 3 END IFs
    END IF                              '|copy
   END IF                               '|
  END IF                                '|
  'if u/b/l is correct u/f/r, move it to d/f/r
  i = c(1, 1, 3): j = c(6, 3, 3): k = c(3, 3, 1)
  'copy 3 IF statements
  IF i = uc OR j = uc OR k = uc THEN    '|copy
   IF i = fc OR j = fc OR k = fc THEN   '|
    IF i = rc OR j = rc OR k = rc THEN  '|
      PrStr "Move u/b/l to d/f/r  ", 4
      PrStr "ie.  L-1D2L           ", 5
      Rotpr 3, 3: Rotpr 2, 2: Rotpr 3, 1
  'copy 3 END IFs
    END IF                              '|copy
   END IF                               '|
  END IF                                '|
  'if u/f/l is correct u/f/r, move it to d/f/r
  i = c(1, 1, 1): j = c(5, 1, 1): k = c(3, 1, 1)
  'copy 3 IF statements
  IF i = uc OR j = uc OR k = uc THEN    '|copy
   IF i = fc OR j = fc OR k = fc THEN   '|
    IF i = rc OR j = rc OR k = rc THEN  '|
      PrStr "Move u/f/l to d/f/r  ", 4
      PrStr "ie.  LDL-1            ", 5
      Rotpr 3, 1: Rotpr 2, 1: Rotpr 3, 3
  'copy 3 END IFs
    END IF                              '|copy
   END IF                               '|
  END IF                                '|
  'if d/b/r is correct u/f/r, move it to d/f/r
  i = c(2, 1, 1): j = c(6, 1, 1): k = c(4, 1, 1)
  'copy 3 IF statements
  IF i = uc OR j = uc OR k = uc THEN    '|copy
   IF i = fc OR j = fc OR k = fc THEN   '|
    IF i = rc OR j = rc OR k = rc THEN  '|
      PrStr "Move d/b/r to d/f/r  ", 4
      PrStr "ie.  D-1              ", 5
      Rotpr 2, 3
  'copy 3 END IFs
    END IF                              '|copy
   END IF                               '|
  END IF                                '|
  'if d/b/l is correct u/f/r, move it to d/f/r
  i = c(2, 1, 3): j = c(6, 3, 1): k = c(3, 3, 3)
  'copy 3 IF statements
  IF i = uc OR j = uc OR k = uc THEN    '|copy
   IF i = fc OR j = fc OR k = fc THEN   '|
    IF i = rc OR j = rc OR k = rc THEN  '|
      PrStr "Move d/b/l to d/f/r  ", 4
      PrStr "ie.  D2               ", 5
      Rotpr 2, 2
  'copy 3 END IFs
    END IF                              '|copy
   END IF                               '|
  END IF                                '|
  'if d/f/l is correct u/f/r, move it to d/f/r
  i = c(2, 3, 3): j = c(5, 3, 1): k = c(3, 1, 3)
  'copy 3 IF statements
  IF i = uc OR j = uc OR k = uc THEN    '|copy
   IF i = fc OR j = fc OR k = fc THEN   '|
    IF i = rc OR j = rc OR k = rc THEN  '|
      PrStr "Move d/f/l to d/f/r  ", 4
      PrStr "ie.  D                ", 5
      Rotpr 2, 1
  'copy 3 END IFs
    END IF                              '|copy
   END IF                               '|
  END IF                                '|
'--------- u/f/r cube now at d/f/r. ----------
'--------- So move to it to u/f/r   ----------
  PrStr "Move d/f/r to u/f/r  ", 4
  IF c(2, 3, 1) = uc THEN 'if uc colour on D
	 'face, it must be moved to R face
   PrStr "ie.  R-1DRD2          ", 5
   Rotpr 4, 3: Rotpr 2, 1: Rotpr 4, 1: Rotpr 2, 2
  END IF
  IF c(5, 3, 3) = uc THEN 'if uc colour on F
   PrStr "ie.  FDF-1            ", 5
   Rotpr 5, 1: Rotpr 2, 1: Rotpr 5, 3'move to u/r
  END IF
  IF c(4, 1, 3) = uc THEN 'if uc colour on R
   PrStr "ie.  R-1D-1R          ", 5
   Rotpr 4, 3: Rotpr 2, 3: Rotpr 4, 1'move to u/r
  END IF
  IF n < 4 THEN RotCube
 NEXT n
 PrStr blank, 3: PrStr blank, 4
 PrStr blank, 5: PrStr blank, 6
END SUB

SUB Corners3
 PrStr "Sort top corners", 3: n = 0: order = 0
 DO UNTIL (order > 900 AND order < 1100) OR order = 1111
  n = n + 1             'number of loop
  IF n > 1 THEN RotCube 'rotate whole cube
  'is u/r/f in correct position ?
  t1 = c(4, 2, 2): t2 = c(5, 2, 2)'r & f colours
  i = c(1, 3, 1): j = c(5, 1, 3): k = c(4, 3, 3)
  IF i = t1 OR j = t1 OR k = t1 THEN
   IF i = t2 OR j = t2 OR k = t2 THEN order = 1000
  END IF
  'is u/r/b in correct position ?
  t1 = c(4, 2, 2): t2 = c(6, 2, 2)'r & b colours
  i = c(1, 3, 3): j = c(4, 3, 1): k = c(6, 1, 3)
  IF i = t1 OR j = t1 OR k = t1 THEN
   IF i = t2 OR j = t2 OR k = t2 THEN order = order + 100
  END IF
  'is u/l/b in correct position ?
  t1 = c(3, 2, 2): t2 = c(6, 2, 2)'l & b colours
  i = c(1, 1, 3): j = c(3, 3, 1): k = c(6, 3, 3)
  IF i = t1 OR j = t1 OR k = t1 THEN
   IF i = t2 OR j = t2 OR k = t2 THEN order = order + 10
  END IF
  'is u/l/f in correct position ?
  t1 = c(5, 2, 2): t2 = c(3, 2, 2)'l & f colours
  i = c(1, 1, 1): j = c(3, 1, 1): k = c(5, 1, 1)
  IF i = t1 OR j = t1 OR k = t1 THEN
   IF i = t2 OR j = t2 OR k = t2 THEN order = order + 1
  END IF
  IF order = 0 THEN        'no corners correct
   PrStr "Rotate top layer only ", 4
   Rotpr 1, 1: n = 0: PrStr blank, 4: PrStr blank, 6
  END IF     'ie. need to go around loop again
 LOOP
 LOCATE 2, 58: PRINT "Order is "; order
 SELECT CASE order
  CASE 1000:    'only u/r/f correct so other 3
   'must circulate - clock or anticlock?
   lc = c(3, 2, 2): bc = c(6, 2, 2)'l & b colours
   IF c(1, 1, 1) = lc OR c(3, 1, 1) = lc OR c(5, 1, 1) = lc THEN
    IF c(1, 1, 1) = bc OR c(3, 1, 1) = bc OR c(5, 1, 1) = bc THEN
     PrStr "ie. L-1URU-1LUR-1U-1  ", 5
       'u/l/f goes clockw. to u/l/b
     Rotpr 3, 3: Rotpr 1, 1: Rotpr 4, 1: Rotpr 1, 3
     Rotpr 3, 1: Rotpr 1, 1: Rotpr 4, 3: Rotpr 1, 3
    END IF
   END IF
   IF c(1, 3, 3) = lc OR c(4, 3, 1) = lc OR c(6, 1, 3) = lc THEN
    IF c(1, 3, 3) = bc OR c(4, 3, 1) = bc OR c(6, 1, 3) = bc THEN
     PrStr "ie. URU-1L-1UR-1U-1L  ", 5
       'u/r/b goes anticl. to u/l/b
     Rotpr 1, 1: Rotpr 4, 1: Rotpr 1, 3: Rotpr 3, 3
     Rotpr 1, 1: Rotpr 4, 3: Rotpr 1, 3: Rotpr 3, 1
    END IF
   END IF
  CASE 1001:    'u/r/f and u/l/f correct
    PrStr "ie. FU-1B-1UF-1U-1BU2 ", 5
    Rotpr 5, 1: Rotpr 1, 3: Rotpr 6, 3: Rotpr 1, 1
    Rotpr 5, 3: Rotpr 1, 3: Rotpr 6, 1: Rotpr 1, 2
  CASE 1010:    'u/r/f and u/l/b correct
    PrStr "ie. UFURU-1R-1F-1     ", 5
    Rotpr 1, 1: Rotpr 5, 1: Rotpr 1, 1: Rotpr 4, 1
    Rotpr 1, 3: Rotpr 4, 3: Rotpr 5, 3
 END SELECT
 PrStr blank, 3: PrStr blank, 4
 PrStr blank, 5: PrStr blank, 6
END SUB

SUB Edges1
 'locate u/f edge cube (23 other possible
 'positions/orientations) and move to u/f
 PrStr "Top layer edges", 3: uc = c(1, 2, 2) 'U &
 FOR n = 1 TO 4: fc = c(5, 2, 2) '..F Centre colours
 'if  at u/f but flipped. (If not flipped, leave it)
  IF c(1, 2, 1) = fc AND c(5, 1, 2) = uc THEN
   PrStr "Flip u/f cube  ", 4: PrStr "ie. F2LD-1L-1F", 5
   Rotpr 5, 2: Rotpr 3, 1: Rotpr 2, 3: Rotpr 3, 3: Rotpr 5, 1
  END IF
  'if at r/f (2 orientations at each position)
  IF c(4, 2, 3) = uc AND c(5, 2, 3) = fc THEN
   PrStr "Move r/f to u/f", 4: PrStr "ie.  F-1      ", 5
   Rotpr 5, 3
  END IF
  IF c(4, 2, 3) = fc AND c(5, 2, 3) = uc THEN
   PrStr "Move r/f to u/f", 4: PrStr "ie.  FLD-1L-1F", 5
   Rotpr 5, 1: Rotpr 3, 1: Rotpr 2, 3: Rotpr 3, 3: Rotpr 5, 1
  END IF
  'if at d/f
  IF c(2, 3, 2) = uc AND c(5, 3, 2) = fc THEN
   PrStr "Move d/f to u/f", 4: PrStr "ie.  F2       ", 5
   Rotpr 5, 2
  END IF
  IF c(2, 3, 2) = fc AND c(5, 3, 2) = uc THEN
   PrStr "Move d/f to u/f", 4: PrStr "ie.  LD-1L-1F ", 5
   Rotpr 3, 1: Rotpr 2, 3: Rotpr 3, 3: Rotpr 5, 1
  END IF
  'if at l/f
  IF c(3, 1, 2) = uc AND c(5, 2, 1) = fc THEN
   PrStr "Move l/f to u/f", 4: PrStr "ie.  F        ", 5
   Rotpr 5, 1
  END IF
  IF c(3, 1, 2) = fc AND c(5, 2, 1) = uc THEN
   PrStr "Move l/f to u/f", 4: PrStr "ie.F-1LD-1L-1F", 5
   Rotpr 5, 3: Rotpr 3, 1: Rotpr 2, 3: Rotpr 3, 3: Rotpr 5, 1
  END IF
  'if at d/l
  IF c(2, 2, 3) = fc AND c(3, 2, 3) = uc THEN
   PrStr "Move d/l to u/f", 4: PrStr "ie.  L-1FL    ", 5
   Rotpr 3, 3: Rotpr 5, 1: Rotpr 3, 1
  END IF
  IF c(2, 2, 3) = uc AND c(3, 2, 3) = fc THEN
   PrStr "Move d/l to u/f", 4: PrStr "ie.  DF2      ", 5
   Rotpr 2, 1: Rotpr 5, 2
  END IF
  'if at d/b
  IF c(2, 1, 2) = uc AND c(6, 2, 1) = fc THEN
   PrStr "Move d/b to u/f", 4: PrStr "ie.  D2F2     ", 5
   Rotpr 2, 2: Rotpr 5, 2
  END IF
  IF c(2, 1, 2) = fc AND c(6, 2, 1) = uc THEN
   PrStr "Move d/b to u/f", 4: PrStr "ie.  DL-1FL   ", 5
   Rotpr 2, 1: Rotpr 3, 3: Rotpr 5, 1: Rotpr 3, 1
  END IF
  'if at d/r
  IF c(2, 2, 1) = fc AND c(4, 1, 2) = uc THEN
   PrStr "Move d/r to u/f", 4: PrStr "ie.  RF-1R-1  ", 5
   Rotpr 4, 1: Rotpr 5, 3: Rotpr 4, 3
  END IF
  IF c(2, 2, 1) = uc AND c(4, 1, 2) = fc THEN
   PrStr "Move d/r to u/f", 4: PrStr "ie.  D-1F2    ", 5
   Rotpr 2, 3: Rotpr 5, 2
  END IF
  'if at b/r
  IF c(4, 2, 1) = fc AND c(6, 1, 2) = uc THEN
   PrStr "Move b/r to u/f", 4: PrStr "ie.  RD-1F2R-1", 5
   Rotpr 4, 1: Rotpr 2, 3: Rotpr 5, 2: Rotpr 4, 3
  END IF
  IF c(4, 2, 1) = uc AND c(6, 1, 2) = fc THEN
   PrStr "Move b/r to u/f", 4: PrStr "ie.  R2F-1R2  ", 5
   Rotpr 4, 2: Rotpr 5, 3: Rotpr 4, 2
  END IF
  'if at b/l
  IF c(3, 3, 2) = fc AND c(6, 3, 2) = uc THEN
   PrStr "Move b/l to u/f", 4: PrStr "ie.  L-1DF2L  ", 5
   Rotpr 3, 3: Rotpr 2, 1: Rotpr 5, 2: Rotpr 3, 1
  END IF
  IF c(3, 3, 2) = uc AND c(6, 3, 2) = fc THEN
   PrStr "Move b/l to u/f", 4: PrStr "ie.  L2FL2    ", 5
   Rotpr 3, 2: Rotpr 5, 1: Rotpr 3, 2
  END IF
  'if at l/u
  IF c(3, 2, 1) = fc AND c(1, 1, 2) = uc THEN
   PrStr "Move l/u to u/f", 4: PrStr "ie.  L2DF2    ", 5
   Rotpr 3, 2: Rotpr 2, 1: Rotpr 5, 2
  END IF
  IF c(3, 2, 1) = uc AND c(1, 1, 2) = fc THEN
   PrStr "Move l/u to u/f", 4: PrStr "ie.  LF       ", 5
   Rotpr 3, 1: Rotpr 5, 1
  END IF
  'if at b/u
  IF c(6, 2, 3) = fc AND c(1, 2, 3) = uc THEN
   PrStr "Move b/u to u/f", 4: PrStr "ie.  B2D2F2   ", 5
   Rotpr 6, 2: Rotpr 2, 2: Rotpr 5, 2
  END IF
  IF c(6, 2, 3) = uc AND c(1, 2, 3) = fc THEN
   PrStr "Move b/u to u/f", 4: PrStr "ie.  BL-1DLF2 ", 5
   Rotpr 6, 1: Rotpr 3, 3: Rotpr 2, 1: Rotpr 3, 1: Rotpr 5, 2
  END IF
  'if at r/u
  IF c(4, 3, 2) = fc AND c(1, 3, 2) = uc THEN
   PrStr "Move r/u to u/f", 4: PrStr "ie.  R2D-1F2  ", 5
   Rotpr 4, 2: Rotpr 2, 3: Rotpr 5, 2
  END IF
  IF c(4, 3, 2) = uc AND c(1, 3, 2) = fc THEN
   PrStr "Move r/u to u/f", 4: PrStr "ie.  R-1F-1   ", 5
   Rotpr 4, 3: Rotpr 5, 3
  END IF
  IF n < 4 THEN RotCube
 NEXT n
 PrStr blank, 3: PrStr blank, 4: PrStr blank, 5: PrStr blank, 6
END SUB

SUB Edges2
 PrStr "Invert whole cube", 3'about L face axis
 MidLayer 5: MidLayer 5      'need 2 x 90 deg.
 Rotate 6, 2: Rotpr 5, 2: PrStr blank, 6
 'The sorted layer is now on the bottom.
 PrStr "Middle layer edges", 3  'tell the user
 'Rotating about vert. to 4 separate positions
 FOR n = 1 TO 4: lc = c(3, 2, 2): fc = c(5, 2, 2)
 'First check 4 middle edge positions for l/f.
 'if l/f in correct position and orientation,
 'leave it. Otherwise, move it to top layer.
 'First, if l/f in position but flipped
  IF c(3, 1, 2) = fc AND c(5, 2, 1) = lc THEN
   PrStr "l/f to top layer   ", 4
   PrStr "ie. FU2RUR-1U2F-1  ", 5
   Rotpr 5, 1: Rotpr 1, 2: Rotpr 4, 1: Rotpr 1, 1
   Rotpr 4, 3: Rotpr 1, 2: Rotpr 5, 3
  END IF
  'Now, check other 3 vertical edge positions
  'if l/f at r/f, move to top layer
  IF c(4, 2, 3) = fc OR c(5, 2, 3) = fc THEN
   IF c(4, 2, 3) = lc OR c(5, 2, 3) = lc THEN
    PrStr "r/f to top layer   ", 4
    PrStr "ie RU2BUB-1U2R-1   ", 5
    Rotpr 4, 1: Rotpr 1, 2: Rotpr 6, 1: Rotpr 1, 1
    Rotpr 6, 3: Rotpr 1, 2: Rotpr 4, 3
   END IF
  END IF
  'if l/f at r/b, move to top layer
  IF c(4, 2, 1) = fc OR c(6, 1, 2) = fc THEN
   IF c(4, 2, 1) = lc OR c(6, 1, 2) = lc THEN
    PrStr "r/b to top layer   ", 4
    PrStr "ie. BU2LUL-1U2B-1  ", 5
    Rotpr 6, 1: Rotpr 1, 2: Rotpr 3, 1: Rotpr 1, 1
    Rotpr 3, 3: Rotpr 1, 2: Rotpr 6, 3
   END IF
  END IF
  'if l/f at l/b, move to top layer
  IF c(3, 3, 2) = fc OR c(6, 3, 2) = fc THEN
   IF c(3, 3, 2) = lc OR c(6, 3, 2) = lc THEN
    PrStr "l/b to top layer   ", 4
    PrStr "ie. LU2FUF-1U2L-1  ", 5
    Rotpr 3, 1: Rotpr 1, 2: Rotpr 5, 1: Rotpr 1, 1
    Rotpr 5, 3: Rotpr 1, 2: Rotpr 3, 3
   END IF
  END IF
 'NOW, find l/f in top layer, transfer to u/r,
 'then to l/f using Edges2a()
  IF c(4, 3, 2) = fc OR c(1, 3, 2) = fc THEN
   IF c(4, 3, 2) = lc OR c(1, 3, 2) = lc THEN
    Edges2a          'candidate already at u/l
   END IF
  END IF
  IF c(6, 2, 3) = fc OR c(1, 2, 3) = fc THEN
   IF c(6, 2, 3) = lc OR c(1, 2, 3) = lc THEN
    PrStr "u/b to u/r          ", 4
    Rotpr 1, 1: Edges2a      'candidate at u/l
   END IF
  END IF
  IF c(3, 2, 1) = fc OR c(1, 1, 2) = fc THEN
   IF c(3, 2, 1) = lc OR c(1, 1, 2) = lc THEN
    PrStr "u/l to u/r          ", 4
    Rotpr 1, 2: Edges2a      'candidate at u/l
   END IF
  END IF
  IF c(5, 1, 2) = fc OR c(1, 2, 1) = fc THEN
   IF c(5, 1, 2) = lc OR c(1, 2, 1) = lc THEN
    PrStr "u/f to u/r          ", 4
    Rotpr 1, 3: Edges2a      'candidate at u/f
   END IF
  END IF
 IF n < 4 THEN RotCube
 NEXT n
 PrStr blank, 3: PrStr blank, 4
 PrStr blank, 5: PrStr blank, 6
END SUB

SUB Edges2a 'After Edges2() puts l/f cube to
'u/r position, this puts it in correct
'position and correct orientation.
 PrStr "u/r to l/f          ", 4
 IF c(1, 3, 2) = c(3, 2, 2) THEN 'U face of u/r
  PrStr "ie. FU2RUR-1U2F-1   ", 5  'is lc
  Rotpr 5, 1: Rotpr 1, 2: Rotpr 4, 1: Rotpr 1, 1
  Rotpr 4, 3: Rotpr 1, 2: Rotpr 5, 3
 ELSE           'ie. U face of u/r = fc colour
  PrStr "ie. UFU2RU-1R-1U2F-1 ", 5
  Rotpr 1, 1: Rotpr 5, 1: Rotpr 1, 2: Rotpr 4, 1
  Rotpr 1, 3: Rotpr 4, 3: Rotpr 1, 2: Rotpr 5, 3
 END IF
END SUB

SUB Edges3
 PrStr "Sort top edge cubes", 3: correct = 0
 'first note centre colours of faces F, R, B & L
 fc = c(5, 2, 2): rc = c(4, 2, 2): bc = c(6, 2, 2): lc = c(3, 2, 2)
 'find which cubes are in correct position
 IF c(1, 2, 1) = fc OR c(5, 1, 2) = fc THEN correct = 1000
 IF c(1, 3, 2) = rc OR c(4, 3, 2) = rc THEN correct = correct + 100
 IF c(1, 2, 3) = bc OR c(6, 2, 3) = bc THEN correct = correct + 10
 IF c(1, 1, 2) = lc OR c(3, 2, 1) = lc THEN correct = correct + 1
 IF correct = 0 THEN      'none of cubes in right place
  IF c(1, 2, 1) = rc OR c(5, 1, 2) = rc THEN 'if u/r at u/f
   RotCube  'rotate whole cube. note new centre colours
   fc = c(5, 2, 2): rc = c(4, 2, 2): bc = c(6, 2, 2): lc = c(3, 2, 2)
  END IF
  IF c(1, 2, 1) = bc OR c(5, 1, 2) = bc THEN 'if u/b at u/f
   PrStr "R2L2DR2L2U2R2L2DR2L2 ", 5'swap opposite pairs
   Rotpr 4, 2: Rotpr 3, 2: Rotpr 2, 1: Rotpr 4, 2
   Rotpr 3, 2: Rotpr 1, 2: Rotpr 4, 2: Rotpr 3, 2
   Rotpr 2, 1: Rotpr 4, 2: Rotpr 3, 2
  END IF
  IF c(1, 2, 1) = lc OR c(5, 1, 2) = lc THEN 'if u/l at u/f
   PrStr "RBUB-1U-1R2F-1U-1FUR ", 5'swap adjacent pairs
   Rotpr 4, 1: Rotpr 6, 1: Rotpr 1, 1: Rotpr 6, 3
   Rotpr 1, 3: Rotpr 4, 2: Rotpr 5, 3: Rotpr 1, 3
   Rotpr 5, 1: Rotpr 1, 1: Rotpr 4, 1
  END IF
 END IF
 SELECT CASE correct     'One cube only correct. Rotate
		  'whole cube to put it at u/r position
  CASE 1000: RotCube: RotCube: RotCube
  CASE 10: RotCube
  CASE 1: RotCube: RotCube
 END SELECT               'in effect, now correct = 100
 bc = c(6, 2, 2): lc = c(3, 2, 2)'centre colours of B & L
 IF c(1, 2, 1) = bc OR c(5, 1, 2) = bc THEN 'if u/b at u/f
  PrStr "L2U-1F-1BL2FB-1U-1L2 ", 5 'circulate anticlock
  Rotpr 3, 2: Rotpr 1, 3: Rotpr 5, 3: Rotpr 6, 1: Rotpr 3, 2
  Rotpr 5, 1: Rotpr 6, 3: Rotpr 1, 3: Rotpr 3, 2
 END IF
 IF c(1, 2, 1) = lc OR c(5, 1, 2) = lc THEN 'if u/l at u/f
  PrStr "ie. L2UF-1BL2FB-1UL2 ", 5 'circulate clockwise
  Rotpr 3, 2: Rotpr 1, 1: Rotpr 5, 3: Rotpr 6, 1: Rotpr 3, 2
  Rotpr 5, 1: Rotpr 6, 3: Rotpr 1, 1: Rotpr 3, 2
 END IF
 PrStr blank, 3: PrStr blank, 4
 PrStr blank, 5: PrStr blank, 6
END SUB

SUB Flips             'flips top edge cubes
 uc = c(1, 2, 2) 'colour of U centre
 DO UNTIL c(1, 2, 1) = uc AND c(1, 1, 2) = uc AND c(1, 2, 3) = uc AND c(1, 3, 2) = uc
  n = 0   'ie. until all top faces match uc
  DO UNTIL c(1, 2, 1) = c(5, 2, 2) OR n = 4
   n = n + 1: RotCube 'until u/f needs flip
  LOOP     'if n reaches 4, all are correct
  'cubes needing flip always occur in pairs
  IF n < 4 THEN 'u/f needs flip. Find other
   IF c(1, 3, 2) = c(4, 2, 2) THEN
    other = 4               'u/r needs flip
    PrStr "u/f & u/r need flip ", 2
   ELSE
    IF c(1, 2, 3) = c(6, 2, 2) THEN
     other = 6              'u/b needs flip
    PrStr "u/f & u/b need flip ", 2
    ELSE
     other = 3              'u/l needs flip
    PrStr "u/f & u/l need flip ", 2
    END IF
   END IF
   PrStr "Flip pair top edges  ", 4
   PrStr "Firstly FUD-1L2U2D2R ", 5
   Rotpr 5, 1: Rotpr 1, 1: Rotpr 2, 3: Rotpr 3, 2
   Rotpr 1, 2: Rotpr 2, 2: Rotpr 4, 1
   PrStr "2nd of pair to u/r   ", 5
   IF other = 4 THEN Rotpr 1, 1
   IF other = 6 THEN Rotpr 1, 2
   IF other = 3 THEN Rotpr 1, 3
   PrStr "Now  R-1D2U2L2DU-1F-1", 5
   Rotpr 4, 3: Rotpr 2, 2: Rotpr 1, 2: Rotpr 3, 2
   Rotpr 2, 1: Rotpr 1, 3: Rotpr 5, 3
   IF other = 4 THEN Rotpr 1, 3
   IF other = 6 THEN Rotpr 1, 2
   IF other = 3 THEN Rotpr 1, 1
   PrStr blank, 2
  END IF
 LOOP
 PrStr blank, 3: PrStr blank, 4
 PrStr blank, 5: PrStr blank, 6
END SUB

SUB Grafic
'face name strings in face(6) array
face(1) = "   UP  ": face(2) = " DOWN  "
face(3) = " LEFT  ": face(4) = " RIGHT "
face(5) = " FRONT ": face(6) = " BACK  "
ang(1) = "+90": ang(2) = "180": ang(3) = "-90"
'blank = "                      "  '22 spaces
blank = SPACE$(22)
'each face's adjacent faces, anticlockwise
f(1, 1) = 5: f(1, 2) = 4: f(1, 3) = 6: f(1, 4) = 3
f(2, 1) = 4: f(2, 2) = 5: f(2, 3) = 3: f(2, 4) = 6
f(3, 1) = 1: f(3, 2) = 6: f(3, 3) = 2: f(3, 4) = 5
f(4, 1) = 6: f(4, 2) = 1: f(4, 3) = 5: f(4, 4) = 2
f(5, 1) = 3: f(5, 2) = 2: f(5, 3) = 4: f(5, 4) = 1
f(6, 1) = 2: f(6, 2) = 3: f(6, 3) = 1: f(6, 4) = 4
CLS : COLOR 15          'now print top table
PrStr "Rightclick to QUIT    ", 7
LOCATE 6, 7: PRINT "Rotate  whole  cube   90"
LOCATE 6, 34: PRINT "Clock wise"
FOR n = 1 TO 6
 LOCATE 1, n * 7: PRINT face(n)
 LOCATE 2, n * 7 + 2: PRINT n
 LOCATE 3, n * 7 + 2: PRINT ang(1)
 LOCATE 4, n * 7 + 2: PRINT ang(2)
 LOCATE 5, n * 7 + 2: PRINT ang(3)
 LINE (n * 56 - 9, 32)-STEP(50, 16), 15, B
 LINE (n * 56 - 9, 48)-STEP(50, 16), 15, B
 LINE (n * 56 - 9, 64)-STEP(50, 16), 15, B
 LINE (n * 56 - 9, 80)-STEP(50, 16), 15, B
NEXT n
LOCATE 3, 50: PRINT "RESET"
LINE (383, 32)-STEP(56, 16), 15, B
LOCATE 4, 50: PRINT "PAUSE"
LINE (383, 48)-STEP(56, 16), 15, B
LOCATE 5, 50: PRINT "SOLVE"
LINE (383, 64)-STEP(56, 32), 15, B
'now print face labels
LOCATE 11, 7: PRINT face(1)
LOCATE 11, 28: PRINT face(1)
LOCATE 25, 67: PRINT face(2)
LOCATE 25, 48: PRINT face(2)
LOCATE 27, 8: PRINT face(3)
LOCATE 9, 69: PRINT face(4)
LOCATE 27, 27: PRINT face(5)
LOCATE 9, 46: PRINT face(6)
LOCATE 8, 15: PRINT "OUTSIDE VIEW"
LOCATE 27, 55: PRINT "INSIDE VIEW"
'draw the cube - 9 times
dx = 40: dx3 = 3 * dx: dy = 24: dy3 = 3 * dy
xs = 20: ys = 24: ys2 = 2 * ys: ys6 = 6 * ys: c = 15
 FOR xl = 159 TO 161: xr = xl + 320
  FOR yl = 288 TO 290: yr = yl - 30
   FOR i = 0 TO 3:
   LINE (xl - i * dx, yl - i * dy)-STEP(0, ys6), c
   LINE (xl - i * dx, yl - i * dy)-STEP(dx3, -dy3), c
   LINE (xl + i * dx, yl - i * dy)-STEP(0, ys6), c
   LINE (xl + i * dx, yl - i * dy)-STEP(-dx3, -dy3), c
   LINE (xl, yl + i * ys2)-STEP(dx3, -dy3), c
   LINE (xl, yl + i * ys2)-STEP(-dx3, -dy3), c

   LINE (xr - i * dx, yr + i * dy)-STEP(0, -ys6), c
   LINE (xr - i * dx, yr + i * dy)-STEP(dx3, dy3), c
   LINE (xr + i * dx, yr + i * dy)-STEP(0, -ys6), c
   LINE (xr + i * dx, yr + i * dy)-STEP(-dx3, dy3), c
   LINE (xr, yr - i * ys2)-STEP(dx3, dy3), c
   LINE (xr, yr - i * ys2)-STEP(-dx3, dy3), c
NEXT i: NEXT yl: NEXT xl
sx = xl - xr: sy = yl - yr'draw dashed lines
LINE (xr, yr - ys6)-STEP(sx, sy), c, , &H700
LINE (xr + dx3, yr - dy3)-STEP(sx, sy), c, , &H700
LINE (xr + dx3, yr + dy3)-STEP(sx, sy), c, , &H700
LINE (xr, yr + ys6)-STEP(sx, sy), c, , &H700
LINE (xr - dx3, yr - dy3)-STEP(sx / 3, sy / 3), c, , &H700
LINE (xr - dx3, yr + dy3)-STEP(sx / 4, sy / 4), c, , &H700
'starting coords to paint each square
FOR i = 1 TO 3: FOR j = 1 TO 3
 x(1, i, j) = xl + i * dx - j * dx
 y(1, i, j) = yl + dy - i * dy - j * dy
 x(2, i, j) = xr - j * dx + i * dx
 y(2, i, j) = yr - dy + i * dy + j * dy
 x(3, i, j) = xl + xs - i * dx
 y(3, i, j) = yl - ys + j * ys2 - i * dy
 x(4, i, j) = xr - xs + j * dx
 y(4, i, j) = yr + ys - i * ys2 + j * dy
 x(5, i, j) = xl - xs + j * dx
 y(5, i, j) = yl - ys + i * ys2 - j * dy
 x(6, i, j) = xr + xs - i * dx
 y(6, i, j) = yr + ys - j * ys2 + i * dy
NEXT j: NEXT i
 Init                  'set original colours
 Redraw                   'paint all squares
END SUB

SUB Init
 FOR n = 1 TO 6: FOR i = 1 TO 3: FOR j = 1 TO 3
      c(n, i, j) = n: NEXT j: NEXT i: NEXT n
END SUB

SUB MidLayer (fac)
 t1 = c(f(fac, 1), 2, 1): t2 = c(f(fac, 1), 2, 2)
 t3 = c(f(fac, 1), 2, 3)    'store temps
 c(f(fac, 1), 2, 1) = c(f(fac, 2), 2, 3)
 c(f(fac, 1), 2, 2) = c(f(fac, 2), 2, 2)
 c(f(fac, 1), 2, 3) = c(f(fac, 2), 2, 1)

 c(f(fac, 2), 2, 3) = c(f(fac, 3), 1, 2)
 c(f(fac, 2), 2, 2) = c(f(fac, 3), 2, 2)
 c(f(fac, 2), 2, 1) = c(f(fac, 3), 3, 2)

 c(f(fac, 3), 1, 2) = c(f(fac, 4), 3, 2)
 c(f(fac, 3), 2, 2) = c(f(fac, 4), 2, 2)
 c(f(fac, 3), 3, 2) = c(f(fac, 4), 1, 2)

 c(f(fac, 4), 3, 2) = t1: c(f(fac, 4), 2, 2) = t2
 c(f(fac, 4), 1, 2) = t3
END SUB

SUB mouse (axx)   'Reset, show or hide mouse
'inregs.ax = axx           'load ax register
'CALL INTERRUPT(&H33, inregs, outregs)

     'QuickBasic above, QBasic below        Adjust comments

 SHARED a()              'machine code array
 a(2) = axx                'sets register ax
 DEF SEG = VARSEG(a(1))        'find address
  CALL ABSOLUTE(VARPTR(a(1)))
 DEF SEG        'bx,cx,dx now in a(15 to 17)
END SUB

SUB MouseLimit  'Restrict mouse to top panel
'inregs.ax =7: inregs.cx =60: inregs.dx =420
'CALL INTERRUPT(&H33, inregs, outregs)
'inregs.ax =8: inregs.cx =40: inregs.dx = 88
'CALL INTERRUPT(&H33,inregs,outregs)

'QuickBasic above. QBasic below        Adjust comments

 SHARED b()              'machine code array
 b(2) = 7: b(4) = 60: b(6) = 420   'ax,cx,dx
 DEF SEG = VARSEG(b(1))        'find address
  CALL ABSOLUTE(VARPTR(b(1)))
 DEF SEG                 'x moves restricted
 b(2) = 8: b(4) = 40: b(6) = 88    'ax,cx,dx
 DEF SEG = VARSEG(b(1))        'find address
  CALL ABSOLUTE(VARPTR(b(1)))
 DEF SEG                 'y moves restricted
END SUB

SUB PrStr (st$, row) 'Prints a string, col 58
 LOCATE row, 58: PRINT st$
END SUB

SUB Redraw             'recolour all squares
 FOR n = 1 TO 6: FOR i = 1 TO 3: FOR j = 1 TO 3
  PAINT (x(n, i, j), y(n, i, j)), c(n, i, j), 15
 NEXT j: NEXT i: NEXT n
END SUB

SUB Rotate (fac, rot)
 DIM t1, t2, t3         'temps for 1st squares
 FOR n = 1 TO rot     '1, 2 or 3 times 90 deg.
  t1 = c(fac, 1, 1): t2 = c(fac, 2, 1)'face squares
  c(fac, 1, 1) = c(fac, 3, 1): c(fac, 2, 1) = c(fac, 3, 2)
  c(fac, 3, 1) = c(fac, 3, 3): c(fac, 3, 2) = c(fac, 2, 3)
  c(fac, 3, 3) = c(fac, 1, 3): c(fac, 2, 3) = c(fac, 1, 2)
  c(fac, 1, 3) = t1: c(fac, 1, 2) = t2
 'rotate adjacent squares of adjacent faces
  t1 = c(f(fac, 1), 1, 1): t2 = c(f(fac, 1), 1, 2)
  t3 = c(f(fac, 1), 1, 3)    'store temps
  c(f(fac, 1), 1, 1) = c(f(fac, 2), 3, 3)
  c(f(fac, 1), 1, 2) = c(f(fac, 2), 3, 2)
  c(f(fac, 1), 1, 3) = c(f(fac, 2), 3, 1)

  c(f(fac, 2), 3, 3) = c(f(fac, 3), 1, 3)
  c(f(fac, 2), 3, 2) = c(f(fac, 3), 2, 3)
  c(f(fac, 2), 3, 1) = c(f(fac, 3), 3, 3)

  c(f(fac, 3), 1, 3) = c(f(fac, 4), 3, 1)
  c(f(fac, 3), 2, 3) = c(f(fac, 4), 2, 1)
  c(f(fac, 3), 3, 3) = c(f(fac, 4), 1, 1)
  c(f(fac, 4), 3, 1) = t1: c(f(fac, 4), 2, 1) = t2
  c(f(fac, 4), 1, 1) = t3  'recover temps
 NEXT
END SUB

SUB RotCube      'rotate about vertical axis
 PrStr "Rotate whole cube +90 ", 6
 PrStr blank, 4: PrStr blank, 5
 IF pause = 1 THEN
  DO: mouse 3           'get left click
' LOOP UNTIL outregs.bx = 1     'QuickBasic     Adjust comments
  LOOP UNTIL a(15) = 1          'QBasic
 END IF
 Rotate 1, 1: MidLayer 1: Rotate 2, 3
 Redraw
 PrStr blank, 6
END SUB

SUB Rotpr (fac, rot)
 count = count + 1: LOCATE 1, 1: PRINT count; "  "
 LOCATE 6, 58: PRINT "Rotate "; face(fac); ang(rot)
 IF pause = 1 THEN
  DO: mouse 3: LOOP UNTIL a(15) = 1      'QBasic
'  DO: mouse 3: LOOP UNTIL outregs.bx = 1 'QuickBasic  Adjust comments
 END IF
 Rotate fac, rot: Redraw
END SUB

SUB Solve
 count = 0          'set move counter to zero
 IF pause = 1 THEN PrStr "Leftclick to go on", 7
 Edges1     'Top edge cubes
 Corners1   'Top corner cubes
 Edges2     'Invert cube. Middle layer edges
 Corners3   'Top corners. Ignore orientation
 Edges3     'Top edges.    ditto
 Flips      'Flip edges to correct orientation
 Twirls     'Twirl corners to ditto
 PrStr "Rightclick to QUIT   ", 7     'restore
END SUB

SUB Twirls 'twirls top corner cubes
 uc = c(1, 2, 2) 'U centre colour
 DO                  'outer loop
  i = 0: j = 0: k = 0: l = 0
  IF c(5, 1, 3) = uc THEN i = 1   'u/f/r
  IF c(4, 3, 3) = uc THEN i = -1
  IF c(4, 3, 1) = uc THEN j = 1   'u/r/b
  IF c(6, 1, 3) = uc THEN j = -1
  IF c(6, 3, 3) = uc THEN k = 1   'u/b/l
  IF c(3, 3, 1) = uc THEN k = -1
  IF c(3, 1, 1) = uc THEN l = 1   'u/l/f
  IF c(5, 1, 1) = uc THEN l = -1
  sum = ABS(i) + ABS(j) + ABS(k) + ABS(l)
  SELECT CASE sum
   CASE 4, 2:
    DO UNTIL c(5, 1, 3) = uc 'until..
     RotCube '..u/f/r needs clock twirl
    LOOP
    IF c(5, 1, 1) = uc THEN num = 3
    'ie. u/l/f needs anticlock twirl
    IF c(3, 3, 1) = uc THEN num = 2
    'ie. u/b/l needs anticlock twirl
    IF c(6, 1, 3) = uc THEN num = 1
    'ie. u/r/b needs anticlock twirl
   CASE 3: num = 1
  END SELECT
  LOCATE 2, 58: PRINT sum; num;
  IF sum > 0 THEN
   PrStr "Twirl two top corners ", 3
   PrStr "First of pair (u/r)   ", 4
   PrStr "ie.  R-1DRFDF-1       ", 5
   Rotpr 4, 3: Rotpr 2, 1: Rotpr 4, 1
   Rotpr 5, 1: Rotpr 2, 1: Rotpr 5, 3
   PrStr "Move 2nd to u/r       ", 4
   PrStr blank, 5: Rotpr 1, num
   PrStr "2nd of pair (u/r)     ", 4
   PrStr "ie.  FD-1F-1R-1D-1R   ", 5
   Rotpr 5, 1: Rotpr 2, 3: Rotpr 5, 3
   Rotpr 4, 3: Rotpr 2, 3: Rotpr 4, 1
   PrStr "Move 2nd to orig. pos.", 4
   PrStr blank, 5: Rotpr 1, 4 - num
  END IF
 LOOP UNTIL sum = 0
 PrStr blank, 2: PrStr blank, 3
 PrStr blank, 4: PrStr blank, 5
 PrStr blank, 6:
END SUB