## Rubik cube

Game development specific discussions.
dodicat
Posts: 6095
Joined: Jan 10, 2006 20:30
Location: Scotland

### Rubik cube

This won't win a prize in Lachie's game site, so I'll put it here instead.
The Rubik cube must be the most boring thing around (IMHO)
edit:
Cull hidden faces (To speed it up in Linux)

Code: Select all

` '======  globals ====Type temp As Point Ptr 'advance noticeDim Shared lightsource As tempConst pi=4*Atn(1)Dim Shared As Integer xres,yresScreen 19,32  'screen 20 or 19 Color Rgb(200,200,200),Rgb(0,0,55)Screeninfo xres,yres#define farpoint type<point>(xres\2,yres\2,1000) 'eyepoint#define range(f,l) Int(Rnd*((l+1)-(f))+(f))Randomize'======================Declare Function Fmain() As Long'====   run  ======End Fmain'typesType Point     As Single x,y,z    Declare  Function rotate(As Point,As Point,As Point=Type<Point>(1,1,1)) As Point    Declare  Function perspective(As Point=farpoint) As Point    Declare  Function dot(As Point) As SingleEnd TypeType plane     As Point p(1 To 4)    Declare Sub Draw(As Ulong)    Private:    Declare Static Sub fill(() As Point,As Ulong,As Long,As Long)End TypeType cube                      'needs point and plane    As plane    f(1 To 6)      'faces    As Point norm(1 To 6)      'normals to faces    As Ulong  clr(1 To 6)      'colours    As Point centre            'centroid    As Point aspect            'orientation in space    Declare Sub  construct                             'create a unit cube    Declare Function spin(As Point) As cube            'spin about centroid    Declare Sub translate(v As Point,s As Double)      'shift and blow    Declare Function rotate(As Point,As Point) As cube 'roatate about a chosen point    Declare Static Sub bsort(() As cube )              'bubblesort (fast enough for a small number of cubes)    Declare Sub Draw    As Long idx                                         'cube id numberEnd TypeType Circle    As Single x,y,r    Declare Sub Draw(As Long,as ulong=rgb(200,200,200),msg as string="")'    'macro method ?    #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radiusEnd Type'==========  method for circle ==========Sub circle.draw(z As Long,cl as ulong,msg as string)    Circle(x,y),r,cl,,,,f   if msg="" then ..draw String(x-4,y-4),Str(z),Rgb(0,0,0) else _     ..draw String(x-4*len(msg),y-4),msg,rgb(0,0,0)End Sub'==========   methods for cube ========='construct unit cubes/normals around origin (0,0,0)Sub cube.construct     Static As Point g(1 To ...,1 To ...)= _        {{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front    {(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_     'right    {(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_     'back    {(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_ 'left    {(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_     'top    {(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}  'base    For n As Long=1 To 6        For m As Long=1 To 4            f(n).p(m)= g(n,m)   'set to g()         Next m    Next n    norm(1)=Type(0,0,-1) 'face normals to cube    norm(2)=Type(1,0,0)    norm(3)=Type(0,0,1)    norm(4)=Type(-1,0,0)    norm(5)=Type(0,1,0)    norm(6)=Type(0,-1,0)    centre=Type(0,0,0)     aspect=Type(0,0,0) End SubFunction cube.spin(p As Point) As cube    Dim As cube tmp=This    For n As Long=1 To Ubound(f)        For m As Long=1 To Ubound(f(n).p)            tmp.f(n).p(m)=this.f(n).p(m).rotate(centre,p)            tmp.f(n).p(m)=tmp.f(n).p(m).perspective()        Next        tmp.norm(n)=tmp.norm(n).rotate(centre,p)'normals spin also     Next    tmp.draw    Return tmpEnd FunctionSub cube.draw    Static As Ubyte Ptr col    For n As Long=1 To Ubound(f)-1        For m As Long=n+1 To Ubound(f)            If norm(n).z<norm(m).z Then                Swap f(n),f(m)                Swap norm(n),norm(m)                Swap clr(n),clr(m)            End If        Next m    Next n    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)    For n As Long=1 To Ubound(f)        col=Cptr(Ubyte Ptr,@clr(n))        Dim As Single cx=norm(n).x-centre.x,cy=norm(n).y-centre.y,cz=norm(n).z-centre.z        Dim As Single dst=Sqr(cx*cx + cy*cy +cz*cz)        Dim As Point cn=Type(cx/dst,cy/dst,cz/dst)'normalized norm        Dim As Point k=Type<Point>(cx,cy,cz)        Dim As Single dt=k.dot(*lightsource)        dt=map(1,-1,dt,.5,1)        If cn.z<.1 Then 'cull face if out of sight (show if the normal points into screen up to about 6 degrees)            f(n).draw(Rgba(dt*col[2],dt*col[1],dt*col[0],col[3]))        End If    Next nEnd SubSub cube.translate(v As Point,s As Double)    For n As Long=1 To Ubound(f)  'expand        norm(n).x*=s        norm(n).y*=s        norm(n).z*=s        For m As Long=1 To Ubound(f(n).p)            f(n).p(m).x*=s            f(n).p(m).y*=s            f(n).p(m).z*=s        Next m    Next n    For n As Long=1 To Ubound(f)   'shift        norm(n).x=norm(n).x+v.x        norm(n).y=norm(n).y+v.y        norm(n).z=norm(n).z+v.z        For m As Long=1 To Ubound(f(n).p)            f(n).p(m).x= f(n).p(m).x+v.x             f(n).p(m).y= f(n).p(m).y+v.y            f(n).p(m).z= f(n).p(m).z+v.z        Next m    Next n    centre.x+=v.x    centre.y+=v.y    centre.z+=v.zEnd SubFunction cube.rotate(c As Point,ang As Point) As cube    Dim As cube tmp=This    For n As Long=1 To Ubound(f)        For m As Long=1 To Ubound(f(n).p)            tmp.f(n).p(m)=this.f(n).p(m).rotate(c,ang)        Next        tmp.norm(n)=this.norm(n).rotate(c,ang)    Next    tmp.centre=this.centre.rotate(c,ang)    Return tmpEnd FunctionSub cube.bsort(c() As cube)    For n As Long=Lbound(c) To Ubound(c)-1        For m As Long=n+1 To Ubound(c)            If c(n).centre.z<c(m).centre.z Then Swap c(n),c(m)        Next    NextEnd Sub'======================  methods for point ====================Function point.dot(v2 As Point) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)(shader)    Dim As Single d1=Sqr(x*x + y*y+ z*z),d2=Sqr(v2.x*v2.x + v2.y*v2.y +v2.z*v2.z)    Dim As Single v1x=x/d1,v1y=y/d1,v1z=z/d1 'normalize    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize    Return (v1x*v2x+v1y*v2y+v1z*v2z) End FunctionFunction point.Rotate(c As Point,angle As Point,scale As Point) As Point    Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)    Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)    Dim As Single dx=this.x-c.x,dy=this.y-c.y,dz=this.z-c.z    Return Type<Point>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_    (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_    (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)',p.col)End FunctionFunction point.perspective(eyepoint As Point) As Point    Dim As Single   w=1+(this.z/eyepoint.z)    Return Type<Point>((this.x-eyepoint.x)/w+eyepoint.x,_    (this.y-eyepoint.y)/w+eyepoint.y,_    (this.z-eyepoint.z)/w+eyepoint.z)End Function  ' ================    methods for plane  ===================Sub plane.fill(a() As Point, c As Ulong,min As Long,max As Long)    Static As Long i,j,k,dy,dx, x,y    Static As Long NewX (1 To Ubound(a))    Static As Single Grad(1 To Ubound(a))    For i=1 To Ubound(a) - 1         dy=a(i+1).y-a(i).y        dx=a(i+1).x-a(i).x        If(dy=0) Then Grad(i)=1        If(dx=0) Then Grad(i)=0        If ((dy <> 0) And (dx <> 0)) Then            Grad(i) = dx/dy        End If    Next i    For y=min To max        k = 1        For i=1 To Ubound(a) - 1            If( ((a(i).y<=y) Andalso (a(i+1).y>y)) Or ((a(i).y>y) _            Andalso (a(i+1).y<=y))) Then            NewX(k)= Int(a(i).x+ Grad(i)*(y-a(i).y))            k +=1        End If    Next i    For j = 1 To k-2        For i = 1 To k-2            If NewX(i) > NewX(i+1) Then Swap  NewX(i),NewX(i+1)        Next i    Next j    For i = 1 To k - 2 Step 2        Line (NewX(i),y)-(NewX(i+1)+1,y), c    Next iNext yEnd SubSub plane.draw(clr As Ulong )    Static As Long miny=1e6,maxy=-1e6    Redim As Point V1(1 To  Ubound(p)+1)    Dim As Long n    For n =1 To Ubound(p)        If miny>p(n).y Then miny=p(n).y        If maxy<p(n).y Then maxy=p(n).y        V1(n)=p(n)     Next    v1(Ubound(v1))=p(Lbound(p))    plane.fill(v1(),clr,miny,maxy)End Sub'================   end methods  ======================'independent proceduresFunction Regulate(Byval MyFps As Long,Byref fps As Long) As Long    Static As Double timervalue,lastsleeptime,t3,frames    Var t=Timer    frames+=1    If (t-t3)>=1 Then t3=t:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=T    Return sleeptimeEnd FunctionFunction StringSplit(s_in As String,chars As String,result() As String) As Long    Dim As Long ctr,ctr2,k,n,LC=Len(chars)    Dim As boolean tally(Len(s_in))    #macro check_instring()    n=0    While n<Lc        If chars[n]=s_in[k] Then             tally(k)=true            If (ctr2-1) Then ctr+=1            ctr2=0            Exit While        End If        n+=1    Wend    #endmacro        #macro split()    If tally(k) Then        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)        ctr2=0    End If    #endmacro    '==================  LOOP TWICE =======================    For k  =0 To Len(s_in)-1        ctr2+=1:check_instring()    Next k    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0    For k  =0 To Len(s_in)-1        ctr2+=1:split()    Next k    '===================== Last one ========================    If ctr2>0 Then        Redim Preserve result(1 To ctr+1)        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)    End If    Return Ubound(result)End FunctionFunction Fmain() As Long    Windowtitle "the cube"    Dim As Long mx,my,btn,tk=1,mouseflag    Dim As Single cx=xres\2,cy=yres\2    lightsource=New Point(0,1,1)    Dim As Point screencentre =(xres\2,yres\2,0)    Dim As Single frx=.6,fry=.4    Dim As Circle cir(1 To 11)={(screencentre.x-frx*cx,screencentre.y-fry*cx/1.3,cx/20),_    (screencentre.x-frx*cx,screencentre.y,cx/20), _    (screencentre.x-frx*cx,screencentre.y+fry*cx/1.3,cx/20), _    (screencentre.x-frx*cx/2,screencentre.y-fry*cx*1.3,cx/20),_    (screencentre.x,screencentre.y-fry*cx*1.3,cx/20), _    (screencentre.x+frx*cx/2,screencentre.y-fry*cx*1.3,cx/20), _    (screencentre.x+frx*cx*1.35,screencentre.y+frx*cx/3,cx/15), _    (screencentre.x+frx*cx*1.35,screencentre.y,cx/20), _    (screencentre.x+frx*cx*1.35,screencentre.y-frx*cx/3,cx/25)}    cir(10)=type(.1*xres,.9*yres,cx/30)    cir(11)=type(.15*xres,.9*yres,cx/30)    Dim As String sf1,sf2,sf3,sf4,sf5,sf6,sf7,sf8,sf9    Redim As cube  c()    Dim As Long ctr    Dim As Single dfrac=.14    For x As Long=xres\2-.4*cx To xres\2+.4*cx  Step .3*cx        For y As Long=yres\2-.4*cx To yres\2+.4*cx Step .3*cx            For z As Long=0-.4*cx To 0+.4*cx Step .3*cx                ctr+=1                Redim Preserve c(1 To ctr)                c(ctr).construct                c(ctr).idx=ctr                c(ctr).translate(Type(x+dfrac*cx,y+dfrac*cx,z+dfrac*cx),dfrac*cx)                For n As Long=1 To 6                    Select Case n                    Case 1:c(ctr).clr(n)=Rgb(200,0,0)                    Case 2:c(ctr).clr(n)=Rgb(0,200,0)                    Case 3:c(ctr).clr(n)=Rgb(200,200,0)                    Case 4:c(ctr).clr(n)=Rgb(0,0,200)                    Case 5:c(ctr).clr(n)=Rgb(250,250,250)                    Case 6:c(ctr).clr(n)=Rgb(0,200,200)                    End Select                                    Next n            Next        Next    Next    'screencentre becomes the Rubik cube centroid    Dim As Single ccx,ccy,ccz    For n As Long=Lbound(c) To Ubound(c)        ccx+=c(n).centre.x        ccy+=c(n).centre.y        ccz+=c(n).centre.z    Next    ccx=ccx/Ubound(c)    ccy=ccy/Ubound(c)    ccz=ccz/Ubound(c)    screencentre=Type(ccx,ccy,ccz)        Dim As cube  tmp(Lbound(c) To Ubound(c))      Dim As Point a    a.y=-.3    a.x=.3    Dim As Long fps    Dim As String key    Dim As Long tflag,shuffle    Do        key=Inkey         Getmouse mx,my,,btn        If key=Chr(255)+"P" Then a.y-=.05   'down y axis        If key=Chr(255)+"H" Then a.y+=.05   'up   y axis        If key=Chr(255)+"K" Then a.z-=.05   'right z axis        If key=Chr(255)+"M" Then a.z+=.05   'left  z axis        If key="q" Then a.x+=.05   'x axis        If key="w" Then a.x-=.05   'x axis        If key=" " Then a=type(.3,-.3,0) 'reset        If key="s" Then            If shuffle=0 Then tflag=range(1,9):shuffle=1        End If        Screenlock        Cls        Draw String (20,20),"Use arrow keys and q and w to change aspect, space key to reset"        Draw String (20,40),"Use left and right mouse clicks on circles"        Draw String (20,60),"Press s to shuffle"        Draw String (20,80),"FPS = " &fps                For n As Long=Lbound(c) To Ubound(c)            tmp(n)=c(n).rotate(screencentre,Type(a.x,a.y,a.z)) 'rotates cube about screen cenre        Next        'macros for repeat tasks        #macro turn90degrees        Static As Single t,k        t=(pi/2)/20        k+=t        If k>=pi/2+t Then tflag=0:k=0:t=0        #endmacro                #macro tflagrot(s,p)        Redim As String L()        stringsplit(s,",",L())        turn90degrees        For n As Long=1 To 9            c(Vallng(L(n)))=c(Vallng(L(n)) ).rotate(screencentre,p)        Next n        If t=0 Then            shuffle=t        End If        #endmacro                Select Case tflag        Case 1              tflagrot(sf1,Type(0,tk*t,0))        Case 2             tflagrot(sf2,Type(0,tk*t,0))        Case 3             tflagrot(sf3,Type(0,tk*t,0))        Case 4             tflagrot(sf4,Type(tk*t,0,0))        Case 5             tflagrot(sf5,Type(tk*t,0,0))        Case 6             tflagrot(sf6,Type(tk*t,0,0))        Case 7             tflagrot(sf7,Type(0,0,tk*t))        Case 8             tflagrot(sf8,Type(0,0,tk*t))        Case 9             tflagrot(sf9,Type(0,0,tk*t))        case 10            a=type(.39*tk,.39,0)        'flip aspects            tflag=0        case 11            a=type(.39*tk,-.39,0)            tflag=0        End Select        cube.bsort(tmp()) 'sort by centre.z        sf4=""        sf5=""        sf6=""        sf1=""        sf2=""        sf3=""        sf7=""        sf8=""        sf9=""        For n As Long=Lbound(tmp) To Ubound(tmp)'advance aspect and spin.            tmp(n).spin(tmp(n).aspect)            '===============  verticals ==========            If c(n).centre.x<.4*xres Then 'lft                sf4+=Str(c(n).idx)+","            End If                        If c(n).centre.x>.4*xres And c(n).centre.x < .6*xres Then'mid                sf5+=Str(c(n).idx)+","            End If                        If c(n).centre.x>.6*xres  Then 'rgt                sf6+=Str(c(n).idx)+","            End If            '====================horizontals ==================            If c(n).centre.y<.4*yres Then 'top                sf1+=Str(c(n).idx)+","            End If                        If c(n).centre.y>.4*yres And c(n).centre.y<.6*yres Then 'mid                sf2+=Str(c(n).idx)+","            End If                        If c(n).centre.y>.6*yres Then  'bot                sf3+=Str(c(n).idx)+","            End If            '=================front to back =============            If c(n).centre.z< screencentre.z-.1*xres Then 'front                sf7+=Str(c(n).idx)+","            End If                        If c(n).centre.z< screencentre.z+.01*xres  And  c(n).centre.z > screencentre.z-.01*xres Then 'mid                sf8+=Str(c(n).idx)+","            End If                        If c(n).centre.z> screencentre.z+.1*xres  Then 'back                sf9+=Str(c(n).idx)+","            End If                    Next        sf4=Rtrim(sf4,",")        sf5=Rtrim(sf5,",")        sf6=Rtrim(sf6,",")        sf1=Rtrim(sf1,",")        sf2=Rtrim(sf2,",")        sf3=Rtrim(sf3,",")        sf7=Rtrim(sf7,",")        sf8=Rtrim(sf8,",")        sf9=Rtrim(sf9,",")        'manage mouse in circles        For n As Long=1 To 11           if n<=9 then cir(n).draw(n)           if n=10 then cir(n).draw(n,rgb(0,100,255),"a1")           if n=11 then cir(n).draw(n,rgb(0,100,255),"a2")            Var x=(cir(n).x),y=(cir(n).y),r=(cir(n).r)            If incircle( x ,y , r ,mx,my) And btn And mouseflag=0 Then                mouseflag=1                If btn=1 Then tk=1                If btn=2 Then tk=-1                tflag=n            End If        Next n        Screenunlock        Sleep regulate(90,fps),1        mouseflag=btn    Loop Until key=Chr(27)    Sleep        Delete lightsource    Return 0End Function      `
Last edited by dodicat on Oct 12, 2018 14:07, edited 1 time in total.
h4tt3n
Posts: 691
Joined: Oct 22, 2005 21:12
Location: Denmark

