## Qbe 3D maze

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

### Qbe 3D maze

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#endifDIM shared AS INTEGER winx, winy, bitdepth , nuSCREENINFO winx , winy , bitdepthSCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREENdim shared as ulong upkl,downkl,leftkl,rightkl,backkl,frontklupkl   =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 = 6const hMaze = 6const dMaze = 6function index(x as integer,y as integer,z as integer)as integer  return x + y * (wMaze+1) + z * (wMaze+1) * (hMaze+1)end functiondim shared as integer upno,downno,leftno,rightno,backno,frontnoupno = 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 fillDIM 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 yNEXT xfunction wal( x as integer , y as integer , z as integer ) as integer  return maze( index( x , y , z ) ) = "#"end functionsub box( x1 as integer , y1 as integer _  , x2 as integer , y2 as integer , kl as ulong )  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bfend subsub 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 iend subsub 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 , klend subsub 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 ifend 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  LOOPend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subdim 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 ]" ; inrandomize cint( val( in ) )createMaze()dim as integer x = 1 , y = 1 , z = 1 , zettennu = 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"drawMazetext 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 qfor 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 jnext i''adata "...1...."data "..111..."data ".1...1.."data "1.....1."data "1111111."data "1.....1."data "1.....1."data "1.....1."''bdata "1111...."data "1...1..."data "1....1.."data "1....1.."data "111111.."data "1.....1."data "1.....1."data "111111.."''cdata "..111..."data ".1...1.."data "1.....1."data "1......."data "1......."data "1.....1."data ".1...1.."data "..111..."''ddata "11111..."data "1....1.."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1....1.."data "11111..."''edata "1111111."data "1.....1."data "1......."data "1......."data "111111.."data "1......."data "1.....1."data "1111111."''fdata "1111111."data "1.....1."data "1......."data "1......."data "111111.."data "1......."data "1......."data "1......."''gdata "..111..."data ".1...1.."data "1.....1."data "1......."data "1...111."data "1.....1."data ".1...1.."data "..111..."''hdata "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1111111."data "1.....1."data "1.....1."data "1.....1."''idata "..111..."data "...1...."data "...1...."data "...1...."data "...1...."data "...1...."data "...1...."data "..111..."''jdata "..111..."data "...1...."data "...1...."data "...1...."data "...1...."data "1..1...."data "1..1...."data ".11...."''kdata "1......."data "1.....1."data "1....1.."data "1...1..."data "1111...."data "1...1..."data "1....1.."data "1.....1."''ldata "1......."data "1......."data "1......."data "1......."data "1......."data "1......."data "1......."data "1111111."''mdata "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."''ndata "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."''odata "..111..."data ".1...1.."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data ".1...1.."data "..111..."''pdata "11111..."data "1....1.."data "1.....1."data "1....1.."data "11111..."data "1.....,."data "1......."data "1......."''qdata "..111..."data ".1...1.."data "1.....1."data "1.....1."data "1..1..1."data "1...1.1."data ".1...1.."data "..111.1."''rdata "11111..."data "1....1.."data "1.....1."data "1....1.."data "111111.."data "1...1..."data "1....1.."data "1.....1."''sdata "..111..."data ".1...1.."data "1.....1."data "1......."data ".11111.."data "......1."data "1.....1."data ".11111.."''tdata "1111111."data "1..1..1."data "...1...."data "...1...."data "...1...."data "...1...."data "...1...."data "..111..."''udata "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data ".11111.."''vdata "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data ".1...1.."data "..1.1..."data "...1...."''wdata "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."''xdata "1.....1."data ".1...1.."data "..1.1.."data "...1...."data "...1...."data "..1.1..."data ".1...1.."data "1.....1."''ydata "1.....1."data ".1...1.."data "..1.1.."data "...1...."data "...1...."data "..1....."data ".1......"data "1......."''zdata "1111111."data ".....1.."data "....1..."data "...1...."data "...1...."data "..1....."data ".1......"data "1111111."''0data ".11111.."data "1.....1."data "1.....1."data "1.....1."data "........"data "1.....1."data "1.....1."data ".11111.."''1data "........"data "......1."data "......1."data "......1."data "........"data "......1."data "......1."data "........"''2data ".11111.."data "......1."data "......1."data "......1."data ".11111.."data "1......."data "1......."data ".11111.."''3data ".11111.."data "......1."data "......1."data "......1."data ".11111.."data "......1."data "......1."data ".11111.."''4data "........"data "1.....1."data "1.....1."data "1.....1."data ".11111.."data "......1."data "......1."data "........"''5data ".11111.."data "1......."data "1......."data "1......."data ".11111.."data "......1."data "......1."data ".11111.."''6data ".11111.."data "1......."data "1......."data "1......."data ".11111.."data "1.....1."data "1.....1."data ".11111.."''7data ".11111.."data "......1."data "......1."data "......1."data "........"data "......1."data "......1."data "........"''8data ".11111.."data "1.....1."data "1.....1."data "1.....1."data ".11111.."data "1.....1."data "1.....1."data ".11111.."''9data ".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 iend subsub 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 iend sub`
bluatigro
Posts: 559
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: Qbe 3D maze

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#endifDIM shared AS INTEGER winx, winy, bitdepth , nuSCREENINFO winx , winy , bitdepthSCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREENdim shared as ulong upkl,downkl,leftkl,rightkl,backkl,frontklupkl   =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 = 6const hMaze = 6const dMaze = 6function index(x as integer,y as integer,z as integer)as integer  return x + y * (wMaze+1) + z * (wMaze+1) * (hMaze+1)end functiondim shared as integer upno,downno,leftno,rightno,backno,frontnoupno = 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 fillDIM 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 yNEXT xfunction wal( x as integer , y as integer , z as integer ) as integer  return maze( index( x , y , z ) ) = "#"end functionsub box( x1 as integer , y1 as integer _  , x2 as integer , y2 as integer , kl as ulong )  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bfend subsub 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 iend subsub 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 , klend subsub 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 ifend 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  LOOPend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subconst as ulong black = 0const as ulong green = rgb( 0 , 255 , 0 )const as ulong white = rgb( 255 , 255 , 255 )dim as string in printprintprint "  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 ] ? >" ; inrandomize cint( val( in ) )createMaze()dim as integer x = 1 , y = 1 , z = 1 , zettennu = 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"drawMazetext winx / 2 , winy / 2 - 200 , "game" _, 30 , whitetext winx / 2 , winy / 2 + 200 , "over" _, 30 , whitetext winx / 2 , winy - 50 , " push return " _, 5 , green , 0sleep`

