if you have more then one desktops try that.
Code: Select all
EnableExplicit
Global.i font , finish , hispeed , flip2 , deelay , delay2 , delay3 ,beep
Global.I Event , pick1 , pick2 , pick3 , gad , gad2 ,mode, scramble , mb , s2 , turning , ret ,ret2
Global.i a , b , mb_c , mbf1 , mx , my , n1 , buff , buff_siz , buffmax ,buffmin, pos1 , pos2 ,vol=40
Global.i Dim ccc(26) , Dim ccci(26) , Dim cc2(42) , Dim col(343)
Global.i i , rrr , rr , inv , n1 , i1, picko , mark , err1 , err2 , po , co,EntityID_1000
Global.f rotate, mxx = 28
Global.s sequ$
#sequ$ = "1============="
Global.i seq2 , seq3
Global.f Dim xp(6) , Dim yp(6) , Dim zp(6)
Global.i Dim xr(6) , Dim yr(6) , Dim zr(6)
Global.i Dim check(6,6,6) , Dim check2(26)
font=LoadFont(0 , "Times New Roman" , 13 );, #PB_Font_Bold)
InitEngine3D()
InitSprite()
InitKeyboard()
InitMouse()
InitSound()
;- ----------desktops-----
#dx2 = 750;dy1 * 1.4 * proc+
#x = 190
#expand = 300
#dy2 = 700;756;dy1 * proc
#dx3 = #dx2/2
#dy3 = (#dy2+30)/2
OpenWindow(0 , 0 , 0 , #dx2+#x+#expand , #dy2 , Space(20)+"Pure Basic"+Space(70)+"rubik's cube 3.04" , 13107201)
OpenWindowedScreen(WindowID(0) , 0 , 0 , #dx2 , #dy2)
;- ----------Texture-----
Define.q Dim col2(7)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem)
CreateMaterial(8 , LoadTexture(1 , "Dirt.jpg")) ;Sol
CreatePlane(0 , 500 , 500 , 100 , 100 , 25 , 25)
CreateEntity(0 , MeshID(0) , MaterialID(8) , 0 , -4.1 , 0)
#orange = (255) + (100) * 1<<8 + (0) * 1<<16 ;RGB(255 , 100 , 0)
col2(0) = RGB(40 , 40 , 40)
col2(1) = #Yellow : yp(1) = -0.5 : xr(1) = 180 ;down
col2(2) = #White : yp(2) = 0.5 : xr(2) = 0 ;up col(6) = #Blacktt
col2(3) = #Red : zp(3) = -0.5 : xr(3) = -90 ;front
col2(4) = #orange : zp(4) = 0.5 : xr(4) = 90 ;back (orange)
col2(5) = #Blue : xp(5) = -0.5 : zr(5) = 90 ;right >
col2(6) = #Green : xp(6) = 0.5 : zr(6) = -90 ;left <
col2(7) = RGB(40 , 40 , 40)
#sc=3
#size = 16 * #sc
For a = 0 To 7
CreateTexture(a , #size , #size)
StartDrawing(TextureOutput(a))
Box(0 , 0 , #size-1 * #sc , #size-1 * #sc , 0)
Box( #sc , #sc , #size-2 * #sc , #size-2 * #sc , col2(a))
; DrawText( 7* #sc, 5* #sc,Str(a))
StopDrawing()
CreateMaterial(a , TextureID(a))
Next a
Procedure kub()
PlaySound(3, 0 , vol)
Protected.i a , a1 , b , x , y , z , yy , zz , xx , c ,c1 ,c2,c3
Protected.f yf , zf , xf
turning = 0 : rotate = 0 : n1 = 0 : rr = 0 : sequ$ = "" : picko=0
buff = 0 : buffmax = 0 : buffmin = 0
seq2 = 0 : seq3 = 0
#cube = 1 : CreateCube(#cube , 0.08)
#plane = 2 : CreatePlane(#plane , 1 , 1 , 1 , 1 , 1 , 1)
For y = -1 To 1 : yy = Abs(y)+Bool(y = 1) : yf = yy * 0.1 * y -y
For z = -1 To 1 : zz = Abs(z)+Bool(z = 1) : zf = (zz+Sign(zz) * 2) * 0.1 * z -z
For x = -1 To 1 : xx = Abs(x)+Bool(x = 1) : xf = (xx+Sign(xx) * 4) * 0.1 * x -x
a = yy + zz * 4 + xx * 16
a1 = a * 8
If a>0
b+1 : ccc(b) = a1
cc2(a) = Abs(x)+Abs(y)+Abs(z)
CreateEntity(a1 , MeshID(#cube) , #PB_Material_None)
c1=0: c2=7
For c = 1 To 6
If Abs(xp(c)+x)>1.1 Or Abs(yp(c)+y)>1.1 Or Abs(zp(c)+z)>1.1
c1+1: c3=c1
If (b=1 Or b=9 Or b=20 Or b=24) And c3>1:c3!1: EndIf
col(a1+c3)=c
Else
c2-1: c3=c2
EndIf
CreateEntity(a1+c3 , MeshID(#plane) , MaterialID(col(a1+c3)) , xp(c) , yp(c) , zp(c) )
RotateEntity(a1+c3 , xr(c) , yr(c) , zr(c))
AddSubEntity(a1 , a1+c3 , #PB_Entity_StaticBody)
Next c
CreateEntity(a1+7 , MeshID(#cube) , #PB_Material_None , xf , yf , zf)
col(a1+c3)
AddSubEntity(a1 , a1+7 , #PB_Entity_StaticBody )
HideEntity (a1+7 , 1)
MoveEntity(a1 , x , y , z , #PB_Absolute+#PB_World)
HideEntity(a1 , 1)
EndIf
Next x
Next z
Next y
For a=1 To 26
If cc2(ccc(a)>>3) = 2
check(col(ccc(a)+1),col(ccc(a)+2),0)=a
check(col(ccc(a)+2),col(ccc(a)+1),0)=a
Else
check(col(ccc(a)+1),col(ccc(a)+2),col(ccc(a)+3))=a
check(col(ccc(a)+2),col(ccc(a)+3),col(ccc(a)+1))=a
check(col(ccc(a)+3),col(ccc(a)+1),col(ccc(a)+2))=a
EndIf
Next a
EndProcedure
;- do a "beep" sound
#samples=350
Define.i *Header = AllocateMemory(44+#samples*2)
For a=0 To 9 : Read.l b : PokeL(*Header+a*4,b) : Next a : PokeL(*Header+a*4,#samples*2)
For a=0 To #samples-2 : b=(Bool(a%25<13)*2-1)*4000 :PokeW(*Header+44+a*2,b) : Next a
DataSection : Data.l $46464952,$0,$45564157,$20746D66,$10,$10001,$2B11,$5622,$100002,$61746164:EndDataSection
For a=1 To 3 : CatchSound(a,*Header) : SetSoundFrequency(a,(44100)>>(4-a) ) : SoundVolume(a, 50) : Next a
CreateSprite(0 , 40 , 40 , #PB_Sprite_AlphaBlending )
Global.f cubespeed2 , cubespeed2_bak , cubespeed1
#d20=20
Procedure cube_speed()
cubespeed1 = 0.1 * Pow(1.07 , GetGadgetState(4))
cubespeed1 = Round(90 / cubespeed1 , 2)
cubespeed2 = 90 / cubespeed1
cubespeed2_bak = cubespeed2
SetGadgetText(3 , " "+Str(cubespeed1)+" "+StrF(cubespeed2 , 3))
If hispeed And mode=14 : cubespeed2 = 90 : EndIf
If (delay2=5*#d20 Or cubespeed2<10) And hispeed=0 : beep=1 : Else :beep=0: EndIf
EndProcedure
Procedure Hi_Speed()
If GetGadgetState(22): hispeed = 1 : cubespeed2 = 90 : vol=10
Else : hispeed = 0 : cubespeed2 = cubespeed2_bak : vol=35
EndIf
If buffmax > buff :SetGadgetState(22,0): hispeed = 0 :cubespeed2 = cubespeed2_bak : EndIf
If (delay2=5*#d20 Or cubespeed2<10) And hispeed=0 : beep=1 : Else :beep=0: EndIf
EndProcedure
Procedure deelay() ; 11 - 18
deelay = GetGadgetState(32)
delay2 = deelay * #d20
delay3 = delay2 + 6
If (delay2 = 5*#d20 Or cubespeed2<10) And hispeed=0 : beep=1 : Else :beep=0: EndIf
EndProcedure
Global.s Dim mode$(3)
mode$(0)="- Manual mode"
mode$(1)="- Edit mode"
mode$(2)="- Solv mode"
Procedure Mode()
mode=EventGadget()
AddGadgetItem (70 , -1 ,mode$(mode-12))
EndProcedure
Procedure Mode2(a)
mode=a
SetGadgetState(mode,1)
AddGadgetItem (70 , -1 ,mode$(mode-12))
EndProcedure
Procedure CanvasGadget2(g.i , x.i , y , xs.i , ys.i , t$)
CanvasGadget(g.i , x.i , y , xs.i , ys.i );,#PB_Canvas_Keyboard )
StartDrawing(CanvasOutput(g))
DrawingFont(font)
DrawingMode(#PB_2DDrawing_Transparent)
Box(1 , 1 , xs-2 , ys-2 , $888888 )
Box(2 , 2 , xs-4 , ys-4 ,#Cyan); $dddddd )
DrawText(xs/10 , 2 , t$ , $333333)
StopDrawing()
EndProcedure
;- -----------gadget-------
SetGadgetFont(#PB_Default , font)
#xx = #x-15 : #ysize = 23 : #ysize2 = #ysize+3
Define.i y=10
CanvasGadget2(1 , #dx2+10 , y , #xx , #ysize , "New") : y+#ysize2
TextGadget(2 , #dx2+10 , y , #xx , #ysize , "Twist-Speed" , #PB_Text_Center) : y+#ysize2
TextGadget(3 , #dx2+10 , y , #xx , #ysize , "tt") : y+#ysize2
TrackBarGadget(4 , #dx2+10 , y , #xx , #ysize , 1 , 100) : y+#ysize2
BindGadgetEvent (4 , @cube_speed())
ContainerGadget(10 , #dx2+10 , y , #xx , #ysize*4+15 ,#PB_Frame_Flat) : y+#ysize2*4+11
TextGadget(11 , 10 , 5 , #xx-11 , #ysize , "Mode" )
OptionGadget(12 , 10 , #ysize2*1 , #xx-11 , #ysize , "Manual")
OptionGadget(13 , 10 , #ysize2*2 , #xx-11 , #ysize , "Edit")
OptionGadget(14 , 10 , #ysize2*3 , #xx-11 , #ysize , "Solv")
CloseGadgetList()
BindGadgetEvent(12 , @mode()) : BindGadgetEvent(13 , @mode()) : BindGadgetEvent(14 , @mode())
ContainerGadget(20 , #dx2+10 , y , #xx , #ysize *10+7 ,#PB_Frame_Flat) : y+#ysize2*9+10
CanvasGadget2(21 , 5 , 5 , #xx-12 , #ysize , "Solv")
CheckBoxGadget(22 , 7 , #ysize2+4 , #xx-15, #ysize , "Hi Speed")
BindGadgetEvent(22 , @Hi_Speed())
ContainerGadget(30 , 5 , #ysize2*2+5 , #xx-12 , #ysize *3+15 ,#PB_Frame_Flat)
TextGadget (31 , 10 , 5 , #xx , #ysize , "Pause after sequence")
TrackBarGadget(32 , 3 , 7+#ysize , #xx-16 , #ysize , 0 , 5)
BindGadgetEvent (32 , @deelay())
CheckBoxGadget(33 , 10 , #ysize2*2 , #xx-11 , #ysize , "R-ctrl (repeat)")
CloseGadgetList()
ContainerGadget(40 , 5, #ysize2*5+17 , #xx-12 , #ysize*3+15 ,#PB_Frame_Flat)
TextGadget(41 , 10 , 5 , #xx-11 , #ysize , "When cube solved" )
OptionGadget(42 , 10 , #ysize2*1 , #xx-11 , #ysize , "Return to manual")
OptionGadget(43 , 10 , #ysize2*2 , #xx-11 , #ysize , "automatic random")
GadgetToolTip(42 , "When cube solved. Return to manual.")
GadgetToolTip(43 , "When cube solved. Automatic random and solv again.")
CloseGadgetList()
CloseGadgetList()
SetGadgetColor(20, #PB_Gadget_BackColor , #Green)
CanvasGadget2(50 , #dx2+10 , y , #xx/2-2 , #ysize , "Undo")
CanvasGadget2(51 , #dx2+10+#xx/2+2 , y , #xx/2-2 , #ysize , "Redo") : y+#ysize2
CanvasGadget2 (52 , #dx2+10 , y , #xx , #ysize , "reset Undo") : y+#ysize2
TextGadget(53 , #dx2+10 , y , #xx , #ysize , "0") : y+#ysize2 +4
StringGadget(60 , #dx2+10 , y , #xx , #ysize , "") : y+#ysize2
CanvasGadget2(61 , #dx2+10 , y , #xx/2-2 , #ysize , "sequence")
CanvasGadget2(62 , #dx2+10+#xx/2+2 , y , #xx/2-2 , #ysize , "Scramble") : y+#ysize2
CanvasGadget2(66 , #dx2+10 , y , #xx/2-2 , #ysize , "paste") : y+#ysize2
CanvasGadget2(63 , #dx2+10+#xx/2+2 , y , #xx/2-2 , #ysize , "verify") : y+#ysize2
CanvasGadget2(64 , #dx2+10 , y , #xx/2-2 , #ysize , "Load")
CanvasGadget2(65 , #dx2+10+#xx/2+2 , y , #xx/2-2 , #ysize , "Save") : y+#ysize2
CheckBoxGadget(100 , #dx2+10 , y-50 , #xx/3 , #ysize , "sprite") :SetGadgetState(100,0)
ListViewGadget(70 , #dx2+#x+3 , 3 , #expand-6 , #dy2-57)
y = 650
CanvasGadget2(71 , #dx2+#x+3 , y , 60 , #ysize , "clear")
CanvasGadget2(72 , #dx2+#x+3+70 , y , 90 , #ysize , "sequences")
CanvasGadget2(73 , #dx2+#x+3+170 , y , 90 , #ysize , "help") : y+#ysize2
OptionGadget(75 , #dx2+#x+3 , y , 60 , #ysize , "no")
OptionGadget(76 , #dx2+#x+3+70 , y , 60 , #ysize , "auto")
OptionGadget(77 , #dx2+#x+3+140 , y , 60 , #ysize , "yes")
;- -------Load Settings-------
If ReadFile(0, "cube_settings.cub") And 1
SetGadgetState(4 , ReadByte(0)): cube_speed() ; twistspeed
mode2(ReadByte(0))
SetGadgetState(22 , ReadByte(0)) : Hi_Speed() ; hi speed
SetGadgetState(32 , ReadByte(0)) : deelay() ;pause after sequence (11-18)
SetGadgetState(33 , ReadByte(0)) ;space repeat
SetGadgetState(ReadByte(0),1) ;return to manual (7,8)
SetGadgetState(ReadByte(0),1) ; no , auto , yes (75,76,77)
SetGadgetText(60,ReadString(0)) ; sequence
CloseFile(0)
Else
SetGadgetState(4 , 60) :cube_speed()
mode2(12)
SetGadgetState(22, 0) :Hi_Speed()
SetGadgetState(32, 3) :deelay() ; pause after seq
SetGadgetState(33, 1) ; Rctrl repeat
SetGadgetState(42, 0) ; return to manual
SetGadgetState(76, 1) ; auto
SetGadgetText(60, #sequ$)
EndIf
;- -------KeyboardShortcut-------
; AddKeyboardShortcut(0 , #PB_Shortcut_Up , 1)
; AddKeyboardShortcut(0 , #PB_Shortcut_Down , 1)
; AddKeyboardShortcut(0 , #PB_Shortcut_Return , 1)
; AddKeyboardShortcut(0 , #PB_Shortcut_Q , 1)
; AddKeyboardShortcut(0 , #PB_Shortcut_Space , 1)
AddKeyboardShortcut(0 , #PB_Shortcut_Add , 1)
AddKeyboardShortcut(0 , #PB_Shortcut_Subtract , 1)
;- -------------start--------
Add3DArchive("texture.zip" , #PB_3DArchive_Zip)
CreateLight(0 , RGB(255 , 255 , 255) , -100 , 200 , 100)
WorldShadows(#PB_Shadow_Additive)
#buf1=2048
#buf2=#buf1-1
Global.i Dim key(11) ,Dim key2(7), Dim nn(11) , Dim a1(6) , Dim ay(2) , Dim az(2) , Dim ax(2) , Dim n1(#buf1)
key2(3)=19 : key2(4)=24 :key2(5)=48 :key2(6)=34 :key2(1)=21 :key2(2)=17 : key2(7)=20
key(4) = 32 : key(5) = 22 : key(0) = 33 : key(2) = 48 : key(3) = 38 : key(1) = 19 : key(6) = 45 : key(7) = 21 : key(8) = 44 : key(9) = 50 : key(10) = 18 : key(11) = 31
nn(4) = 72 : nn(5) = 100 : nn(0) = 8 : nn(2) = 10 : nn(3) = 11 : nn(1) = 9 : nn(6) = 61 : nn(7) = 124 : nn(8) = 56 : nn(9) = 21 : nn(10) = 84 : nn(11) = 16
kub()
Global.s dataa
dataa = "F.008 B.010 U.100 D.072 L.011 R.009 f.024 b.026 u.116 d.088 "
dataa + "l.027 r.025 X.057 Y.124 Z.056 z.056 x.057 y.124 "
dataa + "M.019 E.080 S.016 m.043 e.104 s.040 2.002 '.001 i.001 =.999 "
; 1 2 4 8 16 32 64
; 0-3 4 56 (40) 64
; 2 bitar 1 bit 3 bitar 1 bit
; f.r.b.l. invert abc upp/down
Global.i Dim sequence1(200)
For a = 1 To Len(dataa) Step 6
sequence1(Asc(Mid(dataa , a , 1))) = Val(Mid(dataa , a+2 , 3))
Next a
Global.s Dim seq2(2 , 2 , 2)
Global.s Dim seq3(2 , 2 , 2)
Global.s Dim seq4(2 , 2 , 2)
Global.s Dim seq5(15)
Global.s Dim seq6(3)
Global.s Dim seq7(15)
Global.s Dim steg$(15)
steg$(0)="- edge pieces - row 1"
steg$(4)="- corner pieces - row 1"
steg$(8)="- edge pieces - row 2"
steg$(12)="- edge pieces - row 3 - direction"
steg$(13)="- edge pieces - row 3 - position"
steg$(14)="- corner pieces - row 3 - position"
steg$(15)="- corner pieces - row 3 - direction"
seq2(2 , 0 , 1) = "F' U L' U'"; uf - seq2(1 , -1 , 0) = "F' U L' U'"
seq2(2 , 1 , 0) = "R' F'" ; ur - (1 , 0 , -1) = "R' F'"
seq2(2 , 2 , 1) = "B E F E'" ; ub - seq2(1 , 1 , 0) = "BB DD FF"
seq2(2 , 1 , 2) = "L F" ; ul - seq2(1 , 0 , 1) = "L F"
seq2(1 , 0 , 0) = "F'" ; mfr - (0 , -1 , -1) = "'F"
seq2(1 , 2 , 0) = "E' F' E" ; mbr - (0 , 1 , -1) = "RR 'F"
seq2(1 , 2 , 2) = "E F E'" ; mbl - (0 , 1 , 1) = "LL F"
seq2(1 , 0 , 2) = "F" ; mfl - (0 , -1 , 1 ) = "F"
seq2(0 , 0 , 1) = "FF" ; df - seq2(-1 , -1 , 0) = "FF"
seq2(0 , 1 , 0) = "D' FF" ; dr - seq2(-1 , 0 , -1) = "D' F'"
seq2(0 , 2 , 1) = "DD FF" ; db - seq2(-1 , 1 , 0) = "DD FF"
seq2(0 , 1 , 2) = "D FF" ; dl - seq2(-1 , 0 , 1) = "D F"
seq3(2 , 0 , 0) = "b R' b'" ; ufr - seq2(1 , -1 , 0) = "F' U L' U'"
seq3(2 , 2 , 0) = "S' R'R' S" ; ubr - (1 , 0 , -1) = "R' F'"
seq3(2 , 2 , 2) = "r' B'B' r" ; ubl - seq2(1 , 1 , 0) = "BB DD FF"
seq3(2 , 0 , 2) = "M' FF M" ; ufl - seq2(1 , 0 , 1) = "L F"
seq3(0 , 0 , 0) = "" ; dfr
seq3(0 , 2 , 0) = "D'" ; dbr
seq3(0 , 2 , 2) = "D'D'" ; dbl
seq3(0 , 0 , 2) = "D" ; dfl
seq4(2 , 0 , 1) = "" ; uf
seq4(2 , 1 , 0) = "U" ; ur
seq4(2 , 2 , 1) = "UU" ; ub
seq4(2 , 1 , 2) = "U'" ; ul
seq4(1 , 0 , 0) = "U R U' R' U' F' U F" ; mfr
seq4(1 , 2 , 0) = "U B U' B' U' R' U R" ; mbr
seq4(1 , 2 , 2) = "U L U' L' U' B' U B" ; mbl
seq4(1 , 0 , 2) = "U F U' F' U' L' U L" ; mfl
seq5(3) = "UU" ; 12
seq5(6) = "U'" ; 24
seq5(5) = "U" ; 14
seq5(9) = "U" ; 18
seq6(0) = ""
seq6(1) = "U"
seq6(2) = "UU"
seq6(3) = "U'"
seq7(3) = "Y"
seq7(6) = ""
seq7(12) = "Y'"
seq7(9) = "YY"
seq7(1) = ""
seq7(2) = "Y"
seq7(4) = "YY"
seq7(8) = "Y'"
seq7(5) = ""
seq7(10) = ""
seq7(15) = ""
#st = 15
Global.i Dim ty(#st) , Dim y(#st) , Dim z(#st) , Dim x(#st) , Dim ze(3) , Dim xe(3) , Dim ok1(#st) , Dim xc(3) , Dim zc(3)
For a = 0 To #st
y(a) = 1 : z(a) = -1 : x(a) = -Bool(a>3)
If a&8 : y(a) = 0 : EndIf
If a<12 : ty(a) = Bool((a&3)>0) : EndIf
Next a
ze(0) = -1; : xp(0) = 0
xe(1) = -1; : zp(1) = 0
ze(2) = 1 ; : xp(2) = 0
xe(3) = 1 ; : zp(3) = 0
zc(0) = -1 : xc(0) = -1
xc(1) = -1 : zc(1) = 1
zc(2) = 1 : xc(2) = 1
xc(3) = 1 : zc(3) = -1 : a = 0
For b = 0 To 3
a+1 : ok1(1<<b + 1<<((b+1)&3)) = a
Next b
Global.s Dim mess(6)
mess(1)="-check center 135"
mess(2)="-check center 2"
mess(3)="-check center 4"
mess(4)="-check center 6"
mess(5)="-check invalid"
mess(6)="-check doublet"
;- -------------start--------
Procedure set_cube_rotate()
Protected.i a , c
For a = 1 To 26 : DetachNodeObject(1 , EntityID(ccc(a))) : Next a
If n1&64
rrr = 1
For i = 1 To 26
c = EntityY(ccc(i))
If (n1&8 And c = -1) Or (n1&16 And c = 0) Or (n1&32 And c = 1)
AttachNodeObject(1 , EntityID(ccc(i)))
EndIf
Next i
Else
If n1&2 : rr = -rr : EndIf
rrr = n1&1+2
For i = 1 To 26
If n1&1 : c = EntityX(ccc(i)) : Else : c = EntityZ(ccc(i)) : EndIf
If n1&2 : c = -c : EndIf
If (n1&8 And c = -1) Or (n1&16 And c = 0) Or (n1&32 And c = 1)
AttachNodeObject(1 , EntityID(ccc(i)))
EndIf
Next i
EndIf
turning = 1
EndProcedure
Procedure Scramble()
Protected.i b
For a=1 To 5
b=Val(Mid(sequ$ , seq2-a, a))
If b=0 Or Val(Mid(sequ$ , seq2-a-1, a+1))<b: Break: EndIf
Next a
If b : RandomSeed(b): Debug b :EndIf
n1 = Random(3 , 0) |Random(1 , 0)<<2 | Random(7 , 1)<<3 | Random(1 , 0)<<6
ProcedureReturn n1
EndProcedure
Procedure get_sequence(n30.i)
gg:
seq2+1
If seq2 <= Len(sequ$)
If sequence1(Asc(Mid(sequ$ , seq2 , 1))) <> 2 ;test if do again
seq3 = sequence1(Asc(Mid(sequ$ , seq2 , 1)))
If seq3 = 999 : seq3 = Scramble() : EndIf
If seq3 = 0 : Goto gg : EndIf ;test if nothing
If sequence1(Asc(Mid(sequ$ , seq2+1 , 1))) = 1 : seq3!4 : seq2+1 : EndIf ; test if invert
EndIf
EndIf
If seq2 => Len(sequ$) : seq2 = 0 : sequ$ = "" : EndIf ; test if last turn
ProcedureReturn 3&(n30+seq3)+seq3&124
EndProcedure
Procedure get_Piece(pick) ; search pos
Protected.i x , y , z , x1 , y1 , z1
If pick<>picko : picko = pick
Debug "pick"
y = EntityY(pick) : z = EntityZ(pick) : x = EntityX(pick)
MoveEntity(1001 , x * 1.48 , y * 1.48 , z * 1.48 , #PB_Absolute)
EntityLookAt(1001 , 0 , 0 , 0)
For i = 0 To 5 : a = 8<<i
If y And y = EntityY(a) : y1 = a : EndIf
If z And z = EntityZ(a) : z1 = a : EndIf
If x And x = EntityX(a) : x1 = a : EndIf
Next i
If IsEntity(pos2) : DetachEntityObject(pos2 , EntityID_1000) : Else : PlaySound(1, 0 , vol) : EndIf
pos2 = y1+x1+z1
If IsEntity(pos2) : AttachEntityObject(pos2 , "" , EntityID_1000) : Else : PlaySound(1, 0 , vol) : EndIf
MoveEntity(1000 , 0 , 0 , 0 , #PB_Absolute) : EntityLookAt(1000 , 0 , 0 , 0)
EndIf
EndProcedure
Global.i Dim cam(101)
cam(5)=1
cam(33)=1
cam(61)=1
cam(71)=1
cam(21)=2
cam(50)=2
cam(51)=2
Procedure rotate_camera()
Protected.f myy , mz
If cam( GetActiveGadget()+1 )=0;<>32 Or GetActiveGadget()<>4 Or GetActiveGadget()<>60
If KeyboardPushed(#PB_Key_Left) : mxx -0.7
ElseIf KeyboardPushed(#PB_Key_Right) : mxx +0.7
EndIf
If KeyboardPushed(#PB_Key_Up) : myy = 0.1
ElseIf KeyboardPushed(#PB_Key_Down) : myy = -0.1
Else : myy = 0
EndIf
If KeyboardPushed(#PB_Key_PageUp) : mz = 0.1
ElseIf KeyboardPushed(#PB_Key_PageDown) : mz = -0.1
Else : mz = 0
EndIf
EndIf
If KeyboardPushed(#PB_Key_LeftControl)
mxx+(mx-#dx3)/300 * mbf1; * mus
myy = -(my-#dy3)/5000 * mbf1; * mus
EndIf
RotateNode(0 , 0 , mxx , 0 ) ; rotate camera
; n30 = mxx/90 : n30&3 ; n30 = NodeYaw(0)/90 : n30&3
If CameraY(0)<-4 And myy<0 : myy = 0 : EndIf
If CameraY(0)>4 And myy>0 : myy = 0 : EndIf
If CameraZ(0 , #PB_Relative)>-0.3 And mz>0 : mz = 0 : EndIf
If CameraZ(0 , #PB_Relative)<-15 And mz<0 : mz = 0 : EndIf
MoveCamera (0 , 0 , myy , mz , #PB_World )
CameraLookAt(0 , 0 , 0 , 0)
EndProcedure
Procedure getmouse()
mb = Sign(GetAsyncKeyState_(#VK_LBUTTON)-GetAsyncKeyState_(#VK_RBUTTON))
event = WindowEvent()
If event = #PB_Event_CloseWindow : ret = 3 : EndIf
mx = WindowMouseX(0)
my = WindowMouseY(0)
mbf1=Bool(mx > -1 And mx < #dx2)
pick3 = MousePick(0 , mx , my)
If mb
If mbf1 : SetActiveGadget(100):EndIf
pick2=pick3
If event = #PB_Event_Gadget : gad2 = EventGadget(): EndIf
If mb_c = 0
If gad2>0 : gad=gad2 : mb_c=1 : EndIf
If pick2>0 : pick1=pick2 : mb_c=1 : EndIf
Else
gad=0 : pick1=0
EndIf
Else
mb_c=0 : gad=0 : pick1=0 : gad2=0 ;: pick2=0
EndIf
EndProcedure
Procedure twist_cube()
rotate + cubespeed2
If rotate + cubespeed2 >90 : rotate = 90 : EndIf
If rrr = 1 : RotateNode(1 , 0 , rotate * rr , 0 ) : EndIf
If rrr = 2 : RotateNode(1 , 0 , 0 , rotate * rr ) : EndIf
If rrr = 3 : RotateNode(1 , rotate * rr , 0 , 0 ) : EndIf
If rotate = 90 : rotate = 0 : rr = 0 :turning = 0 : EndIf
EndProcedure
Procedure cube_speed2();cubespeed1
Static.i s2
If KeyboardPushed(#PB_Key_Add) : s2+1
If s2 = 1 Or s2>15 : SetGadgetState(4 , GetGadgetState(4)+1) : cube_speed() : EndIf
ElseIf KeyboardPushed(#PB_Key_Subtract) : s2+1
If s2 = 1 Or s2>14 : SetGadgetState(4 , GetGadgetState(4)-1) : cube_speed() : EndIf
Else : s2 = 0
EndIf
EndProcedure
Procedure stand_seq()
AddGadgetItem (70 , -1 , "-- 1. Getting the 'white cross'")
AddGadgetItem (70 , -1 , "F' U L' U'")
AddGadgetItem (70 , -1 , "-- 2. Placing the corners of the cross")
AddGadgetItem (70 , -1 , "R' D' R D")
AddGadgetItem (70 , -1 , "-- 3a. Right edge piece placement")
AddGadgetItem (70 , -1 , "U R U' R' U' F' U F")
AddGadgetItem (70 , -1 , "-- 3b. Left edge piece placement")
AddGadgetItem (70 , -1 , "U' L' U L U F U' F'")
AddGadgetItem (70 , -1 , "-- 4. The white cross")
AddGadgetItem (70 , -1 , "F R U R' U' F'")
AddGadgetItem (70 , -1 , "-- 5. Aligning the third layer center pieces")
AddGadgetItem (70 , -1 , "R U R' U R U U R'")
AddGadgetItem (70 , -1 , "-- 6. Aligning the third layer corner pieces")
AddGadgetItem (70 , -1 , "U R U' L' U R' U' L")
AddGadgetItem (70 , -1 , "-- 7. Finishing the cube")
AddGadgetItem (70 , -1 , "R' D' R D")
AddGadgetItem (70 , -1 , "-- scramble")
AddGadgetItem (70 , -1 , "F B U D L R f b u d l r M E S")
AddGadgetItem (70 , -1 , " -- scramble")
AddGadgetItem (70 , -1 , "====================")
AddGadgetItem (70 , -1 , "------------exampel------------"); https://www.youtube.com/watch?v=AOMQxLrCI7A
AddGadgetItem (70 , -1 , "B2 R2 F' L2 B L2 B2 L B2 D2 F2 U B U' F' U' B2 F'"); set up (scramble)
AddGadgetItem (70 , -1 , "D' r U x' D L D'") ; // cross
AddGadgetItem (70 , -1 , "R U R' U2 L U' L'") ; // F2L-1 (blue-orange pair)
AddGadgetItem (70 , -1 , "U' R U' R' U D R U' R' D'") ; // F2L-2 (green-orange pair)
AddGadgetItem (70 , -1 , "R' U2 R2 U R'") ; // F2L-3 (green-red pair)
AddGadgetItem (70 , -1 , "U2' R' U R U' y R U R'") ; // F2L-4 (blue-red pair)
AddGadgetItem (70 , -1 , "l' L2 U L' U L U2 L' U M") ; // OLL
AddGadgetItem (70 , -1 , "U' M2 U' M' U2' M U' M2 U") ; // PLL
EndProcedure
Procedure help()
AddGadgetItem (70 , -1 , "- ' Left-Ctrl ' = mouse-move")
; AddGadgetItem (70 , -1 , "- ' Q ' = set/release Sequence window")
AddGadgetItem (70 , -1 , "")
AddGadgetItem (70 , -1 , "- ' R ' = Red")
AddGadgetItem (70 , -1 , "- ' W ' = White")
AddGadgetItem (70 , -1 , "- ' B ' = Blue")
AddGadgetItem (70 , -1 , "- ' O ' = Orange")
AddGadgetItem (70 , -1 , "- ' Y ' = Yellow")
AddGadgetItem (70 , -1 , "- ' G ' = Green")
AddGadgetItem (70 , -1 , "- ' T ' = Test")
AddGadgetItem (70 , -1 , "")
AddGadgetItem (70 , -1 , "- ' Shift ' = reverse twist")
AddGadgetItem (70 , -1 , "- 'X ' = X")
AddGadgetItem (70 , -1 , "- 'L ' = Left")
AddGadgetItem (70 , -1 , "- 'M ' = mid X")
AddGadgetItem (70 , -1 , "- 'R ' = Right")
AddGadgetItem (70 , -1 , "")
AddGadgetItem (70 , -1 , "- 'Y ' = Y")
AddGadgetItem (70 , -1 , "- 'U ' = Upper")
AddGadgetItem (70 , -1 , "- 'E ' = mid Y")
AddGadgetItem (70 , -1 , "- 'D ' = Down")
AddGadgetItem (70 , -1 , "")
AddGadgetItem (70 , -1 , "- 'Z ' = Z")
AddGadgetItem (70 , -1 , "- 'F ' = Front")
AddGadgetItem (70 , -1 , "- 'S ' = mid Z")
AddGadgetItem (70 , -1 , "- 'B ' = Back")
EndProcedure
Procedure keys2()
If gad = 71 : ClearGadgetItems(70) : EndIf
If gad = 72 : stand_seq() : EndIf
If gad = 73 : help() : EndIf
EndProcedure
Procedure keys()
Static.i do2
getmouse()
If (mb=-1 And cam(gad2)=2) Or hispeed : cubespeed2 = 90 : Else : cubespeed2 = cubespeed2_bak : EndIf
ExamineKeyboard()
keys2()
; If gad = 52 : buff = 0 : buffmax = 0 : buffmin = 0 : endif
If gad = 1 Or KeyboardReleased(#PB_Key_Escape) Or GetGadgetState(14)=0 : ret = 2: ProcedureReturn : EndIf
If (KeyboardPushed(#PB_Key_All) = 0 And gad2=0) Or GetGadgetState(33) : do2 = 1 : EndIf
; If deelay<5 : ret2=2: Else : ret2=0: EndIf
; ret2=2
ret2 = Bool(buffmax = buff)*2; :ret2=2: Else : ret2=0 : EndIf
If turning=0 And do2 And (hispeed=0 Or flip2)
;reset buff
If gad2 = 50 And buff > buffmin : buff-1 : n1 = n1(buff&#buf2) : rr = (n1&4)>>1-1 : do2 = 0 : ret2=5 :hispeed=0:SetGadgetState(22,0) ;undo
ElseIf gad2 = 51 And buff < buffmax : n1 = n1(buff&#buf2) : rr = 1-(n1&4)>>1 : buff+1 : do2 = 0 : ret2=5;redo
ElseIf buffmax = buff
If KeyboardPushed(#PB_Key_RightControl) Or gad2 = 21 : ret2=3 : do2 = 0 :EndIf ; manual
EndIf
EndIf
SetGadgetText(53 , " nr: "+Str(buff-buffmin)+" max: "+Str(buffmax-buffmin))
cube_speed2()
rotate_camera()
RenderWorld()
FlipBuffers()
EndProcedure
Procedure do_solv(hhh , st)
If GetGadgetState(75) = 0 : AddGadgetItem (70 , -1 , sequ$ ) : SetGadgetState(70 , CountGadgetItems(70)-1) : EndIf
If hispeed=0 Or flip2
For a=1 To delay2 +2
keys()
If ret2&1:Break: EndIf
If ret>1 :sequ$ = "":ProcedureReturn : EndIf
If delay2=5*#d20: a=delay2-1: EndIf; 20*5
Next a
If GetGadgetState(100) : DisplayTransparentSprite(0 , #dx3-20 , #dy3-20 , 70): EndIf
If beep : PlaySound(3 , 0 , vol>>1):EndIf
EndIf
Repeat
If turning = 0
If ret2&2 And sequ$
n1 = get_sequence(0) : rr = 1-(n1&4)>>1
n1(buff&#buf2) = n1 : buff+1 : buffmax = buff : buff_siz = buffmax - buffmin
If buff_siz > #buf1 : buffmin = buffmax-#buf1 : EndIf
set_cube_rotate() : i1+1
ElseIf ret2&4
set_cube_rotate() :PlaySound(1 , 0 , vol>>1)
EndIf
EndIf ; vridning vald
If rr : twist_cube() : EndIf
If hispeed
RenderWorld()
Else
ret2=0 : keys() : If ret>1 : ProcedureReturn : EndIf
EndIf
Until rr = 0 And sequ$ = "" And ret2<4
EndProcedure
Procedure solv()
ret = 0 :ret2=2 : rr=0
buffmax = buff : SetGadgetText(53 , " nr: "+Str(buff-buffmin)+" max: "+Str(buffmax-buffmin))
Protected.i x , y , z , st , x1 , y1 , z1 , x2 , y2 , z2 , y64 , z64 ,x64, ok , i , j , ok2 , oks , ok2s , js , looptime , rand
PlaySound(2 , 0 , vol)
Hi_Speed()
Repeat
i1 = 0
If GetGadgetState(76) : ClearGadgetItems(70) : EndIf
If GetGadgetState(75) = 0 : AddGadgetItem (70 , -1 , "----------- Solv the cube -------------") : EndIf
looptime = ElapsedMilliseconds()
For a = 0 To 5 : y = EntityY(8<<a) : If y = -1 : ay(0) = 1<<a : ay(2) = 1<<(a!1) : EndIf : Next a
For a = 0 To 5 : z = EntityZ(8<<a) : If z = -1 : az(0) = 1<<a : az(2) = 1<<(a!1) : EndIf : Next a
For a = 0 To 5 : x = EntityX(8<<a) : If x = -1 : ax(0) = 1<<a : ax(2) = 1<<(a!1) : EndIf : Next a
For St = 0 To 15
If GetGadgetState(75) = 0 : If ty(st) = 0 : AddGadgetItem (70 , -1 , steg$(st) +" ----") : EndIf : EndIf
If st = 8
sequ$ = "ZZ" : do_solv(1 , st) : If ret : Break 2 : EndIf
For a = 0 To 5 : y = EntityY(8<<a) : If y = -1 : ay(0) = 1<<a : ay(2) = 1<<(a!1) : EndIf : Next a
For a = 0 To 5 : x = EntityX(8<<a) : If x = -1 : ax(0) = 1<<a : ax(2) = 1<<(a!1) : EndIf : Next a
EndIf
If ty(st)
sequ$ = "Y" : do_solv(2 , st) : If ret : Break 2 : EndIf
For a = 0 To 5 : z = EntityZ(8<<a) : If z = -1 : az(0) = 1<<a : az(2) = 1<<(a!1) : EndIf : Next a
For a = 0 To 5 : x = EntityX(8<<a) : If x = -1 : ax(0) = 1<<a : ax(2) = 1<<(a!1) : EndIf : Next a
EndIf
a=20
If st>11 : Goto g5 : EndIf
y = y(st) : z = z(st) : x = x(st)
y1 = ay(y+1) : z1 = az(z+1) : x1 = ax(x+1)
DetachEntityObject(pos2 , EntityID_1000)
pos1 = y1 + z1 + x1
pos2 = pos1 << 3
AttachEntityObject(pos2 , "" , EntityID_1000)
MoveEntity(1000 , 0 , 0 , 0 , #PB_Absolute) : EntityLookAt(1000 , 0 , 0 , 0)
MoveEntity(1001 , x * 1.48 , y * 1.48 , z * 1.48 , #PB_Absolute)
g4:
y2 = EntityY(pos2) : z2 = EntityZ(pos2) : x2 = EntityX(pos2)
If y2 = y And z2 = z And x2 = x
y64 = Abs(EntityY(pos2+7) * 10)-1
If y1 = 1<<y64 : Continue : EndIf
z64 = Abs(EntityZ(pos2+7) * 10)-1
If z1 = 1<<z64 : Continue : EndIf
x64 = Abs(EntityX(pos2+7) * 10)-1
If x1 = 1<<x64 : Continue: EndIf
EndIf
g5:
Select st
Case 0 To 3
sequ$ = seq2(y2+1 , z2+1 , x2+1)
Case 4 To 7
If y2+z2+x2 = -3
y64 = Abs(EntityY(pos2+7) * 10)-1
If x1 = 1<<y64 : sequ$ = "l' F' l"
ElseIf z1 = 1<<y64 : sequ$ = "b R b'"
Else : sequ$ = "b D R'R' D' b'"
EndIf
Else
sequ$ = seq3(y2+1 , z2+1 , x2+1)
EndIf
Case 8 To 11
sequ$ = seq4(y2+1 , z2+1 , x2+1)
If sequ$ = ""
z64 = Abs(EntityZ(pos2+7) * 10)-1
If z1 = 1<<z64 : sequ$ = "U R U' R' U' F' U F"
Else : sequ$ = "U' U' F' U F U R U' R'"
EndIf
EndIf
Case 12
DetachEntityObject(pos2 , EntityID_1000)
MoveEntity(1000 , 0 , 0 , 0 , #PB_Absolute)
MoveEntity(1001 , 0 , 0 , 0 , #PB_Absolute)
Repeat
ok = 0
For i = 0 To 3
y64 = Abs(EntityY(RayPick(xe(i) , 1 , ze(i) , 0 , 0 , 0)+7) * 10)-1
If ay(2) = 1<<y64 : ok + 1<<i : EndIf
Next i
sequ$ = seq5(ok)
If sequ$ : do_solv(3 , 12) : If ret : Break 3 : EndIf : EndIf
If ok<15 : sequ$ = "F R U R' U' F'" : do_solv(4 , 12) : If ret : Break 3 : EndIf : EndIf
Until ok = 15
Continue
Case 13
Dim r0(3) : Dim r1(3) : Protected.i ray , turn
For i = 0 To 3 : r0(i) = RayPick(xe(i) , 0 , ze(i) , 0 , 0 , 0) : Next i
Repeat
For i = 0 To 3 : r1(i) = RayPick(xe(i) , 1 , ze(i) , 0 , 0 , 0) : Next i
For j = 0 To 3
ok = 0 : ok2 = 0
For i = 0 To 3 : If r0(i) & r1((i+j)&3) : ok+1<<i : ok2+1 : EndIf : Next i
If ok2 = 4 : ok2s = ok2 : js = j : oks = ok : Break : EndIf
If ok2>1 : ok2s = ok2 : js = j+2 : oks = ok : EndIf
Next j
turn = ok1(oks)+js
sequ$ = seq6(turn&3) : do_solv(5 , 13) : If ret : Break 3 : EndIf
If ok2s<4 : sequ$ = "R U R' U R U U R'" : do_solv(6 , 13) : If ret : Break 3 : EndIf : EndIf
Until ok2s = 4
Continue
Case 14
ray = 63-RayPick(0 , 1 , 0 , 0 , 0 , 0)>>3
Repeat
ok = 0 : ok2 = 0
For i = 0 To 3
If RayPick(xc(i) , 0 , zc(i) , 0 , 0 , 0) = RayPick(xc(i) , 1 , zc(i) , 0 , 0 , 0)&(ray<<3)
ok+1<<i : ok2+1
EndIf
Next i
If ok2 = 4 : Break : EndIf
sequ$ = seq7(ok)
do_solv(7 , 14) : If ret : Break 3 : EndIf
sequ$ = "U R U' L' U R' U' L" : do_solv(8 , 14) : If ret : Break 3 : EndIf
ForEver
Continue
Case 15
For i = 0 To 3
Repeat
y64 = Abs(EntityY(RayPick(-1 , 1 , -1 , 0 , 0 , 0)+7) * 10)-1
If ay(2) = 1<<y64 : Break
Else
sequ$ = "R' D' R D R' D' R D" : do_solv(9 , 15) : If ret : Break 4 : EndIf
EndIf
ForEver
sequ$ = "U" : do_solv(10 , 15) : If ret : Break 3 : EndIf
Next i
Continue
EndSelect
do_solv(11 , st) : If ret : Break 2 : EndIf
Goto g4
Next st
PlaySound(2 , 0 , vol)
If GetGadgetState(75) = 0 : AddGadgetItem (70 , -1 , "------------ Cube solved ------") : EndIf
AddGadgetItem (70 , -1 , "-turns : " + Str(i1) )
AddGadgetItem (70 , -1 , "-time : " + Str((ElapsedMilliseconds()-looptime) )+" ms")
AddGadgetItem (70 , -1 , "-time/turn : " + StrF(((ElapsedMilliseconds()-looptime)/i1)*1000,0 )+" µs")
SetGadgetState(70 , CountGadgetItems(70)-1)
If GetGadgetState(42) : Break:EndIf
AddGadgetItem (70 , -1 , "")
flip2=1
If GetGadgetState(75) = 0 : AddGadgetItem (70 , -1 , "------------ Randomize Cube ------") : EndIf
sequ$ = GetGadgetText(60) : If sequ$="" : sequ$=#sequ$: EndIf: do_solv(13 , 17) : If ret : Break : EndIf; random
PlaySound(2 , 0 , vol)
sequ$="*":do_solv(13 , 18) : If ret : Break : EndIf
flip2=0
PlaySound(2 , 0 , vol)
ForEver
flip2=0
If ret=3: ProcedureReturn: EndIf
PlaySound(1 , 0 , vol)
If gad = 1 : mb_c=1 : kub() : EndIf
If GetGadgetState(14)=1 : Mode2(12) : EndIf
EndProcedure
Global.f Dim newx(26,7), Dim newy(26,7), Dim newz(26,7), Dim newc(26,7)
Global.f Dim newxo(26,7), Dim newyo(26,7), Dim newzo(26,7), Dim newwo(26,7)
Procedure copy()
Protected.i a1,a2,c,r
Protected.f yf , zf , xf
For a=1 To 26
a2= ccci(a)
a1= ccc(a)
For c=0 To 7
If c=0 :r=#PB_Absolute: Else :r=#PB_Relative :EndIf
newx(a2,c)= EntityX(a1+c,r)
newy(a2,c)= EntityY(a1+c,r)
newz(a2,c)= EntityZ(a1+c,r)
FetchOrientation(EntityID(a1+c),r)
newc(a2,c)= col(a1+c)
newxo(a2,c)= GetX()
newyo(a2,c)= GetY()
newzo(a2,c)= GetZ()
newwo(a2,c)= GetW()
Next c
Next a
For a=1 To 26
a1 = ccc(a)
CreateEntity(a1 , MeshID(#cube) , #PB_Material_None)
CreateEntity(a1+7 , MeshID(#cube) , #PB_Material_None )
SetOrientation(EntityID(a1), newxo(a,0),newyo(a,0),newzo(a,0),newwo(a,0))
For c=1 To 6
CreateEntity(a1+c,MeshID(#plane) , MaterialID(newc(a,c)) ,newx(a,c),newy(a,c),newz(a,c))
SetOrientation(EntityID(a1+c), newxo(a,c),newyo(a,c),newzo(a,c),newwo(a,c))
AddSubEntity(a1 ,a1+c , #PB_Entity_StaticBody )
col(a1+c)=newc(a,c)
Next c
xf=0: yf=0 : zf=0
For c=1 To 3
If col(a1+c)
If Abs(EntityY(a1+c))>0.4 : yf=col(a1+c)*0.1 : EndIf
If Abs(EntityX(a1+c))>0.4 : xf=col(a1+c)*0.1 : EndIf
If Abs(EntityZ(a1+c))>0.4 : zf=col(a1+c)*0.1 : EndIf
EndIf
Next c
AddSubEntity(a1 ,a1+7 , #PB_Entity_StaticBody )
MoveEntity(a1,newx(a,0),newy(a,0),newz(a,0))
MoveEntity(a1+7,-newx(a,0),-newy(a,0),-newz(a,0),#PB_Absolute|#PB_World)
MoveEntity(a1+7,xf,yf,zf,#PB_Absolute|#PB_World)
HideEntity(a1 , 1)
Next a
EndProcedure
Procedure changecolor(p,c)
If po=p And co=c Or c: ProcedureReturn:EndIf
po=p:co=c
If p&7=7:p&504+1: EndIf
If c<7
If c
col(p)=c
Else
col(p)-mb
If col(p)>6 :col(p)=1 : EndIf
If col(p)<1 :col(p)=6 : EndIf
EndIf
SetEntityMaterial(p, MaterialID(col(p)))
SetEntityMaterial(p&504+7, MaterialID(col(p)))
EndIf
If ccc(check(col(p&504+1),col(p&504+2),col(p&504+3)))
AddGadgetItem (70 , -1 , "- "+Str(check(col(p&504+1),col(p&504+2),col(p&504+3))))
Else :AddGadgetItem (70 , -1 , "- invalid")
EndIf
EndProcedure
Procedure err(pick,a)
Debug mess(a)
AddGadgetItem (70 , -1 , mess(a))
If a = 1 ; center 135
For b=1 To 3 : mark+1
CreateEntity(mark , MeshID(1) , #PB_Material_None , 0 , 0 , 0 , 0) : ScaleEntity(mark , 1.6 , 1.6 , 1.6)
AttachEntityObject(2<<(b *2)+ b , "" , EntityID(mark))
Next b
Else ; center 246 , invalid , doublet
For b=1 To 3 : mark+1
CreateEntity(mark , MeshID(1) , #PB_Material_None , 0 , 0 , 0 , 0) : ScaleEntity(mark , 1.6 , 1.6 , 1.6)
AttachEntityObject(pick+ b , "" , EntityID(mark))
Next b
EndIf
err1+1
EndProcedure
Procedure verify1()
Protected.i pick,c1,c2,c3,nr
err1=0
For a = 1002 To mark : FreeEntity(a) : Next a
mark=1001
c1=col(8+1) : c2=col(128+1) : c3=col(32+1)
If check(c1,c2,c3)=0 : err(0,1) : EndIf ;check center 135
If (c1-1)!(col(17)-1) <> 1 : err(16,4): EndIf ;check center 2
If (c2-1)!(col(257)-1)<> 1 : err(256,3):EndIf ;check center 4
If (c3-1)!(col(65)-1) <> 1 : err(64,2): EndIf ;check center 6
For nr=1 To 26:check2(nr)=0: Next nr
For nr=1 To 26
pick=ccc(nr)
c1 = check(col( pick +1),col( pick+2),col( pick +3))
If nr<>c1 : Debug Str(nr)+" "+Str(c1)+" "+Str(ccc(nr))+" "+Str(ccc(c1)): EndIf
ccci(nr)=c1
If c1=0 ;check invalid
err(pick,5)
Else
check2(c1)+1
If check2(c1)>1 ;check doublet
err1-1
For a=1 To 26
; c1 = check(col( pick + pick +1)),col( pick + pick +2)),col( pick + pick +3)))
c2 = check(col(ccc(a)+1),col(ccc(a)+2),col(ccc(a)+3))
If c2 = c1 : err(ccc(a),6) : EndIf
Next a
EndIf
EndIf
If err1: Break: EndIf
Next nr
Debug"=============="
Debug Str(err1)+" fel"
If err1=0: PlaySound(3, 0 , vol):copy() :Else:PlaySound(1, 0 , vol) : EndIf
EndProcedure
Procedure load()
Protected.i a1,c,r
Protected.f yf , zf , xf ,load1,load2,load3,load4,loadx,loady,loadz
If ReadFile(0, "cube_data.cub") :PlaySound(3 , 0 , vol)
For a=1 To 26
a1 = ccc(a)
CreateEntity(a1 , MeshID(#cube) , #PB_Material_None)
CreateEntity(a1+7 , MeshID(#cube) , #PB_Material_None )
loadx=ReadByte(0)/10
loady=ReadByte(0)/10
loadz=ReadByte(0)/10
load1=ReadByte(0)/10
load2=ReadByte(0)/10
load3=ReadByte(0)/10
load4=ReadByte(0)/10
SetOrientation(EntityID(a1),load1,load2,load3,load4)
For c=1 To 6
load1=ReadByte(0)/10
load2=ReadByte(0)/10
load3=ReadByte(0)/10
CreateEntity(a1+c,MeshID(#plane) , MaterialID(col(a1+c)) ,load1,load2,load3)
load1=ReadByte(0)/10
load2=ReadByte(0)/10
load3=ReadByte(0)/10
load4=ReadByte(0)/10
SetOrientation(EntityID(a1+c), load1,load2,load3,load4)
AddSubEntity(a1 ,a1+c , #PB_Entity_StaticBody )
Next c
xf=0: yf=0 : zf=0
For c=1 To 3
If col(a1+c)
If Abs(EntityY(a1+c))>0.4 : yf=col(a1+c)*0.1 : EndIf
If Abs(EntityX(a1+c))>0.4 : xf=col(a1+c)*0.1 : EndIf
If Abs(EntityZ(a1+c))>0.4 : zf=col(a1+c)*0.1 : EndIf
EndIf
Next c
For c=1 To 7 :ReadByte(0): Next c
AddSubEntity(a1 ,a1+7 , #PB_Entity_StaticBody )
MoveEntity(a1,loadx,loady,loadz)
MoveEntity(a1+7,-loadx,-loady,-loadz,#PB_Absolute|#PB_World)
MoveEntity(a1+7,xf,yf,zf,#PB_Absolute|#PB_World)
HideEntity(a1 , 1)
Next a
CloseFile(0)
buff = 0 : buffmax = 0 : buffmin = 0
Else
PlaySound(1 , 0 , vol)
EndIf
EndProcedure
Procedure Save()
Protected.i c,a1,r
If CreateFile(0, "cube_data.cub") :PlaySound(3 , 0 , vol)
For a=1 To 26
a1= ccc(a)
For c=0 To 7
If c=0 :r=#PB_Absolute: Else :r=#PB_Relative :EndIf
WriteByte(0,EntityX(a1+c,r)*10)
WriteByte(0,EntityY(a1+c,r)*10)
WriteByte(0,EntityZ(a1+c,r)*10)
FetchOrientation(EntityID(a1+c),r)
WriteByte(0,GetX()*10)
WriteByte(0,GetY()*10)
WriteByte(0,GetZ()*10)
WriteByte(0,GetW()*10)
Next c
Next a
CloseFile(0)
Else
PlaySound(1 , 0 , vol)
EndIf
EndProcedure
Procedure get_twist()
Protected.i shift , n30
n1=0
If sequ$
n1 = get_sequence(n30) :If seq3 : rr = 1-(n1&4)>>1 : set_cube_rotate():EndIf
If n1 : n1(buff&#buf2) = n1 : buff+1 : buffmax = buff : buff_siz = buffmax - buffmin
If buff_siz > #buf1 : buffmin = buffmax-#buf1 : EndIf
EndIf
SetGadgetText(53 , " nr: "+Str(buff-buffmin)+" max: "+Str(buffmax-buffmin))
ProcedureReturn
EndIf
n30 = mxx/90 : n30&3
If pick1>0
If GetGadgetState(13) : changecolor(pick1,0)
ElseIf cc2(pick1>>3) = 1 ;twist cube
For a = 0 To 5
If pick1>>3 = 1<<a1(a)
n1 = (3&(n30+nn(a)))+(nn(a)&124)!((mb+1)<<1) : Break
EndIf
Next a
Else ;If GetGadgetState(12)
get_Piece(pick1&(504))
EndIf
Else
If mb=-1
cubespeed2 = 90
If gad2=50 Or gad2=51 Or gad2=62: gad=gad2 : EndIf
Else : cubespeed2 = cubespeed2_bak
EndIf
EndIf
rr = 1
If gad2 = 62 : n1 = Scramble() :EndIf ; ----------Scramble
If n1 : n1(buff&#buf2) = n1 : buff+1 : buffmax = buff : buff_siz = buffmax - buffmin
If buff_siz > #buf1 : buffmin = buffmax-#buf1 : EndIf
EndIf
If gad = 52 : buff = 0 : buffmax = 0 : buffmin = 0 ;reset buff
ElseIf gad = 50 And buff > buffmin : buff-1 : n1 = n1(buff&#buf2) : rr = -1 ;undo
ElseIf gad = 51 And buff < buffmax : n1 = n1(buff&#buf2) : buff+1 ;redo
ElseIf GetGadgetState(14) : solv() : ProcedureReturn ; ----------solv
ElseIf gad = 63 : verify1() ; ----------verify1
ElseIf gad = 64 : load()
ElseIf gad = 65 : save()
ElseIf gad = 66 : SetGadgetText(60,GetClipboardText())
ElseIf (gad = 61 Or KeyboardReleased(#PB_Key_Return)) : sequ$ = GetGadgetText(60)
If sequ$="" : sequ$=#sequ$:EndIf
ElseIf gad = 70 And Left(GetGadgetText(70) , 1)<>"-" :sequ$ = GetGadgetText(70)
EndIf
; ----------keys (d u f b l r y x z M E S) (down up front back left right y x z)
If KeyboardPushed(#PB_Key_All) And GetActiveGadget()<>60
; Debug pick3
If GetGadgetState(13) And pick3>0
For a = 1 To 7 : If KeyboardPushed(key2(a)) : changecolor(pick3,a) : Break :EndIf: Next a
EndIf
If GetGadgetState(12) And GetActiveGadget()<>60
shift = KeyboardPushed(#PB_Key_LeftShift) | KeyboardPushed(#PB_Key_RightShift) / 32
For a = 0 To 11
If KeyboardPushed(key(a)) : n1 = (3&(n30+nn(a)))+(nn(a)&124)!shift : Break : EndIf
Next a
EndIf
Else :po =0
EndIf
SetGadgetText(53 , " nr: "+Str(buff-buffmin)+" max: "+Str(buffmax-buffmin))
If n1&4 : rr = -rr : EndIf
If n1 : set_cube_rotate() : EndIf
EndProcedure
Procedure cube_sides()
Protected.f avsto
avsto = 1000 ; up
For a = 0 To 5
If EntityY(8<<a)<avsto : avsto = EntityY(8<<a) : a1(4) = a : a1(5) = a!1 : EndIf
Next a
avsto = 1000 ; front
For a = 0 To 5
ConvertWorldToLocalPosition(CameraID(0) , EntityX(8<<a) , 0 , EntityZ(8<<a))
If GetZ()<avsto : avsto = GetZ() : a1(0) = a : a1(2) = a!1 : EndIf
Next a
avsto = 1000 ;left
For a = 0 To 5
ConvertWorldToLocalPosition(CameraID(0) , EntityX(8<<a) , 0 , EntityZ(8<<a))
If GetX()<avsto : avsto = GetX() : a1(1) = a : a1(3) = a!1 : EndIf
Next a
EndProcedure
CreateCamera(0 , 0 , 0 , 100 , 100)
CameraBackColor(0 , RGB(245 , 222 , 179))
MoveCamera(0 , 0 , 3 , -8)
CreateNode(0) ; camera
AttachNodeObject(0 , CameraID(0))
CameraLookAt(0 , 0 , 0 , 0)
CreateNode(1) ; cube
CreateEntity(1000 , MeshID(1) , #PB_Material_None , 0 , 0 , 0 , 0) : ScaleEntity(1000 , 1 , 1 , 30): EntityID_1000=EntityID(1000)
CreateEntity(1001 , MeshID(1) , #PB_Material_None , 0 , 0 , 0 , 0) : ScaleEntity(1001 , 1.6 , 1.6 , 1.6)
Repeat : Until WaitWindowEvent()=275
;- loop
Repeat
getmouse()
If gad = 1 : kub() : EndIf ; new
ExamineKeyboard()
keys2()
If turning = 0 : get_twist() : EndIf ; (get n1)
If turning = 1 : twist_cube() : EndIf
cube_speed2()
rotate_camera()
cube_sides()
RenderWorld()
If GetGadgetState(100) : DisplayTransparentSprite(0 , #dx3-20 , #dy3-20 , 70): EndIf
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or ret=3
;- -------Save Settings-------
If CreateFile(0, "cube_settings.cub")
WriteByte(0,GetGadgetState(4)) ;twistspeed
WriteByte(0,mode) ;mode
WriteByte(0,GetGadgetState(22)) ;hi speed
WriteByte(0,GetGadgetState(32)) ;pause after sequence
WriteByte(0,GetGadgetState(33)) ;space repeat
For a= 42 To 43 : If GetGadgetState(a) : WriteByte(0,a) : EndIf : Next a ; When cube solved
For a= 75 To 77 : If GetGadgetState(a) : WriteByte(0,a) : EndIf : Next a ; no , auto , yes
WriteString(0, GetGadgetText(60))
CloseFile(0)
EndIf