Random Terran Diammond-Square Xors3D Part 1

Blitz3D Forums/Blitz3D Tutorials/Random Terran Diammond-Square Xors3D Part 1

TFT (der Falke)(Posted 2010) [#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


JustPlayer(Posted 2015) [#2]
(please use translator if you want:) wie kann man B3D maps einbinden? xD
(srry can not good englisch)


Guy Fawkes(Posted 2015) [#3]
For god sake...

Here:



Hello,

For all interested users....