## Rubik cube

Game development specific discussions.
dodicat
Posts: 6012
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 notice
Dim Shared lightsource As temp
Const pi=4*Atn(1)
Dim Shared As Integer xres,yres
Screen 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

'types
Type 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 Single
End Type

Type 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 Type

Type 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 number
End Type

Type Circle
As Single x,y,r
Declare Sub Draw(As Long,as ulong=rgb(200,200,200),msg as string="")'
'macro method ?
End 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 Sub

Function 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 tmp
End Function

Sub 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 n
End Sub

Sub 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.z
End Sub

Function 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 tmp
End Function

Sub 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
Next
End 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 Function

Function 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 Function

Function 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) And (dx <> 0)) Then
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
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 i
Next y
End Sub

Sub 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 procedures
Function 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 sleeptime
End Function

Function 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 Function

Function 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
#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 0
End Function

Last edited by dodicat on Oct 12, 2018 14:07, edited 1 time in total.
h4tt3n
Posts: 688
Joined: Oct 22, 2005 21:12
Location: Denmark

### Re: Rubik cube

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

### Re: Rubik cube

Well done :-)

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

### Re: Rubik cube

Indeed, well done!
grindstone
Posts: 656
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: 2768
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: 6012
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.