### Re: Rubik cube

Impressive as always :-)
D.J.Peters
Posts: 7905
Joined: May 28, 2005 3:28

### Re: Rubik cube

Well done :-)

Joshy
jj2007
Posts: 1291
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

### Re: Rubik cube

Indeed, well done!
grindstone
Posts: 665
Joined: May 05, 2015 5:35
Location: Germany

### Re: Rubik cube

Great!

Alas, I never got along with this cube. <grin>
Lachie Dazdarian
Posts: 2338
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

### Re: Rubik cube

Hah, really cool!
HelenIrvin
Posts: 1
Joined: Feb 05, 2019 6:57

### Re: Rubik cube

Very interesting. I also want to learn how to write simple games!
Tourist Trap
Posts: 2792
Joined: Jun 02, 2015 16:24

### Re: Rubik cube

HelenIrvin wrote:Very interesting. I also want to learn how to write simple games!

Welcome here HelenIrvin,

whatever you want to do just start trying and ask when you get stuck :) It's what I always do.
Makoto WATANABE
Posts: 118
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

### Re: Rubik cube

Thank you for providing wonderful programs every time.
Often I can not solve the cube and I give it up.
I would appreciate if this program ends the cube by aligning it before the program ends.
I think it will help to learn my puzzle solution.

cf. Solve a Rubik's Cube
https://rosettacode.org/wiki/Solve_a_Rubik%27s_Cube
dodicat
Posts: 6095
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Rubik cube

Hi Makoto.
I could maybe store all moves in a string and reverse everything done, back to the original.
But it wouldn't be the most direct way to the solution.