Anonymous
03-20-2006, 03:04 PM
i translated that other prog into 3d =)
http://members.aol.com/rubentbstk/starz.zip
click left mouse button to repel the stars, right click to attract them.
roll your mouse wheel up or down to resize your gray box
bigger gray box = closer to screen.
heres src
http://members.aol.com/rubentbstk/starz.zip
click left mouse button to repel the stars, right click to attract them.
roll your mouse wheel up or down to resize your gray box
bigger gray box = closer to screen.
heres src
Code:
Option Explicit
#Include "crt.bi"
Type Vector
x As Double
y As Double
End Type
Type VectorPair
u As Vector
v As Vector
End Type
Type Vector3D
x As Double
y As Double
z As Double
End Type
Type VectorPair3D
u As Vector3D
v As Vector3D
End Type
Type victimlist_type
v As vectorPair3d
img As uShort Ptr
End Type
Const max_victims = 20000
'' ==========================================================================
Function V2_Subtract( hi As Vector, lo As Vector ) As Vector
Dim As Vector ret
ret.x = hi.x - lo.x
ret.y = hi.y - lo.y
Function = ret
End Function
Function V3_Subtract( hi As Vector3D, lo As Vector3D ) As Vector3d
Dim As Vector3D ret
ret.x = hi.x - lo.x
ret.y = hi.y - lo.y
ret.z = hi.z - lo.z
Function = ret
End Function
Function V2_Midpoint( m As VectorPair ) As Vector
Dim ret As Vector
ret.x = ( m.u.x + ( m.v.x * .5 ) )
ret.y = ( m.u.y + ( m.v.y * .5 ) )
Function = ret
End Function
Function V3_Midpoint( m As VectorPair3D ) As Vector3D
Dim ret As Vector3D
ret.x = ( m.u.x + ( m.v.x * .5 ) )
ret.y = ( m.u.y + ( m.v.y * .5 ) )
ret.z = ( m.u.z + ( m.v.z * .5 ) )
Function = ret
End Function
Function V2_DotProduct( v As vector, v2 As vector ) As Double
Return v.x * v2.x + v.y * v2.y
End Function
Function V3_DotProduct( v As vector3D, v2 As vector3D ) As Double
Return v.x * v2.x + v.y * v2.y + v.z * v2.z
End Function
Function V2_CalcFlyback( cause As VectorPair, effect As VectorPair ) As Vector
Dim As Vector ret
Dim As Double d
ret = V2_Subtract(V2_Midpoint(effect), V2_Midpoint(cause))
'' Octagonal Flyback
'if abs(dd.x) > abs(dd.y) then
' d = 1.0 / abs(dd.x)
'else
' d = 1.0 / abs(dd.y)
'end if
'' Circular Flyback
'' thanks to coderJeff at freebasic.net forums
d = (Abs(ret.x) + Abs(ret.y)) / V2_DotProduct( ret, ret )
ret.x *= d
ret.y *= d
Function = ret
End Function
Function V3_CalcFlyback( cause As VectorPair3D, effect As VectorPair3D ) As Vector3d
Dim As Vector3D ret
Dim As Double d
ret = V3_Subtract(V3_Midpoint(effect), V3_Midpoint(cause))
'' Octagonal Flyback
'if abs(dd.x) > abs(dd.y) then
' d = 1.0 / abs(dd.x)
'else
' d = 1.0 / abs(dd.y)
'end if
'' Circular Flyback
'' thanks to coderJeff at freebasic.net forums
d = (Abs(ret.x) + Abs(ret.y) + Abs(ret.z)) / V3_DotProduct( ret, ret )
ret.x *= d
ret.y *= d
ret.z *= d
Function = ret
End Function
'' ==========================================================================
Dim Shared As Integer mx, my, mb, mw, sx, sy, sz, victims, victim_i
Dim Shared As uByte Ptr scrn
Dim Shared As Double fps, fps_hold, fps_lock, run_control
Dim Shared As Any Ptr rbox
Dim Shared As vector3D flyback, distance
Dim Shared As VectorPair3D attacker
Redim Shared As victimlist_type victimList(0 To max_victims - 1)
Randomize Timer
Screen 14, 24, 2, 1
ScreenInfo sx, sy
sz = 200
scrn = ScreenPtr
For victim_i = 0 To max_victims - 1
With victimlist(victim_i).v
.u.x = Rnd * sx
.u.y = Rnd * sy
.u.z = Rnd * sz
.v.x = 2
.v.y = 2
.v.z = 2
End With
With victimlist(victim_i)
.img = ImageCreate( .v.v.x, .v.v.y )
Line .img, ( 0, 0 )-( .v.v.x - 1, .v.v.y - 1 ), Rgb( 255, 255, 255 ), bf
End With
Next
attacker.v.x = 16
attacker.v.y = 16
attacker.v.z = 16
ScreenSet 0, 1
SetMouse 160, 100
Open cons For Output As #1
victims = 1000
Do
If fps_hold > 15 Then
If victims < max_victims Then
victims += 10
End If
End If
If fps_hold < 5 Then
If victims > 0 Then
victims -= 10
End If
End If
GetMouse mx, my, mw, mb
If mb = -1 Then mb = 0
For victim_i = 0 To victims - 1
With victimlist(victim_i)
memset( @.img[2], 0, .v.v.x * .v.v.y )
.img[0] = Int( ( .v.v.x / sz ) * .v.u.z ) Shl 3
.img[1] = Int( ( .v.v.y / sz ) * .v.u.z )
Line .img, (0,0)-( Int( ( .v.v.x / sz ) * .v.u.z ) - 1, Int( ( .v.v.y / sz ) * .v.u.z ) - 1 ), Rgb( 255, 255, 255 ), bf
If .v.v.x And .v.v.y Then
Put( .v.u.x, .v.u.y ), .img, Alpha, ( ( .v.u.z / sz ) ) * 196
End If
End With
Next
If mb Then SetMouse , , 0 Else SetMouse , , 1
If mb And (1 Or 2) Then
With attacker
.u.x = mx - .v.x * .5
.u.y = my - .v.y * .5
.u.z = Abs( mw Mod 20 ) * sz / 20
Line (.u.x,.u.y)-(.u.x+ Int( ( .v.x / sz ) * .u.z ) - 1,.u.y+ Int( ( .v.y / sz ) * .u.z ) - 1 ), Rgb( 196, 196, 196 ), bf
End With
Else
With attacker
.u.x = sx /2
.u.y = sy /2
.u.z = sz /2
End With
End If
If run_control = 0 Then
For victim_i = 0 To victims - 1
With victimlist(victim_i).v
distance.x = Abs( attacker.u.x - .u.x )
distance.y = Abs( attacker.u.y - .u.y )
distance.z = Abs( attacker.u.z - .u.z )
flyback = V3_CalcFlyback( attacker, victimlist(victim_i).v )
If mb And (1 Or 4) Then
.u.x += ( flyback.x * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * 1
.u.y += ( flyback.y * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * 1
.u.z += ( flyback.z * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * 1
ElseIf mb And 2 Then
.u.x += ( flyback.x * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * -1
.u.y += ( flyback.y * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * -1
.u.z += ( flyback.z * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * -1
Else
.u.x += ( flyback.x * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * 1
.u.y += ( flyback.y * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * 1
.u.z += ( flyback.z * 2 ) * ( 1 / ( distance.x + distance.y + distance.z ) ) * 128 * 1
End If
End With
If Timer > run_control Then run_control = 0
Next
End If
For victim_i = 0 To victims - 1
With victimlist(victim_i).v
If .u.x + .v.x < 0 Or _
.u.y + .v.y < 0 Or _
.u.z < 0 Or _
.u.x > sx Or _
.u.y > sy Or _
.u.z > sz Then
.u.x = Rnd * sx
.u.y = Rnd * sy
.u.z = Rnd * sz
End If
End With
Next
If fps_lock = 0 Then
fps_hold = fps
fps = 0
fps_lock = Timer + 1
? #1, fps_hold
WindowTitle "StarField - cha0s"
If Timer > fps_lock Then fps_lock = 0
Else
If Timer > fps_lock Then fps_lock = 0
End If
fps += 1
Flip
Cls
If MultiKey( 1 ) Then Exit Do
Loop
For victim_i = 0 To max_victims - 1
With victimlist(victim_i)
ImageDestroy( .img )
End With
Next
Sleep