Code: Select all

`dim shared as integer letterpart( 40 , 7 ) dim as integer j , k const as string letters = "abcdefghijklmnopqrstuvwxyz0123456789[]="dim as string qfor 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 jnext i''adata "...1...."data "..111..."data ".1...1.."data "1.....1."data "1111111."data "1.....1."data "1.....1."data "1.....1."''bdata "1111...."data "1...1..."data "1....1.."data "1....1.."data "111111.."data "1.....1."data "1.....1."data "111111.."''cdata "..111..."data ".1...1.."data "1.....1."data "1......."data "1......."data "1.....1."data ".1...1.."data "..111..."''ddata "11111..."data "1....1.."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1....1.."data "11111..."''edata "1111111."data "1.....1."data "1......."data "1......."data "111111.."data "1......."data "1.....1."data "1111111."''fdata "1111111."data "1.....1."data "1......."data "1......."data "111111.."data "1......."data "1......."data "1......."''gdata "..111..."data ".1...1.."data "1.....1."data "1......."data "1...111."data "1.....1."data ".1...1.."data "..111..."''hdata "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1111111."data "1.....1."data "1.....1."data "1.....1."''idata "..111..."data "...1...."data "...1...."data "...1...."data "...1...."data "...1...."data "...1...."data "..111..."''jdata "..111..."data "...1...."data "...1...."data "...1...."data "...1...."data "1..1...."data "1..1...."data ".11...."''kdata "1......."data "1.....1."data "1....1.."data "1...1..."data "1111...."data "1...1..."data "1....1.."data "1.....1."''ldata "1......."data "1......."data "1......."data "1......."data "1......."data "1......."data "1......."data "1111111."''mdata "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."''ndata "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."''odata "..111..."data ".1...1.."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data ".1...1.."data "..111..."''pdata "11111..."data "1....1.."data "1.....1."data "1....1.."data "11111..."data "1.....,."data "1......."data "1......."''qdata "..111..."data ".1...1.."data "1.....1."data "1.....1."data "1..1..1."data "1...1.1."data ".1...1.."data "..111.1."''rdata "11111..."data "1....1.."data "1.....1."data "1....1.."data "111111.."data "1...1..."data "1....1.."data "1.....1."''sdata "..111..."data ".1...1.."data "1.....1."data "1......."data ".11111.."data "......1."data "1.....1."data ".11111.."''tdata "1111111."data "1..1..1."data "...1...."data "...1...."data "...1...."data "...1...."data "...1...."data "..111..."''udata "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data ".11111.."''vdata "1.....1."data "1.....1."data "1.....1."data "1.....1."data "1.....1."data ".1...1.."data "..1.1..."data "...1...."''wdata "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."''xdata "1.....1."data ".1...1.."data "..1.1.."data "...1...."data "...1...."data "..1.1..."data ".1...1.."data "1.....1."''ydata "1.....1."data ".1...1.."data "..1.1.."data "...1...."data "...1...."data "..1....."data ".1......"data "1......."''zdata "1111111."data ".....1.."data "....1..."data "...1...."data "...1...."data "..1....."data ".1......"data "1111111."''0data ".11111.."data "1.....1."data "1.....1."data "1.....1."data "........"data "1.....1."data "1.....1."data ".11111.."''1data "........"data "......1."data "......1."data "......1."data "........"data "......1."data "......1."data "........"''2data ".11111.."data "......1."data "......1."data "......1."data ".11111.."data "1......."data "1......."data ".11111.."''3data ".11111.."data "......1."data "......1."data "......1."data ".11111.."data "......1."data "......1."data ".11111.."''4data "........"data "1.....1."data "1.....1."data "1.....1."data ".11111.."data "......1."data "......1."data "........"''5data ".11111.."data "1......."data "1......."data "1......."data ".11111.."data "......1."data "......1."data ".11111.."''6data ".11111.."data "1......."data "1......."data "1......."data ".11111.."data "1.....1."data "1.....1."data ".11111.."''7data ".11111.."data "......1."data "......1."data "......1."data "........"data "......1."data "......1."data "........"''8data ".11111.."data "1.....1."data "1.....1."data "1.....1."data ".11111.."data "1.....1."data "1.....1."data ".11111.."''9data ".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 iend subconst as ulong transparent = &h1000000sub 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 iend sub`
bluatigro
Posts: 559
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: Qbe 3D maze

update :

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#endifDIM shared AS INTEGER winx, winy, bitdepth , nuSCREENINFO winx , winy , bitdepthSCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREENdim shared as ulong upkl,downkl,leftkl,rightkl,backkl,frontklupkl   =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 = 6const hMaze = 6const dMaze = 6function index(x as integer,y as integer,z as integer)as integer  return x + y * (wMaze+1) + z * (wMaze+1) * (hMaze+1)end functiondim shared as integer upno,downno,leftno,rightno,backno,frontnoupno = 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 fillDIM 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 yNEXT xfunction wal( x as integer , y as integer , z as integer ) as integer  return maze( index( x , y , z ) ) = "#"end functionsub box( x1 as integer , y1 as integer _  , x2 as integer , y2 as integer , kl as ulong )  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bfend subsub 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 iend subsub 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 , klend subsub 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 ifend 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  LOOPend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subconst as ulong black = 0const as ulong green = rgb( 0 , 255 , 0 )const as ulong white = rgb( 255 , 255 , 255 )dim as string in printprintprint "  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 ] ? >" ; inrandomize cint( val( in ) )createMaze()dim as integer x = 1 , y = 1 , z = 1 , zettennu = 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"drawMazetext winx / 2 , winy / 2 - 170 , "game" _, 30 , whitetext winx / 2 , winy / 2 + 170 , "over" _, 30 , whitetext winx / 2 , winy - 50 , " push return " _, 5 , green , 0sleep `
bluatigro
Posts: 559
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: Qbe 3D maze

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#endifDIM shared AS INTEGER winx, winy, bitdepth , nuSCREENINFO winx , winy , bitdepthSCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREENdim shared as ulong leftkl,rightkl,backkl,frontklleftkl  = rgb(   0 , 255 ,   0 )backkl  = rgb( 255 , 255 ,   0 )frontkl = rgb(   0 ,   0 , 255 )rightkl = rgb( 255 ,   0 ,   0 )const wMaze = 10const hMaze = 10function index( x as integer , y as integer ) as integer  return x + y * ( wMaze + 1 ) end functiondim shared as integer leftno , rightno , backno , frontnoleftno = index( -1 , 0 )rightno = index( 1 , 0 )backno = index( 0 , -1 )frontno = index( 0 , 1 )dim shared as integer movetel''  make array and fillDIM 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 yNEXT xsub box( x1 as integer , y1 as integer _  , x2 as integer , y2 as integer , kl as ulong )  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bfend subsub 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 iend subsub 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 , klend subsub 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 ifend 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  LOOPend subsub 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 = hklend subsub 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 = hklend subconst as ulong black = 0const as ulong cyan = rgb( 0 , 255 , 255 )const as ulong white = rgb( 255 , 255 , 255 )dim as string in printprintprintprintprintprintprintprint "      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 ] ? >" ; inrandomize cint( val( in ) )createMaze()dim as integer x = 1 , y = 1 , zettennu = 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"clsdrawMazetext winx / 2 , winy / 2 - 120 , "game" _, 20 , whitetext winx / 2 , winy / 2 + 120 , "over" _, 20 , whiteif x = wMaze - 1 and y = hMaze - 1 then  text winx / 2 , winy / 2 _  , "you fount the gold" , 5 , whiteelse  text winx / 2 , winy / 2 _  , "you quited" , 5 , whiteend iftext winx / 2 , winy - 50 _, " push return " _, 3 , cyansleep `
bluatigro
Posts: 559
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: Qbe 3D maze

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#endifDIM shared AS INTEGER winx, winy, bitdepth , nuSCREENINFO winx , winy , bitdepthSCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREENdim shared as ulong leftkl,rightkl,backkl,frontklleftkl  = rgb(   0 , 255 ,   0 )backkl  = rgb( 255 , 255 ,   0 )frontkl = rgb(   0 ,   0 , 255 )rightkl = rgb( 255 ,   0 ,   0 )const wMaze = 10const hMaze = 10function index( x as integer , y as integer ) as integer  return x + y * ( wMaze + 1 ) end functiondim shared as integer leftno , rightno , backno , frontnoleftno = index( -1 , 0 )rightno = index( 1 , 0 )backno = index( 0 , -1 )frontno = index( 0 , 1 )dim shared as integer movetel''  make array and fillDIM 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 yNEXT xdim shared as integer sol( index( wMaze , hMaze ) ) , cheatfunction 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 uitend functionfunction 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 uitend functionfunction 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 uitend functionsub box( x1 as integer , y1 as integer _  , x2 as integer , y2 as integer , kl as ulong )  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bfend subsub 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 iend subsub 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 , klend subconst 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 ifend 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  LOOPend subsub 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 = hklend subsub 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 = hklend subconst as ulong black = 0const as ulong cyan = rgb( 0 , 255 , 255 )const as ulong white = rgb( 255 , 255 , 255 )dim as string in printprintprintprintprintprintprintprint "      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 ] ? >" ; inrandomize cint( val( in ) )createMaze()solve( 1 , 1 )dim as integer x = 1 , y = 1 , zettennu = 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"clsdrawMazetext winx / 2 , winy / 2 - 120 , "game" _, 20 , whitetext winx / 2 , winy / 2 + 120 , "over" _, 20 , whiteif x = wMaze - 1 and y = hMaze - 1 then  text winx / 2 , winy / 2 _  , "you fount the gold" , 5 , whiteelse  text winx / 2 , winy / 2 _  , "you quited" , 5 , whiteend iftext winx / 2 , winy - 50 _, " push return " _, 3 , cyan , 0sleep `
bluatigro
Posts: 559
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: Qbe 3D maze

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#endifDIM shared AS INTEGER winx, winy, bitdepth , nuSCREENINFO winx , winy , bitdepthSCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREENdim shared as ulong upkl,downkl,leftkl,rightkl,backkl,frontklupkl   =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 = 6const hMaze = 6const dMaze = 6function index(x as integer,y as integer,z as integer)as integer  return x + y * (wMaze+1) + z * (wMaze+1) * (hMaze+1)end functiondim shared as integer upno,downno,leftno,rightno,backno,frontnoupno = 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 fillDIM 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 yNEXT xfunction wal( x as integer , y as integer , z as integer ) as integer  return maze( index( x , y , z ) ) = "#"end functionsub box( x1 as integer , y1 as integer _  , x2 as integer , y2 as integer , kl as ulong )  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bfend subsub 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 iend subsub 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 , klend subsub 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 ifend 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  LOOPend subfunction 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 uitend functionfunction 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 uitend functionfunction 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 0end functionsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subsub 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 = hklend subconst as ulong black = 0const 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 printprintprintprintprintprintprintprint "      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 ] ? >" ; inrandomize cint( val( in ) )createMaze()dim as integer x = 1 , y = 1 , z = 1 , zetten , dummydummy = 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"drawMazetext winx / 2 , winy / 2 - 120 , "game" _, 20 , whitetext winx / 2 , winy / 2 + 120 , "over" _, 20 , whiteif x = wMaze - 1 and y = hMaze - 1 and z = dMaze - 1 then  text winx / 2 , winy / 2 _  , "you fount the gold" , 5 , whiteelse  text winx / 2 , winy / 2 _  , "you quited" , 5 , whiteend iftext winx / 2 , winy - 50 _, " push return " _, 3 , green , 0sleep `
bluatigro
Posts: 559
Joined: Apr 25, 2012 10:35
Location: netherlands

