JB Rubic's Cube with Solver

[B+]

Code: [Select]

'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



[B+]

If anyone attempts a direct translation from JB to their favorite flavor, here is the game plan I used for Rotations (which could be worked on a bit more), all a 90 degree turn clockwise but the x axis is from right hand side looking at the front (green) face...

Code: [Select]

Rubix Color Index Layout:

           : 26 25 24 :
           : 23 22 21 :  >>>> I had back of cube lined up wrong to this:
           : 20 19 18 :
                                      V
                                      V
           : 36 37 38 :               V
           : 39 40 41 :               V
           : 42 43 44 :
: 27 28 29 :  0  1  2 :  9 10 11 : 18 19 20 :
: 30 31 32 :  3  4  5 : 12 13 14 : 21 22 23 :
: 33 34 35 :  6  7  8 : 15 16 17 : 24 25 26 :
           : 45 46 47 :
           : 48 49 50 :
           : 51 52 53 :


ROTATIONS WERE BASED ON LOOKING AT THE FRONT GREEN FACE OF CUBE:

The x axis was left to right 1, 2, 3 right hand side clockwise when looking at front face.

The y axis was top to bottom 1, 2, 3 right hand above cube front face turning clockwise,

The z axis was front to back 1, 2, 3 turning clockwise while facing front of cube.


         

and of course, I will answer questions about JB commands used here.

EDIT: oops I did change the the y axis rotation to top of cube clock-wise.

Rotations were commanded by axis letter (x, y, or z) and then layer (1, 2, 3).

[B+]

Here is the image I based my code on:

[ScriptBasic]

I have forked this challenge to the AllBASIC.info forum for a better set of forum tools than offered here.

Please return to your favorite program(ming).

[B+]

Perhaps if you show them how easy it is to do in Just Basic (the BASIC for Beginners).

[ZXDunny]

I don't understand the reference to wings.

[ScriptBasic]

RobbeK was a brilliant mathematician and graphics guru. He died a few years ago and we miss him a lot on the O2 forum.

[ScriptBasic]

Perhaps if you show them how easy it is to do in Just Basic (the BASIC for Beginners).

Who said this thread was closed?

[B+]

Perhaps if you show them how easy it is to do in Just Basic (the BASIC for Beginners).

Who said this thread was closed?

? 

The comment I made that you quoted was in reference to the snap I took from ALLBASIC and attached to same reply.

You, John, seemed to be trying to motivate others to take up the Rubic's coding challenge at your forum and I wanted to help you in your motivation by suggesting you suggest there how easy it was to do in an easy to learn BASIC. I mean WTH? even bplus can do it!

[ScriptBasic]

You are welcome to join the AllBASIC.info forum and contribute as you see fit.

[ZXDunny]

RobbeK was a brilliant mathematician and graphics guru. He died a few years ago and we miss him a lot on the O2 forum.

That's very sad but I must ask - I still don't understand what the reference to wings is?

[B+]

He might have been promoted to Angel.

[ScriptBasic]

Bingo.

[ZXDunny]

Ah, I assume he must have been a christian then? I don't know much about that religion, so apologies for my ignorance. There was an old church in the village I grew up in, but nobody went in there and since moving away I've not really met anyone that still does.

[B+]

Perhaps because I've had more exposure to Christianity, in my book, an angel is a person whose excellent personality, their spirit so to speak, their legacy maybe, in a positive way, survives their mortal existence in minds and hearts of survivors. It's a figurative expression not to be taken literally.