piXelfield 2 ( Fake 3D )

Übersicht

BlitzBasic

Codearchiv

	konstantin Betreff: piXelfield 2 ( Fake 3D )	Fr, Dez 26, 2003 20:36 Antworten mit Zitat
So, hier mal wieder nen feines kleines Sternenfeld. Diesmal mit einem "gefaketen" 3D. Schauts euch mal an. Ihr müsst es mindestens 10 Sekunden laufen lassen damit sich das ganze entwickelt Code: [AUSKLAPPEN] [EINKLAPPEN] InitGraphics( "piXelfield 2 :: by Alu-Folie", 640, 480, 16, 2 ) InitBuffer() Dim Starfield( 1000, 4 ) Repeat Cls Func_Starfield() Flip Until( KeyHit( 1 ) ) Function InitGraphics( AppName$, gwidth, gheight, gdeep, gmode ) AppTitle AppName$ Graphics gwidth, gheight, gdeep, gmode HidePointer End Function Function InitBuffer() SetBuffer BackBuffer() End Function Function Func_Starfield() For StarCount = 0 To 1000 If Starfield( StarCount, 0 ) = 1 Then If Starfield( StarCount, 3 ) = 2 Then Color 255, 255, 255 Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 ) Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 5 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 5 End If If Starfield( StarCount, 3 ) = 1 Then Color 200, 200, 200 Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 ) Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 3 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 3 End If If Starfield( StarCount, 3 ) = 0 Then Color 230, 230, 230 Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 ) Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 8 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 8 End If If Starfield( StarCount, 1 ) < 0 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 1 ) > 640 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 2 ) < 0 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 2 ) > 480 Then Starfield( StarCount, 0 ) = 0 End If If Starfield( StarCount, 0 ) = 0 Then Starfield( StarCount, 0 ) = 1 Starfield( StarCount, 1 ) = 320 Starfield( StarCount, 2 ) = 240 Starfield( StarCount, 3 ) = Rand( 0, 2 ) Starfield( StarCount, 4 ) = Rand( 0, 359 ) End If Next End Function

konstantin

Betreff: piXelfield 2 ( Fake 3D )

Fr, Dez 26, 2003 20:36
Antworten mit Zitat

So, hier mal wieder nen feines kleines Sternenfeld. Diesmal mit einem "gefaketen" 3D. Schauts euch mal an. Ihr müsst es mindestens 10 Sekunden laufen lassen damit sich das ganze entwickelt Very Happy

Code: [AUSKLAPPEN]

InitGraphics( "piXelfield 2 :: by Alu-Folie", 640, 480, 16, 2 )
InitBuffer()

Dim Starfield( 1000, 4 )

Repeat
Cls
Func_Starfield()
Flip
Until( KeyHit( 1 ) )

Function InitGraphics( AppName$, gwidth, gheight, gdeep, gmode )
AppTitle AppName$
Graphics gwidth, gheight, gdeep, gmode
HidePointer
End Function

Function InitBuffer()
SetBuffer BackBuffer()
End Function

Function Func_Starfield()
For StarCount = 0 To 1000
   If Starfield( StarCount, 0 ) = 1 Then
      If Starfield( StarCount, 3 ) = 2 Then
         Color 255, 255, 255
         Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 )
         Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 5
         Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 5
      End If
      If Starfield( StarCount, 3 ) = 1 Then
         Color 200, 200, 200
         Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 )
         Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 3
         Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 3
      End If
      If Starfield( StarCount, 3 ) = 0 Then
         Color 230, 230, 230
         Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 )
         Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 8
         Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 8
      End If
      If Starfield( StarCount, 1 ) < 0 Then Starfield( StarCount, 0 ) = 0
      If Starfield( StarCount, 1 ) > 640 Then Starfield( StarCount, 0 ) = 0
      If Starfield( StarCount, 2 ) < 0 Then Starfield( StarCount, 0 ) = 0
      If Starfield( StarCount, 2 ) > 480 Then Starfield( StarCount, 0 ) = 0
   End If
   If Starfield( StarCount, 0 ) = 0 Then
      Starfield( StarCount, 0 ) = 1
      Starfield( StarCount, 1 ) = 320
      Starfield( StarCount, 2 ) = 240
      Starfield( StarCount, 3 ) = Rand( 0, 2 )
      Starfield( StarCount, 4 ) = Rand( 0, 359 )
   End If
Next
End Function

	IonPainter	Fr, Dez 26, 2003 20:40 Antworten mit Zitat
jo sieht kewl aus

IonPainter

Fr, Dez 26, 2003 20:40
Antworten mit Zitat

jo sieht kewl aus Wink

	konstantin	Fr, Dez 26, 2003 20:43 Antworten mit Zitat
