Random Terran Diammond-Square Xors3D Part 1
Blitz3D Forums/Blitz3D Tutorials/Random Terran Diammond-Square Xors3D Part 1
| ||
Hallo, For all intresting users .... ; ; Diamond-Square Random Terran 001 ; Global AppName$= "Diamond-Square Random Terran" Include "..\..\userlibs\blitzsys.bb" Include "..\..\userlibs\Xors3D.bb" Include "include\_xKey_.bb" If DLLBlitzSysInitialise() = False Then RuntimeError("Blitzsys.dll not found") If DLLFindWindow(AppName$)<>0 : RuntimeError("Aplication is runing ("+AppName$+")") : EndIf ; ---------------------------------------------------------------------- SeedRnd(MilliSecs()) WinScreenX#=DLLDesktopWidth() WinScreenY#=DLLDesktopHeight() Global ScreenX=1600 Global ScreenY=800 WinMode=False ; Windowed ;WinMode=True ; FullScreen ; ---------------------------------------------------------------------- xGraphics3D(ScreenX,ScreenY,32,WinMode,True) xSetBuffer(xBackBuffer()) xAppTitle AppName$ Delay 1 If WinMode=False hWnd = DLLFindWindow(AppName$) succ = DLLSetWindowPos(hWnd,HWND_TOPMOST,(WinScreenX#/2)-(Screenx/2),(WinScreenY#/2)-(Screeny/2),ScreenX,ScreenY,SWP_NOSIZE ) EndIf ; ---------------------------------------------------------------------- ; Das Raster wird inizialisiert, di kann bei start 3 - 2^x betragen ; 9 erzieht gute Ergebnisse di=7 ; Die maximale höhe in Y mr=256 Dim x(di) Dim x1(di) For i=0 To di x(i)=Rand(mr) Next ; ---------------------------------------------------------------------- Repeat xCls If xWinMessage("WM_CLOSE") Then Ex=1 ; Close Botton If xKeyHit(1) Then Ex=1 ; ECS If xKeyHit(2) ; Taste 1 , Start new di=9 Dim x(di) Dim x1(di) For i=0 To di x(i)=Rand(mr) Next EndIf If xMouseHit(2) ; Die höhen Daten werden kopiert Dim x1(di) For i=1 To di x1(i)=x(i) Next ; Das Feld wird erweitert di=di+(di-1) Dim x(di) ; Die Alten Feld Daten werden Kopiert do=1 i1=1 For i=1 To di If do=i do=do+2 x(i)=x1(i1) i1=i1+1 Else EndIf Next ; Aus den Höhen Daten des Vorherigen und nachkommenden Punktes ; wird ein züfälliger Zwischen wert gebildet. do=1 i1=1 For i=1 To di If do=i ; Die forherigen Raster punkte behalten do=do+2 Else ; Die Zwischen Punkte berechnen If x(i-1)<=x(i+1) x(i)=x(i-1)+Rand(Abs(x(i-1)-x(i+1))) Else x(i)=x(i+1)+Rand(Abs(x(i-1)-x(i+1))) EndIf EndIf Next EndIf ; Wasser Linie xColor($00,$00,$ff) xRect(1,ScreenY-100-(mr/2),ScreenX-1,mr/2,1) ; Raster punkte raster_x#=(ScreenX-20)/(di-1.0) xColor($ff,$ff,$ff) For i= 1 To di-1 ;xRect(10+((i-1)*raster_x),ScreenY-100-x(i),2,2,0) xLine(10+((i-1)*raster_x),ScreenY-100-x(i),10+((i)*raster_x),ScreenY-100-x(i+1)) Next ; Text Ausgabe xColor($0,$0,$0) xText(ScreenX/2+1,11,"Press rigt mouse botton to generate next calc",1) xColor($0,$ff,$ff) xText(ScreenX/2,10,"Press rigt mouse botton to generate next calc",1) xColor($0,$0,$0) xText(11,11,"Points = "+Str(di)) xColor($0,$ff,$ff) xText(10,10,"Points = "+Str(di)) xFlip() Until Ex=1 End |
| ||
(please use translator if you want:) wie kann man B3D maps einbinden? xD (srry can not good englisch) |
| ||
For god sake... Here: Hello, For all interested users.... |