JB Rubic's Cube with Solver
#1
Code:
'Rubic 4.txt for Just Basic v2 B+ started 2018-05-27 revised again
' post 2018-05-29 edited 2-3 times swap faces at bootom cube view and spin bottom face
' from Rubic 3.txt

'now for my next trick, 3D

global xmax, ymax, pi, cmd$, record$, c6, s6
xmax = 606
ymax = 450
pi = acs(-1)
c6 = 30 * cos(pi/6)
s6 = 30 * sin(pi/6)
nomainwin
WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = (1200 - xmax) / 2
UpperLeftY = (700 - ymax) / 2

open "Rubic 4, press h for help..." for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill 115 115 115"
#gr "size 3"
dim fx(5) : dim fy(5)
fx(0) = 120 : fy(0) = 180
fx(1) = 210 : fy(1) = 180
fx(2) = 300 : fy(2) = 180
fx(3) = 30  : fy(3) = 180
fx(4) = 120 : fy(4) = 90
fx(5) = 120 : fy(5) = 270

dim c(53) '54 colors for squares
dim l$(53) 'labels for squares = original index
dim spin(8)
dim spinl$(8)
for i = 0 to 53
   f = int(i / 9)
   select case f
   case 0 : c(i) = 40  ' front face is green
   case 1 : c(i) = 700 ' right face red
   case 2 : c(i) = 8   ' back face blue
   case 3 : c(i) = 940 ' left face orange
   case 4 : c(i) = 999 ' top face white (which is why the black background
   case 5 : c(i) = 990 ' bottom face yellow
   end select
   l$(i) = str$(i)
next
call update
#gr "flush"
wait

' ======================================  procedures this window

sub quit H$
   close #gr
   end
end sub

sub lButtonUp H$, mx, my
   call quit H$
end sub

sub charIn H$, c$
   'notice "*";c$;"*" 'debug 2nd character not found in INSTR, also 4th????
   'nstr$ = "1 2 3"  'there is some kind of bug such that the 2nd and 4th position in string is not found
   if c$ = "h" then call help
   if instr("xyz",c$) then cmd$ = c$
   if (c$ = "1" or c$ = "2" or c$ = "3") and cmd$ <> "" then
       call cwRotate c$
       cmd$ = ""
   end if
   if c$ = "s" then call solve
   if c$ = "q" then call quit H$
end sub

sub cwRotate level$
   select case cmd$
   case "x"
       select case level$
       case "1"
           call cs  0,  3,  6, 36, 39, 42, 26, 23, 20, 45, 48, 51
           call spinFace 3
       case "2"
           call cs  1,  4,  7, 37, 40, 43, 25, 22, 19, 46, 49, 52
       case "3"
           call cs  2,  5,  8, 38, 41, 44, 24, 21, 18, 47, 50, 53
           call spinFace 1
       end select
   case "y"
       select case level$
       case "1"
           call cs  0,  1,  2,  27, 28, 29,  18, 19, 20,   9, 10, 11
           call spinFace 4
       case "2"
           call cs  3,  4,  5,  30, 31, 32,  21, 22, 23,  12, 13, 14
       case "3"
           call cs 33, 34, 35,  24, 25, 26,  15, 16, 17,   6,  7,  8
           call spinFace 5
       end select
   case "z"
       select case level$
       case "1"
           call spinFace 0 'ok
           call cs 42, 43, 44, 9, 12, 15, 47, 46, 45, 35, 32, 29
       case "2"
           call cs 10, 13, 16, 50, 49, 48, 34, 31, 28, 39, 40, 41
       case "3"
           call cs 36, 37, 38, 11, 14, 17, 53, 52, 51, 33, 30, 27
           call spinFace 2
       end select
   end select
   record$ = record$ + cmd$;level$ + " "
   call update
end sub

' ======================================    JB Library of procedures

sub rgb n3
   s3$ = right$("000";str$(n3), 3)
   r = 28 * val(mid$(s3$, 1, 1)) + 3
   g = 28 * val(mid$(s3$, 2, 1)) + 3
   b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "color ";r;" ";g;" ";b
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub frgb n3
   s3$ = right$("000";str$(n3), 3)
   r = 28 * val(mid$(s3$, 1, 1)) + 3
   g = 28 * val(mid$(s3$, 2, 1)) + 3
   b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "color ";r;" ";g;" ";b
end sub

sub brgb n3
   s3$ = right$("000";str$(n3), 3)
   r = 28 * val(mid$(s3$, 1, 1)) + 3
   g = 28 * val(mid$(s3$, 2, 1)) + 3
   b = 28 * val(mid$(s3$, 3, 1)) + 3
   #gr "backcolor ";r;" ";g;" ";b
end sub

sub label fColor, bColor, x, y, text$
   call frgb fColor
   call brgb bColor
   #gr "place ";x;" ";y;";\";text$
end sub

sub fbox x0, y0, x1, y1
   #gr "place ";x0;" ";y0
   #gr "boxfilled ";x1+1;" ";y1+1
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

