It is currently Thu Jun 04, 2020 7:32 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 10 posts ] 
Author Message
 Post subject: Rubiks Cube(windows)
PostPosted: Mon Dec 30, 2019 3:43 pm 
Offline
User
User

Joined: Sun Nov 25, 2012 5:27 pm
Posts: 31
Location: Sweden
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:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Mon Dec 30, 2019 4:17 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Apr 30, 2003 8:15 am
Posts: 1015
Location: Germany
:shock: :shock: :shock: Amazing!! Thx for sharing :D

_________________
"Daddy, I'll run faster, then it is not so far..."


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Mon Dec 30, 2019 6:24 pm 
Offline
User
User

Joined: Sun Nov 25, 2012 5:27 pm
Posts: 31
Location: Sweden
dige
:D 8)


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Mon Dec 30, 2019 8:11 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1761
Location: Uttoxeter, UK
@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


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Mon Dec 30, 2019 9:20 pm 
Offline
User
User

Joined: Sun Nov 25, 2012 5:27 pm
Posts: 31
Location: Sweden
davido
mb = Sign(GetAsyncKeyState_(#VK_LBUTTON)-GetAsyncKeyState_(#VK_RBUTTON))
in row 490 is the problem what i will remember.


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Tue Dec 31, 2019 7:49 pm 
Offline
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1761
Location: Uttoxeter, UK
@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


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Tue Jan 07, 2020 12:12 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4684
Location: Lyon - France
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Tue Jan 07, 2020 7:19 pm 
Offline
User
User

Joined: Sun Nov 25, 2012 5:27 pm
Posts: 31
Location: Sweden
I'm glad you find it useful :D :oops:


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Wed Jan 08, 2020 3:18 am 
Offline
Enthusiast
Enthusiast

Joined: Mon Jul 09, 2007 4:47 pm
Posts: 227
Location: Courthouse
[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)

:(


Top
 Profile  
Reply with quote  
 Post subject: Re: Rubiks Cube(windows)
PostPosted: Thu Feb 13, 2020 9:05 pm 
Offline
User
User
User avatar

Joined: Mon Sep 14, 2009 5:30 pm
Posts: 10
Location: . <------ ici
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


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 10 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 12 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye