| Automatisches Erstsellen Tilemaps von ??? |
| Ich arbeite gerade an einer völlig automatischen erstellung einer 2d-welt, für z.B. rollenspiele oder wirtschaftsimulationen oder strategiespiele alâ civilisation. hier poste ich jetzt meine fortschritte, und würde mich freuen, wenn ihr noch verbesserungsvorschläge oder neuerungen hättet. zunächst hab ich mal ne routine geschrieben, mit der man meeresflächen erstellen kann. [code:1:b5868ae129] Const Xres=320,Yres=240,land=10 ;land gibt an, wieviel festland es geben soll ( 5-20 is ok ...) Graphics Xres,Yres,0,0 SetBuffer BackBuffer() SeedRnd MilliSecs() Dim map(Xres,Yres) ;1=normales land ;0=wasser For i=0 To land ;umso höher die variable land ist, desto länger brauch die routine a=Rand(100,Xres-100) b=Rand(100,Yres-100) ;erzeugen eines "landflusses" While (a>10 And a<Xres-10 And b>10 And b<Yres-10) map(a,b)=1 a=a+Rand(-1,1) b=b+Rand(-1,1) Wend ;"fehlerkorrektur" For a=1 To Xres-1 For b=1 To Yres-1 wert=(map(a-1,b-1)+map(a,b-1)+map(a+1,b-1)+map(a-1,b)+map(a+1,b)+map(a-1,b+1)+map(a,b+1)+map(a+1,b+1)) If map(a,b)=1 And wert<3 map(a,b)=0 If map(a,b)=0 And wert>4 map(a,b)=1 Next Next Next LockBuffer BackBuffer() ;zeichnen der map For a=0 To Xres For b=0 To Yres If map(a,b)=0 WritePixelFast a,b,$0000FF Next Next UnlockBuffer BackBuffer() Flip Cls WaitKey [/code:1:b5868ae129] |
| von ??? |
| jetzt kann man einstellen wie schroff die küsten sein sollen, in dem man die konstante "korrektur" variirt. (p.S. sorry für den hässlichen code ;) [code:1:dc26beddc4] Const Xres=320,Yres=240,korrektur=5,land=8 ;land gibt an, wieviel festland es geben soll ( 5-20 is ok ...) Graphics Xres,Yres,0,1 SetBuffer BackBuffer() SeedRnd MilliSecs() ClsColor 0,0,$336633 Cls Dim map(Xres,Yres) ;1=normales land ;0=wasser While Not KeyDown(1) create_ocean() LockBuffer BackBuffer() ;zeichnen der map For a=1 To Xres-1 For b=1 To Yres-1 wert=(map(a-1,b-1)+map(a,b-1)+map(a+1,b-1)+map(a-1,b)+map(a+1,b)+map(a-1,b+1)+map(a,b+1)+map(a+1,b+1)) If wert>0 And wert<8 And map(a,b)=1 WritePixelFast a,b,$663300 If map(a,b)=0 WritePixelFast a,b,$000099 Next Next UnlockBuffer BackBuffer() Flip WaitKey Cls Wend End Function create_ocean() For a=0 To Xres For b=0 To Yres map(a,b)=0 Next Next For i=0 To land ;umso höher die variable land ist, desto länger brauch die routine a=Rand(100,Xres-100) b=Rand(100,Yres-100) ;erzeugen eines "landflusses" While (a>10 And a<Xres-10 And b>10 And b<Yres-10) map(a,b)=1 a=a+Rand(-1,1) b=b+Rand(-1,1) Wend Next For i=0 To korrektur ;"fehlerkorrektur" For a=1 To Xres-1 For b=1 To Yres-1 wert=(map(a-1,b-1)+map(a,b-1)+map(a+1,b-1)+map(a-1,b)+map(a+1,b)+map(a-1,b+1)+map(a,b+1)+map(a+1,b+1)) If map(a,b)=1 And wert<3 map(a,b)=0 If map(a,b)=0 And wert>4 map(a,b)=1 map(a-1,b-1)=1 map(a,b-1)=1 map(a+1,b-1)=1 map(a-1,b)=1 map(a+1,b)=1 map(a-1,b+1)=1 map(a,b+1)=1 map(a+1,b+1)=1 EndIf Next Next Next Return 1 End Function [/code:1:dc26beddc4] |
| von ??? |
| hmmm..´. also, ich bräuchte sowas nicht ;) |
| von ??? |
| [ot]Toll Stanio und wen interessiert das? Das is ziemlich deprimierend, wenn einer sagt man braucht sowas nicht! Wie würdest du dich fühlen, wenn du aufwendig irgendwas programmierst, das dann veröffentlichst und alle sagen "Ich brauch das nicht!" Und nochwas: Hör auf irgendwelchen Mist von dir zu geben. Wenn du was postets dann etwas konstruktives, was weiterhilft, oder zum Thema passt. Spammer :evil:[/ot] Sorry ice das ich damit deinen Thread verasaue, aber das musste raus. Und ausserdem können die Mods meinen [u:4444abaf22]und Stanios[/u:4444abaf22] Post löschen, was nötig ist. |
| von ??? |
| ... is schon in ordnung ... is ja auch nich extra für den beginner alias stanio gemacht worden ... dehalb is das völlig wurscht ob der das brauch oda nich ... NEUE VERSION ! - mit gebirgen ... NEUE VERSION ! (1.6.03) - neue farben [code:1:b679d337bb] Const Xres=320,Yres=240 Const unterschied=1,max_hoehe=7, korrektur=4, land=8 ;unterschied gibt an, wie groß der unterschied von zwei benachbarten feldeinträgen sein darf ;max_hoehe gibt an, wie hoch das terrain maximal sein darf ;korrektur gibt an, wie stark "geglättet" das land werden soll || mehr korrektur = mehr "glättung" ;land gibt an, wieviel festland es geben soll, und daher auch, wieviele gebirge Graphics Xres,Yres,0,1 SetBuffer BackBuffer() SeedRnd MilliSecs() ClsColor 0,0,$336633 Text Xres/2,Yres/2-20,"Erzeugen der Karte.",1,1 Text Xres/2,Yres/2,"Dieser Vorgang kann",1,1 Text Xres/2,Yres/2+20,"einige Minuten dauern ...",1,1 Flip Cls Dim map(Xres,Yres) ;1=normales land ;0=wasser While Not KeyDown(1) create_ocean() LockBuffer BackBuffer() ;zeichnen der map For a=1 To Xres-1 For b=1 To Yres-1 If map(a,b)=0 WritePixelFast a,b,$3333CC If map(a,b)=1 WritePixelFast a,b,$C86400 If map(a,b)=2 WritePixelFast a,b,$AA5500 If map(a,b)=3 WritePixelFast a,b,$9B4E00 If map(a,b)=4 WritePixelFast a,b,$7D3F00 If map(a,b)=5 WritePixelFast a,b,$643200 If map(a,b)=6 WritePixelFast a,b,$502800 If map(a,b)>6 WritePixelFast a,b,$3C1E00 Next Next UnlockBuffer BackBuffer() Flip WaitKey Cls Wend End ;//// funktion //// Function create_ocean() For a=0 To Xres For b=0 To Yres map(a,b)=0 Next Next For i=0 To land ;umso höher die variable land ist, desto länger brauch die routine a=Rand(100,Xres-100) b=Rand(100,Yres-100) ;erzeugen eines "landflusses" While (a>10 And a<Xres-10 And b>10 And b<Yres-10) map(a,b)=map(a,b)+(map(a,b)<max_hoehe) a=a+Rand(-1,1) b=b+Rand(-1,1) Wend Next For i=0 To korrektur ;"fehlerkorrektur" For a=1 To Xres-1 For b=1 To Yres-1 wert=(map(a-1,b-1)+map(a,b-1)+map(a+1,b-1)+map(a-1,b)+map(a+1,b)+map(a-1,b+1)+map(a,b+1)+map(a+1,b+1)) If map(a,b)=1 And wert<3 map(a,b)=0 If map(a,b)=0 And wert>4 map(a,b)=1 map(a-1,b-1)=1 map(a,b-1)=1 map(a+1,b-1)=1 map(a-1,b)=1 map(a+1,b)=1 map(a-1,b+1)=1 map(a,b+1)=1 map(a+1,b+1)=1 EndIf For p=-1 To 1 For q=-1 To 1 If p<>0 And q<>0 If map(a,b)+unterschied<map(a-p,b-q) Then map(a,b)=map(a,b)+1 If map(a,b)-unterschied>map(a-p,b-q) Then map(a,b)=map(a,b)-1 EndIf Next Next Next Next Next Return 1 End Function [/code:1:b679d337bb] |
| von ??? |
| Nett; wenn du das so ausbaust, daß statt Punkten, zu spezifizierende Tiles benutzt werden, könnte sich das als recht nützlich erweisen. |
| von ??? |
| Skate hat aber recht. Es interessiert mich(alle anderen) genau einen feuchten dreck ob du das brauchst oder nich. Ansonsten find ichs toll das eis uns seinen hart ercodeten code freigibt. also :) |
| von ??? |
| von BigSnake: "Nett; wenn du das so ausbaust, daß statt Punkten, zu spezifizierende Tiles benutzt werden, könnte sich das als recht nützlich erweisen." das muss dann der programmierer noch selbst machen. Mein programm erzeugt ja vorerst nur ein feld, das man dann in eine datei speichern könnte, und diese dann in einem spiel verwenden könnte (wo man dann erst die tiles sieht) ... habe aber geplant das richtig als eigenständiges tool zu machen, das sozusagen die umwelt, die extrem nervig zu mappen is, automatisch erzeugt ... so mit wasser, bergen, wald, wiesen ... dann soll das erzeugte feld in verschiedenste tielmap-formate gespeichert werden können. dannach kann man diese erzeugte map dann mit einem 2d tileeditor laden, und dann weiterbearbeiten (z.B. häuser draufsetzen ...). |