Für Silvester mal ein paar Werte verändert. Der Mauszeiger ist nun eine kleine "Zündkerze" Code: [AUSKLAPPEN] [EINKLAPPEN] InitGraphics( "piXelfield 2 :: by Alu-Folie", 640, 480, 16, 2 ) InitBuffer() Dim Starfield( 1000, 4 ) Repeat Cls Func_Starfield() Flip Until( KeyHit( 1 ) ) Function InitGraphics( AppName$, gwidth, gheight, gdeep, gmode ) AppTitle AppName$ Graphics gwidth, gheight, gdeep, gmode HidePointer End Function Function InitBuffer() SetBuffer BackBuffer() End Function Function Func_Starfield() For StarCount = 0 To 1000 If Starfield( StarCount, 0 ) = 1 Then If Starfield( StarCount, 3 ) = 2 Then Color 255, 255, 255 Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 ) Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 10 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 10 End If If Starfield( StarCount, 3 ) = 1 Then Color 200, 200, 200 Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 ) Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 12 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 12 End If If Starfield( StarCount, 3 ) = 0 Then Color 230, 230, 230 Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 ) Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 8 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 8 End If If Starfield( StarCount, 1 ) < 0 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 1 ) > 640 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 2 ) < 0 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 2 ) > 480 Then Starfield( StarCount, 0 ) = 0 End If If Starfield( StarCount, 0 ) = 0 Then Starfield( StarCount, 0 ) = 1 Starfield( StarCount, 1 ) = MouseX() Starfield( StarCount, 2 ) = MouseY() Starfield( StarCount, 3 ) = Rand( 0, 2 ) Starfield( StarCount, 4 ) = Rand( 0, 359 ) End If Next End Function

konstantin

Fr, Dez 26, 2003 20:43
Antworten mit Zitat

Für Silvester mal ein paar Werte verändert. Der Mauszeiger ist nun eine kleine "Zündkerze" Very Happy

Code: [AUSKLAPPEN]

InitGraphics( "piXelfield 2 :: by Alu-Folie", 640, 480, 16, 2 )
InitBuffer()

Dim Starfield( 1000, 4 )

Repeat
Cls
Func_Starfield()
Flip
Until( KeyHit( 1 ) )

Function InitGraphics( AppName$, gwidth, gheight, gdeep, gmode )
AppTitle AppName$
Graphics gwidth, gheight, gdeep, gmode
HidePointer
End Function

Function InitBuffer()
SetBuffer BackBuffer()
End Function

Function Func_Starfield()
For StarCount = 0 To 1000
   If Starfield( StarCount, 0 ) = 1 Then
      If Starfield( StarCount, 3 ) = 2 Then
         Color 255, 255, 255
         Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 )
         Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 10
         Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 10
      End If
      If Starfield( StarCount, 3 ) = 1 Then
         Color 200, 200, 200
         Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 )
         Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 12
         Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 12
      End If
      If Starfield( StarCount, 3 ) = 0 Then
         Color 230, 230, 230
         Plot Starfield( StarCount, 1 ), Starfield( StarCount, 2 )
         Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 8
         Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 8
      End If
      If Starfield( StarCount, 1 ) < 0 Then Starfield( StarCount, 0 ) = 0
      If Starfield( StarCount, 1 ) > 640 Then Starfield( StarCount, 0 ) = 0
      If Starfield( StarCount, 2 ) < 0 Then Starfield( StarCount, 0 ) = 0
      If Starfield( StarCount, 2 ) > 480 Then Starfield( StarCount, 0 ) = 0
   End If
   If Starfield( StarCount, 0 ) = 0 Then
      Starfield( StarCount, 0 ) = 1
      Starfield( StarCount, 1 ) = MouseX()
      Starfield( StarCount, 2 ) = MouseY()
      Starfield( StarCount, 3 ) = Rand( 0, 2 )
      Starfield( StarCount, 4 ) = Rand( 0, 359 )
   End If
Next
End Function

	IonPainter	Fr, Dez 26, 2003 20:50 Antworten mit Zitat
dr. ion empfiehlt: farbe & speed: Code: [AUSKLAPPEN] [EINKLAPPEN] InitGraphics( "piXelfield 2 :: by Alu-Folie - modded by IonPainter", 640, 480, 16, 2 ) InitBuffer() Dim Starfield( 1000, 4 ) Repeat Cls Func_Starfield() Flip Until( KeyHit( 1 ) ) Function InitGraphics( AppName$, gwidth, gheight, gdeep, gmode ) AppTitle AppName$ Graphics gwidth, gheight, gdeep, gmode HidePointer End Function Function InitBuffer() SetBuffer BackBuffer() End Function Function Func_Starfield() For StarCount = 0 To 1000 If Starfield( StarCount, 0 ) = 1 Then If Starfield( StarCount, 3 ) = 2 Then RGBa=Rnd(0,255)$10000 + Rnd(0,255)$100 + Rnd(0,255) LockBuffer BackBuffer() WritePixelFast Starfield( StarCount, 1 ), Starfield( StarCount, 2 ),rgba UnlockBuffer BackBuffer() Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 10 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 10 End If If Starfield( StarCount, 3 ) = 1 Then RGBa=Rnd(0,255)$10000 + Rnd(0,255)$100 + Rnd(0,255) LockBuffer BackBuffer() WritePixelFast Starfield( StarCount, 1 ), Starfield( StarCount, 2 ),rgba UnlockBuffer BackBuffer() Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 12 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 12 End If If Starfield( StarCount, 3 ) = 0 Then RGBa=Rnd(0,255)$10000 + Rnd(0,255)$100 + Rnd(0,255) LockBuffer BackBuffer() WritePixelFast Starfield( StarCount, 1 ), Starfield( StarCount, 2 ),rgba UnlockBuffer BackBuffer() Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 8 Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 8 End If If Starfield( StarCount, 1 ) < 0 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 1 ) > 640 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 2 ) < 0 Then Starfield( StarCount, 0 ) = 0 If Starfield( StarCount, 2 ) > 480 Then Starfield( StarCount, 0 ) = 0 End If If Starfield( StarCount, 0 ) = 0 Then Starfield( StarCount, 0 ) = 1 Starfield( StarCount, 1 ) = MouseX() Starfield( StarCount, 2 ) = MouseY() Starfield( StarCount, 3 ) = Rand( 0, 2 ) Starfield( StarCount, 4 ) = Rand( 0, 359 ) End If Next End Function