### Re: Qbe 3D maze

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,frontklleftkl  = rgb(   0 , 255 ,   0 )backkl  = rgb( 255 , 255 ,   0 )frontkl = rgb(   0 ,   0 , 255 )rightkl = rgb( 255 ,   0 ,   0 )const wMaze = 10const hMaze = 10function index( x as integer , y as integer ) as integer  return x + y * ( wMaze + 1 ) end functiondim shared as integer leftno , rightno , backno , frontnoleftno = index( -1 , 0 )rightno = index( 1 , 0 )backno = index( 0 , -1 )frontno = index( 0 , 1 )dim shared as integer movetel''  make array and fillDIM 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 yNEXT xsub box( x1 as integer , y1 as integer _  , x2 as integer , y2 as integer , kl as ulong )  line ( x1 , y1 ) - ( x2 , y2 ) , kl , bfend subsub 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 iend subsub 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 , klend subsub 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 ifend 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  LOOPend subsub 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 = hklend subsub 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 = hklend subconst as ulong black = 0const as ulong cyan = rgb( 0 , 255 , 255 )const as ulong white = rgb( 255 , 255 , 255 )dim as string in printprintprintprintprintprintprintprint "      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 ] ? >" ; inrandomize cint( val( in ) )createMaze()dim as integer x = 1 , y = 1 , zettennu = 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"clsdrawMazetext winx / 2 , winy / 2 - 120 , "game" _, 10 , whitetext winx / 2 , winy / 2 + 120 , "over" _, 10 , whiteif x = wMaze - 1 and y = hMaze - 1 then  text winx / 2 , winy / 2 _  , "you fount the gold" , 7 , whiteelse  text winx / 2 , winy / 2 _  , "you quited" , 7 , whiteend iftext winx / 2 , winy - 50 _, "push return" _, 5 , cyansleep`

_big_chars.bas

Code: Select all

`'' bluatigro 9 jun 2018'' automatic big textdim 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#endifDIM shared AS INTEGER winx, winy, bitdepth , nuSCREENINFO winx , winy , bitdepthSCREENRES winx , winy , 32 , 2 , FB.GFX_FULLSCREENfor 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 ixnext charsub 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 xend subsub 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 xend sub                                        `