Liberty BASIC Community Forum
« lbgfx : Qbe 3D maze 2.0 »

Welcome Guest. Please Login or Register.
Feb 22nd, 2018, 05:04am


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


« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: lbgfx : Qbe 3D maze 2.0  (Read 131 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: 970
xx lbgfx : Qbe 3D maze 2.0
« Thread started on: Jan 31st, 2018, 06:56am »

i had this laing on a shelf
i dusted it up and added a random maze

error :
lbgfx wrong dll function

HAVE FUN !!

how do i create this whit a bigger 3D maze ?
max is now 8x8x8
Code:
dim maze$( 1000 )
global false , true , up , down , right , left , front , back , nu , zetten
global up$ , down$ , r$ , l$ , back$ , front$ , size
false = 0
true = not( false )
up = 100
down = -100
right = 1
left = -1
front = 10
back = -10
up$ = "yellow"
down$ = "blue"
l$ = "red"
r$ = "cyan"
front$ = "green"
back$ = "pink"
size = 6 '' or 8 : must be even and < 10

nomainwin
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
winx = WindowWidth
winy = WindowHeight
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "Qbe3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
''#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy,hwnd(#m),hwnd(#m.lbgfx))

notice chr$( 13 ) _
       + "Bluatigro presents : Qbe ." + chr$( 13 ) _
       + "object of this game :" + chr$( 13 ) _
       + "find the gold in at" + chr$( 13 ) _
       + "leasts moves as posible ." + chr$( 13 ) _
       + "use cursor keys to rotate ." + chr$( 13 ) _
       + "and spacebar to move . esc = quit ."

  nu = 111
  zetten = 0
  call new.maze
  call draw
wait
sub new.maze
  nu = 111
for x = 0 to size
  for y = 0 to size
    for z = 0 to size
      maze$( index( x , y , z ) ) = "#"
    next z
  next y
next x
[new.maze]

'' initial start location
currentx = INT( RND(0) * ( size - 1 ) )
currenty = INT( RND(0) * ( size - 1 ) )
currentz = int( rnd(0) * ( size - 1 ) )
'' value must be odd
IF currentx MOD 2 = 0 THEN currentx = currentx + 1
IF currenty MOD 2 = 0 THEN currenty = currenty + 1
if currentz mod 2 = 0 then currentz = currentz + 1
maze$( index( currentx , currenty , currentz ) ) = "."

'' generate maze
done = 0
DO WHILE done = 0
    FOR i = 0 TO 99
        oldx = currentx
        oldy = currenty
        oldz = currentz

        '' move in random direction
        SELECT CASE INT( RND(0) * 6 )
            CASE 0
                IF currentx + 2 < size THEN currentx = currentx + 2
            CASE 1
                IF currenty + 2 < size THEN currenty = currenty + 2
            case 2
                if currentz + 2 < size then currentz = currentz + 2
            CASE 3
                IF currentx - 2 > 0 THEN currentx = currentx - 2
            CASE 4
                IF currenty - 2 > 0 THEN currenty = currenty - 2
            case 5
                if currentz - 2 > 0 then currentz = currentz - 2
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$( index( currentx , currenty , currentz ) ) = "#" THEN
            maze$( index( currentx, currenty , currentz ) ) = "."
            maze$( index( INT( ( currentx + oldx ) / 2 ) _
                        , int( ( currenty + oldy ) / 2 ) _
                        , int( ( currentz + oldz ) / 2 ) ) ) = " "
        END IF
    NEXT i

    '' check if all cells are visited
    done = 1
    FOR x = 1 TO size - 1 STEP 2
        FOR y = 1 TO size - 1 STEP 2
          for z = 1 to size - 1 step 2
            IF maze$( index( x , y , z ) ) = "#" THEN done = 0
          next z
        NEXT y
    NEXT x
LOOP
end sub
sub draw
  call lbgfx "cls"
  kl$ = "yellow"
  if maze$( nu + up ) = "#" then
    call tri 0,0 , winx/4,0 , winx/4,winy/4 , up$
    call box winx/4,0 , winx*3/4,winy/4 , up$
    call tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , up$
    kl$ = up$
  else
    call tri 0,0 , winx/4,0 , winx/4,winy/4 , l$
    call box winx/4,0 , winx*3/4,winy/4 , front$
    call tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , r$
    kl$ = front$
  end if
  if maze$( nu + right ) = "#" then
    call tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , r$
    call box winx,winy/4 , winx*3/4,winy*3/4 , r$
    call tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , r$
  else
    call tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , up$
    call box winx,winy/4 , winx*3/4,winy*3/4 , front$
    call tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , down$
  end if
  if maze$( nu + down ) = "#" then
    call tri 0,winy , winx/4,winy , winx/4,winy*3/4 , down$
    call box winx/4,winy*3/4 , winx*3/4,winy , down$
    call tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , down$
  else
    call tri 0,winy , winx/4,winy , winx/4,winy*3/4 , l$
    call box winx/4,winy*3/4 , winx*3/4,winy , front$
    call tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , r$
  end if
  if maze$( nu + left ) = "#" then
    call tri 0,0 , 0,winy/4 , winx/4,winy/4 , l$
    call box 0,winy/4 , winx/4,winy*3/4 , l$
    call tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , l$
  else
    call tri 0,0 , 0,winy/4 , winx/4,winy/4 , up$
    call box 0,winy/4 , winx/4,winy*3/4 , front$
    call tri 0,winy*3/4 , winx/4,winy*3/4 , 0,winy , down$
  end if
  if maze$( nu + front ) <> "#" then
    call quad 1/4,1/4 , 3/4,1/4 , 5/8,3/8 , 3/8,3/8 , up$
    call quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , r$
    call quad 3/4,3/4 , 1/4,3/4 , 3/8,5/8 , 5/8,5/8 , down$
    call quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , l$
    call box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , "black"
  else
    call box winx/4,winy/4 , winx*3/4,winy*3/4 , front$
  end if
''  call lbgfx "goto " ; winx/2 - 200 ; " " ; 50
''  call lbgfx "font Courier_new 24 bold"
''  call lbgfx "color black"
''  call lbgfx "backcolor " ; kl$
''  call lbgfx "\You are in room " ; nu ; " ."
''  call lbgfx "\You made " ; zetten ; " moves ."
  call lbgfx "flip"
  notice "info :" + chr$( 13 ) _
  + "You are in room " ; nu ; " . " + chr$( 13 ) _
  + "You moved " ; zetten ; " times ."
end sub
[key]
  call draw
  select case right$( Inkey$ , 1 )
    case chr$( _VK_UP )
      call turnup
    case chr$( _VK_RIGHT )
      call turnright
    case chr$( _VK_DOWN )
      call turndown
    case chr$( _VK_LEFT )
      call turnleft
    case " "
      if maze$( nu + front ) <> "#" then
        zetten = zetten + 1
        nu = nu + front
      end if
    case chr$( _VK_ESCAPE )
      goto [quit]
    case else
  end select
  if nu = 111 * ( size - 1 ) then
    notice chr$( 13 ) + "You fount the gold" + chr$( 13 ) _
                      +  "you made " ; zetten ; " moves ."
    goto [quit]
  end if
wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m
end
sub box x1 , y1 , x2 , y2 , kl$
    call lbgfx "color " ; kl$
    call lbgfx "backcolor "; kl$
    call lbgfx "boxfilled " ; x1 ; " " ; y1 _
    ; " " ; x2 ; " " ; y2
end sub
sub quad x1,y1,x2,y2,x3,y3,x4,y4,kl$
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  call lbgfx "color " ; kl$
  call lbgfx "backcolor " ; kl$
  call lbgfx "polyfilled " ; x1 ; " " ; y1 _
  ; " " ; x2 ; " " ; y2 ; " " ; x3 ; " " ; y3 _
  ; " " ; x4 ; " " ; y4
end sub
sub tri x1 , y1 , x2 , y2 , x3 , y3 , kl$
  call lbgfx "color " ; kl$
  call lbgfx "backcolor " ; kl$
  call lbgfx "polyfilled " ; x1 ; " " ; y1 _
  ; " " ; x2 ; " " ; y2 ; " " ; x3 ; " " ; y3
end sub
sub lijn x1 , y1 , x2 , y2 , t , kl$
  call lbgfx "color " ; kl$
  call lbgfx "size " ; t
  call lbgfx "line " ; x1 ; " " ; y1 ; " " ; x2 ; " " ; y2
end sub
sub turnup
  h = front
  h$ = front$
  front = up
  front$ = up$
  up = back
  up$ = back$
  back = down
  back$ = down$
  down = h
  down$ = h$
end sub
sub turndown
  h = front
  front = down
  down = back
  back = up
  up = h
  h$ = front$
  front$ = down$
  down$ = back$
  back$ = up$
  up$ = h$
end sub
sub turnright
  h = front
  front = right
  right = back
  back = left
  left = h
  h$ = front$
  front$ = r$
  r$ = back$
  back$ = l$
  l$ = h$
end sub
sub turnleft
  h = front
  front = left
  left = back
  back = right
  right = h
  h$ = front$
  front$ = l$
  l$ = back$
  back$ = r$
  r$ = h$
end sub
function index( x , y , z )
  index = x + y * 10 + z * 100
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx , "graphicCommand" _
  , gfx as ulong _
  , text$ as ptr _
  , ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub
 
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: 970
xx Re: lbgfx : Qbe 3D maze 2.0
« Reply #1 on: Jan 31st, 2018, 07:16am »

update :
any size posible

waring :
dont make the maze to big [ memory ]

Code:

global false , true , up , down , right , left , front , back , nu , zetten
global up$ , down$ , r$ , l$ , back$ , front$ 
global xmax , ymax , zmax
'' must be even
xmax = 6
ymax = 6
zmax = 6
dim maze$( index( xmax , ymax , zmax ) )
false = 0
true = not( false )
up = index( 0 , 0 , 1 )
down = 0 - index( 0 , 0 , 1 )
right = index( 1 , 0 , 0 )
left = 0 - index( 1 , 0 , 0 )
front = index( 0 , 1 , 0 )
back = 0 - index( 0 , 1 , 0 )
up$ = "yellow"
down$ = "blue"
l$ = "red"
r$ = "cyan"
front$ = "green"
back$ = "pink"


nomainwin
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx
winx = WindowWidth
winy = WindowHeight
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "Qbe3D" for window as #m
call FixWindowSize hwnd(#m),winx,winy
''#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy,hwnd(#m),hwnd(#m.lbgfx))

notice chr$( 13 ) _
       + "Bluatigro presents : Qbe ." + chr$( 13 ) _
       + "object of this game :" + chr$( 13 ) _
       + "find the gold in at" + chr$( 13 ) _
       + "leasts moves as posible ." + chr$( 13 ) _
       + "use cursor keys to rotate ." + chr$( 13 ) _
       + "and spacebar to move . esc = quit ."

  nu = index( 1 , 1 , 1 )
  zetten = 0
  call new.maze
  call draw
wait
sub new.maze
  nu = index( 1 , 1 , 1 )
for x = 0 to size
  for y = 0 to size
    for z = 0 to size
      maze$( index( x , y , z ) ) = "#"
    next z
  next y
next x
[new.maze]

'' initial start location
currentx = INT( RND(0) * ( xmax - 1 ) )
currenty = INT( RND(0) * ( ymax - 1 ) )
currentz = int( rnd(0) * ( zmax - 1 ) )
'' value must be odd
IF currentx MOD 2 = 0 THEN currentx = currentx + 1
IF currenty MOD 2 = 0 THEN currenty = currenty + 1
if currentz mod 2 = 0 then currentz = currentz + 1
maze$( index( currentx , currenty , currentz ) ) = "."

'' generate maze
done = 0
DO WHILE done = 0
    FOR i = 0 TO 99
        oldx = currentx
        oldy = currenty
        oldz = currentz

        '' move in random direction
        SELECT CASE INT( RND(0) * 6 )
            CASE 0
                IF currentx + 2 < xmax THEN currentx = currentx + 2
            CASE 1
                IF currenty + 2 < ymax THEN currenty = currenty + 2
            case 2
                if currentz + 2 < zmax then currentz = currentz + 2
            CASE 3
                IF currentx - 2 > 0 THEN currentx = currentx - 2
            CASE 4
                IF currenty - 2 > 0 THEN currenty = currenty - 2
            case 5
                if currentz - 2 > 0 then currentz = currentz - 2
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$( index( currentx , currenty , currentz ) ) = "#" THEN
            maze$( index( currentx, currenty , currentz ) ) = "."
            maze$( index( INT( ( currentx + oldx ) / 2 ) _
                        , int( ( currenty + oldy ) / 2 ) _
                        , int( ( currentz + oldz ) / 2 ) ) ) = " "
        END IF
    NEXT i

    '' check if all cells are visited
    done = 1
    FOR x = 1 TO xmax - 1 STEP 2
        FOR y = 1 TO ymax - 1 STEP 2
          for z = 1 to zmax - 1 step 2
            IF maze$( index( x , y , z ) ) = "#" THEN done = 0
          next z
        NEXT y
    NEXT x
LOOP
end sub
sub draw
  call lbgfx "cls"
  kl$ = "yellow"
  if maze$( nu + up ) = "#" then
    call tri 0,0 , winx/4,0 , winx/4,winy/4 , up$
    call box winx/4,0 , winx*3/4,winy/4 , up$
    call tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , up$
    kl$ = up$
  else
    call tri 0,0 , winx/4,0 , winx/4,winy/4 , l$
    call box winx/4,0 , winx*3/4,winy/4 , front$
    call tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , r$
    kl$ = front$
  end if
  if maze$( nu + right ) = "#" then
    call tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , r$
    call box winx,winy/4 , winx*3/4,winy*3/4 , r$
    call tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , r$
  else
    call tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , up$
    call box winx,winy/4 , winx*3/4,winy*3/4 , front$
    call tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , down$
  end if
  if maze$( nu + down ) = "#" then
    call tri 0,winy , winx/4,winy , winx/4,winy*3/4 , down$
    call box winx/4,winy*3/4 , winx*3/4,winy , down$
    call tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , down$
  else
    call tri 0,winy , winx/4,winy , winx/4,winy*3/4 , l$
    call box winx/4,winy*3/4 , winx*3/4,winy , front$
    call tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , r$
  end if
  if maze$( nu + left ) = "#" then
    call tri 0,0 , 0,winy/4 , winx/4,winy/4 , l$
    call box 0,winy/4 , winx/4,winy*3/4 , l$
    call tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , l$
  else
    call tri 0,0 , 0,winy/4 , winx/4,winy/4 , up$
    call box 0,winy/4 , winx/4,winy*3/4 , front$
    call tri 0,winy*3/4 , winx/4,winy*3/4 , 0,winy , down$
  end if
  if maze$( nu + front ) <> "#" then
    call quad 1/4,1/4 , 3/4,1/4 , 5/8,3/8 , 3/8,3/8 , up$
    call quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , r$
    call quad 3/4,3/4 , 1/4,3/4 , 3/8,5/8 , 5/8,5/8 , down$
    call quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , l$
    call box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , "black"
  else
    call box winx/4,winy/4 , winx*3/4,winy*3/4 , front$
  end if
''  call lbgfx "goto " ; winx/2 - 200 ; " " ; 50
''  call lbgfx "font Courier_new 24 bold"
''  call lbgfx "color black"
''  call lbgfx "backcolor " ; kl$
''  call lbgfx "\You are in room " ; nu ; " ."
''  call lbgfx "\You made " ; zetten ; " moves ."
  call lbgfx "flip"
  notice "info :" + chr$( 13 ) _
  + "You are in room " ; nu ; " . " + chr$( 13 ) _
  + "You moved " ; zetten ; " times ."
end sub
[key]
  call draw
  select case right$( Inkey$ , 1 )
    case chr$( _VK_UP )
      call turnup
    case chr$( _VK_RIGHT )
      call turnright
    case chr$( _VK_DOWN )
      call turndown
    case chr$( _VK_LEFT )
      call turnleft
    case " "
      if maze$( nu + front ) <> "#" then
        zetten = zetten + 1
        nu = nu + front
      end if
    case chr$( _VK_ESCAPE )
      goto [quit]
    case else
  end select
  if nu = index( xmax - 1 , ymax - 1 , zmax - 1 ) then
    notice chr$( 13 ) + "You fount the gold" + chr$( 13 ) _
                      +  "you made " ; zetten ; " moves ."
    goto [quit]
  end if
wait
[quit]
  call DestroyLBGfx
  close #lbgfx
  close #m
end
sub box x1 , y1 , x2 , y2 , kl$
    call lbgfx "color " ; kl$
    call lbgfx "backcolor "; kl$
    call lbgfx "boxfilled " ; x1 ; " " ; y1 _
    ; " " ; x2 ; " " ; y2
end sub
sub quad x1,y1,x2,y2,x3,y3,x4,y4,kl$
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  call lbgfx "color " ; kl$
  call lbgfx "backcolor " ; kl$
  call lbgfx "polyfilled " ; x1 ; " " ; y1 _
  ; " " ; x2 ; " " ; y2 ; " " ; x3 ; " " ; y3 _
  ; " " ; x4 ; " " ; y4
end sub
sub tri x1 , y1 , x2 , y2 , x3 , y3 , kl$
  call lbgfx "color " ; kl$
  call lbgfx "backcolor " ; kl$
  call lbgfx "polyfilled " ; x1 ; " " ; y1 _
  ; " " ; x2 ; " " ; y2 ; " " ; x3 ; " " ; y3
end sub
sub lijn x1 , y1 , x2 , y2 , t , kl$
  call lbgfx "color " ; kl$
  call lbgfx "size " ; t
  call lbgfx "line " ; x1 ; " " ; y1 ; " " ; x2 ; " " ; y2
end sub
sub turnup
  h = front
  h$ = front$
  front = up
  front$ = up$
  up = back
  up$ = back$
  back = down
  back$ = down$
  down = h
  down$ = h$
end sub
sub turndown
  h = front
  front = down
  down = back
  back = up
  up = h
  h$ = front$
  front$ = down$
  down$ = back$
  back$ = up$
  up$ = h$
end sub
sub turnright
  h = front
  front = right
  right = back
  back = left
  left = h
  h$ = front$
  front$ = r$
  r$ = back$
  back$ = l$
  l$ = h$
end sub
sub turnleft
  h = front
  front = left
  left = back
  back = right
  right = h
  h$ = front$
  front$ = l$
  l$ = back$
  back$ = r$
  r$ = h$
end sub
function index( x , y , z )
  index = x + y * (xmax+1) + z * (xmax+1) * (ymax+1)
end function

''whit thanks to dan teel

sub lbgfx text$
  calldll #lbgfx , "graphicCommand" _
  , gfx as ulong _
  , text$ as ptr _
  , ret as void
end sub

function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
  style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
  calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
  calldll #user32,"CreateWindowExA",_
  0 as long,_
  "LBGfx32" as ptr,_
  0 as ulong,_
  style as ulong,_
  x as long,_
  y as long,_
  w as long,_
  h as long,_
  hParent as ulong,_
  0 as ulong,_
  instance as ulong,_
  hMessageHandler as ulong,_
  CreateLBGfx as ulong
end function

sub DestroyLBGfx
  calldll #user32, "DestroyWindow",_
  gfx as ulong, _
  ret as long
end sub

sub FixWindowSize hwnd,width,height
  struct fixrect _
    ,left as long _
    ,top as long _
    ,right as long _
    ,bottom as long
  calldll #user32,"GetClientRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  width=width-fixrect.right.struct+width
  height=height-fixrect.bottom.struct+height
  calldll #user32,"GetWindowRect" _
  ,hwnd as ulong _
  ,fixrect as struct _
  ,ret as void
  x=fixrect.left.struct
  y=fixrect.top.struct
  calldll #user32,"MoveWindow" _
  ,hwnd as ulong _
  ,x as long _
  ,y as long _
  ,width as long _
  ,height as long _
  ,1 as long _
  ,ret as void
end sub
 

 
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: 970
xx Re: lbgfx : Qbe 3D maze 2.0
« Reply #2 on: Feb 1st, 2018, 04:38am »

update :
TEXT version

you can choise out of many maze's

but try to sovle maze 0 6x6x6 first

you can make bigger maze's
but not to big [ memory ]

HAVE FUN !!
Code:
'' bluatigro 1 feb 2018
'' Qbe a 3D maze
'' text version

''  must be even
global wMaze , hMaze , dMaze , movetel
wMaze = 6
hMaze = 6
dMaze = 6
''  make array and fill
DIM maze$( index( wMaze, hMaze , dMaze ) )
FOR x = 0 TO wMaze
    FOR y = 0 TO hMaze
      for z = 0 to dMaze
        maze$( index( x , y , z ) ) = "#"
      next z
    NEXT y
NEXT x
print "bluatigro presents :"
print "Qbe , a 3D maze ."
print "Try to reats chamber ( " _
+str$(wMaze-1)+" , "+str$(hMaze-1)+" , "+str$(dMaze-1)+" )"
input "Whitch maze [ 0 - 1000000 ] : " ; in$
randomize abs( val( in$ ) ) + 1
call createMaze
x = 1
y = 1
z = 1
do
  call drawMaze x , y , z
loop until x = wMaze - 1 and y = hMaze - 1 and z = dMaze - 1
print "game over : you reatsed the end ."
end
sub drawMaze byref x , byref y  , byref z
  while fl = 0
  print
  print "You are in chamber ( " _
  +str$(x)+" , "+str$(y)+" , "+str$(z)+" )"
  print "You made " + str$( movetel ) + " moves ."
  print "you can move :"
  if maze$( index( x , y , z + 1 ) ) <> "#" then
    print "f : forewart"
    keuze$ = keuze$ + "f "
  end if
  if maze$( index( x , y , z - 1 ) ) <> "#" then
    print "b : backwart"
    keuze$ = keuze$ + "b "
  end if
  if maze$( index( x , y + 1 , z ) ) <> "#" then
    print "u : up"
    keuze$ = keuze$ + "u "
  end if
  if maze$( index( x , y - 1 , z ) ) <> "#" then
    print "d : down"
    keuze$ = keuze$ + "d "
  end if
  if maze$( index( x + 1 , y , z ) ) <> "#" then
    print "r : right"
    keuze$ = keuze$ + "r "
  end if
  if maze$( index( x - 1 , y , z ) ) <> "#" then
    print "l : left"
    keuze$ = keuze$ + "l "
  end if
  print "Whitch move ? [ " + keuze$ + "] :"
  input "maze : > " ; in$
  fl = instr( keuze$ , in$ )
  wend
  select case mid$( keuze$ , fl , 1 )
    case "f"
      z = z + 1
    case "b"
      z = z - 1
    case "u"
      y = y + 1
    case "d"
      y = y - 1
    case "r"
      x = x + 1
    case "l"
      x = x - 1
  end select
end sub

sub createMaze
  ''  initial start location
 currentx = INT(RND * (wMaze - 1))
 currenty = INT(RND * (hMaze - 1))
 currentz = int(rnd * (dMaze - 1))

  ''  value must be odd
  IF currentx MOD 2 = 0 THEN currentx = currentx + 1
  IF currenty MOD 2 = 0 THEN currenty = currenty + 1
  if currentz mod 2 = 0 then currentz = currentz + 1
  maze$(index(currentx, currenty,currentz)) = " "


  done = 0
  DO WHILE done = 0
    FOR i = 0 TO 99
      scan
      oldx = currentx
      oldy = currenty
      oldz = currentz

      ''  move in random direction
      SELECT CASE INT(RND(0) * 6)
        CASE 0
          IF currentx + 2 < wMaze THEN currentx = currentx + 2
        CASE 1
          IF currenty + 2 < hMaze THEN currenty = currenty + 2
        CASE 2
          IF currentx - 2 > 0 THEN currentx = currentx - 2
        CASE 3
          IF currenty - 2 > 0 THEN currenty = currenty - 2
        case 4
          if currentz + 2 < dMaze then currentz = currentz + 2
        case 5
          if currentz - 2 > 0 then currentz = currentz - 2
      END SELECT

      ''  if cell is unvisited then connect it
      IF maze$(index(currentx, currenty, currentz)) = "#" THEN
        maze$(index(currentx, currenty,currentz)) = " "
        maze$( index(INT((currentx + oldx) / 2) _
            , int((currenty + oldy) / 2) _
            , int((currentz + oldz) / 2)) ) = " "
      END If
    NEXT i

    ''  check if all cells are visited
    done = 1
    FOR x = 1 TO wMaze - 1 step 2
      FOR y = 1 TO hMaze - 1 step 2
        for z = 1 to dMaze - 1 step 2
        IF maze$( index( x , y , z ) ) = "#" THEN done = 0
        next z
      NEXT y
    NEXT x
  LOOP
end sub
function index( x , y , z )
  index = x + y * ( wMaze + 1 ) + z * ( wMaze + 1 ) * ( hMaze + 1 )
end function
 
« Last Edit: Feb 1st, 2018, 04:41am by bluatigro » 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: 970
xx Re: lbgfx : Qbe 3D maze 2.0
« Reply #3 on: Feb 2nd, 2018, 03:37am »

update :
text whit 'graphics' version

Code:
'' bluatigro 2 feb 2018
'' Qbe a 3D maze
'' text version

''  must be even
global wMaze , hMaze , dMaze , movetel
wMaze = 6
hMaze = 6
dMaze = 6
''  make array and fill
DIM maze$( index( wMaze, hMaze , dMaze ) )
FOR x = 0 TO wMaze
    FOR y = 0 TO hMaze
      for z = 0 to dMaze
        maze$( index( x , y , z ) ) = "#"
      next z
    NEXT y
NEXT x
print "bluatigro presents :"
print "Qbe , a 3D maze ."
print "Try to reats chamber ( " _
+str$(wMaze-1)+" , "+str$(hMaze-1)+" , "+str$(dMaze-1)+" )"
input "Whitch maze [ 0 - 1000000 ] : " ; in$
randomize abs( val( in$ ) ) + 1
call createMaze
x = 1
y = 1
z = 1
do
  call drawMaze x , y , z
loop until x = wMaze - 1 and y = hMaze - 1 and z = dMaze - 1
print "game over : you reatsed the end ."
end
sub drawMaze byref x , byref y  , byref z
  while fl = 0
  print
  print "You are in chamber ( " _
  +str$(x)+" , "+str$(y)+" , "+str$(z)+" )"
  print "You made " + str$( movetel ) + " moves ."
  print "you can move :"
  print "    " ;
  if wal( x , y + 1 , z ) then
    print "  " ;
  else
    print "w " ;
    keuze$ = keuze$ + "w "
  end if
  if wal( x , y , z + 1 ) then
    print
  else
    print "e"
    keuze$ = keuze$ + "e "
  end if
  print "    " ;
  if wal( x , y + 1 , z ) then
    print " " ;
  else
    print "|" ;
  end if
  if wal( x , y , z + 1 ) then
    print
  else
    print "/"
  end if
  if wal( x - 1 , y , z ) then
    print "    " ;
  else
    print "  a-" ;
    keuze$ = keuze$ + "a "
  end if
  print "+" ;
  if wal( x + 1 , y , z ) then
    print
  else
    print "-d"
    keuze$ = keuze$ + "d "
  end if
  print "   " ;
  if wal( x , y , z - 1 ) then
    print " " ;
  else
    print "/" ;
  end if
  if wal( x , y - 1 , z ) then
    print
  else
    print "|"
  end if
  if wal( x , y , z - 1 ) then
    print "    " ;
  else
    print "  z " ;
    keuze$ = keuze$ + "z "
  end if
  if wal( x , y - 1 , z ) then
    print
  else
    print "x"
    keuze$ = keuze$ + "x "
  end if
  print "Whitch move ? [ " + keuze$ + "] :"
  input "Maze : > " ; in$
  fl = instr( keuze$ , in$ )
  wend
  select case mid$( keuze$ , fl , 1 )
    case "e"
      z = z + 1
    case "z"
      z = z - 1
    case "w"
      y = y + 1
    case "x"
      y = y - 1
    case "d"
      x = x + 1
    case "a"
      x = x - 1
  end select
  movetel = movetel + 1
end sub
function wal( x , y , z )
  wal = ( maze$( index( x , y , z ) ) = "#" )
end function
sub createMaze
  ''  initial start location
 currentx = INT(RND * (wMaze - 1))
 currenty = INT(RND * (hMaze - 1))
 currentz = int(rnd * (dMaze - 1))

  ''  value must be odd
  IF currentx MOD 2 = 0 THEN currentx = currentx + 1
  IF currenty MOD 2 = 0 THEN currenty = currenty + 1
  if currentz mod 2 = 0 then currentz = currentz + 1
  maze$(index(currentx, currenty,currentz)) = " "


  done = 0
  DO WHILE done = 0
    FOR i = 0 TO 99
      scan
      oldx = currentx
      oldy = currenty
      oldz = currentz

      ''  move in random direction
      SELECT CASE INT(RND(0) * 6)
        CASE 0
          IF currentx + 2 < wMaze THEN currentx = currentx + 2
        CASE 1
          IF currenty + 2 < hMaze THEN currenty = currenty + 2
        CASE 2
          IF currentx - 2 > 0 THEN currentx = currentx - 2
        CASE 3
          IF currenty - 2 > 0 THEN currenty = currenty - 2
        case 4
          if currentz + 2 < dMaze then currentz = currentz + 2
        case 5
          if currentz - 2 > 0 then currentz = currentz - 2
      END SELECT

      ''  if cell is unvisited then connect it
      IF maze$(index(currentx, currenty, currentz)) = "#" THEN
        maze$(index(currentx, currenty,currentz)) = " "
        maze$( index(INT((currentx + oldx) / 2) _
            , int((currenty + oldy) / 2) _
            , int((currentz + oldz) / 2)) ) = " "
      END If
    NEXT i

    ''  check if all cells are visited
    done = 1
    FOR x = 1 TO wMaze - 1 step 2
      FOR y = 1 TO hMaze - 1 step 2
        for z = 1 to dMaze - 1 step 2
        IF maze$( index( x , y , z ) ) = "#" THEN done = 0
        next z
      NEXT y
    NEXT x
  LOOP
end sub
function index( x , y , z )
  index = x + y * ( wMaze + 1 ) + z * ( wMaze + 1 ) * ( hMaze + 1 )
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: 970
xx Re: lbgfx : Qbe 3D maze 2.0
« Reply #4 on: Feb 5th, 2018, 03:51am »

update :
try at 3D graphics

error :
color error [ but where ? ]

Code:
'' bluatigro 5 feb 2018
'' Qbe 3D maze
global false , true , up , down , right , left , front , back , nu , zetten
global up$ , down$ , r$ , l$ , back$ , front$ 
global xmax , ymax , zmax , nux , nuy , nuz
'' must be even
xmax = 6
ymax = 6
zmax = 6
dim maze$( index( xmax , ymax , zmax ) )
false = 0
true = not( false )
up = index( 0 , 0 , 1 )
down = 0 - index( 0 , 0 , 1 )
right = index( 1 , 0 , 0 )
left = 0 - index( 1 , 0 , 0 )
front = index( 0 , 1 , 0 )
back = 0 - index( 0 , 1 , 0 )
up$ = "yellow"
down$ = "blue"
l$ = "red"
r$ = "cyan"
front$ = "green"
back$ = "pink"


nomainwin
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
nomainwin
open "Qbe 3D maze" for window as #m


notice chr$( 13 ) _
       + "Bluatigro presents : Qbe ." + chr$( 13 ) _
       + "object of this game :" + chr$( 13 ) _
       + "find the gold in at" + chr$( 13 ) _
       + "leasts moves as posible ." + chr$( 13 ) _
       + "use cursor keys to rotate ." + chr$( 13 ) _
       + "and spacebar to move . esc = quit ."
  nux = 1
  nuy = 1
  nuz = 1
  nu = index( nux , nuy , nuz )
  zetten = 0
  call new.maze
  call draw
wait
sub new.maze
  nux = 1
  nuy = 1
  nuz = 1
  nu = index( nux , nuy , nuz )
for x = 0 to size
  for y = 0 to size
    for z = 0 to size
      maze$( index( x , y , z ) ) = "#"
    next z
  next y
next x

'' initial start location
currentx = INT( RND(0) * ( xmax - 1 ) )
currenty = INT( RND(0) * ( ymax - 1 ) )
currentz = int( rnd(0) * ( zmax - 1 ) )
'' value must be odd
IF currentx MOD 2 = 0 THEN currentx = currentx + 1
IF currenty MOD 2 = 0 THEN currenty = currenty + 1
if currentz mod 2 = 0 then currentz = currentz + 1
maze$( index( currentx , currenty , currentz ) ) = "."

'' generate maze
done = 0
DO WHILE done = 0
    FOR i = 0 TO 99
        oldx = currentx
        oldy = currenty
        oldz = currentz

        '' move in random direction
        SELECT CASE INT( RND(0) * 6 )
            CASE 0
                IF currentx + 2 < xmax THEN currentx = currentx + 2
            CASE 1
                IF currenty + 2 < ymax THEN currenty = currenty + 2
            case 2
                if currentz + 2 < zmax then currentz = currentz + 2
            CASE 3
                IF currentx - 2 > 0 THEN currentx = currentx - 2
            CASE 4
                IF currenty - 2 > 0 THEN currenty = currenty - 2
            case 5
                if currentz - 2 > 0 then currentz = currentz - 2
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$( index( currentx , currenty , currentz ) ) = "#" THEN
            maze$( index( currentx, currenty , currentz ) ) = "."
            maze$( index( INT( ( currentx + oldx ) / 2 ) _
                        , int( ( currenty + oldy ) / 2 ) _
                        , int( ( currentz + oldz ) / 2 ) ) ) = " "
        END IF
    NEXT i

    '' check if all cells are visited
    done = 1
    FOR x = 1 TO xmax - 1 STEP 2
        FOR y = 1 TO ymax - 1 STEP 2
          for z = 1 to zmax - 1 step 2
            IF maze$( index( x , y , z ) ) = "#" THEN done = 0
          next z
        NEXT y
    NEXT x
LOOP
end sub
sub draw
  kl$ = "yellow"
  if maze$( nu + up ) = "#" then
    call tri 0,0 , winx/4,0 , winx/4,winy/4 , up$
    call box winx/4,0 , winx*3/4,winy/4 , up$
    call tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , up$
    kl$ = up$
  else
    call tri 0,0 , winx/4,0 , winx/4,winy/4 , l$
    call box winx/4,0 , winx*3/4,winy/4 , front$
    call tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , r$
    kl$ = front$
  end if
  if maze$( nu + right ) = "#" then
    call tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , r$
    call box winx,winy/4 , winx*3/4,winy*3/4 , r$
    call tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , r$
  else
    call tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , up$
    call box winx,winy/4 , winx*3/4,winy*3/4 , front$
    call tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , down$
  end if
  if maze$( nu + down ) = "#" then
    call tri 0,winy , winx/4,winy , winx/4,winy*3/4 , down$
    call box winx/4,winy*3/4 , winx*3/4,winy , down$
    call tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , down$
  else
    call tri 0,winy , winx/4,winy , winx/4,winy*3/4 , l$
    call box winx/4,winy*3/4 , winx*3/4,winy , front$
    call tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , r$
  end if
  if maze$( nu + left ) = "#" then
    call tri 0,0 , 0,winy/4 , winx/4,winy/4 , l$
    call box 0,winy/4 , winx/4,winy*3/4 , l$
    call tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , l$
  else
    call tri 0,0 , 0,winy/4 , winx/4,winy/4 , up$
    call box 0,winy/4 , winx/4,winy*3/4 , front$
    call tri 0,winy*3/4 , winx/4,winy*3/4 , 0,winy , down$
  end if
  if maze$( nu + front ) <> "#" then
    call quad 1/4,1/4 , 3/4,1/4 , 5/8,3/8 , 3/8,3/8 , up$
    call quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , r$
    call quad 3/4,3/4 , 1/4,3/4 , 3/8,5/8 , 5/8,5/8 , down$
    call quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , l$
    call box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , "black"
  else
    call box winx/4,winy/4 , winx*3/4,winy*3/4 , front$
  end if
  #m "goto " ; winx/2 - 200 ; " " ; 50
  #m "font Courier_new 24 bold"
  #m "color white"
  #m "backcolor black"
  #m "\You are in room (" ; nux _
  ; " , " ; nuy ; " , " ; nuz ; " ) ."
  #m "\You made " ; zetten ; " moves ."
''  notice "info :" + chr$( 13 ) _
''  + "You are in room " ; nu ; " . " + chr$( 13 ) _
''  + "You moved " ; zetten ; " times ."
end sub
[key]
  call draw
  select case right$( Inkey$ , 1 )
    case chr$( _VK_UP )
      call turnup
    case chr$( _VK_RIGHT )
      call turnright
    case chr$( _VK_DOWN )
      call turndown
    case chr$( _VK_LEFT )
      call turnleft
    case " "
      if maze$( nu + front ) <> "#" then
        zetten = zetten + 1
        nu = nu + front
        if front = index(  1 , 0 , 0 ) then nux = nux + 1
        if front = index( -1 , 0 , 0 ) then nux = nux - 1
        if front = index( 0 ,  1 , 0 ) then nuy = nuy + 1
        if front = index( 0 , -1 , 0 ) then nuy = nuy - 1
        if front = index( 0 , 0 ,  1 ) then nuz = nuz + 1
        if front = index( 0 , 0 , -1 ) then nuz = nuz - 1
      end if
    case chr$( _VK_ESCAPE )
      goto [quit]
    case else
  end select
  if nu = index( xmax - 1 , ymax - 1 , zmax - 1 ) then
    notice chr$( 13 ) + "You fount the gold" + chr$( 13 ) _
                      +  "you made " ; zetten ; " moves ."
    goto [quit]
  end if
wait
[quit]
  close #m
end
sub box x1 , y1 , x2 , y2 , kl$
    #m "color " ; kl$
    #m "backcolor "; kl$
    #m "goto "; x1 ; " " ; y1
    #m "down"
    #m "boxfilled " ; x2 ; " " ; y2
    #m "up"
end sub
sub quad x1,y1,x2,y2,x3,y3,x4,y4,kl$
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  call tri x1 , y1 , x2 , y2 , x3 , y3 , kl$
  call tri x1 , y1 , x3 , y3 , x4 , y4 , kl$
end sub
sub tri x1 , y1 , x2 , y2 , x3 , y3 , kl$
  #m "color "; kl$
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    call swap y1 , y3
    call swap x1 , x3
  end if
  if y1 > y2 then
    call swap y1 , y2
    call swap x1 , x2
  end if
  if y2 > y3 then
    call swap y2 , y3
    call swap x2 , x3
  end if
  for i = y1 to y3
    a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
    if i < y2 then
      b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
    else
      b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
    end if
    #m "down"
    #m "line " ; a ; " " ; i ; " " ; b ; " " ; i
    #m "up"
  next i
end sub
sub swap byref a , byref b
  h = a
  a = b
  b = h
end sub
sub lijn x1 , y1 , x2 , y2 , t , kl$
  #m "color " ; kl$
  #m "size " ; t
  #m "down"
  #m "line " ; x1 ; " " ; y1 ; " " ; x2 ; " " ; y2
  #m "up"
end sub
sub turnup
  h = front
  h$ = front$
  front = up
  front$ = up$
  up = back
  up$ = back$
  back = down
  back$ = down$
  down = h
  down$ = h$
end sub
sub turndown
  h = front
  front = down
  down = back
  back = up
  up = h
  h$ = front$
  front$ = down$
  down$ = back$
  back$ = up$
  up$ = h$
end sub
sub turnright
  h = front
  front = right
  right = back
  back = left
  left = h
  h$ = front$
  front$ = r$
  r$ = back$
  back$ = l$
  l$ = h$
end sub
sub turnleft
  h = front
  front = left
  left = back
  back = right
  right = h
  h$ = front$
  front$ = l$
  l$ = back$
  back$ = r$
  r$ = h$
end sub
function index( x , y , z )
  index = x + y * (xmax+1) + z * (xmax+1) * (ymax+1)
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 offline

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1745
xx Re: lbgfx : Qbe 3D maze 2.0
« Reply #5 on: Feb 5th, 2018, 07:00am »

Code:
open "Qbe 3D maze" for window as #m 

shuld be
Code:
open "Qbe 3D maze" for graphics as #m 
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: 970
xx Re: lbgfx : Qbe 3D maze 2.0
« Reply #6 on: Feb 7th, 2018, 03:10am »

@ tsh73 :
thanks for spoting that

error :
my wal's are not drawn

Code:
'' bluatigro 5 feb 2018
'' Qbe 3D maze
global false , true
global up , down , right , left , front , back , nu , zetten
global up$ , down$ , r$ , l$ , back$ , front$ 
global xmax , ymax , zmax , nux , nuy , nuz
'' must be even
xmax = 6
ymax = 6
zmax = 6
dim maze$( index( xmax , ymax , zmax ) )
false = 0
true = not( false )
up = index( 0 , 0 , 1 )
down = 0 - index( 0 , 0 , 1 )
right = index( 1 , 0 , 0 )
left = 0 - index( 1 , 0 , 0 )
front = index( 0 , 1 , 0 )
back = 0 - index( 0 , 1 , 0 )
up$ = "yellow"
down$ = "blue"
l$ = "red"
r$ = "cyan"
front$ = "green"
back$ = "pink"


nomainwin
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight
nomainwin
open "Qbe 3D maze" for graphics as #m


  #m "when characterInput [key]"
  #m "setfocus"
  nux = 1
  nuy = 1
  nuz = 1
  nu = index( nux , nuy , nuz )
  zetten = 0
  call new.maze
  call draw
notice chr$( 13 ) _
       + "Bluatigro presents : Qbe ." + chr$( 13 ) _
       + "object of this game :" + chr$( 13 ) _
       + "find the gold in at" + chr$( 13 ) _
       + "leasts moves as posible ." + chr$( 13 ) _
       + "use cursor keys to rotate ." + chr$( 13 ) _
       + "and spacebar to move . q = quit ."
wait
sub new.maze
  nux = 1
  nuy = 1
  nuz = 1
  nu = index( nux , nuy , nuz )
for x = 0 to size
  for y = 0 to size
    for z = 0 to size
      maze$( index( x , y , z ) ) = "#"
    next z
  next y
next x

'' initial start location
currentx = INT( RND(0) * ( xmax - 1 ) )
currenty = INT( RND(0) * ( ymax - 1 ) )
currentz = int( rnd(0) * ( zmax - 1 ) )
'' value must be odd
IF currentx MOD 2 = 0 THEN currentx = currentx + 1
IF currenty MOD 2 = 0 THEN currenty = currenty + 1
if currentz mod 2 = 0 then currentz = currentz + 1
maze$( index( currentx , currenty , currentz ) ) = "."

'' generate maze
done = 0
DO WHILE done = 0
    FOR i = 0 TO 99
        oldx = currentx
        oldy = currenty
        oldz = currentz

        '' move in random direction
        SELECT CASE INT( RND(0) * 6 )
            CASE 0
                IF currentx + 2 < xmax THEN currentx = currentx + 2
            CASE 1
                IF currenty + 2 < ymax THEN currenty = currenty + 2
            case 2
                if currentz + 2 < zmax then currentz = currentz + 2
            CASE 3
                IF currentx - 2 > 0 THEN currentx = currentx - 2
            CASE 4
                IF currenty - 2 > 0 THEN currenty = currenty - 2
            case 5
                if currentz - 2 > 0 then currentz = currentz - 2
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$( index( currentx , currenty , currentz ) ) = "#" THEN
            maze$( index( currentx, currenty , currentz ) ) = "."
            maze$( index( INT( ( currentx + oldx ) / 2 ) _
                        , int( ( currenty + oldy ) / 2 ) _
                        , int( ( currentz + oldz ) / 2 ) ) ) = " "
        END IF
    NEXT i

    '' check if all cells are visited
    done = 1
    FOR x = 1 TO xmax - 1 STEP 2
        FOR y = 1 TO ymax - 1 STEP 2
          for z = 1 to zmax - 1 step 2
            IF maze$( index( x , y , z ) ) = "#" THEN done = 0
          next z
        NEXT y
    NEXT x
LOOP
end sub
sub draw
  kl$ = "yellow"
  if maze$( nu + up ) = "#" then
    call tri 0,0 , winx/4,0 , winx/4,winy/4 , up$
    call box winx/4,0 , winx*3/4,winy/4 , up$
    call tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , up$
    kl$ = up$
  else
    call tri 0,0 , winx/4,0 , winx/4,winy/4 , l$
    call box winx/4,0 , winx*3/4,winy/4 , front$
    call tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , r$
    kl$ = front$
  end if
  if maze$( nu + right ) = "#" then
    call tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , r$
    call box winx,winy/4 , winx*3/4,winy*3/4 , r$
    call tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , r$
  else
    call tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , up$
    call box winx,winy/4 , winx*3/4,winy*3/4 , front$
    call tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , down$
  end if
  if maze$( nu + down ) = "#" then
    call tri 0,winy , winx/4,winy , winx/4,winy*3/4 , down$
    call box winx/4,winy*3/4 , winx*3/4,winy , down$
    call tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , down$
  else
    call tri 0,winy , winx/4,winy , winx/4,winy*3/4 , l$
    call box winx/4,winy*3/4 , winx*3/4,winy , front$
    call tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , r$
  end if
  if maze$( nu + left ) = "#" then
    call tri 0,0 , 0,winy/4 , winx/4,winy/4 , l$
    call box 0,winy/4 , winx/4,winy*3/4 , l$
    call tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , l$
  else
    call tri 0,0 , 0,winy/4 , winx/4,winy/4 , up$
    call box 0,winy/4 , winx/4,winy*3/4 , front$
    call tri 0,winy*3/4 , winx/4,winy*3/4 , 0,winy , down$
  end if
  if maze$( nu + front ) <> "#" then
    call quad 1/4,1/4 , 3/4,1/4 , 5/8,3/8 , 3/8,3/8 , up$
    call quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , r$
    call quad 3/4,3/4 , 1/4,3/4 , 3/8,5/8 , 5/8,5/8 , down$
    call quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , l$
    call box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , "black"
  else
    call box winx/4,winy/4 , winx*3/4,winy*3/4 , front$
  end if
  #m "goto " ; winx/2 - 200 ; " " ; 50
  #m "font Courier_new 24 bold"
  #m "color white"
  #m "backcolor " ; kl$
  #m "\room ( " ; nux ; " , " ; nuy ; " , " ; nuz ; " ) ."
  #m "\You made " ; zetten ; " moves ."

end sub
[key]
  call draw
  select case right$( Inkey$ , 1 )
    case chr$( _VK_UP )
      call turnup
    case chr$( _VK_RIGHT )
      call turnright
    case chr$( _VK_DOWN )
      call turndown
    case chr$( _VK_LEFT )
      call turnleft
    case " "
      if maze$( nu + front ) <> "#" then
        zetten = zetten + 1
        nu = nu + front
        if front = index(  1 , 0 , 0 ) then nux = nux + 1
        if front = index( -1 , 0 , 0 ) then nux = nux - 1
        if front = index( 0 ,  1 , 0 ) then nuy = nuy + 1
        if front = index( 0 , -1 , 0 ) then nuy = nuy - 1
        if front = index( 0 , 0 ,  1 ) then nuz = nuz + 1
        if front = index( 0 , 0 , -1 ) then nuz = nuz - 1
      end if
    case "q"
      goto [quit]
    case else
  end select
  if nu = index( xmax - 1 , ymax - 1 , zmax - 1 ) then
    notice chr$( 13 ) + "You fount the gold" + chr$( 13 ) _
                      +  "you made " ; zetten ; " moves ."
    goto [quit]
  end if
wait
[quit]
  close #m
end
sub box x1 , y1 , x2 , y2 , kl$
    #m "color " ; kl$
    #m "backcolor "; kl$
    #m "goto "; x1 ; " " ; y1
    #m "down"
    #m "boxfilled " ; x2 ; " " ; y2
    #m "up"
end sub
sub quad x1,y1,x2,y2,x3,y3,x4,y4,kl$
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  call tri x1 , y1 , x2 , y2 , x3 , y3 , kl$
  call tri x1 , y1 , x3 , y3 , x4 , y4 , kl$
end sub
sub tri x1 , y1 , x2 , y2 , x3 , y3 , kl$
  #m "color "; kl$
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    call swap y1 , y3
    call swap x1 , x3
  end if
  if y1 > y2 then
    call swap y1 , y2
    call swap x1 , x2
  end if
  if y2 > y3 then
    call swap y2 , y3
    call swap x2 , x3
  end if
  for i = y1 to y3
    a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
    if i < y2 then
      b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
    else
      b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
    end if
    #m "down"
    #m "line " ; a ; " " ; i ; " " ; b ; " " ; i
    #m "up"
  next i
end sub
sub swap byref a , byref b
  h = a
  a = b
  b = h
end sub
sub lijn x1 , y1 , x2 , y2 , t , kl$
  #m "color " ; kl$
  #m "size " ; t
  #m "down"
  #m "line " ; x1 ; " " ; y1 ; " " ; x2 ; " " ; y2
  #m "up"
end sub
sub turnup
  h = front
  h$ = front$
  front = up
  front$ = up$
  up = back
  up$ = back$
  back = down
  back$ = down$
  down = h
  down$ = h$
end sub
sub turndown
  h = front
  front = down
  down = back
  back = up
  up = h
  h$ = front$
  front$ = down$
  down$ = back$
  back$ = up$
  up$ = h$
end sub
sub turnright
  h = front
  front = right
  right = back
  back = left
  left = h
  h$ = front$
  front$ = r$
  r$ = back$
  back$ = l$
  l$ = h$
end sub
sub turnleft
  h = front
  front = left
  left = back
  back = right
  right = h
  h$ = front$
  front$ = l$
  l$ = back$
  back$ = r$
  r$ = h$
end sub
function index( x , y , z )
  index = x + y * (xmax+1) + z * (xmax+1) * (ymax+1)
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
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