IonPainter

Fr, Dez 26, 2003 20:50
Antworten mit Zitat

dr. ion empfiehlt: farbe & speed:

Code: [AUSKLAPPEN]

InitGraphics( "piXelfield 2 :: by Alu-Folie - modded by IonPainter", 640, 480, 16, 2 )
InitBuffer()

Dim Starfield( 1000, 4 )

Repeat
Cls
Func_Starfield()
Flip
Until( KeyHit( 1 ) )

Function InitGraphics( AppName$, gwidth, gheight, gdeep, gmode )
AppTitle AppName$
Graphics gwidth, gheight, gdeep, gmode
HidePointer
End Function

Function InitBuffer()
SetBuffer BackBuffer()
End Function

Function Func_Starfield()
For StarCount = 0 To 1000
If Starfield( StarCount, 0 ) = 1 Then
If Starfield( StarCount, 3 ) = 2 Then
RGBa=Rnd(0,255)*$10000 + Rnd(0,255)*$100 + Rnd(0,255)

         LockBuffer BackBuffer()
         WritePixelFast Starfield( StarCount, 1 ), Starfield( StarCount, 2 ),rgba
         UnlockBuffer BackBuffer()

Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 10
Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 10
End If
If Starfield( StarCount, 3 ) = 1 Then
RGBa=Rnd(0,255)*$10000 + Rnd(0,255)*$100 + Rnd(0,255)

         LockBuffer BackBuffer()
         WritePixelFast Starfield( StarCount, 1 ), Starfield( StarCount, 2 ),rgba
         UnlockBuffer BackBuffer()

Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 12
Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 12
End If
If Starfield( StarCount, 3 ) = 0 Then
RGBa=Rnd(0,255)*$10000 + Rnd(0,255)*$100 + Rnd(0,255)

         LockBuffer BackBuffer()
         WritePixelFast Starfield( StarCount, 1 ), Starfield( StarCount, 2 ),rgba
         UnlockBuffer BackBuffer()

Starfield( StarCount, 1 ) = Starfield( StarCount, 1 ) - Sin( Starfield( StarCount, 4 ) ) * 8
Starfield( StarCount, 2 ) = Starfield( StarCount, 2 ) + Cos( Starfield( StarCount, 4 ) ) * 8
End If
If Starfield( StarCount, 1 ) < 0 Then Starfield( StarCount, 0 ) = 0
If Starfield( StarCount, 1 ) > 640 Then Starfield( StarCount, 0 ) = 0
If Starfield( StarCount, 2 ) < 0 Then Starfield( StarCount, 0 ) = 0
If Starfield( StarCount, 2 ) > 480 Then Starfield( StarCount, 0 ) = 0
End If
If Starfield( StarCount, 0 ) = 0 Then
Starfield( StarCount, 0 ) = 1
Starfield( StarCount, 1 ) = MouseX()
Starfield( StarCount, 2 ) = MouseY()
Starfield( StarCount, 3 ) = Rand( 0, 2 )
Starfield( StarCount, 4 ) = Rand( 0, 359 )
End If
Next
End Function

	konstantin	Fr, Dez 26, 2003 20:52 Antworten mit Zitat
Hehe, schaut gut aus, so wie zersprungenes Buntglas .

konstantin

Fr, Dez 26, 2003 20:52
Antworten mit Zitat

Hehe, schaut gut aus, so wie zersprungenes Buntglas Very Happy

	Suco-X Betreff: .....	Fr, Dez 26, 2003 22:18 Antworten mit Zitat
Nette Sources. Ich weiß nicht ob das babsichtigt war, aber macht Starfield mal Float! Starfield#( 1000, 4 ) . Dadurch wirkt der effekt besser. bye
Intel Core 2 Quad Q8300, 4× 2500 MHz, 4096 MB DDR2-Ram, GeForce 9600GT 512 MB

Suco-X

Betreff: .....

Fr, Dez 26, 2003 22:18
Antworten mit Zitat

Nette Sources. Ich weiß nicht ob das babsichtigt war, aber macht Starfield mal Float! Starfield#( 1000, 4 ) . Dadurch wirkt der effekt besser.
bye

Intel Core 2 Quad Q8300, 4× 2500 MHz, 4096 MB DDR2-Ram, GeForce 9600GT 512 MB

	OJay	Fr, Dez 26, 2003 22:22 Antworten mit Zitat