'===============================================    procedures this app

sub update
   for i = 0 to 53
       f = int(i/9)
       xoff = fx(f) : yoff = fy(f)
       row = int((i - f * 9)/3) : col = i mod 3
       call rgb c(i)
       fore = 999 - c(i) : bk = c(i)
       call fbox xoff + col * 30, yoff + row * 30, xoff + col * 30 + 30, yoff + row * 30 + 30
       call label fore, bk, xoff + col * 30 + 8, yoff + row * 30 + 20, right$("  ";l$(i), 2)
   next
   'draw grids
   call rgb 0
   for f = 0 to 5
       xoff = fx(f) : yoff = fy(f)
       for i = 0 TO 3
           #gr "line ";xoff + 30 * i;" ";yoff;" ";xoff + 30 * i;" ";yoff + 90
           #gr "line ";xoff;" ";yoff + 30 * i;" ";xoff + 90;" ";yoff + 30 * i
       next
   next

   '3D views
   #gr "size 1"
   for face = 0 to 5
       fi = face * 9
       select case face
       case 0 : fx = 420 : fy = 75
           for row = 0 to 2
           for col = 0 to 2
               x = fx + col * c6
               y = fy + row * 30 + 15 * col
               call rgb c(fi + row * 3 + col)
               call d1 x, y
           next
           next
       case 1 : fx = 498 : fy = 120
           for row = 0 to 2
           for col = 0 to 2
               x = fx + col * c6
               y = fy + row * 30 - 15 * col
               call rgb c(fi + row * 3 + col)
               call d2 x, y
           next
           next
       case 3 : fx = 498 : fy = 240  'back side is mirror of front view
           for row = 0 to 2
           for col = 0 to 2
               x = fx + col * c6
               y = fy + row * 30 + 15 * col
               call rgb c(fi + row * 3 + (col))
               call d1 x, y
           next
           next
       case 2 : fx = 420 : fy = 285
           for row = 0 to 2
           for col = 0 to 2
               x = fx + col * c6
               y = fy + row * 30 - 15 * col
               call rgb c(fi + row * 3 + (col))
               call d2 x, y
           next
           next
       case 4 : fx = 498 : fy = 30
           for row = 0 to 2
           for col = 0 to 2
               x = fx + col * 26 - row * 26
               y = fy + row * 15 + 15 * col
               call rgb c(fi + row * 3 + col)
               call d3 x, y
           next
           next
       case 5 : fx = 498 : fy = 330
           for row = 0 to 2
           for col = 0 to 2
               x = fx + col * 26 - row * 26
               y = fy + row * 15 + 15 * col
               'spin the face
               i = row * 3 + col
               select case i
               case 0 : j = 6
               case 1 : j = 3
               case 2 : j = 0
               case 3 : j = 7
               case 4 : j = 4
               case 5 : j = 1
               case 6 : j = 8
               case 7 : j = 5
               case 8 : j = 2
               end select
               call rgb c(fi + j)
               call d3 x, y
           next
           next
       end select
   next
   call label 999, 444, 426, 20, "Top Front Right View:"
   call label 999, 444, 425, 440, "Back Left Bottom View:"
end sub

sub d1 x, y
   for yo = 0 to 30
       #gr "line ";x;" ";y + yo;" ";x + c6;" ";y + yo + s6
   next
   #gr "size 4"
   #gr "color black"
   #gr "line ";x;" ";y;" ";x + c6;" ";y + s6
   #gr "line ";x;" ";y;" ";x;" ";y + 30
   #gr "line ";x + c6;" ";y + s6;" ";x + c6;" ";y + 30 + s6
   #gr "line ";x;" ";y + 30;" ";x + c6;" ";y + 30 + s6
end sub

sub d2 x, y
   for yo = 0 to 30
       #gr "line ";x;" ";y + yo;" ";x + c6;" ";y + yo - s6
   next
   #gr "size 4"
   #gr "color black"
   #gr "line ";x;" ";y;" ";x + c6;" ";y - s6
   #gr "line ";x;" ";y;" ";x;" ";y + 30
   #gr "line ";x + c6;" ";y - s6;" ";x + c6;" ";y + 30 - s6
   #gr "line ";x;" ";y + 30;" ";x + c6;" ";y + 30 - s6
end sub

sub d3 x, y
   yy = y + 15
   for xx = 0 to 26
       fx = 15 - 15/26 * xx
       #gr "line ";x + xx;" ";yy - fx;" ";x + xx;" ";yy + fx
       #gr "line ";x - xx;" ";yy - fx;" ";x - xx;" ";yy + fx
   next
   #gr "size 4"
   #gr "color black"
   #gr "place ";x;" ";y
   #gr "north"
   #gr "turn 120"
   #gr "go 30"
   #gr "turn 120"
   #gr "go 30"
   #gr "turn 60"
   #gr "go 30"
   #gr "turn 120"
   #gr "go 30"
end sub

