Liberty BASIC Community Forum
« 27 / 7 cube puzle »

Welcome Guest. Please Login or Register.
Feb 18th, 2018, 3:48pm


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: 27 / 7 cube puzle  (Read 60 times)
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx 27 / 7 cube puzle
« Thread started on: Jan 28th, 2018, 06:43am »

test this please

i don't think it is whitout error's

can this be done whit code alone ?

Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , number
winx = WindowWidth
winy = WindowHeight
dim p$(6,3) , bord$(27) , kl$(7)
for i = 0 to 7
  read q$
  kl$(i) = q$
next i
data "black","red","green","yellow"
data "blue","pink","cyan","white"
for i = 0 to 27
  bord$(i) = "black"
next i
for i = 0 to 6
  for j = 1 to 3
    read x , y , z
    p$( i , j ) = v3d$( x , y , z )
  next j
next i
'' pice L     red
data 1,0,0 , 2,0,0 , 0,1,0
'' pice T     green
data -1,0,0 , 1,0,0 , 0,1,0
'' pice S     yellow
data 1,-1,0 , 1,0,0 , 0,1,0
'' pice Q     blue
data 1,0,0 , 0,1,0 , 0,0,1
'' pice left  pink
data 1,0,0 , 0,1,0 , 0,1,1
'' pice right cyan
data 1,0,0 , 0,1,0 , 0,1,-1
'' pice smal  white
data 1,0,0 , 0,1,0 , 0,0,0

nomainwin
menu #m , "block" _
        , "up" , [block.up] _
        , "down" , [block.down]
menu #m , "rotate" _
        , "X" , [rot.x] _
        , "Y" , [rot.y] _
        , "Z" , [rot.z]
menu #m , "move" _
        , "left" , [move.left] _
        , "right" , [move.right] _
        , "up" , [move.up] _
        , "down" , [move.down] _
        , "back" , [move.back] _
        , "forwart" , [move.for]
open "27/7 cube puzle" for graphics as #m
  #m "fill lightgray"
  #m "trapclose [quit]"
  #m "setfocus"
  call update
wait
[quit]
  close #m
end
[block.up]
  if number < 6 then number = number + 1
  call update
wait
[block.down]
  if number > 0 then number = number - 1
  call update
wait
[rot.x]
  call rot number , 1
  call update
wait
[rot.y]
  call rot number , 2
  call update
wait
[rot.z]
  call rot number , 3
  call update
wait
[move.up]
  call move number , 0 , 1 , 0
  call update
wait
[move.down]
  call move number , 0 , -1 , 0
  call update
wait
[move.left]
  call move number , -1 , 0 , 0
  call update
wait
[move.right]
  call move number , 1 , 0 , 0
  call update
wait
[move.back]
  call move number , 0 , 0 , -1
  call update
wait
[move.for]
  call move number , 0 , 0 , 1
  call update
wait
sub update
  #m "fill lightgray"
  #m "goto 150 150"
  #m "down"
  #m "backcolor " ; kl$( number + 1 )
  #m "circlefilled 7"
  #m "up"
  for i = 1 to 3
    x = v.x( p$( number , i ) )
    y = v.y( p$( number , i ) )
    z = v.z( p$( number , i ) )
    #m "goto ";150+x*35+z*10;" ";150+y*35+z*10
    #m "down"
    #m "backcolor " ; kl$( number + 1 )
    #m "circlefilled 5"
    #m "up"
  next i
  for i = 0 to 27
    bord$(i) = "black"
  next i
  for b = 0 to 6
    p.x = v.x( p$( b , 0 ) )
    p.y = v.y( p$( b , 0 ) )
    p.z = v.z( p$( b , 0 ) )
    if inbord(p.x,p.y,p.z) then
      bord$( index( p.x,p.y,p.z ) ) = kl$( b + 1 )
    end if
    for i = 1 to 3
      x = v.x( p$( b , i ) )
      y = v.y( p$( b , i ) )
      z = v.z( p$( b , i ) )
      if inbord(p.x+x,p.y+y,p.z+z) then
        bord$( index(p.x+x,p.y+y,p.z+z) ) = kl$( b + 1 )
      end if
    next i
  next b
  fl = 1
  for x = 0 to 2
    for y = 0 to 2
      for z = 0 to 2
        #m "goto ";650+x*150+z*35;" ";50+y*150+z*35
        #m "down"
        #m "backcolor ";bord$(index(x,y,z))
        #m "circlefilled 15"
        #m "up"
        if bord$( index(x,y,z) ) = "black" then
          fl = 0
        end if
      next z
    next y
  next x
  if fl then
    notice "GAME OVER !!" + chr$( 13 ) _
    + "Congratulations :" + chr$( 13 ) _
    + "You solved the puzle !!"
  end if