was da bitteschön 3D? ich seh du nur ein haufen punkte nach außen fliegen... DAS ist 3D: Code: [AUSKLAPPEN] [EINKLAPPEN] Const wd=800,ht=600 Const rspeed=3 Const m3d=500 size=20000 ;anzahl der punkte u#=17 r0#=10 uu#=0 ii#=0 Dim x#(size) Dim y#(size) Dim z#(size) Dim p_sin#(1000000) Dim p_cos#(1000000) For i=0 To 1000000 p_sin(i)=Sin(i-500000) p_cos(i)=Cos(i-500000) Next ;kugel For i=0 To Int(size/3) r#=2 h#=Rnd#(-r0,r0) ;hoehe und winkel werden zufaellig gewaehlt r#=Sin#(h#)+Sin#(h#3)+Cos#(h#)+Cos#(h#4)+10Sin#(h#/2) a#=Rnd#(0,360) yy#=h# rr#=Sqr(r^2-h#^2) ;berechnung der x und z-koordinate des punktes xx#=Cos#(a)rr# zz#=Sin#(a)rr# x#(i)=xx# y#(i)=yy#-5 z#(i)=zz# Next ;torus For i=Int(size/3)To Int(size/32) r1#=5 r2#=2 a#=Rnd#(0,360) ;hoehe und winkel werden zufaellig gewaehlt b#=Rnd#(0,360) xx#=Cos#(a)r1#+Cos#(a)Cos#(b)r2 ;berechnung der x und z-koordinate des punktes zz#=Sin#(a)r1#+Sin#(a)Cos#(b)r2 yy#=Sin#(b)r2 x#(i)=xx# y#(i)=yy# z#(i)=zz# Next For i=Int(size/32) To size r#=2 h#=Rnd#(-r0,r0) r#=Sin#(h#)+Sin#(h#3)+Cos#(h#)+Cos#(h#4)+10Sin#(h#/2) a#=Rnd#(0,360) yy#=h# rr#=Sqr(r^2-h#^2) xx#=Cos#(a)rr# zz#=Sin#(a)rr# x#(i)=xx# y#(i)=yy#+5 z#(i)=zz# Next Graphics wd,ht,16,1 SetBuffer BackBuffer() d=1 Mod 360 ;################################# Repeat LockBuffer BackBuffer() uu#=uu#+rspeed ii#=ii#+rspeed cosii#=Cos#(ii) sinii#=Sin#(ii) cosuu#=Cos#(uu#) sinuu#=Sin#(uu#) For i=0 To size rx# = (cosii# x#(i) + Sinii * z#(i)) rz# = (Sinii# * x#(i) - Cosii# * z#(i)) ry# = (cosuu# * y#(i) + sinuu# * rz#) rz# = (sinuu# * y#(i) - cosuu# * rz#) p#=rz#+u If (p#5)>255 Then p#=51 nx=xy3d(rx#,rz#+u) ny=xy3d(ry#,rz#+u) px=nx+wd/2 py=ny+ht/2 cond=(px>=1) And (px<=wd-1) And (py>=1) And (py<=ht-1) If cond Then farbe=255-(p#5) rgb=farbe$10000 + farbe$100 + farbe WritePixelFast px,py,rgb End If Next UnlockBuffer BackBuffer() Flip Cls Until KeyHit(1) ;################################### Function xy3d(xm#, xz#) If xz#<>0 Then Return Int(m3d * xm# / xz#) End Function

OJay

Fr, Dez 26, 2003 22:22
Antworten mit Zitat

was da bitteschön 3D? ich seh du nur ein haufen punkte nach außen fliegen...

DAS ist 3D:

Code: [AUSKLAPPEN]

Const wd=800,ht=600
Const rspeed=3
Const m3d=500
size=20000 ;anzahl der punkte
u#=17
r0#=10
uu#=0
ii#=0

Dim x#(size)
Dim y#(size)
Dim z#(size)

Dim p_sin#(1000000)
Dim p_cos#(1000000)

For i=0 To 1000000
p_sin(i)=Sin(i-500000)
p_cos(i)=Cos(i-500000)
Next

;kugel
For i=0 To Int(size/3)
r#=2
h#=Rnd#(-r0,r0) ;hoehe und winkel werden zufaellig gewaehlt
r#=Sin#(h#)+Sin#(h#*3)+Cos#(h#)+Cos#(h#*4)+10*Sin#(h#/2)
a#=Rnd#(0,360)
yy#=h#
rr#=Sqr(r^2-h#^2) ;berechnung der x und z-koordinate des punktes
xx#=Cos#(a)*rr#
zz#=Sin#(a)*rr#
x#(i)=xx#
y#(i)=yy#-5
z#(i)=zz#
Next

;torus
For i=Int(size/3)To Int(size/3*2)
r1#=5
r2#=2
a#=Rnd#(0,360) ;hoehe und winkel werden zufaellig gewaehlt
b#=Rnd#(0,360)
xx#=Cos#(a)*r1#+Cos#(a)*Cos#(b)*r2 ;berechnung der x und z-koordinate des punktes
zz#=Sin#(a)*r1#+Sin#(a)*Cos#(b)*r2
yy#=Sin#(b)*r2
x#(i)=xx#
y#(i)=yy#
z#(i)=zz#
Next

