Listing 5

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
  LOOP UNTIL a(15) = 1      'QBasic
 END IF
 Rotate 1, 1: MidLayer 1: Rotate 2, 3
 Redraw
 PrStr blank, 6
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 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
 END IF			    'or outregs.bx = 1
 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

---end Listing 5----