Here a rather long source of a 2d topdown randommap coincollecting rpg. Not much has been done but it shows how you can mix different code from this blog into one thing. press t to warp into a new dungeon. click in the applet to enable. move with the cursor keys. Collect health and coins.
Import mojo ' map things ' 1 = wal, 2 = door, 3 = health, 4 = coin, ' 5 = tree, 6 = water, 7 = rock 'map gen part Global mapwidth:Int = 70 Global mapheight:Int= 60 Global sx:Int 'path start x Global sy:Int 'path start y Global ex:Int=mapwidth/2 'path end x Global ey:Int=mapheight/2 'path end y Global monmap:Int[mapwidth][] Global map:Int[mapwidth][] Global olmap:Int[mapwidth][] Global clmap:Int[mapwidth][] Global pmap:Int[mapwidth][] ' this one refreshes maps Global waittime:Int=0 ' scrolling rpg part Const tilewidth:Int=20 Const tileheight:Int=20 Global mapx:Int=0 Global mapy:Int=0 Global mapsx:Int=0 Global mapsy:Int=0 Global showmap:Bool=False Global remakemap:Bool=False Class tiles Field walltile:Image Field rocktile:Image Field groundtile:Image Field moneytile:Image Field pixels:Int[tilewidth*tileheight] Method New() DebugLog "creating images" walltile = CreateImage(tilewidth,tileheight) rocktile = CreateImage(tilewidth,tileheight) groundtile = CreateImage(tilewidth,tileheight) moneytile = CreateImage(tilewidth,tileheight) DebugLog "drawing in image" Local s:Int=255/tileheight Local ss:Int=tileheight/125 For Local y=0 Until tileheight drawr(0,y,tilewidth,y,y*s,y*s,y*s) Next DebugLog "finishing image wall" walltile.WritePixels(pixels, 0, 0, tilewidth, tileheight, 0) For Local y=0 Until tileheight Local col:Int=0 If y<tileheight/2 col=0+((y*s)) Else col=(255)-((y*s)) End If drawr(0,y,tilewidth,y,col,col/3,0) Next DebugLog "finishing image rock" rocktile.WritePixels(pixels, 0, 0, tilewidth, tileheight, 0) For Local y=0 Until tileheight Local col:Int=0 If y<tileheight/2 col=0+((y*s)/6) Else col=(255/6)-((y*s)/6) End If drawr(0,y,tilewidth,y,col,col,col) Next DebugLog "finishing image ground" groundtile.WritePixels(pixels, 0, 0, tilewidth, tileheight, 0) drawo(tilewidth/3,tileheight/3,tilewidth/3,$FFFF0000) DebugLog "finishing image money" moneytile.WritePixels(pixels, 0, 0, tilewidth, tileheight, 0) End Method Method drawo(x1,y1,radius,col) For Local y2=-radius To radius For Local x2=-radius To radius If (y2*y2+x2*x2) <= radius*radius+radius*0.8 Local x3 = x2+x1 Local y3 = y2+y1 Local pc = y3*tilewidth+x3 If pc>=0 And pc < tilewidth*tileheight pixels[pc] = col End If End If Next Next End Method Method drawr(x1,y1,w1,h1,r:Int,g:Int,b:Int) For Local y2=y1 Until y1+h1 For Local x2=x1 Until x1+w1 Local pc = y2*tilewidth+x2 If pc >= 0 And pc < tilewidth*tileheight pixels[pc] = argb(r,g,b) End If Next Next End Method Function argb:Int(r:Int, g:Int, b:Int ,alpha:Int=255) Return (alpha Shl 24) | (r Shl 16) | (g Shl 8) | b End Function End Class Class monster Field lmap:Int[][] Field x:Int,y:Int Field mdelay:Int=0 Field monsterspeed:Int Field offx:Int,offy:Int Field offxt:Int,offyt:Int Field mnx:Int,mny:Int Method New() lmap = makearray() ' find place for monster Local exitloop:Bool=False While exitloop = False Local x1:Int=Rnd(5,mapwidth-5) Local y1:Int=Rnd(5,mapheight-5) If monmap[x1][y1] = 1 Then exitloop = True lmap[x1][y1]=1 Self.x = x1 Self.y = y1 End If Wend mnx = Self.x mny = Self.y offxt = 0 offyt = 0 offx = 0 offy = 0 monsterspeed = Rnd(1,15) End Method Method update() 'Return mdelay+=1 If mdelay< monsterspeed Then Return mdelay=0 If offx<offxt offx+=1 End If If offx>offxt offx-=1 End If If offy<offyt offy+=1 End If If offy>offyt offy-=1 End If Local set:Bool=False If offx=offxt And offy=offyt Then set=True End If If set=False Then Return ' DebugLog offx+":"+offxt+","+offy+":"+offyt x = mnx y = mny lmap[x][y]+=1 If lmap[x][y] > 1000 For Local y1=0 Until mapheight For Local x1=0 Until mapwidth lmap[x1][y1] = 0 Next Next lmap[x][y]=1 End If Local exitloop:Bool=False Local db:Int=0 While exitloop = False db+=1 If db>200 Then exitloop=True Local y2:Int=Rnd(-2,2) Local x2:Int=Rnd(-2,2) If monmap[x+x2][y+y2] = 1 If lmap[x+x2][y+y2] <= lmap[x][y] offx = 0 offy = 0 offxt = 0 offyt = 0 If x2<0 offxt -= tilewidth Elseif x2>0 offxt += tilewidth End If If y2<0 offyt -= tileheight Elseif y2>0 offyt += tileheight End If 'offxt=x2*tilewidth 'offyt=y2*tileheight mnx=x+x2 mny=y+y2 exitloop=True Return End If End If Wend End Method Method draw() SetColor 255,0,0 Local x1 = (x*tilewidth) Local y1 = (y*tileheight) x1-=(mapx*tilewidth) y1-=(mapy*tileheight) x1+=mapsx y1+=mapsy x1+=offx y1+=offy DrawRect x1-tilewidth, y1, tilewidth,tileheight SetColor 255,255,255 DrawText "M", (x1-tilewidth)+(tilewidth/2), y1+tileheight/2, 0.5,0.5 End Method End Class Class player Field x:Float=3*tilewidth Field y:Float=3*tileheight Field width:Int = tilewidth Field height:Int = tileheight Field keys:Int = 0 Field coins:Int = 0 Field health:Int = 3 Field maxhealth:Int=10 End Class Class mapgen Field gmap:Int[mapwidth][] Field hmap:Int[mapwidth][] Field twidth:Float,theight:Float Method New() For Local i = 0 Until mapwidth gmap[i] = New Int[mapheight] hmap[i] = New Int[mapheight] Next twidth=640/mapwidth theight=480/mapheight makehmap makemap End Method Method makemap() DebugLog "make map" For Local y=0 Until mapheight For Local x=0 Until mapwidth map[x][y] = hmap[x][y] Next Next ex = Rnd(10,mapwidth-10) ey = Rnd(10,mapheight-10) Local numpaths:Int = (mapwidth*mapheight)/700 DebugLog "make area's" For Local i=0 Until numpaths sx = ex sy = ey Local exitloop:Bool=False While exitloop = False ex = Rnd(10,mapwidth-10) ey = Rnd(10,mapheight-10) If sx<>ex And sy<>ey Then exitloop = True End If Wend findpath For Local ii:=Eachin path Local s:Int=2 If Int(Rnd(1,5)) = 2 s=Rnd(2,5) Elseif Int(Rnd(1,9)) = 2 s=8 End If For Local y=-s/2 Until s/2 For Local x=-s/2 Until s/2 If ii.x+x >= 0 And ii.x+x <mapwidth And ii.y+y >= 0 And ii.y+y < mapheight gmap[ii.x+x][ii.y+y] = 1 pmap[ii.x+x][ii.y+y] = 1 End If Next Next Next Next ' make monster map For Local y=0 Until mapheight For Local x=0 Until mapwidth If gmap[x][y] = 1 monmap[x][y] = 1 End If Next Next DebugLog "add walls" ' here add the walls For Local y=1 Until mapheight-1 For Local x=1 Until mapwidth-1 If gmap[x][y] = 0 If gmap[x+1][y] = 1 gmap[x][y]=2 End If End If If gmap[x][y] = 1 If gmap[x+1][y] = 0 gmap[x+1][y] = 2 End If End If If gmap[x][y] = 0 If gmap[x][y+1] = 1 gmap[x][y] = 2 End If End If If gmap[x][y] = 1 If gmap[x][y+1] = 0 gmap[x][y+1] = 2 End If End If Next Next DebugLog "set player on map and placecoins" ' set player on maptile setplayerposition DebugLog "place coins" placecoins((mapwidth*mapheight)/260) DebugLog "place life" placehealth((mapwidth*mapheight)/1000) ' map conversion DebugLog "turn walkable into rock" ' turn walkable into rock For Local y=0 Until mapheight For Local x=0 Until mapwidth If gmap[x][y] = 0 Then gmap[x][y] = 7 Next Next DebugLog "Turn floor into walkable" ' turn floor into walkable For Local y=0 Until mapheight For Local x=0 Until mapwidth If gmap[x][y] = 1 Then gmap[x][y] = 0 End If If gmap[x][y] = 2 gmap[x][y] = 1 End If Next Next End Method Method drawmap() For Local y=0 Until mapheight For Local x=0 Until mapwidth If gmap[x][y] = 1 SetColor 150,150,150 DrawRect x*twidth,y*theight, twidth,theight End If If gmap[x][y] = 2 SetColor 200,200,200 DrawRect x*twidth,y*theight, twidth,theight End If Next Next SetColor 255,255,0 drawboxedrect( mapx*twidth,mapy*theight, (DeviceWidth/tilewidth)*twidth, (DeviceHeight/tileheight)*theight) End Method Method makehmap() For Local y=0 Until mapheight For Local x=0 Until mapwidth hmap[x][y] = 3 Next Next For Local i=0 To (mapwidth*mapheight)/10 Local w:Int=Rnd(3,8) Local h:Int=Rnd(3,8) Local x:Int=Rnd(3,mapwidth-8) Local y:Int=Rnd(3,mapheight-8) For Local y1=-w/2 To w/2 For Local x1=-h/2 To h/2 hmap[x+x1][y+y1]+=1 Next Next Next End Method Method drawhmap() For Local y=0 Until mapheight For Local x=0 Until mapwidth SetColor hmap[x][y]*10,0,0 DrawRect x*twidth,y*theight, twidth,theight Next Next End Method Method placehealth(amount:Int) For Local i=0 Until amount Local exitloop:Bool=False Local exloop:Int=0 While exitloop = False Local x:Int=Rnd(0,mapwidth) Local y:Int=Rnd(0,mapheight) If gmap[x][y] = 1 gmap[x][y] = 3 exitloop = True End If exloop+=1 If exloop>100 Then exitloop=True Wend Next End Method Method placecoins(amount:Int) For Local i=0 Until amount Local exitloop:Bool=False Local exloop:Int=0 While exitloop = False Local x:Int=Rnd(0,mapwidth) Local y:Int=Rnd(0,mapheight) If gmap[x][y] = 1 gmap[x][y] = 4 exitloop = True End If exloop+=1 If exloop>100 Then exitloop=True Wend Next End Method Method setplayerposition() Local exitloop:Bool=False Local eo:Int=0 While exitloop = False eo+=1 If eo>500 Then remakemap = True Return End If Local x:Int=Rnd(mapwidth) Local y:Int=Rnd(mapheight) If gmap[x][y] = 1 mapx = x-(DeviceWidth/tilewidth)/2 mapy = y-(DeviceHeight/tileheight)/2 p.x = (DeviceWidth)/2 p.y = (DeviceHeight)/2 mapsx = 0 mapsy = 0 exitloop = True End If Wend End Method End Class Class openlist Field x:Int Field y:Int Field f:Int Field g:Int Field h:Int Field px:Int Field py:Int Method New( x:Int=0,y:Int=0,f:Int=0, g:Int=0,h:Int=0,px:Int=0, py:Int=0) Self.x=x Self.y=y Self.f=f Self.g=g Self.h=h Self.px=px Self.py=py End Method End Class Class closedlist Field x:Int Field y:Int Field px:Int Field py:Int Method New(x:Int,y:Int,px:Int,py:Int) Self.x = x Self.y = y Self.px = px Self.py = py End Method End Class Class pathnode Field x:Int Field y:Int Method New(x:Int,y:Int) Self.x = x Self.y = y End Method End Class Global mytiles:tiles Global ol:List<openlist> = New List<openlist> Global cl:List<closedlist> = New List<closedlist> Global path:List<pathnode> = New List<pathnode> Global mymonster:List<monster> = New List<monster> Global mymapgen:mapgen ' the player class in p Global p:player = New player Class MyGame Extends App Method OnCreate() mytiles = New tiles SetUpdateRate(60) For Local i=0 Until mapwidth monmap[i] = New Int[mapheight] map[i] = New Int[mapheight] olmap[i] = New Int[mapheight] clmap[i] = New Int[mapheight] pmap[i] = New Int[mapheight] Next mymapgen = New mapgen() For Local y=0 Until mapheight For Local x=0 Until mapwidth map[x][y] = mymapgen.gmap[x][y] Next Next For Local i=0 Until 5 mymonster.AddLast(New monster()) Next End Method Method OnUpdate() waittime+=1 ' If waittime>120 ' If Rnd(0,100)>98 Then remakemap=True For Local i:=Eachin mymonster i.update Next showmap=False If KeyDown(KEY_M) showmap=True End If If KeyHit(KEY_T) Or remakemap=True' Or 'waittime>180 Then mymonster.Clear waittime=0 remakemap=False Seed=Millisecs() mapwidth=Rnd(30,200) mapheight=Rnd(30,200) monmap = makearray() map = makearray() olmap = makearray() clmap = makearray() pmap = makearray() mymapgen = New mapgen() For Local y=0 Until mapheight For Local x=0 Until mapwidth map[x][y] = mymapgen.gmap[x][y] Next Next For Local i=0 Until (mapwidth*mapheight)/500 mymonster.AddLast(New monster()) Next If ptc(0,0) remakemap=True End If End If ' waittime = 0 ' End If ' scrolling rpg part For Local i=0 Until 2 If p.x > DeviceWidth / 2 If mapx+(DeviceWidth/tilewidth) < mapwidth-1 mapsx-=1 If mapsx < 0 Then mapsx = tilewidth-1 mapx += 1 Endif p.x-=1 End If End If Next For Local i=0 Until 2 If p.x < DeviceWidth / 2 If mapx > 0 mapsx+=1 If mapsx > tilewidth Then mapsx = 0 mapx -= 1 Endif p.x+=1 End If End If Next ' scrolling down For Local i=0 Until 2 If p.y > DeviceHeight / 2 If mapy+(DeviceHeight/tileheight) < mapheight-1 mapsy-=1 If mapsy < 0 Then mapsy = tileheight-1 mapy += 1 Endif p.y-=1 End If End If Next ' scrolling up For Local i=0 Until 2 If p.y < DeviceHeight / 2 If mapy > 0 mapsy+=1 If mapsy > tileheight-1 Then mapsy = 0 mapy -= 1 Endif p.y+=1 End If End If Next If KeyDown(KEY_RIGHT) ptcs(1,0) For Local i=0 Until 2 If ptc(1,0) = False p.x+=1 End If Next End If If KeyDown(KEY_LEFT) ptcs(-1,0) For Local i=0 Until 2 If ptc(-1,0) = False p.x-=1 End If Next End If If KeyDown(KEY_UP) ptcs(0,-1) For Local i=0 Until 2 If ptc(0,-1) = False p.y-=1 End If Next End If If KeyDown(KEY_DOWN) ptcs(0,1) For Local i=0 Until 2 If ptc(0,1) = False p.y+=1 End If Next End If End Method Method OnRender() Cls(0,0,0) If remakemap=True Then Return If showmap=True Then mymapgen.drawmap End If If showmap = False SetColor 255,255,255 drawmap SetColor 255,255,0 DrawOval p.x,p.y,p.width,p.height For Local i:=Eachin mymonster i.draw Next SetColor 0,0,0 DrawRect 0,0,DeviceWidth,32 SetColor 255,255,255 DrawText "Keys : "+p.keys,10,0 DrawText "Coins : "+p.coins,10,16 DrawText "Health : "+p.health+ " of "+p.maxhealth,96,0 DrawText "Use Cursor keys to move.", DeviceWidth/2,0 DrawText "Collect coins, press t = Teleport"+ " to new cavern.",DeviceWidth/2,16 DrawText "Press m for mapscreen.", DeviceWidth/2,DeviceHeight-20 End If End End ' player collide with special blocks. Function ptcs:Int(offsetx:Int=0,offsety:Int=0) Local cx = (p.x+offsetx)/tilewidth+mapx Local cy = (p.y+offsety)/tileheight+mapy For Local y2=cy-1 Until cy+4 For Local x2=cx-1 Until cx+4 If x2>=0 And x2<mapwidth And y2>=0 And y2<mapheight If map[x2][y2] > 0 Local x3 = (x2-mapx)*tilewidth-tilewidth+mapsx Local y3 = (y2-mapy)*tileheight+mapsy If rectsoverlap( p.x+offsetx, p.y+offsety, p.width, p.height, x3,y3, tilewidth, tileheight) = True Select map[x2][y2] Case 2 If p.keys > 0 map[x2][y2] = 0 p.keys-=1 End If Case 3 'health If p.health < p.maxhealth map[x2][y2] = 0 p.health+=1 Else map[x2][y2] = 0 p.maxhealth+=1 p.health+=1 End If Case 4 'coins map[x2][y2] = 0 p.coins+=1 End Select End If End If End If Next Next Return 0 End Function 'player collide with solid blocks true/false Function ptc:Bool(offsetx:Int=0,offsety:Int=0) Local cx = (p.x+offsetx)/tilewidth+mapx Local cy = (p.y+offsety)/tileheight+mapy For Local y2=cy-1 Until cy+4 For Local x2=cx-1 Until cx+4 If x2>=0 And x2<mapwidth And y2>=0 And y2<mapheight If map[x2][y2] = 1 Or map[x2][y2] = 2 Or map[x2][y2] = 5 Or map[x2][y2] = 6 Or map[x2][y2] = 7 Local x3 = (x2-mapx)*tilewidth-tilewidth+mapsx Local y3 = (y2-mapy)*tileheight+mapsy If rectsoverlap(p.x+offsetx,p.y+offsety, p.width,p.height,x3,y3, tilewidth,tileheight) = True Return True End If End If End If Next Next Return False End Function Function drawmap:Void() For Local y=0 To DeviceHeight/tileheight For Local x=0 To DeviceWidth/tilewidth Local x1 = ((x*tilewidth)+mapsx)-tilewidth Local y1 = ((y*tileheight)+mapsy) Local mw:Int=mapwidth Local mh:Int=mapheight Local mx:Int=mapx Local my:Int=mapy If x+mapx<mapwidth And x+mapx>0 And y+mapy<mapheight And y+mapy>0 Select map[x+mapx][y+mapy] Case 0 'ground DrawImage mytiles.groundtile,x1,y1 Case 1'Wall ' SetColor 100,100,100 ' DrawRect x1,y1,tilewidth,tileheight DrawImage mytiles.walltile,x1,y1 Case 2'Door SetColor 200,100,0 DrawRect x1,y1,tilewidth,tileheight Case 3'Health SetColor 200,0,0 DrawOval x1+4,y1+4,tilewidth-8,tileheight-8 SetColor 255,255,255 DrawText "H",x1+tilewidth/2,y1+tileheight/2,0.5,0.5 Case 4'Coin 'SetColor 255,255,0 'DrawOval x1+4,y1+4,tilewidth-8,tileheight-8 'SetColor 255,255,255 DrawImage mytiles.moneytile,x1,y1 DrawText "$",x1+tilewidth/2,y1+tileheight/2,0.5,0.5 Case 5'tree SetColor 0,200,0 DrawPoly( [Float(x1+16),y1 ,x1+tilewidth, y1+tileheight , x1,y1+tileheight]) Case 6'water SetColor 0,0,200 DrawRect x1,y1,tilewidth,tileheight Case 7'rock 'SetColor 150,50,0 'DrawRect x1,y1+10,tilewidth,tileheight-10 DrawImage mytiles.rocktile,x1,y1 'DrawPoly([Float(x1+tilewidth/2),y1,x1+tilewidth, ' y1+tileheight,x1,y1+tileheight]) End Select End If Next Next End Function Function rectsoverlap:Bool( x1:Int, y1:Int, w1:Int, h1:Int, x2:Int, y2:Int, w2:Int, h2:Int) If x1 >= (x2 + w2) Or (x1 + w1) <= x2 Then Return False If y1 >= (y2 + h2) Or (y1 + h1) <= y2 Then Return False Return True End Function Function drawboxedrect:Void(x:Int,y:Int,w:Int,h:Int) DrawLine x,y,x+w,y DrawLine x,y,x,y+h DrawLine x,y+h,x+w,y+h DrawLine x+w,y,x+w,y+h End Function Function makearray:Int[][]() Local aa:Int[mapwidth][] For Local i=0 Until mapwidth aa[i] = New Int[mapheight] Next Return aa End Function Function findpath:Bool() If sx = ex And sy = ey Then Return False For Local y=0 Until mapheight For Local x=0 Until mapwidth olmap[x][y] = 0 clmap[x][y] = 0 Next Next ol.Clear cl.Clear path.Clear ol.AddFirst(New openlist(sx,sy)) Local tx:Int Local ty:Int Local tf:Int Local tg:Int Local th:Int Local tpx:Int Local tpy:Int Local newx:Int Local newy:Int Local lowestf:Int olmap[sx][sy] = 1 While ol.IsEmpty() = False lowestf = 100000 For Local i:=Eachin ol If i.f < lowestf lowestf = i.f tx = i.x ty = i.y tf = i.f tg = i.g th = i.h tpx = i.px tpy = i.py End If Next If tx = ex And ty = ey cl.AddLast(New closedlist(tx,ty,tpx,tpy)) findpathback Return True Else removefromopenlist(tx,ty) olmap[tx][ty] = 0 clmap[tx][ty] = 1 cl.AddLast(New closedlist(tx,ty,tpx,tpy)) For Local y=-1 To 1 For Local x=-1 To 1 newx = tx+x newy = ty+y If newx>=0 And newy>=0 And newx<mapwidth And newy<mapheight If olmap[newx][newy] = 0 If clmap[newx][newy] = 0 olmap[newx][newy] = 1 Local gg:Int If pmap[newx][newy] = 1 gg=1 Else gg = map[newx][newy]+1 End If Local hh = distance(newx,newy,ex,ey) Local ff = gg+hh ol.AddLast(New openlist(newx, newy,ff, gg,hh, tx,ty)) End If End If End If Next Next End If Wend Return False End Function Function findpathback:Bool() Local x=ex Local y=ey path.AddFirst(New pathnode(x,y)) Repeat For Local i:=Eachin cl If i.x = x And i.y = y x = i.px y = i.py path.AddFirst(New pathnode(x,y)) End If Next If x = sx And y = sy Then Return True Forever End Function Function removefromopenlist:Void(x1:Int,y1:Int) For Local i:=Eachin ol If i.x = x1 And i.y = y1 ol.Remove i Exit End If Next End Function Function distance:Int(x1:Int,y1:Int,x2:Int,y2:Int) Return Abs(x2-x1)+Abs(y2-y1) End Function Function Main() New MyGame() End
No comments:
Post a Comment
Note: Only a member of this blog may post a comment.