For i=Int(size/3*2) To size
r#=2
h#=Rnd#(-r0,r0)
r#=Sin#(h#)+Sin#(h#*3)+Cos#(h#)+Cos#(h#*4)+10*Sin#(h#/2)
a#=Rnd#(0,360)
yy#=h#
rr#=Sqr(r^2-h#^2)
xx#=Cos#(a)*rr#
zz#=Sin#(a)*rr#
x#(i)=xx#
y#(i)=yy#+5
z#(i)=zz#
Next

Graphics wd,ht,16,1
SetBuffer BackBuffer()

d=1 Mod 360

;#################################
Repeat

LockBuffer BackBuffer()

uu#=uu#+rspeed
ii#=ii#+rspeed

cosii#=Cos#(ii)
sinii#=Sin#(ii)
cosuu#=Cos#(uu#)
sinuu#=Sin#(uu#)

For i=0 To size
   rx# = (cosii# * x#(i) + Sinii * z#(i))
   rz# = (Sinii# * x#(i) - Cosii# * z#(i))
   ry# = (cosuu# * y#(i) + sinuu# * rz#)
   rz# = (sinuu# * y#(i) - cosuu# * rz#)
   p#=rz#+u

   If (p#*5)>255 Then p#=51

   nx=xy3d(rx#,rz#+u)
   ny=xy3d(ry#,rz#+u)
   px=nx+wd/2
   py=ny+ht/2
   cond=(px>=1) And (px<=wd-1) And (py>=1) And (py<=ht-1)

   If cond Then
      farbe=255-(p#*5)
      rgb=farbe*$10000 + farbe*$100 + farbe
      WritePixelFast px,py,rgb
   End If
Next

UnlockBuffer BackBuffer()

Flip
Cls

Until KeyHit(1)

;###################################
Function xy3d(xm#, xz#)
If xz#<>0 Then Return Int(m3d * xm# / xz#)
End Function

	konstantin	Fr, Dez 26, 2003 22:32 Antworten mit Zitat
Nein, aber es sieht so aus als ob alles auf einen zuströmt. Aber dein Effekt ist auch ganz nett, gehört nur völlig nicht hier hin

konstantin

Fr, Dez 26, 2003 22:32
Antworten mit Zitat

Nein, aber es sieht so aus als ob alles auf einen zuströmt.
Aber dein Effekt ist auch ganz nett, gehört nur völlig nicht hier hin Wink

	OJay	Fr, Dez 26, 2003 22:36 Antworten mit Zitat
Zitat: piXelfield 2 ( Fake 3D ) wieso nicht? weil es nicht von dir ist? o_O

OJay

Fr, Dez 26, 2003 22:36
Antworten mit Zitat

Zitat:

piXelfield 2 ( Fake 3D )

wieso nicht? weil es nicht von dir ist? o_O

	konstantin	Fr, Dez 26, 2003 22:48 Antworten mit Zitat
es geht hier um mein Pixelfield Ich find deins auch Klasse, aber mach dann dafür auch nen eigenen Thread

konstantin

Fr, Dez 26, 2003 22:48
Antworten mit Zitat

es geht hier um mein Pixelfield Wink

Ich find deins auch Klasse, aber mach dann dafür auch nen eigenen Thread Wink

	OJay	Fr, Dez 26, 2003 22:51 Antworten mit Zitat
lol, du bist lustig! was meinst du, was das ist?

OJay

Fr, Dez 26, 2003 22:51
Antworten mit Zitat

lol, du bist lustig! was meinst du, was das ist? Laughing

	Travis	Fr, Dez 26, 2003 23:21 Antworten mit Zitat
@ Alu Das sieht fast so aus, wie mein erster Versuch ein Sternenfeld (ähnlich dem Win Bildschirmschoner) zu entwickeln. Hier mal mein zweiter Versuch: Code: [AUSKLAPPEN] [EINKLAPPEN] ; Sternenfeld v2.0 ; Copyright (C) Dez 2003, Daniel Nobis Global StartX, StartY ResX = 1024 ; Horizontale Auflösung ResY = 768 ; Vertikale Auflösung StartX = 512 ; Startpunkt X der Sterne StartY = 384 ; Startpunkt Y der Sterne Mouse = 0 ; Maussteuerung 1/0 MaxSpeed = 5 ; Maximale Geschwindigkeit n = 500 ; Anzahl der Sterne Dim x#(n) Dim y#(n) Dim Winkel(n) Dim Speed#(n), AktuellSpeed#(n) Dim AbstandWert#(n) Dim Farbe(n) Graphics ResX, ResY, GraphicsDepth, 1 SetBuffer BackBuffer() ; Allen Sternen Werte zuweisen SeedRnd MilliSecs() For i = 1 To n CreateStern(i) Next Repeat Cls If Mouse = 1 Then StartX = MouseX(): StartY = MouseY() For i = 1 To n AbstandWert#(i) = Abstand(x#(i), y#(i), StartX, StartY) Farbe(i) = AbstandWert#(i) * .9 If Farbe(i) > 255 Then Farbe(i) = 255 Color Farbe(i), Farbe(i), Farbe(i) Plot x(i), y(i) x#(i) = x#(i) + Cos(Winkel(i)) * AktuellSpeed#(i) y#(i) = y#(i) + Sin(Winkel(i)) * AktuellSpeed#(i) AktuellSpeed#(i) = AbstandWert#(i) / 30 * Speed#(i) + .4 If x#(i) > ResX Or x#(i) < 0 Then CreateStern(i) ; Sterne außerhalb des Bildschirmes zurücksetzen If y#(i) > ResY Or y#(i) < 0 Then CreateStern(i) Next Flip Until KeyHit(1) Or MouseHit(1) End Function Abstand#(x1#,y1#,x2#,y2#) xhypo# = x1# - x2# yhypo# = y1# - y2# Abstand# = Abs(Sqr((xhypo# ^ 2) + (yhypo# ^2))) Return abstand# End Function Function CreateStern(i) x#(i) = StartX: y#(i) = StartY: Winkel(i) = Rnd(0, 359): Speed#(i) = Rnd(1, MaxSpeed) End Function
www.funforge.org Ich hasse WASD-Steuerung. Man kann alles sagen, man muss es nur vernünftig begründen können.

Travis

Fr, Dez 26, 2003 23:21
Antworten mit Zitat

@ Alu

Das sieht fast so aus, wie mein erster Versuch ein Sternenfeld (ähnlich dem Win Bildschirmschoner) zu entwickeln.

Hier mal mein zweiter Versuch:

Code: [AUSKLAPPEN]

; Sternenfeld v2.0
; Copyright (C) Dez 2003, Daniel Nobis

Global StartX, StartY

ResX = 1024 ; Horizontale Auflösung
ResY = 768 ; Vertikale Auflösung
StartX = 512 ; Startpunkt X der Sterne
StartY = 384 ; Startpunkt Y der Sterne

Mouse = 0 ; Maussteuerung 1/0
MaxSpeed = 5 ; Maximale Geschwindigkeit
n = 500 ; Anzahl der Sterne

Dim x#(n)
Dim y#(n)
Dim Winkel(n)
Dim Speed#(n), AktuellSpeed#(n)
Dim AbstandWert#(n)
Dim Farbe(n)

Graphics ResX, ResY, GraphicsDepth, 1
SetBuffer BackBuffer()

; Allen Sternen Werte zuweisen
SeedRnd MilliSecs()
For i = 1 To n
CreateStern(i)
Next

Repeat

Cls

If Mouse = 1 Then StartX = MouseX(): StartY = MouseY()

For i = 1 To n

AbstandWert#(i) = Abstand(x#(i), y#(i), StartX, StartY)

Farbe(i) = AbstandWert#(i) * .9
If Farbe(i) > 255 Then Farbe(i) = 255

Color Farbe(i), Farbe(i), Farbe(i)
Plot x(i), y(i)

x#(i) = x#(i) + Cos(Winkel(i)) * AktuellSpeed#(i)
y#(i) = y#(i) + Sin(Winkel(i)) * AktuellSpeed#(i)

AktuellSpeed#(i) = AbstandWert#(i) / 30 * Speed#(i) + .4

If x#(i) > ResX Or x#(i) < 0 Then CreateStern(i) ; Sterne außerhalb des Bildschirmes zurücksetzen
If y#(i) > ResY Or y#(i) < 0 Then CreateStern(i)

Next

Flip

Until KeyHit(1) Or MouseHit(1)
End

Function Abstand#(x1#,y1#,x2#,y2#)
xhypo# = x1# - x2#
yhypo# = y1# - y2#

Abstand# = Abs(Sqr((xhypo# ^ 2) + (yhypo# ^2)))
Return abstand#
End Function

Function CreateStern(i)
x#(i) = StartX:
y#(i) = StartY:
Winkel(i) = Rnd(0, 359):
Speed#(i) = Rnd(1, MaxSpeed)
End Function

www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.

	Cloud	Fr, Dez 26, 2003 23:57 Antworten mit Zitat
Das von Alu sieht komisch aus weil alle sterne aus einem einziegen Punkt starten, da würde ich ne größere Flache als Startpunkt nehmen dann würde das bestimmt gut aussehen. Das von Travis gefällt mir echt gut sieht aus wie nen richtiges Sternenfeld
Duron 1200 \| 256 RAM \| Geforce 2 TI

Cloud

Fr, Dez 26, 2003 23:57
Antworten mit Zitat

Das von Alu sieht komisch aus weil alle sterne aus einem einziegen Punkt starten, da würde ich ne größere Flache als Startpunkt nehmen dann würde das bestimmt gut aussehen.

Das von Travis gefällt mir echt gut sieht aus wie nen richtiges Sternenfeld

Duron 1200 | 256 RAM | Geforce 2 TI

	junky	Sa, Dez 27, 2003 0:19 Antworten mit Zitat
kopfnick so, nochma en geschwindigkeitsboost für deinen code travis ( damit lässt sich doch bestimmt noch mehr anstellen ... oder ?! ) Code:* [AUSKLAPPEN] [EINKLAPPEN] ; Sternenfeld v2.0 ; Copyright (C) Dez 2003, Daniel Nobis Global StartX, StartY ResX = 1024 ; Horizontale Auflösung ResY = 768 ; Vertikale Auflösung StartX = 512 ; Startpunkt X der Sterne StartY = 384 ; Startpunkt Y der Sterne Mouse = 0 ; Maussteuerung 1/0 MaxSpeed = 5 ; Maximale Geschwindigkeit n = 500 ; Anzahl der Sterne Dim x#(n) Dim y#(n) Dim Winkel(n) Dim Speed#(n), AktuellSpeed#(n) Dim AbstandWert#(n) Dim Farbe(n) Graphics ResX, ResY, GraphicsDepth, 1 SetBuffer BackBuffer() ; Allen Sternen Werte zuweisen SeedRnd MilliSecs() For i = 1 To n CreateStern(i) Next Repeat ; ==== FPS-Counter ====>> syszeit=MilliSecs() If syszeit>fpszeit+1000 fps=fpsct : fpszeit=syszeit : fpsct=0 Else fpsct=fpsct+1 EndIf ; <<==== Cls If Mouse = 1 Then StartX = MouseX(): StartY = MouseY() LockBuffer(BackBuffer()) For i = 1 To n AbstandWert#(i) = Abstand(x#(i), y#(i), StartX, StartY) Farbe(i) = AbstandWert#(i) * .9 If Farbe(i) > 255 Then Farbe(i) = 255 ;Color Farbe(i), Farbe(i), Farbe(i) ;Plot x(i), y(i) Pixelfarbe=(Farbe(i)$1000000 + Farbe(i)$10000 + Farbe(i)$100 + Farbe(i)) ; ==>> !!!! WritePixelFast(x(i),y(i),Pixelfarbe,BackBuffer) ; ==>> !!!! x#(i) = x#(i) + Cos(Winkel(i)) AktuellSpeed#(i) y#(i) = y#(i) + Sin(Winkel(i)) * AktuellSpeed#(i) AktuellSpeed#(i) = AbstandWert#(i) / 30 * Speed#(i) + .4 If x#(i) > ResX Or x#(i) < 0 Then CreateStern(i) ; Sterne außerhalb des Bildschirmes zurücksetzen If y#(i) > ResY Or y#(i) < 0 Then CreateStern(i) Next UnlockBuffer(BackBuffer()) ; ==>> !!!! Color 255,255,255 Text 0,0,fps ; mit Flip 0 sieht man den Unterschied Flip 1 Until KeyHit(1) Or MouseHit(1) End Function Abstand#(x1#,y1#,x2#,y2#) xhypo# = x1# - x2# yhypo# = y1# - y2# Abstand# = Abs(Sqr((xhypo# ^ 2) + (yhypo# ^2))) Return abstand# End Function Function CreateStern(i) x#(i) = StartX: y#(i) = StartY: Winkel(i) = Rnd(0, 359): Speed#(i) = Rnd(1, MaxSpeed) End Function
gestern stand ich noch vorm Abgrund heute bin ich einen Schritt weiter...

junky

Sa, Dez 27, 2003 0:19
Antworten mit Zitat

*kopfnick

so, nochma en geschwindigkeitsboost für deinen code travis ( damit lässt sich doch bestimmt noch mehr anstellen ... oder ?! )

Code: [AUSKLAPPEN]

; Sternenfeld v2.0
; Copyright (C) Dez 2003, Daniel Nobis

Global StartX, StartY

ResX = 1024 ; Horizontale Auflösung
ResY = 768 ; Vertikale Auflösung
StartX = 512 ; Startpunkt X der Sterne
StartY = 384 ; Startpunkt Y der Sterne

Mouse = 0 ; Maussteuerung 1/0
MaxSpeed = 5 ; Maximale Geschwindigkeit
n = 500 ; Anzahl der Sterne

Dim x#(n)
Dim y#(n)
Dim Winkel(n)
Dim Speed#(n), AktuellSpeed#(n)
Dim AbstandWert#(n)
Dim Farbe(n)

Graphics ResX, ResY, GraphicsDepth, 1
SetBuffer BackBuffer()

; Allen Sternen Werte zuweisen
SeedRnd MilliSecs()
For i = 1 To n
CreateStern(i)
Next

Repeat

; ==== FPS-Counter ====>>
syszeit=MilliSecs()
If syszeit>fpszeit+1000
fps=fpsct : fpszeit=syszeit : fpsct=0
Else
fpsct=fpsct+1
EndIf
; <<====

Cls

If Mouse = 1 Then StartX = MouseX(): StartY = MouseY()

LockBuffer(BackBuffer())
For i = 1 To n

AbstandWert#(i) = Abstand(x#(i), y#(i), StartX, StartY)

Farbe(i) = AbstandWert#(i) * .9
If Farbe(i) > 255 Then Farbe(i) = 255

;Color Farbe(i), Farbe(i), Farbe(i)
;Plot x(i), y(i)

Pixelfarbe=(Farbe(i)*$1000000 + Farbe(i)*$10000 + Farbe(i)*$100 + Farbe(i)) ; ==>> !!!!
WritePixelFast(x(i),y(i),Pixelfarbe,BackBuffer) ; ==>> !!!!

x#(i) = x#(i) + Cos(Winkel(i)) * AktuellSpeed#(i)
y#(i) = y#(i) + Sin(Winkel(i)) * AktuellSpeed#(i)

AktuellSpeed#(i) = AbstandWert#(i) / 30 * Speed#(i) + .4

If x#(i) > ResX Or x#(i) < 0 Then CreateStern(i) ; Sterne außerhalb des Bildschirmes zurücksetzen
If y#(i) > ResY Or y#(i) < 0 Then CreateStern(i)

Next
UnlockBuffer(BackBuffer()) ; ==>> !!!!

Color 255,255,255
Text 0,0,fps

; mit Flip 0 sieht man den Unterschied
Flip 1

Until KeyHit(1) Or MouseHit(1)
End

Function Abstand#(x1#,y1#,x2#,y2#)
xhypo# = x1# - x2#
yhypo# = y1# - y2#

Abstand# = Abs(Sqr((xhypo# ^ 2) + (yhypo# ^2)))
Return abstand#
End Function

Function CreateStern(i)
x#(i) = StartX:
y#(i) = StartY:
Winkel(i) = Rnd(0, 359):
Speed#(i) = Rnd(1, MaxSpeed)
End Function

gestern stand ich noch vorm Abgrund
heute bin ich einen Schritt weiter...

	Travis	Sa, Dez 27, 2003 0:55 Antworten mit Zitat
Wow! Jetzt ist Warpgeschwindigkeit angesagt . Nicht schlecht. Leider kenne ich mich mit dem WritePixelFast und den Buffer-Befehlen nicht so gut aus. Ich hatte da mit den Farbwerten immer Schwierigkeiten. Er zeigt jetzt bei mir ca 1190 FPS an. Habe das ganze dann aber mit Delay wieder auf ca 90 runtergebremst, sonst läuft es doch etwas sehr schnell.
www.funforge.org Ich hasse WASD-Steuerung. Man kann alles sagen, man muss es nur vernünftig begründen können.

Travis

Sa, Dez 27, 2003 0:55
Antworten mit Zitat

Wow! Jetzt ist Warpgeschwindigkeit angesagt Very Happy

. Nicht schlecht. Leider kenne ich mich mit dem WritePixelFast und den Buffer-Befehlen nicht so gut aus. Ich hatte da mit den Farbwerten immer Schwierigkeiten.

Er zeigt jetzt bei mir ca 1190 FPS an. Habe das ganze dann aber mit Delay wieder auf ca 90 runtergebremst, sonst läuft es doch etwas sehr schnell.

www.funforge.org

Ich hasse WASD-Steuerung.

Man kann alles sagen, man muss es nur vernünftig begründen können.

	konstantin	Sa, Dez 27, 2003 1:38 Antworten mit Zitat
WOW - Sieht gut aus! Ich werde mich morgen früh mal ransetzen um meins noch etwas auszuweiten ( auch mit besserer Farbfahl und längeren Sternen ), mal sehen, was daraus wird. Respekt!

konstantin

Sa, Dez 27, 2003 1:38
Antworten mit Zitat

WOW - Sieht gut aus!
Ich werde mich morgen früh mal ransetzen um meins noch etwas auszuweiten ( auch mit besserer Farbfahl und längeren Sternen ), mal sehen, was daraus wird.
Respekt!

	Shadow of the night	Sa, Dez 27, 2003 15:03 Antworten mit Zitat
Hei das von Travis sieht echt gut aus. @OJay wenn ich dich wäre hätte ich einen neuen Thread gemacht, sieht super aus. MfG Shadow of the Night
User posted image

Shadow of the night

Sa, Dez 27, 2003 15:03
Antworten mit Zitat

Hei das von Travis sieht echt gut aus.

@OJay wenn ich dich wäre hätte ich einen neuen Thread gemacht, sieht super aus.

MfG Shadow of the Night

User posted image

	junky	Sa, Dez 27, 2003 15:45 Antworten mit Zitat
@ Travis - so schwer is das auch nicht, wirste auch noch druff kommen ( is in der onlinehilfe eigentlich recht gut beschrieben ) aber en delay brauchste eigentich nicht - lasses ganz normal mit "flip 1" laufen - insgesamt bringt es halt nur ( auch bei flip 1 ) mehr geschwindigkeit , sozusagen im hintergrund - um z.b. noch mehr mit solchen pixel-befehlen anstellen zu können
gestern stand ich noch vorm Abgrund heute bin ich einen Schritt weiter...

junky

Sa, Dez 27, 2003 15:45
Antworten mit Zitat

@ Travis - so schwer is das auch nicht, wirste auch noch druff kommen ( is in der onlinehilfe eigentlich recht gut beschrieben )
aber en delay brauchste eigentich nicht - lasses ganz normal mit "flip 1" laufen - insgesamt bringt es halt nur ( auch bei flip 1 ) mehr geschwindigkeit , sozusagen im hintergrund - um z.b. noch mehr mit solchen pixel-befehlen anstellen zu können Wink

gestern stand ich noch vorm Abgrund
heute bin ich einen Schritt weiter...

Übersicht

BlitzBasic

Codearchiv

Nach Oben

BlitzBasic Portal

piXelfield 2 ( Fake 3D )

Betreff: piXelfield 2 ( Fake 3D )

Betreff: .....