end sub
sub remove no
  for i = 0 to 27
    if bord$( i ) = kl$( no ) then bord$( i ) = "black"
  next
end sub
sub place no , x , y , z
  if not( inbord(x,y,z) ) then exit sub
  p$( no , 0 ) = v3d$( x , y , z )
end sub
function inbord( x , y , z )
  inbord = (x>=0)and (x<=2) _
       and (y>=0)and (y<=2) _
       and (z>=0)and (z<=2)
end function
sub move no , x , y , z
  call remove no
  p.x = v.x( p$( no , 0 ) )
  p.y = v.y( p$( no , 0 ) )
  p.z = v.z( p$( no , 0 ) )
  call place no , p.x + x , p.y + y , p.z + z
end sub
function index( x , y , z )
  index = x + y * 3 + z * 9
end function
function v3d$( x , y , z )
  v3d$ = str$( x ) ; " " ; y ; " " ; z
end function
function v.x( v$ )
  v.x = val( word$( v$ , 1 ) )
end function
function v.y( v$ )
  v.y = val( word$( v$ , 2 ) )
end function
function v.z( v$ )
  v.z = val( word$( v$ , 3 ) )
end function
sub rot no , ax
  for i = 1 to 3
    p$( no , i ) = rot$( p$( no , i ) , ax )
  next i
end sub
function rot$( v$ , ax )
  x = v.x( v$ )
  y = v.y( v$ )
  z = v.z( v$ )
  nx = x
  ny = y
  nz = z
  select case ax
    case 1
      ny = 0 - z
      nz = y
    case 2
      nx = 0 - z
      nz = x
    case 3
      nx = 0 - z
      ny = x
    case else
  end select
  rot$ = v3d$( nx , ny , nz )
end function

 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: 27 / 7 cube puzle
« Reply #1 on: Jan 28th, 2018, 06:59am »

update :
removed some error's

Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , number
winx = WindowWidth
winy = WindowHeight
dim p$(6,3) , bord$(27) , kl$(7)
for i = 0 to 7
  read q$
  kl$(i) = q$
next i
data "black","red","green","yellow"
data "blue","pink","cyan","white"
for i = 0 to 27
  bord$(i) = "black"
next i
for i = 0 to 6
  for j = 1 to 3
    read x , y , z
    p$( i , j ) = v3d$( x , y , z )
  next j
next i
'' pice L     red
data 1,0,0 , 2,0,0 , 0,1,0
'' pice T     green
data -1,0,0 , 1,0,0 , 0,1,0
'' pice S     yellow
data 1,-1,0 , 1,0,0 , 0,1,0
'' pice Q     blue
data 1,0,0 , 0,1,0 , 0,0,1
'' pice left  pink
data 1,0,0 , 0,1,0 , 0,1,1
'' pice right cyan
data 1,0,0 , 0,1,0 , 0,1,-1
'' pice smal  white
data 1,0,0 , 0,1,0 , 0,0,0

nomainwin
menu #m , "block" _
        , "up"   , [block.up] _
        , "down" , [block.down]
menu #m , "rotate" _
        , "X +" , [rot.x]  _
        , "X -" , [rot.xx] _
        , "Y +" , [rot.y]  _
        , "Y -" , [rot.yy] _
        , "Z +" , [rot.z]  _
        , "Z -" , [rot.zz]
menu #m , "move" _
        , "left"    , [move.left] _
        , "right"   , [move.right] _
        , "up"      , [move.up] _
        , "down"    , [move.down] _
        , "back"    , [move.back] _
        , "forwart" , [move.for]
open "27/7 cube puzle" for graphics as #m
  #m "fill lightgray"
  #m "trapclose [quit]"
  #m "setfocus"
  call update
wait
[quit]
  close #m
end
[block.up]
  if number < 6 then number = number + 1
  call update
wait
[block.down]
  if number > 0 then number = number - 1
  call update
wait
[rot.x]
  call rot number , 1
  call update
wait
[rot.y]
  call rot number , 2
  call update
wait
[rot.z]
  call rot number , 3
  call update
wait
[rot.xx]
  call rot number , 4
  call update
wait
[rot.yy]
  call rot number , 5
  call update
wait
[rot.zz]
  call rot number , 6
  call update
wait
[move.up]
  call move number , 0 , 1 , 0
  call update
wait
[move.down]
  call move number , 0 , -1 , 0
  call update