'color shifter, these are all indexes to the c() array
sub cs k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12
   ks1 = c(k10) : ks2 = c(k11) : ks3 = c(k12) 'save first three
   ls1$ = l$(k10) : ls2$ = l$(k11) : ls3$ = l$(k12) 'save first three

   c(k10) = c(k7) : c(k11) = c(k8) : c(k12) = c(k9)
   l$(k10) = l$(k7) : l$(k11) = l$(k8) : l$(k12) = l$(k9)

   c(k7) = c(k4) : c(k8) = c(k5) : c(k9) = c(k6)
   l$(k7) = l$(k4) : l$(k8) = l$(k5) : l$(k9) = l$(k6)

   c(k4) = c(k1) : c(k5) = c(k2) : c(k6) = c(k3)
   l$(k4) = l$(k1) : l$(k5) = l$(k2) : l$(k6) = l$(k3)

   c(k1) = ks1 : c(k2) = ks2 : c(k3) = ks3
   l$(k1) = ls1$ : l$(k2) = ls2$ : l$(k3) = ls3$
end sub

sub spinFace face
   for i = 0 to 8 'save data
       row = int(i / 3) : col = i mod 3
       idx = face * 9 + 3 * row + col
       spin(i) = c(idx)
       spinl$(i) = l$(idx)
   next
   if face = 0 or face = 1 or face = 4 then
       for i = 0 to 8 'swap data
           row = int(i / 3) : col = i mod 3
           idx = face * 9 + 3 * row + col
           select case i
           case 0 : c(idx) = spin(6) : l$(idx) = spinl$(6)
           case 1 : c(idx) = spin(3) : l$(idx) = spinl$(3)
           case 2 : c(idx) = spin(0) : l$(idx) = spinl$(0)
           case 3 : c(idx) = spin(7) : l$(idx) = spinl$(7)
           case 5 : c(idx) = spin(1) : l$(idx) = spinl$(1)
           case 6 : c(idx) = spin(8) : l$(idx) = spinl$(8)
           case 7 : c(idx) = spin(5) : l$(idx) = spinl$(5)
           case 8 : c(idx) = spin(2) : l$(idx) = spinl$(2)
           end select
       next
   else 'reverse
           for i = 0 to 8 'swap data
           row = int(i / 3) : col = i mod 3
           idx = face * 9 + 3 * row + col
           select case i
           case 0 : c(idx) = spin(2) : l$(idx) = spinl$(2)
           case 1 : c(idx) = spin(5) : l$(idx) = spinl$(5)
           case 2 : c(idx) = spin(8) : l$(idx) = spinl$(8)
           case 3 : c(idx) = spin(1) : l$(idx) = spinl$(1)
           case 5 : c(idx) = spin(7) : l$(idx) = spinl$(7)
           case 6 : c(idx) = spin(0) : l$(idx) = spinl$(0)
           case 7 : c(idx) = spin(3) : l$(idx) = spinl$(3)
           case 8 : c(idx) = spin(6) : l$(idx) = spinl$(6)
           end select
       next
   end if
end sub

sub solve
   i = 1 'cnt moves
   while word$(record$, i) <> ""
       scan
       cnt = cnt + 1
       i = i + 1
   wend
   for i = cnt to 1 step -1
       scan
       cmd$ = left$(word$(record$, i), 1)
       lv$ = right$(word$(record$, i), 1)
       for j = 1 to 3
           scan
           call cwRotate lv$
           call pause 100
       next
   next
   cmd$ = ""
   record$ = ""
end sub

sub help
   nl$ = Chr$(13)
   s$ =      "****************** Rubic Help *******************" + nl$
   s$ = s$ + "Let's call the 9 small cubes that make up 1/3" + nl$
   s$ = s$ + "of the entire cube a 'layer'.  Now, we need a" +nl$
   s$ = s$ + "shorthand method to specify which layer to rotate." + nl$
   s$ = s$ + "The x axis is layered left to right 1, 2, 3." + nl$
   s$ = s$ + "The y axis is layered top down 1, 2, 3." + nl$
   s$ = s$ + "The z axis is layered front to back 1, 2, 3." + nl$
   s$ = s$ + "So, to command a rotation:"+ nl$
   s$ = s$ + "Key press the axis and then the layer number." + nl$
   s$ = s$ + "Can also press h for this help, or q to quit." + nl$ + nl$
   s$ = s$ + "SOLVE!, press s to solve the cube."
   notice s$
end sub

This one really challenged my 3D spatial skills!

Rotations are commanded by keypress the axis: x, y, or z you want to rotate clockwise 90 degrees, and then press the layer to rotate 1, 2, or 3. x

axis left to right 1, 2, 3 is rotated from right side clockwise,
y axis top down 1, 2, 3 from top clockwise
and z axis front to back 1, 2, 3 rotated from front clockwise

Here is x1, y1, z1:
B += x
Reply
#2
Hehe - LOVE your new avatar! An animated BUG typing on a computer!

Simply *disgusting*

Erik.
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply