sync on hide mouse randomize timer() autocam off set text font "Arial",1 Level=1 cls set text size 40 center text 320,220,"Generating Textures..." sync gosub MakeStuff cls set text size 40 ink rgb(255,255,255),0 center text 320,220,"Creating level "+str$(Level)+"..." sync mapwidth=20 mapheight=20 boxes=20 enemies=10 dim enemydir(enemies) dim cellwall(mapwidth+1,mapheight+1+10,2) dim cellstatus(mapwidth+1,mapheight+1) dim Sstackx((mapwidth+1)*(mapheight+1)) dim Sstacky((mapwidth+1)*(mapheight+1)) dim cellwallobject(mapwidth+1,mapheight+1+10,2) dim Gold(mapwidth+1,mapheight+1) dim NodeOC(mapwidth+1,mapheight+1) dim Nodestack(mapwidth+1,mapheight+1) dim Openlistx(mapwidth*mapheight) dim Openlisty(mapwidth*mapheight) dim Oparentx(mapwidth*mapheight) dim Oparenty(mapwidth*mapheight) dim ONodeG(mapwidth*mapheight) dim ONodeH(mapwidth*mapheight) dim ONodeF(mapwidth*mapheight) dim Cparentx(mapwidth*mapheight) dim Cparenty(mapwidth*mapheight) dim CNodeG(mapwidth*mapheight) dim CNodeH(mapwidth*mapheight) dim CNodeF(mapwidth*mapheight) dim Closelistx(mapwidth*mapheight) dim Closelisty(mapwidth*mapheight) dim tilecol(mapwidth+1,mapheight+1) dim Stackx1(mapwidth*mapheight) dim Stacky1(mapwidth*mapheight) dim Stackx2(mapwidth*mapheight) dim Stacky2(mapwidth*mapheight) dim Roomx1(mapwidth*mapheight) dim Roomy1(mapwidth*mapheight) dim Roomx2(mapwidth*mapheight) dim Roomy2(mapwidth*mapheight) for x=1 to mapwidth cellwall(x,1,2)=1 cellwall(x,mapheight+1,2)=1 next x for y=1 to mapheight cellwall(1,y,1)=1 cellwall(mapwidth+1,y,1)=1 next y MakeMap(mapwidth,mapheight,5) playerx#=50 playerz#=50 playeryang#=0 pltaryang#=playeryang# startx=rnd(mapwidth-1)+1 starty=rnd(mapheight-1)+1 endx=rnd(mapwidth-1)+1 endy=rnd(mapheight-1)+1 sync rate 0 gosub AStarPathFindermaze sync rate 40 remend cellwall(1,1,2)=2 cellwall(mapwidth,mapheight+1,2)=0 for i=1 to sqrt(mapwidth*mapheight)*2 cellwall(rnd(mapwidth-2)+2,rnd(mapheight-2)+2,rnd(1)+1)=0 next i midhori=rnd(5)+23 sections=rnd(1)+2 for y=21 to midhori if y<midhori then cellwall(mapwidth,y,1)=1 cellwall(mapwidth+1,y,1)=1 next i lastverti=mapwidth-(rnd(7)+5) if sections=2 for x=mapwidth to lastverti step -1 if x<mapwidth then cellwall(x,midhori,2)=1 cellwall(x,midhori+1,2)=1 next x cellwall(lastverti,midhori,1)=2 nextlvlx=lastverti nextlvly=midhori else for x=mapwidth to lastverti step -1 if x<mapwidth then cellwall(x,midhori,2)=1 if x>lastverti then cellwall(x,midhori+1,2)=1 next x for y=midhori to mapheight+10 if y>midhori then cellwall(lastverti+1,y,1)=1 cellwall(lastverti,y,1)=1 next x cellwall(lastverti,mapheight+11,2)=2 nextlvlx=lastverti nextlvly=mapheight+10 endif create bitmap 3,mapwidth*5+10,(mapheight+10)*5+10 gosub Displaymap flip bitmap 3 get image 10,5,5,mapwidth*5+6,(mapheight+10)*5+6 set current bitmap 0 delete bitmap 3 backdrop on color backdrop rgb(55,55,55) fog on fog color rgb(55,55,55) fog distance 500 gosub Makemaze3D make object sphere 1,5 hide object 1 set object collision to spheres 1 make object collision box 1,-5,-20,-5,5,5,5,0 walkpos#=0 Goldcoll=0 mapscrollU#=0 mapscrollV#=0 wayoutpos#=0 do set cursor 0,0 ink rgb(255,255,255),0 print "Gold Collected: ";goldcoll print "Level: ";level print "FPS: ";screen fps() if upkey()=1 then playerx#=newxvalue(playerx#,playeryang#,5) : playerz#=newzvalue(playerz#,playeryang#,5) : `walkpos#=walkpos#+5 if downkey()=1 then playerx#=newxvalue(playerx#,playeryang#,-5) : playerz#=newzvalue(playerz#,playeryang#,-5) : `walkpos#=walkpos#-5 if rightkey()=1 then pltaryang#=pltaryang#+3 if leftkey()=1 then pltaryang#=pltaryang#-3 gosub HandleEnemies playeryang#=curveangle(playeryang#,pltaryang#,5) position camera playerx#,50,playerz# position object 1,playerx#,50,playerz# tileonx=playerx#/100+1 tileony=playerz#/100+1 if object collision(1,0)>1 playerx#=playerx#-get object collision x() playerz#=playerz#-get object collision z() position camera playerx#,50,playerz# endif for i=1 to golds if object exist(i+3000)=1 yang#=object angle y(i+3000) yrotate object i+3000,wrapvalue(yang#+1) position object i+3000,object position x(i+3000),cos(yang#)*5+15,object position z(i+3000) endif next i if tileonx>=0 and tileony>=0 and tileonx<=mapwidth and tileony<=mapheight if gold(tileonx,tileony)>0 goldcoll=goldcoll+1 delete object gold(tileonx,tileony)+3000 gold(tileonx,tileony)=0 goldfog=goldfog+70 if goldfog>200 then goldfog=200 endif endif if goldfog>0 goldfog=goldfog-2 fog color rgb(goldfog+55,goldfog+55,55) color backdrop rgb(goldfog+55,goldfog+55,55) endif if death=1 then gosub Death if tileonx=nextlvlx and tileony=nextlvly gosub nextlevel endif Uscroll#=((playerx#/(mapwidth*100-10))-0.15) Vscroll#=1-((playerz#/((mapheight+10)*100-10)))-0.1 oldUscroll#=Uscroll# oldVscroll#=Vscroll# if Uscroll#<0 then Uscroll#=0 if Vscroll#<0.00416 then Vscroll#=0.00416 if Uscroll#>0.698437 then Uscroll#=0.698437 if Vscroll#>0.793 then Vscroll#=0.793 scroll object texture 2,Uscroll#-mapscrollU#,Vscroll#-mapscrollV# zrotate object 2,playeryang# mapscrollU#=Uscroll# mapscrollV#=Vscroll# Udiff#=(oldUscroll#-Uscroll#)*33.333333 Vdiff#=(oldVscroll#-Vscroll#)*50 angle#=wrapvalue((atanfull(Udiff#,Vdiff#)-90)+playeryang#) distance#=sqrt(Udiff#^2+Vdiff#^2) psxdiff#=cos(angle#)*distance#/2 psydiff#=sin(angle#)*distance#/2 position object 3,-13+psxdiff#,-8+psydiff#,20 print mapscrollU#;",";mapscrollV# yrotate camera playeryang# sync loop end MakeStuff: create bitmap 1,640,480 gridwidth=300 gridheight=300 dim grid(gridwidth,gridheight) startvalue=70 maxvalue=100 minvalue=50 variation=30 if variation>abs(maxvalue-minvalue) then variation=abs(maxvalue-minvalue) for x=1 to gridwidth for y=1 to gridheight grid(x,y)=startvalue next y next x for i=1 to gridwidth*gridheight/10 feild=abs(maxvalue-minvalue) x=rnd(gridwidth) y=rnd(gridheight) value=rnd(feild) grid(x,y)=value next i for x=1 to gridwidth step 1 for y=1 to gridheight otherpoints=0 totalofothers=0 if x>0 value=grid(x-1,y) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if y>0 value=grid(x,y-1) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if x<gridwidth value=grid(x+1,y) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if y<gridheight value=grid(x,y+1) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if otherpoints>0 o#=otherpoints t#=totalofothers average#=t#/o# else average#=startvalue endif gridvalue=average#+(rnd(variation)-(variation/2)) if gridvalue<minvalue then gridvalue=minvalue if gridvalue>maxvalue then gridvalue=maxvalue grid(x,y)=gridvalue if x<150 and y<150 gv#=gridvalue rg#=gv#/100*90 ink rgb(rg#,rg#,gridvalue),0 endif if x<150 and y>=150 ink rgb(60,60,gridvalue),0 endif if x>=150 and y<150 gv#=gridvalue r#=gv#*1.25 ink rgb(r#,gridvalue,gridvalue/2),0 endif if x>=150 and y>=150 gv#=gridvalue r#=gv#*0.5 g#=gv#*0.4 b#=gv#*1.0 ink rgb(r#,g#,b#),0 endif dot x,y next y next x ink rgb(95,95,95),0 xstart=0 for y=0 to 300 step 25 if xstart=0 then xstart=25 else xstart=0 for x=xstart to 300 step 50 for yno2=y to y+25 grey=rnd(20)+80 : ink rgb(grey,grey,grey),0 dot x,yno2 grey=rnd(20)+80 : ink rgb(grey,grey,grey),0 dot x+1,yno2 next yno2 grey=rnd(20)+80 : ink rgb(grey,grey,grey),0 dot x+2,y+2 grey=rnd(20)+80 : ink rgb(grey,grey,grey),0 dot x+2,y+24 grey=rnd(20)+80 : ink rgb(grey,grey,grey),0 dot x+49,y+2 grey=rnd(20)+80 : ink rgb(grey,grey,grey),0 dot x+49,y+24 next x for x=0 to 300 grey=rnd(20)+80 : ink rgb(grey,grey,grey),0 dot x,y grey=rnd(20)+80 : ink rgb(grey,grey,grey),0 dot x,y+1 next x next y undim grid(gridwidth,gridheight) get image 1,0,0,300,300 get image 3,0,0,150,150 cls gridwidth=256 gridheight=256 dim grid(gridwidth,gridheight) startvalue=50 maxvalue=100 minvalue=0 variation=50 if variation>abs(maxvalue-minvalue) then variation=abs(maxvalue-minvalue) for x=1 to gridwidth for y=1 to gridheight grid(x,y)=startvalue next y next x for i=1 to gridwidth*gridheight/10 feild=abs(maxvalue-minvalue) x=rnd(gridwidth) y=rnd(gridheight) value=rnd(feild) grid(x,y)=value next i for x=1 to gridwidth step 1 for y=1 to gridheight otherpoints=0 totalofothers=0 if x>0 value=grid(x-1,y) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if y>0 value=grid(x,y-1) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if x<gridwidth value=grid(x+1,y) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if y<gridheight value=grid(x,y+1) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if otherpoints>0 o#=otherpoints t#=totalofothers average#=t#/o# else average#=startvalue endif gridvalue=average#+(rnd(variation)-(variation/2)) if gridvalue<minvalue then gridvalue=minvalue if gridvalue>maxvalue then gridvalue=maxvalue grid(x,y)=gridvalue gv#=gridvalue rg#=gv#*0.9 ink rgb(rg#,rg#,gridvalue),0 dot x,y next y next x undim grid(gridwidth,gridheight) get image 4,0,0,256,256 cls gridwidth=256 gridheight=256 dim grid(gridwidth,gridheight) startvalue=70 maxvalue=100 minvalue=70 variation=30 if variation>abs(maxvalue-minvalue) then variation=abs(maxvalue-minvalue) for x=1 to gridwidth for y=1 to gridheight grid(x,y)=startvalue next y next x for i=1 to gridwidth*gridheight/10 feild=abs(maxvalue-minvalue) x=rnd(gridwidth) y=rnd(gridheight) value=rnd(feild) grid(x,y)=value next i for x=1 to gridwidth-1 for y=1 to gridheight-1 otherpoints=0 totalofothers=0 if y>0 value=grid(x,y-1) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if otherpoints>0 o#=otherpoints t#=totalofothers average#=t#/o# else average#=startvalue endif gridvalue=average#+(rnd(variation)-(variation/2)) if gridvalue<minvalue then gridvalue=minvalue if gridvalue>maxvalue then gridvalue=maxvalue grid(x,y)=gridvalue gv#=gridvalue r#=gv#*1.5 for tx=0 to 256 step 32 if x>tx and x<=tx+32 basex#=x-tx endif next tx if basex#<16 multiply#=(basex#+12)/16 else multiply#=((32-basex#)+12)/16 endif if multiply#>1 then multiply#=1 ink rgb(r#*multiply#,gv#*multiply#,0),0 dot x,y next y next x ink rgb(100,50,0),0 for x=0 to 256 step 32 line x,1,x,256 next x ink rgb(70,40,0),0 cx=208 circle cx,128,10 circle cx+1,128,10 circle cx,129,10 circle cx-1,128,10 circle cx,127,10 circle cx,128,11 circle cx+1,128,11 circle cx,129,11 circle cx-1,128,11 circle cx,127,11 circle cx,128,9 circle cx+1,128,9 circle cx,129,9 circle cx-1,128,9 circle cx,127,9 ink rgb(100,70,0),0 circle cx,128,10 undim grid(gridwidth,gridheight) get image 6,0,0,256,256 cls gridwidth=256 gridheight=256 dim grid(gridwidth,gridheight) startvalue=70 maxvalue=100 minvalue=70 variation=30 if variation>abs(maxvalue-minvalue) then variation=abs(maxvalue-minvalue) for x=1 to gridwidth for y=1 to gridheight grid(x,y)=startvalue next y next x for i=1 to gridwidth*gridheight/10 feild=abs(maxvalue-minvalue) x=rnd(gridwidth) y=rnd(gridheight) value=rnd(feild) grid(x,y)=value next i for x=1 to gridwidth-1 for y=1 to gridheight-1 otherpoints=0 totalofothers=0 if y>0 value=grid(x,y-1) if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value endif if otherpoints>0 o#=otherpoints t#=totalofothers average#=t#/o# else average#=startvalue endif gridvalue=average#+(rnd(variation)-(variation/2)) if gridvalue<minvalue then gridvalue=minvalue if gridvalue>maxvalue then gridvalue=maxvalue grid(x,y)=gridvalue gv#=gridvalue r#=gv#*1.6 g#=gv#*1.2 for tx=0 to 256 step 32 if x>tx and x<=tx+32 basex#=x-tx endif next tx if basex#<16 multiply#=(basex#+12)/16 else multiply#=((32-basex#)+12)/16 endif if multiply#>1 then multiply#=1 ink rgb(r#*multiply#,g#*multiply#,0),0 dot x,y next y next x ink rgb(100,50,0),0 for x=0 to 256 step 32 line x,1,x,256 next x for x=1 to 32 for y=1 to gridheight gridvalue=grid(x,y) gv#=gridvalue r#=gv#*1.6 g#=gv#*1.2 for tx=0 to 256 step 32 if x>tx and x<=tx+32 basex#=x-tx endif next tx if basex#<16 multiply#=(basex#+12)/16 else multiply#=((32-basex#)+12)/16 endif if multiply#>1 then multiply#=1 ink rgb(r#*multiply#,g#*multiply#,0),0 dot y,x+224 dot y,x next y next x undim grid(gridwidth,gridheight) get image 7,0,0,256,256 cls ink rgb(255,255,255),0 for i=1 to 1000 dot rnd(128),rnd(128) next i blur bitmap 1,1 get image 2,0,0,128,128 ink 255,0 box 0,0,128,128 ink rgb(0,0,55),0 ellipse 64,96,25,30 ellipse 32,32,25,13 ellipse 96,32,25,13 circle 32,32,1 circle 96,32,1 get image 5,0,0,128,128 cls set text size 20 set text to bold ink rgb(150,0,0),0 text 0,0,"WAY OUT" get image 8,0,0,78,16 set current bitmap 0 return AStarPathFindermaze: Opens=1 Closed=0 NodeOC(startx,starty)=1 NodeStack(startx,starty)=Opens Openlistx(Opens)=startx Openlisty(Opens)=starty ONodeG(Opens)=0 ONodeH(Opens)=ManhattanHeuristic(startx,starty,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=0 OParenty(Opens)=0 NoPath=0 endfound=0 endloop=0 Node=1 Nodex=startx Nodey=starty repeat Closed=Closed+1 NodeOC(nodex,nodey)=2 NodeStack(nodex,nodey)=Closed Closelistx(Closed)=nodex Closelisty(Closed)=nodey CNodeG(Closed)=ONodeG(Node) CNodeH(Closed)=ONodeH(Node) CNodeF(Closed)=ONodeF(Node) CParentx(Closed)=OParentx(Node) CParenty(Closed)=OParenty(Node) ONodeG(Node)=-1 ONodeH(Node)=-1 ONodeF(Node)=-1 OParentx(Node)=-1 OParenty(Node)=-1 if nodex=endx and nodey=endy then endfound=1 x=nodex : y=nodey-1 if Cellwall(nodex,nodey,2)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=ManhattanHeuristic(x,y,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey-1 if Cellwall(nodex+1,nodey,1)=0 and Cellwall(nodex,nodey,2)=0 and Cellwall(nodex+1,nodey-1,1)=0 and Cellwall(nodex+1,nodey,2)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=ManhattanHeuristic(x,y,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey if Cellwall(nodex+1,nodey,1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=ManhattanHeuristic(x,y,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex+1 : y=nodey+1 if Cellwall(nodex+1,nodey,1)=0 and Cellwall(nodex,nodey+1,2)=0 and Cellwall(nodex+1,nodey+1,1)=0 and Cellwall(nodex+1,nodey+1,2)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=ManhattanHeuristic(x,y,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex : y=nodey+1 if Cellwall(nodex,nodey+1,2)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=ManhattanHeuristic(x,y,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey+1 if Cellwall(nodex,nodey,1)=0 and Cellwall(nodex,nodey+1,2)=0 and Cellwall(nodex,nodey+1,1)=0 and Cellwall(nodex-1,nodey+1,2)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=ManhattanHeuristic(x,y,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey if Cellwall(nodex,nodey,1)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=10+CNodeG(closed) ONodeH(Opens)=ManhattanHeuristic(x,y,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+10<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+10 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif x=nodex-1 : y=nodey-1 if Cellwall(nodex,nodey,1)=0 and Cellwall(nodex,nodey,2)=0 and Cellwall(nodex,nodey-1,1)=0 and Cellwall(nodex-1,nodey,2)=0 if NodeOC(x,y)=0 NodeOC(x,y)=1 Opens=Opens+1 NodeStack(x,y)=Opens Openlistx(Opens)=x Openlisty(Opens)=y ONodeG(Opens)=14+CNodeG(closed) ONodeH(Opens)=ManhattanHeuristic(x,y,endx,endy)*10 ONodeF(Opens)=ONodeG(Opens)+ONodeH(Opens) OParentx(Opens)=nodex OParenty(Opens)=nodey else if NodeOC(x,y)=1 Stack=NodeStack(x,y) if CNodeG(Closed)+14<ONodeG(Stack) ONodeG(Stack)=CNodeG(Closed)+14 ONodeF(Stack)=ONodeG(Stack)+ONodeH(Stack) OParentx(Stack)=nodex OParenty(Stack)=nodey endif endif endif endif Node=FindlowestOpen(Opens) Nodex=Openlistx(Node) Nodey=Openlisty(Node) if Node=0 and endfound=0 then noPath=1 until NoPath=1 or endfound=1 if NoPath=0 nodex=endx nodey=endy repeat Gold(nodex,nodey)=1 Stack=NodeStack(nodex,nodey) nodex=CParentx(Stack) nodey=CParenty(Stack) until nodex=startx and nodey=starty else cls ink rgb(255,0,0),0 Print "Severe Exception!!" end endif return DisplayMap: cls rgb(255,255,255) ink 0,0 for x=0 to mapwidth+1 for y=0 to mapheight+1+10 if cellwall(x,y,1)=1 then line x*5,y*5,x*5,y*5+5 if cellwall(x,y,2)=1 then line x*5,y*5,x*5+5,y*5 if cellwall(x,y,1)=2 ink rgb(255,255,0),0 line x*5,y*5,x*5,y*5+5 ink 0,0 endif if cellwall(x,y,2)=2 ink rgb(255,255,0),0 line x*5,y*5,x*5+5,y*5 ink 0,0 endif next y next x return Makemaze3D: make matrix 1,mapwidth*100,(mapheight+10)*100,mapwidth,mapheight+10 prepare matrix texture 1,1,2,2 fill matrix 1,0,1 make matrix 2,mapwidth*100,(mapheight+10)*100,mapwidth,mapheight+10 prepare matrix texture 2,4,1,1 position matrix 2,0,90,0 fill matrix 2,0,1 maxwalls=0 for x=0 to mapwidth+1 for y=0 to mapheight+1+10 if cellwall(x,y,1)=1 or cellwall(x,y,1)=2 maxwalls=maxwalls+1 cellwallobject(x,y,1)=maxwalls+100 make object box maxwalls+100,110,110,10 if cellwall(x,y,1)=1 then texture object maxwalls+100,3 else texture object maxwalls+100,6 yrotate object maxwalls+100,90 position object maxwalls+100,x*100-100,50,y*100-50 make object collision box maxwalls+100,-5,-50,-50,5,50,50,0 endif if cellwall(x,y,2)=1 or cellwall(x,y,2)=2 maxwalls=maxwalls+1 cellwallobject(x,y,2)=maxwalls+100 make object box maxwalls+100,108,110,10 if cellwall(x,y,2)=1 then texture object maxwalls+100,3 else texture object maxwalls+100,6 position object maxwalls+100,x*100-50,50,y*100-100 make object collision box maxwalls+100,-50,-50,-5,50,50,5,0 endif if x>0 and y>0 and x<mapwidth+1 and y<mapheight+1 img=tilecol(x,y) set matrix tile 1,x-1,y-1,img endif next y next x update matrix 1 maxwalls=maxwalls+1 make object plain 5,50,12 texture object 5,8 ghost object on 5 position object 5,mapwidth*100-50,78,mapheight*100 make object plain 2,5,5 texture object 2,10 scale object texture 2,0.3,0.2 scroll object texture 2,0,0 ghost object on 2 position object 2,-13,-8,20 lock object on 2 make object sphere 3,0.2 color object 3,rgb(255,0,0) lock object on 3 golds=0 for x=1 to mapwidth for y=1 to mapheight if Gold(x,y)=1 golds=golds+1 make object cube golds+3000,10 color object golds+3000,rgb(255,235,0) ghost object on golds+3000 fade object golds+3000,200 position object golds+3000,x*100-50,15,y*100-50 Gold(x,y)=golds endif next y next x for i=1 to enemies repeat enemyx#=(rnd(mapwidth)*100)+50 enemyz#=(rnd(mapheight)*100)+50 until (playerx#-enemyx#)^2+(playerz#-enemyz#)^2>250000 make object cube 3100+i,30 texture object 3100+i,5 fade object 3100+i,0 position object 3100+i,enemyx#,70,enemyz# next i for i=1 to boxes repeat boxx=rnd(mapwidth-1)+1 boxy=rnd(mapheight-1)+1 rightplace=0 if cellwall(boxx,boxy,1)=1 and cellwall(boxx,boxy-1,1)=1 and cellwall(boxx,boxy+1,1)=1 and cellwall(boxx+1,boxy,1)=0 then rightplace=1 : rem left if cellwall(boxx,boxy,2)=1 and cellwall(boxx-1,boxy,2)=1 and cellwall(boxx+1,boxy,2)=1 and cellwall(boxx,boxy+1,2)=0 then rightplace=1 : rem top if cellwall(boxx+1,boxy,1)=1 and cellwall(boxx+1,boxy-1,1)=1 and cellwall(boxx+1,boxy+1,1)=1 and cellwall(boxx,boxy,1)=0 then rightplace=1 : rem right if cellwall(boxx,boxy+1,2)=1 and cellwall(boxx-1,boxy+1,2)=1 and cellwall(boxx+1,boxy+1,2)=1 and cellwall(boxx,boxy,2)=0 then rightplace=1 : rem bottom until rightplace=1 and gold(boxx,boxy)=0 make object cube 3200+i,50 make object collision box 3200+i,-25,-25,-25,25,25,25,0 texture object 3200+i,7 position object 3200+i,boxx*100-50,25,boxy*100-50 next i return HandleEnemies: for i=1 to enemies object=3100+i oldenemyx#=object position x(object) oldenemyz#=object position z(object) if (playerx#-oldenemyx#)^2+(playerz#-oldenemyz#)^2<250000 point object object,playerx#,70,playerz# move object object,1.5 newenemyx#=object position x(object) newenemyz#=object position z(object) if object collision(object,0)>1 ghost object on object move object object,-0.75 else ghost object off object endif if newenemyx#>mapwidth*100-50 then position object object,mapwidth*100-50,70,newenemyz# : enemydir(i)=rnd(360) if newenemyz#>mapheight*100-50 then position object object,newenemyx#,70,mapheight*100-50 : enemydir(i)=rnd(360) if newenemyx#<50 then position object object,50,70,newenemyz# : enemydir(i)=rnd(360) if newenemyz#<50 then position object object,newenemyx#,70,50 : enemydir(i)=rnd(360) enemyx#=object position x(object) enemyz#=object position z(object) if (enemyx#-playerx#)^2+(enemyz#-playerz#)^2<900 death=1 endif else yrotate object object,enemydir(i) move object object,1.5 newenemyx#=object position x(object) newenemyz#=object position z(object) if object collision(object,0)>1 and (playerx#-oldenemyx#)^2+(playerz#-oldenemyz#)^2<350000 ghost object on object move object object,-0.75 else ghost object off object endif if newenemyx#>mapwidth*100-50 then position object object,mapwidth*100-50,70,newenemyz# : enemydir(i)=rnd(360) if newenemyz#>mapheight*100-50 then position object object,newenemyx#,70,mapheight*100-50 : enemydir(i)=rnd(360) if newenemyx#<50 then position object object,50,70,newenemyz# : enemydir(i)=rnd(360) if newenemyz#<50 then position object object,newenemyx#,70,50 : enemydir(i)=rnd(360) endif next i return Death: for i=1 to enemies delete object i+3100 next i sync fog distance 200 fog color rgb(200,0,0) for i=100 to 0 step -5 fog distance i sync next i for i=200 to 0 step -2 fog color rgb(i,0,0) sync next i repeat ink rgb(255,0,0),0 set text size 100 center text 320,100,"You Lose!" ink rgb(200,0,0),0 set text size 20 center text 320,200,"They got you!" center text 320,230,"Play level again?" center text 320,255,"[Y]es / [N]o" sync until inkey$()="y" or inkey$()="n" or spacekey()=1 if inkey$()="n" then end fog color rgb(55,55,55) fog distance 500 Goldcoll=0 playerx#=50 playerz#=50 playeryang#=0 pltaryang#=playeryang# for i=1 to enemies repeat enemyx#=(rnd(mapwidth)*100)+50 enemyz#=(rnd(mapheight)*100)+50 until (playerx#-enemyx#)^2+(playerz#-enemyz#)^2>250000 make object cube 3100+i,30 texture object 3100+i,5 fade object 3100+i,0 position object 3100+i,enemyx#,70,enemyz# next i death=0 return NextLevel: Level=Level+1 cls set text size 40 center text 320,220,"Creating level "+str$(Level)+"..." sync undim enemydir(enemies) undim cellwall(mapwidth+1,mapheight+1+10,2) undim cellstatus(mapwidth+1,mapheight+1) undim Sstackx((mapwidth+1)*(mapheight+1)) undim Sstacky((mapwidth+1)*(mapheight+1)) undim cellwallobject(mapwidth+1,mapheight+1+10,2) undim Gold(mapwidth+1,mapheight+1) undim NodeOC(mapwidth+1,mapheight+1) undim Nodestack(mapwidth+1,mapheight+1) undim Openlistx(mapwidth*mapheight) undim Openlisty(mapwidth*mapheight) undim Oparentx(mapwidth*mapheight) undim Oparenty(mapwidth*mapheight) undim ONodeG(mapwidth*mapheight) undim ONodeH(mapwidth*mapheight) undim ONodeF(mapwidth*mapheight) undim Cparentx(mapwidth*mapheight) undim Cparenty(mapwidth*mapheight) undim CNodeG(mapwidth*mapheight) undim CNodeH(mapwidth*mapheight) undim CNodeF(mapwidth*mapheight) undim Closelistx(mapwidth*mapheight) undim Closelisty(mapwidth*mapheight) undim tilecol(mapwidth+1,mapheight+1) undim Stackx1(mapwidth*mapheight) undim Stacky1(mapwidth*mapheight) undim Stackx2(mapwidth*mapheight) undim Stacky2(mapwidth*mapheight) undim Roomx1(mapwidth*mapheight) undim Roomy1(mapwidth*mapheight) undim Roomx2(mapwidth*mapheight) undim Roomy2(mapwidth*mapheight) for i=2 to 3300 if object exist(i)=1 then delete object i next i delete matrix 1 delete matrix 2 fog off backdrop off dim enemydir(enemies) mapwidth=20 mapheight=20 dim cellwall(mapwidth+1,mapheight+1+10,2) dim cellstatus(mapwidth+1,mapheight+1) dim Sstackx((mapwidth+1)*(mapheight+1)) dim Sstacky((mapwidth+1)*(mapheight+1)) dim cellwallobject(mapwidth+1,mapheight+1+10,2) dim Gold(mapwidth+1,mapheight+1) dim NodeOC(mapwidth+1,mapheight+1) dim Nodestack(mapwidth+1,mapheight+1) dim Openlistx(mapwidth*mapheight) dim Openlisty(mapwidth*mapheight) dim Oparentx(mapwidth*mapheight) dim Oparenty(mapwidth*mapheight) dim ONodeG(mapwidth*mapheight) dim ONodeH(mapwidth*mapheight) dim ONodeF(mapwidth*mapheight) dim Cparentx(mapwidth*mapheight) dim Cparenty(mapwidth*mapheight) dim CNodeG(mapwidth*mapheight) dim CNodeH(mapwidth*mapheight) dim CNodeF(mapwidth*mapheight) dim Closelistx(mapwidth*mapheight) dim Closelisty(mapwidth*mapheight) dim tilecol(mapwidth+1,mapheight+1) dim Stackx1(mapwidth*mapheight) dim Stacky1(mapwidth*mapheight) dim Stackx2(mapwidth*mapheight) dim Stacky2(mapwidth*mapheight) dim Roomx1(mapwidth*mapheight) dim Roomy1(mapwidth*mapheight) dim Roomx2(mapwidth*mapheight) dim Roomy2(mapwidth*mapheight) for x=1 to mapwidth cellwall(x,1,2)=1 cellwall(x,mapheight+1,2)=1 next x for y=1 to mapheight cellwall(1,y,1)=1 cellwall(mapwidth+1,y,1)=1 next y MakeMap(mapwidth,mapheight,5) playerx#=50 playerz#=50 playeryang#=0 pltaryang#=playeryang# mapscrollU#=0 mapscrollV#=0 startx=rnd(mapwidth-1)+1 starty=rnd(mapheight-1)+1 endx=rnd(mapwidth-1)+1 endy=rnd(mapheight-1)+1 sync rate 0 gosub AStarPathFindermaze sync rate 40 cellwall(1,1,2)=2 cellwall(mapwidth,mapheight+1,2)=0 for i=1 to sqrt(mapwidth*mapheight)*2 cellwall(rnd(mapwidth-2)+2,rnd(mapheight-2)+2,rnd(1)+1)=0 next i midhori=rnd(5)+23 sections=rnd(1)+2 for y=21 to midhori if y<midhori then cellwall(mapwidth,y,1)=1 cellwall(mapwidth+1,y,1)=1 next i lastverti=mapwidth-(rnd(7)+5) if sections=2 for x=mapwidth to lastverti step -1 if x<mapwidth then cellwall(x,midhori,2)=1 cellwall(x,midhori+1,2)=1 next x cellwall(lastverti,midhori,1)=2 nextlvlx=lastverti nextlvly=midhori else for x=mapwidth to lastverti step -1 if x<mapwidth then cellwall(x,midhori,2)=1 if x>lastverti then cellwall(x,midhori+1,2)=1 next x for y=midhori to mapheight+10 if y>midhori then cellwall(lastverti+1,y,1)=1 cellwall(lastverti,y,1)=1 next x cellwall(lastverti,mapheight+11,2)=2 nextlvlx=lastverti nextlvly=mapheight+10 endif create bitmap 3,mapwidth*5+10,(mapheight+10)*5+10 gosub Displaymap flip bitmap 3 get image 10,5,6,mapwidth*5+6,(mapheight+10)*5+6 set current bitmap 0 delete bitmap 3 backdrop on color backdrop rgb(55,55,55) fog on fog color rgb(55,55,55) fog distance 500 gosub Makemaze3D return end function MakeMap(mapwidth,mapheight,maxroomsize) Rooms=1 stack=1 Stackx1(stack)=1 Stacky1(stack)=1 Stackx2(stack)=mapwidth+1 Stacky2(stack)=mapheight+1 generateend=0 repeat cls sx1=Stackx1(stack) sy1=Stacky1(stack) sx2=Stackx2(stack) sy2=Stacky2(stack) if sx2-sx1<=maxroomsize or sy2-sy1<=maxroomsize repeat stack=stack-1 sx1=Stackx1(stack) sy1=Stacky1(stack) sx2=Stackx2(stack) sy2=Stacky2(stack) until (sx2-sx1>maxroomsize and sy2-sy1>maxroomsize) or stack=0 if stack=0 then generateend=1 endif if generateend=0 divx=rnd((sx2-sx1)-2)+1+sx1 divy=rnd((sy2-sy1)-2)+1+sy1 for y=sy1 to sy2-1 cellwall(divx,y,1)=1 next y for x=sx1 to sx2-1 cellwall(x,divy,2)=1 next x wallex=rnd(3)+1 `wallex=4 if wallex=1 cellwall(rnd((sx2-divx)-1)+divx,divy,2)=0 : rem Wall 2 cellwall(divx,rnd((sy2-divy)-1)+divy,1)=0 : rem Wall 3 cellwall(rnd((divx-sx1)-1)+sx1,divy,2)=0 : rem Wall 4 endif if wallex=2 cellwall(divx,rnd((divy-sy1)-1)+sy1,1)=0 : rem Wall 1 cellwall(divx,rnd((sy2-divy)-1)+divy,1)=0 : rem Wall 3 cellwall(rnd((divx-sx1)-1)+sx1,divy,2)=0 : rem Wall 4 endif if wallex=3 cellwall(divx,rnd((divy-sy1)-1)+sy1,1)=0 : rem Wall 1 cellwall(rnd((sx2-divx)-1)+divx,divy,2)=0 : rem Wall 2 cellwall(rnd((divx-sx1)-1)+sx1,divy,2)=0 : rem Wall 4 endif if wallex=4 cellwall(divx,rnd((divy-sy1)-1)+sy1,1)=0 : rem Wall 1 cellwall(rnd((sx2-divx)-1)+divx,divy,2)=0 : rem Wall 2 cellwall(divx,rnd((sy2-divy)-1)+divy,1)=0 : rem Wall 3 endif stack=stack-1 : rem Memory stack=stack+1 Stackx1(stack)=sx1 : rem Section 1 Stacky1(stack)=sy1 Stackx2(stack)=divx Stacky2(stack)=divy stack=stack+1 Stackx1(stack)=divx : rem Section 2 Stacky1(stack)=sy1 Stackx2(stack)=sx2 Stacky2(stack)=divy stack=stack+1 Stackx1(stack)=divx : rem Section 3 Stacky1(stack)=divy Stackx2(stack)=sx2 Stacky2(stack)=sy2 stack=stack+1 Stackx1(stack)=sx1 : rem Section 4 Stacky1(stack)=divy Stackx2(stack)=divx Stacky2(stack)=sy2 rem Record rooms Room=Room-1 : rem Memory Roomss=Roomss+1 Roomx1(Rooms)=sx1 : rem Section 1 Roomy1(Rooms)=sy1 Roomx2(Rooms)=divx Roomy2(Rooms)=divy Rooms=Rooms+1 Roomx1(Rooms)=divx : rem Section 2 Roomy1(Rooms)=sy1 Roomx2(Rooms)=sx2 Roomy2(Rooms)=divy Rooms=Rooms+1 Roomx1(Rooms)=divx : rem Section 3 Roomy1(Rooms)=divy Roomx2(Rooms)=sx2 Roomy2(Rooms)=sy2 Rooms=Rooms+1 Roomx1(Rooms)=sx1 : rem Section 4 Roomy1(Rooms)=divy Roomx2(Rooms)=divx Roomy2(Rooms)=sy2 endif until generateend=1 for i=1 to Rooms colour=rnd(3)+1 for x=roomx1(i) to roomx2(i)-1 for y=roomy1(i) to roomy2(i)-1 tilecol(x,y)=colour next y next x next i endfunction function ManhattanHeuristic(startx,starty,endx,endy) returnv=abs(startx-endx)+abs(starty-endy) endfunction returnv function EuclideanHeuristic(startx,starty,endx,endy) returnv=sqrt((startx-endx)^2+abs(starty-endy)^2) endfunction returnv function FindlowestOpen(Opens) cOpen=0 cF=1000000 for i=1 to Opens if ONodeF(i)>-1 if ONodeF(i)<cF cOpen=i cF=ONodeF(i) endif endif next i endfunction cOpen function linebox(x1,y1,x2,y2) line x1,y1,x1,y2 line x1,y2,x2,y2 line x2,y2,x2,y1 line x2,y1,x1,y1 endfunction