wait
[move.left]
  call move number , -1 , 0 , 0
  call update
wait
[move.right]
  call move number , 1 , 0 , 0
  call update
wait
[move.back]
  call move number , 0 , 0 , -1
  call update
wait
[move.for]
  call move number , 0 , 0 , 1
  call update
wait
sub update
  #m "fill lightgray"
  #m "goto 150 150"
  #m "down"
  #m "backcolor " ; kl$( number + 1 )
  #m "circlefilled 7"
  #m "up"
  for i = 1 to 3
    x = v.x( p$( number , i ) )
    y = v.y( p$( number , i ) )
    z = v.z( p$( number , i ) )
    #m "goto ";150+x*35-z*10;" ";150+y*35+z*10
    #m "down"
    #m "backcolor " ; kl$( number + 1 )
    #m "circlefilled 5"
    #m "up"
  next i
  for i = 0 to 27
    bord$(i) = "black"
  next i
  for b = 0 to 6
    p.x = v.x( p$( b , 0 ) )
    p.y = v.y( p$( b , 0 ) )
    p.z = v.z( p$( b , 0 ) )
    if inbord(p.x,p.y,p.z) then
      bord$( index( p.x,p.y,p.z ) ) = kl$( b + 1 )
    end if
    for i = 1 to 3
      x = v.x( p$( b , i ) )
      y = v.y( p$( b , i ) )
      z = v.z( p$( b , i ) )
      if inbord(p.x+x,p.y+y,p.z+z) then
        bord$( index(p.x+x,p.y+y,p.z+z) ) = kl$( b + 1 )
      end if
    next i
  next b
  fl = 1
  for x = 0 to 2
    for y = 0 to 2
      for z = 0 to 2
        #m "goto ";650+x*150-z*35;" ";50+y*150+z*35
        #m "down"
        #m "backcolor ";bord$(index(x,y,z))
        #m "circlefilled 15"
        #m "up"
        if bord$( index(x,y,z) ) = "black" then
          fl = 0
        end if
      next z
    next y
  next x
  if fl then
    notice "GAME OVER !!" + chr$( 13 ) _
    + "Congratulations :" + chr$( 13 ) _
    + "You solved the puzle !!"
  end if
end sub
sub remove no
  for i = 0 to 27
    if bord$( i ) = kl$( no ) then bord$( i ) = "black"
  next
end sub
sub place no , x , y , z
  if not( inbord(x,y,z) ) then exit sub
  p$( no , 0 ) = v3d$( x , y , z )
end sub
function inbord( x , y , z )
  inbord = (x>=0)and (x<=2) _
       and (y>=0)and (y<=2) _
       and (z>=0)and (z<=2)
end function
sub move no , x , y , z
  call remove no
  p.x = v.x( p$( no , 0 ) )
  p.y = v.y( p$( no , 0 ) )
  p.z = v.z( p$( no , 0 ) )
  call place no , p.x + x , p.y + y , p.z + z
end sub
function index( x , y , z )
  index = x + y * 3 + z * 9
end function
function v3d$( x , y , z )
  v3d$ = str$( x ) ; " " ; y ; " " ; z
end function
function v.x( v$ )
  v.x = val( word$( v$ , 1 ) )
end function
function v.y( v$ )
  v.y = val( word$( v$ , 2 ) )
end function
function v.z( v$ )
  v.z = val( word$( v$ , 3 ) )
end function
sub rot no , ax
  for i = 1 to 3
    p$( no , i ) = rot$( p$( no , i ) , ax )
  next i
end sub
function rot$( v$ , ax )
  x = v.x( v$ )
  y = v.y( v$ )
  z = v.z( v$ )
  nx = x
  ny = y
  nz = z
  select case ax
    case 1
      ny = 0 - z
      nz = y
    case 2
      nx = 0 - z
      nz = x
    case 3
      nx = 0 - y
      ny = x
    case 4
      ny = z
      nz = 0 - y
    case 5
      nx = z
      nz = 0 - x
    case 6
      nx = y
      ny = 0 - x
    case else
  end select
  rot$ = v3d$( nx , ny , nz )
end function
 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
tsh73
Board Moderator

member is online

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1745
xx Re: 27 / 7 cube puzle
« Reply #2 on: Jan 29th, 2018, 01:15am »

Hello bluatigro
Is it Soma cube puzzle?
User IP Logged

damned Dog in the Manger
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: 27 / 7 cube puzle
« Reply #3 on: Jan 29th, 2018, 03:50am »

@ tsh73 :
yes it is

i m not good at remembering names

i can bild a opengl verion whit cubes
but that won't fit on this forum
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls