Qbe 3D maze

Game development specific discussions.
Post Reply
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Qbe 3D maze

Post by bluatigro »

here is Qbe a 3D maze


milions of maze's
but try to solve maze 0 6x6x6 first

HAVE FUN

Code: Select all

'' bluatigro 5 feb 2018
'' Qbe a 3D maze

#include "_text.bas"
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

DIM shared AS INTEGER winx, winy, bitdepth , nu
SCREENINFO winx , winy , bitdepth
SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

dim shared as ulong upkl,downkl,leftkl,rightkl,backkl,frontkl
upkl   =rgb(255,0,0)
leftkl =rgb(0,255,0)
backkl =rgb(255,255,0)
frontkl=rgb(0,0,255)
rightkl=rgb(255,0,255)
downkl =rgb(0,255,255)
const wMaze = 6
const hMaze = 6
const dMaze = 6
function index(x as integer,y as integer,z as integer)as integer
  return x + y * (wMaze+1) + z * (wMaze+1) * (hMaze+1)
end function
dim shared as integer upno,downno,leftno,rightno,backno,frontno
upno = index( 0 , 1 , 0 )
downno = index( 0 , -1 , 0 )
leftno = index( -1 , 0 , 0 )
rightno = index( 1 , 0 , 0 )
backno = index( 0 , 0 , -1 )
frontno = index( 0 , 0 , 1 )
dim shared as integer movetel
''  make array and fill
DIM shared as string maze( index(wMaze, hMaze , dMaze) )
FOR x as integer  = 0 TO wMaze
    FOR y as integer = 0 TO hMaze
      for z as integer = 0 to dMaze
        maze( index(x , y , z) ) = "#"
      next z
    NEXT y
NEXT x
function wal( x as integer , y as integer , z as integer ) as integer
  return maze( index( x , y , z ) ) = "#"
end function
sub box( x1 as integer , y1 as integer _
  , x2 as integer , y2 as integer , kl as ulong )
  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bf
end sub
sub tri( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double , kl as ulong )
  dim as integer i , a , b
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    swap y1 , y3
    swap x1 , x3
  end if
  if y1 > y2 then
    swap y1 , y2
    swap x1 , x2
  end if
  if y2 > y3 then
    swap y2 , y3
    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
    line ( a , i ) - ( b , i ) , kl
  next i
end sub
sub quad( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double _
  , x4 as double , y4 as double ,kl as ulong )
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  tri x1 , y1 , x2 , y2 , x3 , y3 , kl
  tri x1 , y1 , x3 , y3 , x4 , y4 , kl
end sub
sub drawMaze
  if maze( nu + upno ) = "#" then
    tri 0,0 , winx/4,0 , winx/4,winy/4 , upkl
    box winx/4,0 , winx*3/4,winy/4 , upkl
    tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , upkl
  else
    tri 0,0 , winx/4,0 , winx/4,winy/4 , leftkl
    box winx/4,0 , winx*3/4,winy/4 , frontkl
    tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , rightkl
  end if
  if maze( nu + rightno ) = "#" then
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , rightkl
    box winx,winy/4 , winx*3/4,winy*3/4 , rightkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , rightkl
  else
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , upkl
    box winx,winy/4 , winx*3/4,winy*3/4 , frontkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , downkl
  end if
  if maze( nu + downno ) = "#" then
    tri 0,winy , winx/4,winy , winx/4,winy*3/4 , downkl
    box winx/4,winy*3/4 , winx*3/4,winy , downkl
    tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , downkl
  else
    tri 0,winy , winx/4,winy , winx/4,winy*3/4 , leftkl
    box winx/4,winy*3/4 , winx*3/4,winy , frontkl
    tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , rightkl
  end if
  if maze( nu + leftno ) = "#" then
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , leftkl
    box 0,winy/4 , winx/4,winy*3/4 , leftkl
    tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , leftkl
  else
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , upkl
    box 0,winy/4 , winx/4,winy*3/4 , frontkl
    tri 0,winy*3/4 , winx/4,winy*3/4 , 0,winy , downkl
  end if
  if maze( nu + frontno ) <> "#" then
    quad 1/4,1/4 , 3/4,1/4 , 5/8,3/8 , 3/8,3/8 , upkl
    quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , rightkl
    quad 3/4,3/4 , 1/4,3/4 , 3/8,5/8 , 5/8,5/8 , downkl
    quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , leftkl
    box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , 0
  else
    box winx/4,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if

end sub
 
sub createMaze()
  ''  initial start location
  dim as integer currentx = INT(RND * (wMaze - 1))
  dim as integer currenty = INT(RND * (hMaze - 1))
  dim as integer 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)) = " "
 
  ''  generate maze
  dim as integer done,oldx,oldy,oldz

  done = 0
  DO WHILE done = 0
    FOR i as integer = 0 TO 99
      oldx = currentx
      oldy = currenty
      oldz = currentz
 
      ''  move in random direction
      SELECT CASE INT(RND * 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 += 2
        case 5
          if currentz - 2 > 0 then 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 as integer = 1 TO wMaze - 1 STEP 2
      FOR y as integer = 1 TO hMaze - 1 STEP 2
        for z as integer = 1 to dMaze - 1 step 2
        IF maze( index( x , y , z ) ) = "#" THEN done = 0
        next z
      NEXT y
    NEXT x
  LOOP
end sub
sub turnup
  dim as integer hno = frontno
  dim as ulong hkl = frontkl
  frontno = upno
  frontkl = upkl
  upno = backno
  upkl = backkl
  backno = downno
  backkl = downkl
  downno = hno
  downkl = hkl
end sub
sub turndown
  dim as integer hno = frontno
  frontno = downno
  downno = backno
  backno = upno
  upno = hno
  dim as ulong hkl = frontkl
  frontkl = downkl
  downkl = backkl
  backkl = upkl
  upkl = hkl
end sub
sub turnright
  dim as integer hno = frontno
  frontno = rightno
  rightno = backno
  backno = leftno
  leftno = hno
  dim as ulong hkl = frontkl
  frontkl = rightkl
  rightkl = backkl
  backkl = leftkl
  leftkl = hkl
end sub
sub turnleft
  dim as integer hno = frontno
  frontno = leftno
  leftno = backno
  backno = rightno
  rightno = hno
  dim as ulong hkl = frontkl
  frontkl = leftkl
  leftkl = backkl
  backkl = rightkl
  rightkl = hkl
end sub

dim as string in 
print "bluatigro presents :"
print "Qbe , a 3D maze ."
print "Try to reats chamber "+str(wMaze-1)+" "+str(hMaze-1)+" "+str(dMaze-1)
print "instructions :"
print "use a w d x to rotate ."
print "use s to move ."
print "use q to quit ."
input "Whitch maze [ 0 - 1000000 ]" ; in
randomize cint( val( in ) )
createMaze()
dim as integer x = 1 , y = 1 , z = 1 , zetten
nu = index( 1 , 1 , 1 ) 
do
  cls
  drawMaze
  text winx / 2 , winy / 2 - 100 , "x " + str( x ) , 10 , rgb( 255 , 255 , 255 ) 
  text winx / 2 , winy / 2 , "y " + str( y ) , 10 , rgb( 255 , 255 , 255 )
  text winx / 2 , winy / 2 + 100 , "z " + str( z ) , 10 , rgb( 255 , 255 , 255 )
  in = ""
  while in = ""
    in = inkey
  wend
  select case in
    case "w"
     turnup
    case "a"
      turnleft
    case "x"
      turndown
    case "d"
      turnright
    case "s"
      if maze( nu + frontno ) <> "#" then
        nu += frontno
        zetten += 1
        select case frontno
          case index( -1 , 0 , 0 )
            x -= 1
          case index( 1 , 0 , 0 )
            x += 1
          case index( 0 , -1 , 0 )
            y -= 1
          case index( 0 , 1 , 0 )
            y += 1
          case index( 0 , 0 , -1 )
            z -= 1
          case index( 0 , 0 , 1 )
            z += 1
          case else
        end select
      end if
    case else
  end select
  
loop until ( x = wMaze - 1 and y = hMaze - 1 and z = dMaze - 1 ) or in = "q"
drawMaze
text winx / 2 , winy / 2 , "game over" , 20 , rgb( 255 , 255 , 255 )
sleep
 


Code: Select all

dim shared as integer letterpart( 40 , 7 ) 
dim as integer j , k 
const as string letters = "abcdefghijklmnopqrstuvwxyz0123456789"
dim as string q
for i as byte = 1 to len( letters )
  for j = 0 to 7
    read q
    for k = 0 to 7
      if mid( q , k + 1 , 1 ) = "1" then
        letterpart( i , j ) = letterpart( i , j ) or 2 ^ k
      end if
    next k
  next j
next i

''a
data "...1...."
data "..111..."
data ".1...1.."
data "1.....1."
data "1111111."
data "1.....1."
data "1.....1."
data "1.....1."
''b
data "1111...."
data "1...1..."
data "1....1.."
data "1....1.."
data "111111.."
data "1.....1."
data "1.....1."
data "111111.."
''c
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data "1......."
data "1.....1."
data ".1...1.."
data "..111..."
''d
data "11111..."
data "1....1.."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1....1.."
data "11111..."
''e
data "1111111."
data "1.....1."
data "1......."
data "1......."
data "111111.."
data "1......."
data "1.....1."
data "1111111."
''f
data "1111111."
data "1.....1."
data "1......."
data "1......."
data "111111.."
data "1......."
data "1......."
data "1......."
''g
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data "1...111."
data "1.....1."
data ".1...1.."
data "..111..."
''h
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1111111."
data "1.....1."
data "1.....1."
data "1.....1."
''i
data "..111..."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "..111..."
''j
data "..111..."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "1..1...."
data "1..1...."
data ".11...."
''k
data "1......."
data "1.....1."
data "1....1.."
data "1...1..."
data "1111...."
data "1...1..."
data "1....1.."
data "1.....1."
''l
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1111111."
''m
data "1.....1."
data "11...11."
data "1.1.1.1."
data "1..1..1."
data "1..1..1."
data "1.....1."
data "1.....1."
data "1.....1."
''n
data "1.....1."
data "11....1."
data "1.1...1."
data "1..1..1."
data "1..1..1."
data "1...1.1."
data "1....11."
data "1.....1."
''o
data "..111..."
data ".1...1.."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".1...1.."
data "..111..."
''p
data "11111..."
data "1....1.."
data "1.....1."
data "1....1.."
data "11111..."
data "1.....,."
data "1......."
data "1......."
''q
data "..111..."
data ".1...1.."
data "1.....1."
data "1.....1."
data "1..1..1."
data "1...1.1."
data ".1...1.."
data "..111.1."
''r
data "11111..."
data "1....1.."
data "1.....1."
data "1....1.."
data "111111.."
data "1...1..."
data "1....1.."
data "1.....1."
''s
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data ".11111.."
data "......1."
data "1.....1."
data ".11111.."
''t
data "1111111."
data "1..1..1."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "..111..."
''u
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
''v
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".1...1.."
data "..1.1..."
data "...1...."
''w
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1..1..1."
data "1.1.1.1."
data "11...11."
data "1.....1."
''x
data "1.....1."
data ".1...1.."
data "..1.1.."
data "...1...."
data "...1...."
data "..1.1..."
data ".1...1.."
data "1.....1."
''y
data "1.....1."
data ".1...1.."
data "..1.1.."
data "...1...."
data "...1...."
data "..1....."
data ".1......"
data "1......."
''z
data "1111111."
data ".....1.."
data "....1..."
data "...1...."
data "...1...."
data "..1....."
data ".1......"
data "1111111."
''0
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data "........"
data "1.....1."
data "1.....1."
data ".11111.."
''1
data "........"
data "......1."
data "......1."
data "......1."
data "........"
data "......1."
data "......1."
data "........"
''2
data ".11111.."
data "......1."
data "......1."
data "......1."
data ".11111.."
data "1......."
data "1......."
data ".11111.."
''3
data ".11111.."
data "......1."
data "......1."
data "......1."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''4
data "........"
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "......1."
data "......1."
data "........"
''5
data ".11111.."
data "1......."
data "1......."
data "1......."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''6
data ".11111.."
data "1......."
data "1......."
data "1......."
data ".11111.."
data "1.....1."
data "1.....1."
data ".11111.."
''7
data ".11111.."
data "......1."
data "......1."
data "......1."
data "........"
data "......1."
data "......1."
data "........"
''8
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "1.....1."
data "1.....1."
data ".11111.."
''9
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "......1."
data "......1."
data ".11111.."


sub digit( x as integer , y as integer , b as integer , d as double , kl as ulong )
  dim as integer i , j
  for i = 0 to 7
    for j = 0 to 7
      if ( letterpart( b , i ) and 2 ^ j ) <> 0 then
        circle ( x + j * d - 3 * d , y + i * d - 3 * d ) , d / 2 , kl ,,,, f
      end if
    next j
  next i
end sub

sub text( x as integer , y as integer , t as string , d as double , kl as ulong )
  dim as integer i
  for i = 1 to len( t )
    digit x + i * 8 * d - len( t ) * 4 * d , y , instr( letters , lcase( mid( t , i , 1 ) ) ) , d , kl
  next i
end sub

bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: Qbe 3D maze

Post by bluatigro »

update :
inproved text.bas + call's

Code: Select all

'' bluatigro 7 feb 2018
'' Qbe a 3D maze

#include "_text.bas"
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

DIM shared AS INTEGER winx, winy, bitdepth , nu
SCREENINFO winx , winy , bitdepth
SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

dim shared as ulong upkl,downkl,leftkl,rightkl,backkl,frontkl
upkl   =rgb(255,0,0)
leftkl =rgb(0,255,0)
backkl =rgb(255,255,0)
frontkl=rgb(0,0,255)
rightkl=rgb(255,0,255)
downkl =rgb(0,255,255)
const wMaze = 6
const hMaze = 6
const dMaze = 6
function index(x as integer,y as integer,z as integer)as integer
  return x + y * (wMaze+1) + z * (wMaze+1) * (hMaze+1)
end function
dim shared as integer upno,downno,leftno,rightno,backno,frontno
upno = index( 0 , 1 , 0 )
downno = index( 0 , -1 , 0 )
leftno = index( -1 , 0 , 0 )
rightno = index( 1 , 0 , 0 )
backno = index( 0 , 0 , -1 )
frontno = index( 0 , 0 , 1 )
dim shared as integer movetel
''  make array and fill
DIM shared as string maze( index(wMaze, hMaze , dMaze) )
FOR x as integer  = 0 TO wMaze
    FOR y as integer = 0 TO hMaze
      for z as integer = 0 to dMaze
        maze( index(x , y , z) ) = "#"
      next z
    NEXT y
NEXT x
function wal( x as integer , y as integer , z as integer ) as integer
  return maze( index( x , y , z ) ) = "#"
end function
sub box( x1 as integer , y1 as integer _
  , x2 as integer , y2 as integer , kl as ulong )
  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bf
end sub
sub tri( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double , kl as ulong )
  dim as integer i , a , b
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    swap y1 , y3
    swap x1 , x3
  end if
  if y1 > y2 then
    swap y1 , y2
    swap x1 , x2
  end if
  if y2 > y3 then
    swap y2 , y3
    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
    line ( a , i ) - ( b , i ) , kl
  next i
end sub
sub quad( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double _
  , x4 as double , y4 as double ,kl as ulong )
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  tri x1 , y1 , x2 , y2 , x3 , y3 , kl
  tri x1 , y1 , x3 , y3 , x4 , y4 , kl
end sub
sub drawMaze
  if maze( nu + upno ) = "#" then
    tri 0,0 , winx/4,0 , winx/4,winy/4 , upkl
    box winx/4,0 , winx*3/4,winy/4 , upkl
    tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , upkl
  else
    tri 0,0 , winx/4,0 , winx/4,winy/4 , leftkl
    box winx/4,0 , winx*3/4,winy/4 , frontkl
    tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , rightkl
  end if
  if maze( nu + rightno ) = "#" then
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , rightkl
    box winx,winy/4 , winx*3/4,winy*3/4 , rightkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , rightkl
  else
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , upkl
    box winx,winy/4 , winx*3/4,winy*3/4 , frontkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , downkl
  end if
  if maze( nu + downno ) = "#" then
    tri 0,winy , winx/4,winy , winx/4,winy*3/4 , downkl
    box winx/4,winy*3/4 , winx*3/4,winy , downkl
    tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , downkl
  else
    tri 0,winy , winx/4,winy , winx/4,winy*3/4 , leftkl
    box winx/4,winy*3/4 , winx*3/4,winy , frontkl
    tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , rightkl
  end if
  if maze( nu + leftno ) = "#" then
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , leftkl
    box 0,winy/4 , winx/4,winy*3/4 , leftkl
    tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , leftkl
  else
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , upkl
    box 0,winy/4 , winx/4,winy*3/4 , frontkl
    tri 0,winy*3/4 , winx/4,winy*3/4 , 0,winy , downkl
  end if
  if maze( nu + frontno ) <> "#" then
    quad 1/4,1/4 , 3/4,1/4 , 5/8,3/8 , 3/8,3/8 , upkl
    quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , rightkl
    quad 3/4,3/4 , 1/4,3/4 , 3/8,5/8 , 5/8,5/8 , downkl
    quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , leftkl
    box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , 0
  else
    box winx/4,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if

end sub
 
sub createMaze()
  ''  initial start location
  dim as integer currentx = INT(RND * (wMaze - 1))
  dim as integer currenty = INT(RND * (hMaze - 1))
  dim as integer 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)) = " "
 
  ''  generate maze
  dim as integer done,oldx,oldy,oldz

  done = 0
  DO WHILE done = 0
    FOR i as integer = 0 TO 99
      oldx = currentx
      oldy = currenty
      oldz = currentz
 
      ''  move in random direction
      SELECT CASE INT(RND * 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 += 2
        case 5
          if currentz - 2 > 0 then 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 as integer = 1 TO wMaze - 1 STEP 2
      FOR y as integer = 1 TO hMaze - 1 STEP 2
        for z as integer = 1 to dMaze - 1 step 2
        IF maze( index( x , y , z ) ) = "#" THEN done = 0
        next z
      NEXT y
    NEXT x
  LOOP
end sub
sub turnup
  dim as integer hno = frontno
  dim as ulong hkl = frontkl
  frontno = upno
  frontkl = upkl
  upno = backno
  upkl = backkl
  backno = downno
  backkl = downkl
  downno = hno
  downkl = hkl
end sub
sub turndown
  dim as integer hno = frontno
  frontno = downno
  downno = backno
  backno = upno
  upno = hno
  dim as ulong hkl = frontkl
  frontkl = downkl
  downkl = backkl
  backkl = upkl
  upkl = hkl
end sub
sub turnright
  dim as integer hno = frontno
  frontno = rightno
  rightno = backno
  backno = leftno
  leftno = hno
  dim as ulong hkl = frontkl
  frontkl = rightkl
  rightkl = backkl
  backkl = leftkl
  leftkl = hkl
end sub
sub turnleft
  dim as integer hno = frontno
  frontno = leftno
  leftno = backno
  backno = rightno
  rightno = hno
  dim as ulong hkl = frontkl
  frontkl = leftkl
  leftkl = backkl
  backkl = rightkl
  rightkl = hkl
end sub
const as ulong black = 0
const as ulong green = rgb( 0 , 255 , 0 )
const as ulong white = rgb( 255 , 255 , 255 )
dim as string in 
print
print
print "  bluatigro presents" 
print "  Qbe , a 3D maze ."
print "  Try to reats chamber "+str(wMaze-1)+" "+str(hMaze-1)+" "+str(dMaze-1)
print "  instructions :"
print "    use a w d x to rotate ."
print "    use s to move ."
print "    use q to quit ."
input "  Whitch maze [ 0 - 1000000 ] ? >" ; in
randomize cint( val( in ) )
createMaze()
dim as integer x = 1 , y = 1 , z = 1 , zetten
nu = index( 1 , 1 , 1 ) 
do
  cls
  drawMaze
  text winx / 2 , winy / 2 - 250 _
  , "move = " + str( zetten ) , 10 , white
  text winx / 2 , winy / 2 - 100 _
  , "x = " + str( x ) , 10 , white 
  text winx / 2 , winy / 2 _
  , "y = " + str( y ) , 10 , white
  text winx / 2 , winy / 2 + 100 _
  , "z = " + str( z ) , 10 , white
  text winx / 2 , winy - 150 _
  , "         w                " _
  , 5 , green , 0
  text winx / 2 , winy - 100 _
  , "  push a s d or q = quit  " _
  , 5 , green , 0
  text winx / 2 , winy - 50 _
  , "         x                " _
  , 5 , green , 0

  in = ""
  while in = ""
    in = inkey
  wend
  select case in
    case "w"
     turnup
    case "a"
      turnleft
    case "x"
      turndown
    case "d"
      turnright
    case "s"
      if maze( nu + frontno ) <> "#" then
        nu += frontno
        zetten += 1
        select case frontno
          case index( -1 , 0 , 0 )
            x -= 1
          case index( 1 , 0 , 0 )
            x += 1
          case index( 0 , -1 , 0 )
            y -= 1
          case index( 0 , 1 , 0 )
            y += 1
          case index( 0 , 0 , -1 )
            z -= 1
          case index( 0 , 0 , 1 )
            z += 1
          case else
        end select
      end if
    case else
  end select
  
loop until ( x = wMaze - 1 and y = hMaze - 1 and z = dMaze - 1 ) or in = "q"
drawMaze
text winx / 2 , winy / 2 - 200 , "game" _
, 30 , white
text winx / 2 , winy / 2 + 200 , "over" _
, 30 , white
text winx / 2 , winy - 50 , " push return " _
, 5 , green , 0
sleep

Code: Select all

dim shared as integer letterpart( 40 , 7 ) 
dim as integer j , k 
const as string letters = "abcdefghijklmnopqrstuvwxyz0123456789[]="
dim as string q
for i as byte = 1 to len( letters )
  for j = 0 to 7
    read q
    for k = 0 to 7
      if mid( q , k + 1 , 1 ) = "1" then
        letterpart( i , j ) = letterpart( i , j ) or 2 ^ k
      end if
    next k
  next j
next i

''a
data "...1...."
data "..111..."
data ".1...1.."
data "1.....1."
data "1111111."
data "1.....1."
data "1.....1."
data "1.....1."
''b
data "1111...."
data "1...1..."
data "1....1.."
data "1....1.."
data "111111.."
data "1.....1."
data "1.....1."
data "111111.."
''c
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data "1......."
data "1.....1."
data ".1...1.."
data "..111..."
''d
data "11111..."
data "1....1.."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1....1.."
data "11111..."
''e
data "1111111."
data "1.....1."
data "1......."
data "1......."
data "111111.."
data "1......."
data "1.....1."
data "1111111."
''f
data "1111111."
data "1.....1."
data "1......."
data "1......."
data "111111.."
data "1......."
data "1......."
data "1......."
''g
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data "1...111."
data "1.....1."
data ".1...1.."
data "..111..."
''h
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1111111."
data "1.....1."
data "1.....1."
data "1.....1."
''i
data "..111..."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "..111..."
''j
data "..111..."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "1..1...."
data "1..1...."
data ".11...."
''k
data "1......."
data "1.....1."
data "1....1.."
data "1...1..."
data "1111...."
data "1...1..."
data "1....1.."
data "1.....1."
''l
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1......."
data "1111111."
''m
data "1.....1."
data "11...11."
data "1.1.1.1."
data "1..1..1."
data "1..1..1."
data "1.....1."
data "1.....1."
data "1.....1."
''n
data "1.....1."
data "11....1."
data "1.1...1."
data "1..1..1."
data "1..1..1."
data "1...1.1."
data "1....11."
data "1.....1."
''o
data "..111..."
data ".1...1.."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".1...1.."
data "..111..."
''p
data "11111..."
data "1....1.."
data "1.....1."
data "1....1.."
data "11111..."
data "1.....,."
data "1......."
data "1......."
''q
data "..111..."
data ".1...1.."
data "1.....1."
data "1.....1."
data "1..1..1."
data "1...1.1."
data ".1...1.."
data "..111.1."
''r
data "11111..."
data "1....1.."
data "1.....1."
data "1....1.."
data "111111.."
data "1...1..."
data "1....1.."
data "1.....1."
''s
data "..111..."
data ".1...1.."
data "1.....1."
data "1......."
data ".11111.."
data "......1."
data "1.....1."
data ".11111.."
''t
data "1111111."
data "1..1..1."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "...1...."
data "..111..."
''u
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
''v
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data ".1...1.."
data "..1.1..."
data "...1...."
''w
data "1.....1."
data "1.....1."
data "1.....1."
data "1.....1."
data "1..1..1."
data "1.1.1.1."
data "11...11."
data "1.....1."
''x
data "1.....1."
data ".1...1.."
data "..1.1.."
data "...1...."
data "...1...."
data "..1.1..."
data ".1...1.."
data "1.....1."
''y
data "1.....1."
data ".1...1.."
data "..1.1.."
data "...1...."
data "...1...."
data "..1....."
data ".1......"
data "1......."
''z
data "1111111."
data ".....1.."
data "....1..."
data "...1...."
data "...1...."
data "..1....."
data ".1......"
data "1111111."
''0
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data "........"
data "1.....1."
data "1.....1."
data ".11111.."
''1
data "........"
data "......1."
data "......1."
data "......1."
data "........"
data "......1."
data "......1."
data "........"
''2
data ".11111.."
data "......1."
data "......1."
data "......1."
data ".11111.."
data "1......."
data "1......."
data ".11111.."
''3
data ".11111.."
data "......1."
data "......1."
data "......1."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''4
data "........"
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "......1."
data "......1."
data "........"
''5
data ".11111.."
data "1......."
data "1......."
data "1......."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''6
data ".11111.."
data "1......."
data "1......."
data "1......."
data ".11111.."
data "1.....1."
data "1.....1."
data ".11111.."
''7
data ".11111.."
data "......1."
data "......1."
data "......1."
data "........"
data "......1."
data "......1."
data "........"
''8
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "1.....1."
data "1.....1."
data ".11111.."
''9
data ".11111.."
data "1.....1."
data "1.....1."
data "1.....1."
data ".11111.."
data "......1."
data "......1."
data ".11111.."
''[
data "..1111.."
data "..1....."
data "..1....."
data "..1....."
data "..1....."
data "..1....."
data "..1....."
data "..1111.."
'']
data "..1111..."
data ".....1.."
data ".....1.."
data ".....1.."
data ".....1.."
data ".....1.."
data ".....1.."
data "..1111.."
''=
data "........"
data "........"
data "..1111.."
data "........"
data "........"
data "..1111.."
data "........"
data "........"


sub digit( x as integer , y as integer , b as integer , d as double , kl as ulong )
  dim as integer i , j
  for i = 0 to 7
    for j = 0 to 7
      if ( letterpart( b , i ) and 2 ^ j ) <> 0 then
        circle ( x + j * d - 3 * d , y + i * d - 3 * d ) , d / 2 , kl ,,,, f
      end if
    next j
  next i
end sub
const as ulong transparent = &h1000000
sub text( x as integer , y as integer _
  , t as string , d as double _
  , kl as ulong , bkl as ulong = transparent )
  dim as integer i , l = len( t )
  if bkl < transparent then
    line ( x - l * 4 * d + d * 4 , y - 4 * d ) _
    - step ( l * 8 * d + d * 4 , 9 * d ) , bkl , bf 
  end if
  for i = 1 to l
    digit x + i * 8 * d - l * 4 * d , y _
    , instr( letters , lcase( mid( t , i , 1 ) ) ) , d , kl
  next i
end sub
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: Qbe 3D maze

Post by bluatigro »

update :
added cw and ccw rotation

Code: Select all

'' bluatigro 7 feb 2018
'' Qbe a 3D maze

#include "_text.bas"
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

DIM shared AS INTEGER winx, winy, bitdepth , nu
SCREENINFO winx , winy , bitdepth
SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

dim shared as ulong upkl,downkl,leftkl,rightkl,backkl,frontkl
upkl   =rgb(255,0,0)
leftkl =rgb(0,255,0)
backkl =rgb(255,255,0)
frontkl=rgb(0,0,255)
rightkl=rgb(255,0,255)
downkl =rgb(0,255,255)
const wMaze = 6
const hMaze = 6
const dMaze = 6
function index(x as integer,y as integer,z as integer)as integer
  return x + y * (wMaze+1) + z * (wMaze+1) * (hMaze+1)
end function
dim shared as integer upno,downno,leftno,rightno,backno,frontno
upno = index( 0 , 1 , 0 )
downno = index( 0 , -1 , 0 )
leftno = index( -1 , 0 , 0 )
rightno = index( 1 , 0 , 0 )
backno = index( 0 , 0 , -1 )
frontno = index( 0 , 0 , 1 )
dim shared as integer movetel
''  make array and fill
DIM shared as string maze( index(wMaze, hMaze , dMaze) )
FOR x as integer  = 0 TO wMaze
    FOR y as integer = 0 TO hMaze
      for z as integer = 0 to dMaze
        maze( index(x , y , z) ) = "#"
      next z
    NEXT y
NEXT x
function wal( x as integer , y as integer , z as integer ) as integer
  return maze( index( x , y , z ) ) = "#"
end function
sub box( x1 as integer , y1 as integer _
  , x2 as integer , y2 as integer , kl as ulong )
  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bf
end sub
sub tri( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double , kl as ulong )
  dim as integer i , a , b
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    swap y1 , y3
    swap x1 , x3
  end if
  if y1 > y2 then
    swap y1 , y2
    swap x1 , x2
  end if
  if y2 > y3 then
    swap y2 , y3
    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
    line ( a , i ) - ( b , i ) , kl
  next i
end sub
sub quad( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double _
  , x4 as double , y4 as double ,kl as ulong )
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  tri x1 , y1 , x2 , y2 , x3 , y3 , kl
  tri x1 , y1 , x3 , y3 , x4 , y4 , kl
end sub
sub drawMaze
  if maze( nu + upno ) = "#" then
    tri 0,0 , winx/4,0 , winx/4,winy/4 , upkl
    box winx/4,0 , winx*3/4,winy/4 , upkl
    tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , upkl
  else
    tri 0,0 , winx/4,0 , winx/4,winy/4 , leftkl
    box winx/4,0 , winx*3/4,winy/4 , frontkl
    tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , rightkl
  end if
  if maze( nu + rightno ) = "#" then
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , rightkl
    box winx,winy/4 , winx*3/4,winy*3/4 , rightkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , rightkl
  else
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , upkl
    box winx,winy/4 , winx*3/4,winy*3/4 , frontkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , downkl
  end if
  if maze( nu + downno ) = "#" then
    tri 0,winy , winx/4,winy , winx/4,winy*3/4 , downkl
    box winx/4,winy*3/4 , winx*3/4,winy , downkl
    tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , downkl
  else
    tri 0,winy , winx/4,winy , winx/4,winy*3/4 , leftkl
    box winx/4,winy*3/4 , winx*3/4,winy , frontkl
    tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , rightkl
  end if
  if maze( nu + leftno ) = "#" then
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , leftkl
    box 0,winy/4 , winx/4,winy*3/4 , leftkl
    tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , leftkl
  else
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , upkl
    box 0,winy/4 , winx/4,winy*3/4 , frontkl
    tri 0,winy*3/4 , winx/4,winy*3/4 , 0,winy , downkl
  end if
  if maze( nu + frontno ) <> "#" then
    quad 1/4,1/4 , 3/4,1/4 , 5/8,3/8 , 3/8,3/8 , upkl
    quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , rightkl
    quad 3/4,3/4 , 1/4,3/4 , 3/8,5/8 , 5/8,5/8 , downkl
    quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , leftkl
    box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , 0
  else
    box winx/4,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if

end sub
 
sub createMaze()
  ''  initial start location
  dim as integer currentx = INT(RND * (wMaze - 1))
  dim as integer currenty = INT(RND * (hMaze - 1))
  dim as integer 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)) = " "
 
  ''  generate maze
  dim as integer done,oldx,oldy,oldz

  done = 0
  DO WHILE done = 0
    FOR i as integer = 0 TO 99
      oldx = currentx
      oldy = currenty
      oldz = currentz
 
      ''  move in random direction
      SELECT CASE INT(RND * 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 += 2
        case 5
          if currentz - 2 > 0 then 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 as integer = 1 TO wMaze - 1 STEP 2
      FOR y as integer = 1 TO hMaze - 1 STEP 2
        for z as integer = 1 to dMaze - 1 step 2
        IF maze( index( x , y , z ) ) = "#" THEN done = 0
        next z
      NEXT y
    NEXT x
  LOOP
end sub
sub turnup
  dim as integer hno = frontno
  dim as ulong hkl = frontkl
  frontno = upno
  frontkl = upkl
  upno = backno
  upkl = backkl
  backno = downno
  backkl = downkl
  downno = hno
  downkl = hkl
end sub
sub turndown
  dim as integer hno = frontno
  frontno = downno
  downno = backno
  backno = upno
  upno = hno
  dim as ulong hkl = frontkl
  frontkl = downkl
  downkl = backkl
  backkl = upkl
  upkl = hkl
end sub
sub turnright
  dim as integer hno = frontno
  frontno = rightno
  rightno = backno
  backno = leftno
  leftno = hno
  dim as ulong hkl = frontkl
  frontkl = rightkl
  rightkl = backkl
  backkl = leftkl
  leftkl = hkl
end sub
sub turnleft
  dim as integer hno = frontno
  frontno = leftno
  leftno = backno
  backno = rightno
  rightno = hno
  dim as ulong hkl = frontkl
  frontkl = leftkl
  leftkl = backkl
  backkl = rightkl
  rightkl = hkl
end sub
sub turnclock
  dim as integer hno
  dim as ulong hkl
  hno = upno
  hkl = upkl
  upno = rightno
  upkl = rightkl
  rightno = downno
  rightkl = downkl
  downno = leftno
  downkl = leftkl
  leftno = hno
  leftkl = hkl
end sub
sub turnanticlock
  dim as integer hno
  dim as ulong hkl
  hno = upno
  hkl = upkl
  upno = leftno
  upkl = leftkl
  leftno = downno
  leftkl = downkl
  downno = rightno
  downkl = rightkl
  rightno = hno
  rightkl = hkl
end sub
const as ulong black = 0
const as ulong green = rgb( 0 , 255 , 0 )
const as ulong white = rgb( 255 , 255 , 255 )
dim as string in 
print
print
print "  bluatigro presents" 
print "  Qbe , a 3D maze ."
print "  Try to reats chamber "+str(wMaze-1)+" "+str(hMaze-1)+" "+str(dMaze-1)
print "  instructions :"
print "    use a w d x z e to rotate ."
print "    use s to move ."
print "    use q to quit ."
input "  Whitch maze [ 0 - 1000000 ] ? >" ; in
randomize cint( val( in ) )
createMaze()
dim as integer x = 1 , y = 1 , z = 1 , zetten
nu = index( 1 , 1 , 1 ) 
do
  cls
  drawMaze
  text winx / 2 , winy / 2 - 250 _
  , "move = " + str( zetten ) , 10 , white
  text winx / 2 , winy / 2 - 100 _
  , "x = " + str( x ) , 10 , white 
  text winx / 2 , winy / 2 _
  , "y = " + str( y ) , 10 , white
  text winx / 2 , winy / 2 + 100 _
  , "z = " + str( z ) , 10 , white
  text winx / 2 , winy - 150 _
  , "         w e              " _
  , 5 , green , 0
  text winx / 2 , winy - 100 _
  , "  push a s d or q = quit  " _
  , 5 , green , 0
  text winx / 2 , winy - 50 _
  , "       z x                " _
  , 5 , green , 0

  in = ""
  while in = ""
    in = inkey
  wend
  select case in
    case "w"
      turnup
    case "a"
      turnleft
    case "x"
      turndown
    case "d"
      turnright
    case "e"
      turnclock
    case "z"
      turnanticlock
    case "s"
      if maze( nu + frontno ) <> "#" then
        nu += frontno
        zetten += 1
        select case frontno
          case index( -1 , 0 , 0 )
            x -= 1
          case index( 1 , 0 , 0 )
            x += 1
          case index( 0 , -1 , 0 )
            y -= 1
          case index( 0 , 1 , 0 )
            y += 1
          case index( 0 , 0 , -1 )
            z -= 1
          case index( 0 , 0 , 1 )
            z += 1
          case else
        end select
      end if
    case else
  end select
  
loop until ( x = wMaze - 1 and y = hMaze - 1 and z = dMaze - 1 ) or in = "q"
drawMaze
text winx / 2 , winy / 2 - 170 , "game" _
, 30 , white
text winx / 2 , winy / 2 + 170 , "over" _
, 30 , white
text winx / 2 , winy - 50 , " push return " _
, 5 , green , 0
sleep
 
bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: Qbe 3D maze

Post by bluatigro »

update :
a 2D version

i tryed to sovle no 0 10x10
i used 40 moves whit left wal hugging
i didn't get the gold

Code: Select all

'' bluatigro 14 feb 2018
'' Qbe a 2D maze

#include "_text.bas"
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

DIM shared AS INTEGER winx, winy, bitdepth , nu
SCREENINFO winx , winy , bitdepth
SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

dim shared as ulong leftkl,rightkl,backkl,frontkl
leftkl  = rgb(   0 , 255 ,   0 )
backkl  = rgb( 255 , 255 ,   0 )
frontkl = rgb(   0 ,   0 , 255 )
rightkl = rgb( 255 ,   0 ,   0 )
const wMaze = 10
const hMaze = 10

function index( x as integer , y as integer ) as integer
  return x + y * ( wMaze + 1 ) 
end function
dim shared as integer leftno , rightno , backno , frontno
leftno = index( -1 , 0 )
rightno = index( 1 , 0 )
backno = index( 0 , -1 )
frontno = index( 0 , 1 )
dim shared as integer movetel
''  make array and fill
DIM shared as string maze( index( wMaze , hMaze ) )
FOR x as integer  = 0 TO wMaze
    FOR y as integer = 0 TO hMaze
        maze( index( x , y ) ) = "#"
    NEXT y
NEXT x
sub box( x1 as integer , y1 as integer _
  , x2 as integer , y2 as integer , kl as ulong )
  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bf
end sub
sub tri( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double , kl as ulong )
  dim as integer i , a , b
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    swap y1 , y3
    swap x1 , x3
  end if
  if y1 > y2 then
    swap y1 , y2
    swap x1 , x2
  end if
  if y2 > y3 then
    swap y2 , y3
    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
    line ( a , i ) - ( b , i ) , kl
  next i
end sub
sub quad( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double _
  , x4 as double , y4 as double ,kl as ulong )
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  tri x1 , y1 , x2 , y2 , x3 , y3 , kl
  tri x1 , y1 , x3 , y3 , x4 , y4 , kl
end sub
sub drawMaze
  if maze( nu + rightno ) = "#" then
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , rightkl
    box winx,winy/4 , winx*3/4,winy*3/4 , rightkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , rightkl
  else
    box winx,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if
  if maze( nu + leftno ) = "#" then
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , leftkl
    box 0,winy/4 , winx/4,winy*3/4 , leftkl
    tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , leftkl
  else
    box 0,winy/4 , winx/4,winy*3/4 , frontkl
  end if
  if maze( nu + frontno ) <> "#" then
    quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , rightkl
    quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , leftkl
    box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , 0
  else
    box winx/4,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if

end sub
 
sub createMaze()
  ''  initial start location
  dim as integer currentx = INT(RND * ( wMaze - 1 ) )
  dim as integer currenty = INT(RND * ( hMaze - 1 ) )

  ''  value must be odd
  IF currentx MOD 2 = 0 THEN currentx = currentx + 1
  IF currenty MOD 2 = 0 THEN currenty = currenty + 1
  maze( index( currentx , currenty ) ) = " "
 
  ''  generate maze
  dim as integer done , oldx , oldy

  done = 0
  DO WHILE done = 0
    FOR i as integer = 0 TO 99
      oldx = currentx
      oldy = currenty
 
      ''  move in random direction
      SELECT CASE INT( RND * 4 )
        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
      END SELECT
 
      ''  if cell is unvisited then connect it
      IF maze( index( currentx , currenty ) ) = "#" THEN
        maze( index( currentx , currenty ) ) = " "
        maze( index( INT( ( currentx + oldx ) / 2 ) _
                   , int( ( currenty + oldy ) / 2 ) ) ) = " "
      END If
    NEXT i
    
    ''  check if all cells are visited
    done = 1
    FOR x as integer = 1 TO wMaze - 1 STEP 2
      FOR y as integer = 1 TO hMaze - 1 STEP 2
        IF maze( index( x , y ) ) = "#" THEN done = 0
      NEXT y
    NEXT x
  LOOP
end sub
sub turnright
  dim as integer hno = frontno
  frontno = rightno
  rightno = backno
  backno = leftno
  leftno = hno
  dim as ulong hkl = frontkl
  frontkl = rightkl
  rightkl = backkl
  backkl = leftkl
  leftkl = hkl
end sub
sub turnleft
  dim as integer hno = frontno
  frontno = leftno
  leftno = backno
  backno = rightno
  rightno = hno
  dim as ulong hkl = frontkl
  frontkl = leftkl
  leftkl = backkl
  backkl = rightkl
  rightkl = hkl
end sub
const as ulong black = 0
const as ulong cyan = rgb( 0 , 255 , 255 )
const as ulong white = rgb( 255 , 255 , 255 )
dim as string in 
print
print
print
print
print
print
print
print "      bluatigro presents" 
print "      Qbe , a 3D maze ."
print "      Try to reats chamber ( " _
      + str( wMaze - 1 ) + " " + str( hMaze - 1 ) + " )"
print "      instructions :"
print "        use a d to rotate ."
print "        use s to move ."
print "        use q to quit ."
input "      Whitch maze [ 0 - 1000000 ] ? >" ; in
randomize cint( val( in ) )
createMaze()
dim as integer x = 1 , y = 1 , zetten
nu = index( 1 , 1 ) 
do
  cls
  drawMaze
  text winx / 2 , winy / 2 - 100 _
  , "move = " + str( zetten ) , 10 , white
  text winx / 2 , winy / 2 _
  , "x = " + str( x ) , 10 , white 
  text winx / 2 , winy / 2 + 100 _
  , "y = " + str( y ) , 10 , white
  text winx / 2 , winy - 70 _
  , " push a s d or q = quit " _
  , 3 , cyan
  in = ""
  while in = ""
    in = inkey
  wend
  select case in
    case "a"
      turnleft
    case "d"
      turnright
    case "s"
      if maze( nu + frontno ) <> "#" then
        nu += frontno
        zetten += 1
        select case frontno
          case index( -1 , 0 )
            x -= 1
          case index( 1 , 0 )
            x += 1
          case index( 0 , -1 )
            y -= 1
          case index( 0 , 1 )
            y += 1
          case else
        end select
      end if
    case else
  end select
  
loop until nu = index( wMaze - 1 , hMaze - 1 ) or in = "q"
cls
drawMaze
text winx / 2 , winy / 2 - 120 , "game" _
, 20 , white
text winx / 2 , winy / 2 + 120 , "over" _
, 20 , white
if x = wMaze - 1 and y = hMaze - 1 then
  text winx / 2 , winy / 2 _
  , "you fount the gold" , 5 , white
else
  text winx / 2 , winy / 2 _
  , "you quited" , 5 , white
end if
text winx / 2 , winy - 50 _
, " push return " _
, 3 , cyan
sleep
 


bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: Qbe 3D maze

Post by bluatigro »

update :
now whit cheat mode

error :
cheat mode don't work

Code: Select all

'' bluatigro 14 feb 2018
'' Qbe a 2D maze

#include "_text.bas"
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

DIM shared AS INTEGER winx, winy, bitdepth , nu
SCREENINFO winx , winy , bitdepth
SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

dim shared as ulong leftkl,rightkl,backkl,frontkl
leftkl  = rgb(   0 , 255 ,   0 )
backkl  = rgb( 255 , 255 ,   0 )
frontkl = rgb(   0 ,   0 , 255 )
rightkl = rgb( 255 ,   0 ,   0 )
const wMaze = 10
const hMaze = 10

function index( x as integer , y as integer ) as integer
  return x + y * ( wMaze + 1 ) 
end function
dim shared as integer leftno , rightno , backno , frontno
leftno = index( -1 , 0 )
rightno = index( 1 , 0 )
backno = index( 0 , -1 )
frontno = index( 0 , 1 )
dim shared as integer movetel
''  make array and fill
DIM shared as string maze( index( wMaze , hMaze ) )
FOR x as integer  = 0 TO wMaze
    FOR y as integer = 0 TO hMaze
        maze( index( x , y ) ) = "#"
    NEXT y
NEXT x
dim shared as integer sol( index( wMaze , hMaze ) ) , cheat
function safe( x as integer , y as integer ) as integer
  dim as integer uit = 1
  if x < 0 then uit = 0
  if x > wMaze then uit = 0
  if y < 0 then uit = 0
  if y > hMaze then uit = 0
  return uit
end function
function free( x as integer , y as integer ) as integer
  dim as integer uit = 1
  if maze( index( x , y ) ) = "#" then uit = 0
  if sol( index( x , y ) ) then uit = 0
  return uit
end function

function solve( x as integer , y as integer ) as integer
  dim as integer uit = 0
  if x = wMaze - 1 and y = hMaze - 1 then
    sol( index( x , y ) ) = 1
    uit = 1
  end if
  if safe( x , y ) then
    if free( x , y ) then
      sol( index( x , y ) ) = 1
      if solve( x + 1 , y ) then
        uit = 1
      end if
      if solve( x - 1 , y ) then
        uit = 1
      end if
      if solve( x , y + 1 ) then
        uit = 1
      end if
      if solve( x , y - 1 ) then
        uit = 1
      end if
      if not uit then sol( index( x , y ) ) = 0
    end if
  end if

  return uit
end function
sub box( x1 as integer , y1 as integer _
  , x2 as integer , y2 as integer , kl as ulong )
  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bf
end sub
sub tri( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double , kl as ulong )
  dim as integer i , a , b
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    swap y1 , y3
    swap x1 , x3
  end if
  if y1 > y2 then
    swap y1 , y2
    swap x1 , x2
  end if
  if y2 > y3 then
    swap y2 , y3
    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
    line ( a , i ) - ( b , i ) , kl
  next i
end sub
sub quad( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double _
  , x4 as double , y4 as double ,kl as ulong )
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  tri x1 , y1 , x2 , y2 , x3 , y3 , kl
  tri x1 , y1 , x3 , y3 , x4 , y4 , kl
end sub
const as ulong gray = rgb( 100 , 100 , 100 )
sub drawMaze
  if cheat then
    if sol( nu ) then
      box winx/4,winy*3/4,winx*3/4,winy,gray
    end if
    if sol( nu + leftno ) then
      box 0,winy*3/4,winx/4,winy,gray
    end if
    if sol( nu + rightno ) then
      box winx*3/4,winy*3/4,winx,winy,gray
    end if
    if sol( nu + frontno ) then
      box winx/4,winy*5/8,winx*3/4,winy*3/4,gray
    end if
  end if
  if maze( nu + rightno ) = "#" then
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , rightkl
    box winx,winy/4 , winx*3/4,winy*3/4 , rightkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , rightkl
  else
    box winx,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if
  if maze( nu + leftno ) = "#" then
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , leftkl
    box 0,winy/4 , winx/4,winy*3/4 , leftkl
    tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , leftkl
  else
    box 0,winy/4 , winx/4,winy*3/4 , frontkl
  end if
  if maze( nu + frontno ) <> "#" then
    quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , rightkl
    quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , leftkl
    box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , 0
  else
    box winx/4,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if

end sub
 
sub createMaze()
  ''  initial start location
  dim as integer currentx = INT(RND * ( wMaze - 1 ) )
  dim as integer currenty = INT(RND * ( hMaze - 1 ) )

  ''  value must be odd
  IF currentx MOD 2 = 0 THEN currentx = currentx + 1
  IF currenty MOD 2 = 0 THEN currenty = currenty + 1
  maze( index( currentx , currenty ) ) = " "
 
  ''  generate maze
  dim as integer done , oldx , oldy

  done = 0
  DO WHILE done = 0
    FOR i as integer = 0 TO 99
      oldx = currentx
      oldy = currenty
 
      ''  move in random direction
      SELECT CASE INT( RND * 4 )
        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
      END SELECT
 
      ''  if cell is unvisited then connect it
      IF maze( index( currentx , currenty ) ) = "#" THEN
        maze( index( currentx , currenty ) ) = " "
        maze( index( INT( ( currentx + oldx ) / 2 ) _
                   , int( ( currenty + oldy ) / 2 ) ) ) = " "
      END If
    NEXT i
    
    ''  check if all cells are visited
    done = 1
    FOR x as integer = 1 TO wMaze - 1 STEP 2
      FOR y as integer = 1 TO hMaze - 1 STEP 2
        IF maze( index( x , y ) ) = "#" THEN done = 0
      NEXT y
    NEXT x
  LOOP
end sub
sub turnright
  dim as integer hno = frontno
  frontno = rightno
  rightno = backno
  backno = leftno
  leftno = hno
  dim as ulong hkl = frontkl
  frontkl = rightkl
  rightkl = backkl
  backkl = leftkl
  leftkl = hkl
end sub
sub turnleft
  dim as integer hno = frontno
  frontno = leftno
  leftno = backno
  backno = rightno
  rightno = hno
  dim as ulong hkl = frontkl
  frontkl = leftkl
  leftkl = backkl
  backkl = rightkl
  rightkl = hkl
end sub
const as ulong black = 0
const as ulong cyan = rgb( 0 , 255 , 255 )
const as ulong white = rgb( 255 , 255 , 255 )
dim as string in 
print
print
print
print
print
print
print
print "      bluatigro presents" 
print "      Qbe , a 3D maze ."
print "      Try to reats chamber ( " _
      + str( wMaze - 1 ) + " " + str( hMaze - 1 ) + " )"
print "      instructions :"
print "        use a d to rotate ."
print "        use s to move ."
print "        use q to quit ."
input "      Whitch maze [ 0 - 1000000 ] ? >" ; in
randomize cint( val( in ) )
createMaze()
solve( 1 , 1 )
dim as integer x = 1 , y = 1 , zetten
nu = index( 1 , 1 ) 
do
  cls
  drawMaze
  text winx / 2 , winy / 2 - 100 _
  , "move = " + str( zetten ) , 10 , white
  text winx / 2 , winy / 2 _
  , "x = " + str( x ) , 10 , white 
  text winx / 2 , winy / 2 + 100 _
  , "y = " + str( y ) , 10 , white
  text winx / 2 , winy - 70 _
  , " push a s d or q = quit " _
  , 3 , cyan , 0
  in = ""
  while in = ""
    in = inkey
  wend
  select case in
    case "a"
      turnleft
    case "d"
      turnright
    case "t"
      cheat = 1 
    case "y"
      cheat = 0
    case "s"
      if maze( nu + frontno ) <> "#" then
        nu += frontno
        zetten += 1
        select case frontno
          case index( -1 , 0 )
            x -= 1
          case index( 1 , 0 )
            x += 1
          case index( 0 , -1 )
            y -= 1
          case index( 0 , 1 )
            y += 1
          case else
        end select
      end if
    case else
  end select
  
loop until nu = index( wMaze - 1 , hMaze - 1 ) or in = "q"
cls
drawMaze
text winx / 2 , winy / 2 - 120 , "game" _
, 20 , white
text winx / 2 , winy / 2 + 120 , "over" _
, 20 , white
if x = wMaze - 1 and y = hMaze - 1 then
  text winx / 2 , winy / 2 _
  , "you fount the gold" , 5 , white
else
  text winx / 2 , winy / 2 _
  , "you quited" , 5 , white
end if
text winx / 2 , winy - 50 _
, " push return " _
, 3 , cyan , 0
sleep
 


bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: Qbe 3D maze

Post by bluatigro »

update :
try at hint system in 3D maze
the 3Dmaze is diffecolt to solve whitouut it

error :
solve() takes long time

Code: Select all

'' bluatigro 18 mrt 2018
'' Qbe a 3D maze

#include "_text.bas"
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

DIM shared AS INTEGER winx, winy, bitdepth , nu
SCREENINFO winx , winy , bitdepth
SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

dim shared as ulong upkl,downkl,leftkl,rightkl,backkl,frontkl
upkl   =rgb(255,0,0)
leftkl =rgb(0,255,0)
backkl =rgb(255,255,0)
frontkl=rgb(0,0,255)
rightkl=rgb(255,0,255)
downkl =rgb(0,255,255)
const wMaze = 6
const hMaze = 6
const dMaze = 6
function index(x as integer,y as integer,z as integer)as integer
  return x + y * (wMaze+1) + z * (wMaze+1) * (hMaze+1)
end function
dim shared as integer upno,downno,leftno,rightno,backno,frontno
upno = index( 0 , 1 , 0 )
downno = index( 0 , -1 , 0 )
leftno = index( -1 , 0 , 0 )
rightno = index( 1 , 0 , 0 )
backno = index( 0 , 0 , -1 )
frontno = index( 0 , 0 , 1 )
dim shared as integer movetel
''  make array and fill
DIM shared as string maze( index(wMaze, hMaze , dMaze) )
dim shared as integer sol( index( wMaze , hMaze , dMaze ) )
dim shared as integer been( index( wMaze , hMaze , dMaze ) )
FOR x as integer  = 0 TO wMaze
    FOR y as integer = 0 TO hMaze
      for z as integer = 0 to dMaze
        maze( index(x , y , z) ) = "#"
      next z
    NEXT y
NEXT x
function wal( x as integer , y as integer , z as integer ) as integer
  return maze( index( x , y , z ) ) = "#"
end function
sub box( x1 as integer , y1 as integer _
  , x2 as integer , y2 as integer , kl as ulong )
  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bf
end sub
sub tri( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double , kl as ulong )
  dim as integer i , a , b
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    swap y1 , y3
    swap x1 , x3
  end if
  if y1 > y2 then
    swap y1 , y2
    swap x1 , x2
  end if
  if y2 > y3 then
    swap y2 , y3
    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
    line ( a , i ) - ( b , i ) , kl
  next i
end sub
sub quad( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double _
  , x4 as double , y4 as double ,kl as ulong )
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  tri x1 , y1 , x2 , y2 , x3 , y3 , kl
  tri x1 , y1 , x3 , y3 , x4 , y4 , kl
end sub
sub drawMaze
  if maze( nu + upno ) = "#" then
    tri 0,0 , winx/4,0 , winx/4,winy/4 , upkl
    box winx/4,0 , winx*3/4,winy/4 , upkl
    tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , upkl
  else
    tri 0,0 , winx/4,0 , winx/4,winy/4 , leftkl
    box winx/4,0 , winx*3/4,winy/4 , frontkl
    tri winx,0 , winx*3/4,0 , winx*3/4,winy/4 , rightkl
  end if
  if maze( nu + rightno ) = "#" then
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , rightkl
    box winx,winy/4 , winx*3/4,winy*3/4 , rightkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , rightkl
  else
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , upkl
    box winx,winy/4 , winx*3/4,winy*3/4 , frontkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , downkl
  end if
  if maze( nu + downno ) = "#" then
    tri 0,winy , winx/4,winy , winx/4,winy*3/4 , downkl
    box winx/4,winy*3/4 , winx*3/4,winy , downkl
    tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , downkl
  else
    tri 0,winy , winx/4,winy , winx/4,winy*3/4 , leftkl
    box winx/4,winy*3/4 , winx*3/4,winy , frontkl
    tri winx,winy , winx*3/4,winy , winx*3/4,winy*3/4 , rightkl
  end if
  if maze( nu + leftno ) = "#" then
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , leftkl
    box 0,winy/4 , winx/4,winy*3/4 , leftkl
    tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , leftkl
  else
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , upkl
    box 0,winy/4 , winx/4,winy*3/4 , frontkl
    tri 0,winy*3/4 , winx/4,winy*3/4 , 0,winy , downkl
  end if
  if maze( nu + frontno ) <> "#" then
    quad 1/4,1/4 , 3/4,1/4 , 5/8,3/8 , 3/8,3/8 , upkl
    quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , rightkl
    quad 3/4,3/4 , 1/4,3/4 , 3/8,5/8 , 5/8,5/8 , downkl
    quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , leftkl
    box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , 0
  else
    box winx/4,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if

end sub
 
sub createMaze()
  ''  initial start location
  dim as integer currentx = INT(RND * (wMaze - 1))
  dim as integer currenty = INT(RND * (hMaze - 1))
  dim as integer 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)) = " "
 
  ''  generate maze
  dim as integer done,oldx,oldy,oldz

  done = 0
  DO WHILE done = 0
    FOR i as integer = 0 TO 99
      oldx = currentx
      oldy = currenty
      oldz = currentz
 
      ''  move in random direction
      SELECT CASE INT(RND * 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 += 2
        case 5
          if currentz - 2 > 0 then 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 as integer = 1 TO wMaze - 1 STEP 2
      FOR y as integer = 1 TO hMaze - 1 STEP 2
        for z as integer = 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 free( x as integer , y as integer , z as integer ) as integer
  dim as integer uit = 1
  if maze( index( x , y , z ) ) = "#" then uit = 0
  if sol( index( x , y , z ) ) then uit = 0
  return uit
end function
function safe( x as integer , y as integer , z as integer ) as integer
  dim as integer uit = 1
  if x < 0 then uit = 0
  if x > wMaze then uit = 0
  if y < 0 then uit = 0
  if y > hMaze then uit = 0
  if z < 0 then uit = 0
  if z > dMaze then uit = 0
  return uit
end function
function solve( x as integer , y as integer , z as integer ) as integer
  if x = wMaze - 1 _
  and y = hMaze - 1 _
  and z = dMaze - 1 then
    return 1
  end if
  if safe( x , y , z ) then
    if free( x , y , z ) then
      sol( index( x , y , z ) ) = 1
      if solve( x + 1 , y , z ) then return 1
      if solve( x - 1 , y , z ) then return 1
      if solve( x , y + 1 , z ) then return 1
      if solve( x , y + 1 , z ) then return 1
      if solve( x , y , z + 1 ) then return 1
      if solve( x , y , z - 1 ) then return 1
    end if
  end if
  sol( index( x , y , z ) ) = 0
  return 0
end function
sub turnup
  dim as integer hno = frontno
  dim as ulong hkl = frontkl
  frontno = upno
  frontkl = upkl
  upno = backno
  upkl = backkl
  backno = downno
  backkl = downkl
  downno = hno
  downkl = hkl
end sub
sub turndown
  dim as integer hno = frontno
  frontno = downno
  downno = backno
  backno = upno
  upno = hno
  dim as ulong hkl = frontkl
  frontkl = downkl
  downkl = backkl
  backkl = upkl
  upkl = hkl
end sub
sub turnright
  dim as integer hno = frontno
  frontno = rightno
  rightno = backno
  backno = leftno
  leftno = hno
  dim as ulong hkl = frontkl
  frontkl = rightkl
  rightkl = backkl
  backkl = leftkl
  leftkl = hkl
end sub
sub turnleft
  dim as integer hno = frontno
  frontno = leftno
  leftno = backno
  backno = rightno
  rightno = hno
  dim as ulong hkl = frontkl
  frontkl = leftkl
  leftkl = backkl
  backkl = rightkl
  rightkl = hkl
end sub
sub turnclock
  dim as integer hno
  dim as ulong hkl
  hno = upno
  hkl = upkl
  upno = rightno
  upkl = rightkl
  rightno = downno
  rightkl = downkl
  downno = leftno
  downkl = leftkl
  leftno = hno
  leftkl = hkl
end sub
sub turnanticlock
  dim as integer hno
  dim as ulong hkl
  hno = upno
  hkl = upkl
  upno = leftno
  upkl = leftkl
  leftno = downno
  leftkl = downkl
  downno = rightno
  downkl = rightkl
  rightno = hno
  rightkl = hkl
end sub
const as ulong black = 0
const as ulong red = rgb( 255 , 0 , 0 )
const as ulong green = rgb( 0 , 255 , 0 )
const as ulong white = rgb( 255 , 255 , 255 )
dim as string in 
print
print
print
print
print
print
print
print "      bluatigro presents" 
print "      Qbe , a 3D maze ."
print "      Try to reats chamber "+str(wMaze-1)+" "+str(hMaze-1)+" "+str(dMaze-1)
print "      instructions :"
print "        use a w d x z e to rotate ."
print "        use s to move ."
print "        use o to get hint ."
print "        use q to quit ."
input "      Whitch maze [ 0 - 1000000 ] ? >" ; in
randomize cint( val( in ) )
createMaze()
dim as integer x = 1 , y = 1 , z = 1 , zetten , dummy
dummy = solve( 1 , 1 , 1 )
nu = index( 1 , 1 , 1 ) 
do
  cls
  nu = index( x , y , z )
  been( nu ) = 1
  drawMaze
  text winx / 2 , winy / 2 - 250 _
  , "move = " + str( zetten ) , 10 , white
  text winx / 2 , winy / 2 - 100 _
  , "x = " + str( x ) , 10 , white 
  text winx / 2 , winy / 2 _
  , "y = " + str( y ) , 10 , white
  text winx / 2 , winy / 2 + 100 _
  , "z = " + str( z ) , 10 , white
  text winx / 2 , winy - 97 _
  , "        w e             " _
  , 3 , green , 0
  text winx / 2 , winy - 70 _
  , " push a s d or q = quit " _
  , 3 , green , 0
  text winx / 2 , winy - 43 _
  , "      z x               " _
  , 3 , green , 0
  in = ""
  while in = ""
    in = inkey
  wend
  select case in
    case "w"
      turnup
    case "a"
      turnleft
    case "x"
      turndown
    case "d"
      turnright
    case "e"
      turnclock
    case "z"
      turnanticlock
    case "o"
      zetten += 10
      if sol( nu + upno ) and not been( nu + upno ) then
        text winx / 2 , 50 , "turn up" , 5 , white
      end if
      if sol( nu + downno ) and not been( nu + downno) then
        text winx / 2 , 50 , "turn down" , 5 , white
      end if
      if sol( nu + leftno ) and not been( nu + leftno ) then
        text winx / 2 , 50 , "turn left" , 5 , white
      end if
      if sol( nu + rightno ) and not been( nu + rightno ) then
        text winx / 2 , 50 , "turn right" , 5 , white
      end if
      if sol( nu + frontno ) and not been( nu + frontno ) then
        text winx / 2 , 50 , "go forwart" , 5 , white
      end if
    case "s"
      if maze( nu + frontno ) <> "#" then
        nu += frontno
        zetten += 1
        select case frontno
          case index( -1 , 0 , 0 )
            x -= 1
          case index( 1 , 0 , 0 )
            x += 1
          case index( 0 , -1 , 0 )
            y -= 1
          case index( 0 , 1 , 0 )
            y += 1
          case index( 0 , 0 , -1 )
            z -= 1
          case index( 0 , 0 , 1 )
            z += 1
          case else
        end select
      end if
    case else
  end select
  
loop until ( x = wMaze - 1 and y = hMaze - 1 and z = dMaze - 1 ) or in = "q"
drawMaze
text winx / 2 , winy / 2 - 120 , "game" _
, 20 , white
text winx / 2 , winy / 2 + 120 , "over" _
, 20 , white
if x = wMaze - 1 and y = hMaze - 1 and z = dMaze - 1 then
  text winx / 2 , winy / 2 _
  , "you fount the gold" , 5 , white
else
  text winx / 2 , winy / 2 _
  , "you quited" , 5 , white
end if
text winx / 2 , winy - 50 _
, " push return " _
, 3 , green , 0
sleep
 


bluatigro
Posts: 660
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: Qbe 3D maze

Post by bluatigro »

update :
better big chars in qbe 2d

Code: Select all

'' bluatigro 9 jun 2018
'' Qbe a 2D maze

#include "_big_chars.bas"

dim shared as ulong leftkl,rightkl,backkl,frontkl
leftkl  = rgb(   0 , 255 ,   0 )
backkl  = rgb( 255 , 255 ,   0 )
frontkl = rgb(   0 ,   0 , 255 )
rightkl = rgb( 255 ,   0 ,   0 )
const wMaze = 10
const hMaze = 10

function index( x as integer , y as integer ) as integer
  return x + y * ( wMaze + 1 ) 
end function
dim shared as integer leftno , rightno , backno , frontno
leftno = index( -1 , 0 )
rightno = index( 1 , 0 )
backno = index( 0 , -1 )
frontno = index( 0 , 1 )
dim shared as integer movetel
''  make array and fill
DIM shared as string maze( index( wMaze , hMaze ) )
FOR x as integer  = 0 TO wMaze
    FOR y as integer = 0 TO hMaze
        maze( index( x , y ) ) = "#"
    NEXT y
NEXT x
sub box( x1 as integer , y1 as integer _
  , x2 as integer , y2 as integer , kl as ulong )
  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bf
end sub
sub tri( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double , kl as ulong )
  dim as integer i , a , b
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    swap y1 , y3
    swap x1 , x3
  end if
  if y1 > y2 then
    swap y1 , y2
    swap x1 , x2
  end if
  if y2 > y3 then
    swap y2 , y3
    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
    line ( a , i ) - ( b , i ) , kl
  next i
end sub
sub quad( x1 as double , y1 as double _
  , x2 as double , y2 as double _
  , x3 as double , y3 as double _
  , x4 as double , y4 as double ,kl as ulong )
  x1=x1*winx
  y1=y1*winy
  x2=x2*winx
  y2=y2*winy
  x3=x3*winx
  y3=y3*winy
  x4=x4*winx
  y4=y4*winy
  tri x1 , y1 , x2 , y2 , x3 , y3 , kl
  tri x1 , y1 , x3 , y3 , x4 , y4 , kl
end sub
sub drawMaze
  if maze( nu + rightno ) = "#" then
    tri winx,0 , winx,winy/4 , winx*3/4,winy/4 , rightkl
    box winx,winy/4 , winx*3/4,winy*3/4 , rightkl
    tri winx,winy , winx,winy*3/4 , winx*3/4,winy*3/4 , rightkl
  else
    box winx,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if
  if maze( nu + leftno ) = "#" then
    tri 0,0 , 0,winy/4 , winx/4,winy/4 , leftkl
    box 0,winy/4 , winx/4,winy*3/4 , leftkl
    tri 0,winy*3/4 , winx/4,winy*3/4  , 0,winy , leftkl
  else
    box 0,winy/4 , winx/4,winy*3/4 , frontkl
  end if
  if maze( nu + frontno ) <> "#" then
    quad 3/4,1/4 , 3/4,3/4 , 5/8,5/8 , 5/8,3/8 , rightkl
    quad 1/4,3/4 , 1/4,1/4 , 3/8,3/8 , 3/8,5/8 , leftkl
    box winx*3/8,winy*3/8 , winx*5/8,winy*5/8 , 0
  else
    box winx/4,winy/4 , winx*3/4,winy*3/4 , frontkl
  end if

end sub
 
sub createMaze()
  ''  initial start location
  dim as integer currentx = INT(RND * ( wMaze - 1 ) )
  dim as integer currenty = INT(RND * ( hMaze - 1 ) )

  ''  value must be odd
  IF currentx MOD 2 = 0 THEN currentx = currentx + 1
  IF currenty MOD 2 = 0 THEN currenty = currenty + 1
  maze( index( currentx , currenty ) ) = " "
 
  ''  generate maze
  dim as integer done , oldx , oldy

  done = 0
  DO WHILE done = 0
    FOR i as integer = 0 TO 99
      oldx = currentx
      oldy = currenty
 
      ''  move in random direction
      SELECT CASE INT( RND * 4 )
        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
      END SELECT
 
      ''  if cell is unvisited then connect it
      IF maze( index( currentx , currenty ) ) = "#" THEN
        maze( index( currentx , currenty ) ) = " "
        maze( index( INT( ( currentx + oldx ) / 2 ) _
                   , int( ( currenty + oldy ) / 2 ) ) ) = " "
      END If
    NEXT i
    
    ''  check if all cells are visited
    done = 1
    FOR x as integer = 1 TO wMaze - 1 STEP 2
      FOR y as integer = 1 TO hMaze - 1 STEP 2
        IF maze( index( x , y ) ) = "#" THEN done = 0
      NEXT y
    NEXT x
  LOOP
end sub
sub turnright
  dim as integer hno = frontno
  frontno = rightno
  rightno = backno
  backno = leftno
  leftno = hno
  dim as ulong hkl = frontkl
  frontkl = rightkl
  rightkl = backkl
  backkl = leftkl
  leftkl = hkl
end sub
sub turnleft
  dim as integer hno = frontno
  frontno = leftno
  leftno = backno
  backno = rightno
  rightno = hno
  dim as ulong hkl = frontkl
  frontkl = leftkl
  leftkl = backkl
  backkl = rightkl
  rightkl = hkl
end sub
const as ulong black = 0
const as ulong cyan = rgb( 0 , 255 , 255 )
const as ulong white = rgb( 255 , 255 , 255 )
dim as string in 
print
print
print
print
print
print
print
print "      bluatigro presents" 
print "      Qbe , a 3D maze ."
print "      Try to reats chamber ( " _
      + str( wMaze - 1 ) + " " + str( hMaze - 1 ) + " )"
print "      instructions :"
print "        use a d to rotate ."
print "        use s to move ."
print "        use q to quit ."
input "      Whitch maze [ 0 - 1000000 ] ? >" ; in
randomize cint( val( in ) )
createMaze()
dim as integer x = 1 , y = 1 , zetten
nu = index( 1 , 1 ) 
do
  cls
  drawMaze
  text winx / 2 , winy / 2 - 100 _
  , "move = " + str( zetten ) , 7 , white
  text winx / 2 , winy / 2 _
  , "x = " + str( x ) , 7 , white 
  text winx / 2 , winy / 2 + 100 _
  , "y = " + str( y ) , 7 , white
  text winx / 2 , winy - 70 _
  , " push a s d or q = quit " _
  , 5 , cyan
  in = ""
  while in = ""
    in = inkey
  wend
  select case in
    case "a"
      turnleft
    case "d"
      turnright
    case "s"
      if maze( nu + frontno ) <> "#" then
        nu += frontno
        zetten += 1
        select case frontno
          case index( -1 , 0 )
            x -= 1
          case index( 1 , 0 )
            x += 1
          case index( 0 , -1 )
            y -= 1
          case index( 0 , 1 )
            y += 1
          case else
        end select
      end if
    case else
  end select
  
loop until nu = index( wMaze - 1 , hMaze - 1 ) or in = "q"
cls
drawMaze
text winx / 2 , winy / 2 - 120 , "game" _
, 10 , white
text winx / 2 , winy / 2 + 120 , "over" _
, 10 , white
if x = wMaze - 1 and y = hMaze - 1 then
  text winx / 2 , winy / 2 _
  , "you fount the gold" , 7 , white
else
  text winx / 2 , winy / 2 _
  , "you quited" , 7 , white
end if
text winx / 2 , winy - 50 _
, "push return" _
, 5 , cyan
sleep
_big_chars.bas

Code: Select all

'' bluatigro 9 jun 2018
'' automatic big text

dim shared as integer letterpart( 255 , 20 ) 
dim as integer char , ix , iy

#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
  Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif

DIM shared AS INTEGER winx, winy, bitdepth , nu
SCREENINFO winx , winy , bitdepth
SCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREEN

for char = 30 to 255
  cls
  print chr( char )
  for ix = 0 to 16
    for iy = 0 to 20
      if point( ix , iy ) <> -16777216 then
        letterpart( char , iy ) += 2 ^ ix
      end if
    next iy
  next ix
next char

sub digit( a as double , b as double _
  , q as double , d as double  , kl as ulong )
  dim as double x , y
  for x = 0 to 16
    for y = 0 to 20
      if letterpart( q , y ) and 2 ^ x then 
        circle( a + ( x - 4 ) * d , b + ( y - 4 ) * d ) _
        , d / 3 , kl ,,,, f
      end if
    next y
  next x
end sub

sub text( a as double , b as double , txt as string _
  , d as double , kl as ulong )
  dim as double l = len( txt ) , x
  for x = 1 to l
    digit a + ( x - l / 4 - 1 ) * d * 8 , b _
    , asc( mid( txt , x , 1 ) ) , d , kl
  next x
end sub

        
        
        
        
        
Post Reply