Rubiks Cube(windows)

Advanced game related topics
Realizimo
User
User
Posts: 64
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

Rubiks Cube(windows)

Post by Realizimo »

Truble with sprite in line 220, if sprite is set off .I got error in last line when I end program and has moved it to other desktops.
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
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Rubiks Cube(windows)

Post by dige »

:shock: :shock: :shock: Amazing!! Thx for sharing :D
"Daddy, I'll run faster, then it is not so far..."
Realizimo
User
User
Posts: 64
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

Re: Rubiks Cube(windows)

Post by Realizimo »

dige
:D 8)
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Rubiks Cube(windows)

Post by davido »

@Realizimo,
Thank you for sharing. :D

In, your opinion, would it be possible to make it work on a Mac?
If so, I'll try to make it work on my MacBook.
You'll need to consider it very, very easy. Otherwise it will probably be beyond me. :)

Could you add a by-line it helps to give credit where it is due!
DE AA EB
Realizimo
User
User
Posts: 64
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

Re: Rubiks Cube(windows)

Post by Realizimo »

davido
mb = Sign(GetAsyncKeyState_(#VK_LBUTTON)-GetAsyncKeyState_(#VK_RBUTTON))
in row 490 is the problem what i will remember.
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Rubiks Cube(windows)

Post by davido »

@Realizimo,
Thank you for your swift response.

That was the only difference I could find.
However, I had to ask as I seem to excel in missing things. :)
I'll try to find a Mac compatible alternative.

Have a great 2020.
DE AA EB
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Rubiks Cube(windows)

Post by Kwai chang caine »

Image

I always love the rubiks cube !!!!

Since i was young, the rubicks cube is exactly like the programming for me, it's not because i love it of all my heart, than i understand it :mrgreen:
Huuuummmm !!! nearly like programming..., several weeks for never resolve even one line :lol:

So your splendid code is a double sharing (Like kiss cool effect :D ), first we can see what Rubicks have into his PB belly
Furthermore, the cherry on the kebab, it can help waffer like me to understand the whole mystery of all my life...and all that....behind my tousled eyes :shock:
Very welcome to the familly 8)

Excuse me for the late answer, because i can't test immediately your code with my phone (What a pity :cry: )
Thanks a lot for sharing this splendid great jewel 8)
ImageThe happiness is a road...
Not a destination
Realizimo
User
User
Posts: 64
Joined: Sun Nov 25, 2012 5:27 pm
Location: Sweden

Re: Rubiks Cube(windows)

Post by Realizimo »

I'm glad you find it useful :D :oops:
juror
Enthusiast
Enthusiast
Posts: 228
Joined: Mon Jul 09, 2007 4:47 pm
Location: Courthouse

Re: Rubiks Cube(windows)

Post by juror »

[21:11:28] Waiting for executable to start...
[21:11:28] Executable type: Windows - x86 (32bit, Unicode)
[21:11:29] Executable started.
[21:11:30] [ERROR] Line: 1136 (RenderWorld()) - I have a few leading comments
[21:11:30] [ERROR] Invalid memory access. (read error at address 435727372)

:(
User avatar
venom27
User
User
Posts: 10
Joined: Mon Sep 14, 2009 5:30 pm
Location: . <------ ici
Contact:

Re: Rubiks Cube(windows)

Post by venom27 »

juror wrote:[21:11:28] Waiting for executable to start...
[21:11:28] Executable type: Windows - x86 (32bit, Unicode)
[21:11:29] Executable started.
[21:11:30] [ERROR] Line: 1136 (RenderWorld()) - I have a few leading comments
[21:11:30] [ERROR] Invalid memory access. (read error at address 435727372)

:(
Hi,

In the compiler options, put OpenGl in the : Library Subsysteme :wink:
Thank's for the share Realizimo.







@++
Windows 10 x64, PureBasic 5.71 Beta 1 x86 & x64
Post Reply