Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
flownet.bi
| Uploader: |  OneCypher |
| Datum/Zeit: | 13.10.2009 11:04:04 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts GuiPtr, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
#include once "GuiPtr.bi"
#include once "GuiWindow.bi"
'################################################################################
' TPM - FlowNet - 03.06.2008 (modified by OneCypher 10.10.09)
'################################################################################
Type G_Particle_2D_Type
V_InUse as UByte
X as Single
Y as Single
SpeedX as Single
SpeedY as Single
LX as Single
LY as Single
InertiaX as Single
InertiaY as Single
InertiaTime as Single
V_Presure as Single
V_Color as UInteger
End Type
Type G_Obj_2D_Type
V_InUse as UByte
X as Integer
Y as Integer
Size as UInteger
TColor as UInteger
End Type
type FlowNet
VWindow as GuiWindow = GuiWindow(0,0,600,400,"It Flows...")
G_Room_Width as UInteger
G_Room_Height as UInteger
G_ParticleD(0 to 2000) as G_Particle_2D_Type
G_ParticleC as UInteger
G_TColorG as UByte
G_TColorB as UByte
G_ShowTColor as UByte
G_ObjD(0 to 2000) as G_Obj_2D_Type
G_ObjC as UInteger
G_Density as Single = 20
G_FlowReaction as Single = 0.1
G_ChaosReaction as Single = 30000
G_SubRuntime as UInteger = 6
G_ShowSize as UInteger = 5
G_InertiaTime as Single = 1.2
G_FlowOff as UByte = 1
declare sub Particle_Add()
declare function Obj_Add() as UInteger
declare function Obj_GetOnMouse(V_X as Integer, V_Y as Integer) as UInteger
declare sub Particle_Calculate_Reorientation()
declare constructor (left as integer, top as integer,title as string)
end type
Sub FlowNet.Particle_Add()
Dim XID as UInteger
For X as ULong = 1 to G_ParticleC
If G_ParticleD(X).V_InUse = 0 Then XID = X: Exit For
Next
If XID = 0 Then
G_ParticleC += 1
XID = G_ParticleC
'Redim Preserve G_ParticleD(G_ParticleC) as G_Particle_2D_Type
End If
If G_TColorG Mod 2 = G_TColorB mod 2 Then
G_TColorB += 1
Else: G_TColorG += 1
End if
With G_ParticleD(XID)
.V_InUse = 1
.X = 0
.Y = Int((Rnd * G_Room_Height) + 1)
.SpeedX = 0
.SpeedY = 0
.LX = .LX
.LY = .LY
.InertiaX = 0
.InertiaY = 0
.InertiaTime = 0
.V_Presure = 0
.V_Color = RGB(255, G_TColorG, G_TColorB)
End With
End Sub
Function FlowNet.Obj_Add() as UInteger
Dim XID as UInteger
For X as ULong = 1 to G_ObjC
If G_ObjD(X).V_InUse = 0 Then XID = X: Exit For
Next
If XID = 0 Then
G_ObjC += 1
XID = G_ObjC
'Redim Preserve G_ObjD(G_ObjC) as G_Obj_2D_Type
End If
With G_ObjD(XID)
.V_InUse = 1
.X = 0
.Y = 0
.Size = 100
.TColor = RGB(100 + Int((Rnd * 155) + 1), 100 + Int((Rnd * 155) + 1), 100 + Int((Rnd * 155) + 1))
End With
Return XID
End Function
Function FlowNet.Obj_GetOnMouse(V_X as Integer, V_Y as Integer) as UInteger
For X as ULong = G_ObjC to 1 Step - 1
With G_ObjD(X)
If V_X >= .X and V_X <= .X + .Size and V_Y >= .Y and V_Y <= .Y + .Size Then Return X
End With
Next
End Function
Sub FlowNet.Particle_Calculate_Reorientation()
Dim X as ULong
Dim Y as ULong
Dim RX as Single
Dim RY as Single
Dim NX as Single
Dim NY as Single
Dim DX as UByte
Dim DY as UByte
For X = 1 to G_ParticleC
With G_ParticleD(X)
If .V_InUse = 1 Then
.InertiaTime += G_InertiaTime
If .InertiaTime >= 3 Then
.InertiaX /= 2
.InertiaY /= 2
.InertiaTime = 0
End If
.X += .InertiaX
.Y += .InertiaY
.V_Presure = 0
For Y = 1 To G_ParticleC
If G_ParticleD(Y).V_InUse = 1 Then
If X <> Y Then
If .X < G_ParticleD(Y).X Then
If .Y < G_ParticleD(Y).Y Then
If G_ParticleD(Y).X - .X < G_Density Then
If G_ParticleD(Y).Y - .Y < G_Density Then
RX = ((G_Density - (G_ParticleD(Y).X - .X)) * G_FlowReaction) + (int((rnd * 10) + 1) / G_ChaosReaction)
.X -= RX
G_ParticleD(Y).X += RX
RY = ((G_Density - (G_ParticleD(Y).Y - .Y)) * G_FlowReaction) + (int((rnd * 10) + 1) / G_ChaosReaction)
.Y -= RY
G_ParticleD(Y).Y += RY
.SpeedX = -RX * G_SubRuntime
.SpeedY = -RY * G_SubRuntime
.V_Presure = 1024 / G_Density * ((abs(RX) + abs(RY)) / 2)
End If
End If
Else
If G_ParticleD(Y).X - .X < G_Density Then
If .Y - G_ParticleD(Y).Y < G_Density Then
RX = ((G_Density - (G_ParticleD(Y).X - .X)) * G_FlowReaction) + (int((rnd * 10) + 1) / G_ChaosReaction)
.X -= RX
G_ParticleD(Y).X += RX
RY = ((G_Density - (.Y - G_ParticleD(Y).Y)) * G_FlowReaction) + (int((rnd * 10) + 1) / G_ChaosReaction)
.Y += RY
G_ParticleD(Y).Y -= RY
.SpeedX = -RX * G_SubRuntime
.SpeedY = +RY * G_SubRuntime
.V_Presure = 1024 / G_Density * ((abs(RX) + abs(RY)) / 2)
End If
End If
End If
Else
If .Y < G_ParticleD(Y).Y Then
If .X - G_ParticleD(Y).X < G_Density Then
If G_ParticleD(Y).Y - .Y < G_Density Then
RX = ((G_Density - (.X - G_ParticleD(Y).X)) * G_FlowReaction) + (int((rnd * 10) + 1) / G_ChaosReaction)
.X += RX
G_ParticleD(Y).X -= RX
RY = ((G_Density - (G_ParticleD(Y).Y - .Y)) * G_FlowReaction) + (int((rnd * 10) + 1) / G_ChaosReaction)
.Y -= RY
G_ParticleD(Y).Y += RY
.SpeedX = +RX * G_SubRuntime
.SpeedY = -RY * G_SubRuntime
.V_Presure = 1024 / G_Density * ((abs(RX) + abs(RY)) / 2)
End If
End If
Else
If .X - G_ParticleD(Y).X < G_Density Then
If .Y - G_ParticleD(Y).Y < G_Density Then
RX = ((G_Density - (.X - G_ParticleD(Y).X)) * G_FlowReaction) + (int((rnd * 10) + 1) / G_ChaosReaction)
.X += RX
G_ParticleD(Y).X -= RX
RY = ((G_Density - (.Y - G_ParticleD(Y).Y)) * G_FlowReaction) + (int((rnd * 10) + 1) / G_ChaosReaction)
.Y += RY
G_ParticleD(Y).Y -= RY
.SpeedX = +RX * G_SubRuntime
.SpeedY = +RY * G_SubRuntime
.V_Presure = 1024 / G_Density * ((abs(RX) + abs(RY)) / 2)
End If
End If
End If
End If
End If
End If
Next
For Y = 1 to G_ObjC
If G_ObjD(Y).V_InUse = 1 Then
If (.X > G_ObjD(Y).X - G_Density) and (.X < G_ObjD(Y).X + G_ObjD(Y).Size + G_Density) Then
If (.Y > G_ObjD(Y).Y - G_Density) and (.Y < G_ObjD(Y).Y + G_ObjD(Y).Size + G_Density) Then
If .X - (G_ObjD(Y).X - G_Density) < (G_ObjD(Y).X + G_ObjD(Y).Size + G_Density) - .X Then
NX = .X - (G_ObjD(Y).X - G_Density): DX = 1
Else: NX = (G_ObjD(Y).X + G_ObjD(Y).Size + G_Density) - .X: DX = 2
End If
If .Y - (G_ObjD(Y).Y - G_Density) < (G_ObjD(Y).Y + G_ObjD(Y).Size + G_Density) - .Y Then
NY = .Y - (G_ObjD(Y).Y - G_Density): DY = 1
Else: NY = (G_ObjD(Y).Y + G_ObjD(Y).Size + G_Density) - .Y: DY = 2
End If
If NX < NY Then
If DX = 1 Then
.X = G_ObjD(Y).X - G_Density
Else: .X = G_ObjD(Y).X + G_ObjD(Y).Size + G_Density
End If
Else
If DY = 1 Then
.Y = G_ObjD(Y).Y - G_Density
Else: .Y = G_ObjD(Y).Y + G_ObjD(Y).Size + G_Density
End IF
End If
End If
End if
End if
Next
.InertiaX += (.X - .LX) / 4
.InertiaY += (.Y - .LY) / 4
.LX = .X
.LY = .Y
DY = 0
If .X - G_Density < 0 Then DY = 1: .X = G_Density + ((abs(.X - G_Density) * G_FlowReaction) / 2) + (int((rnd * 10) + 1) / G_ChaosReaction)
If .Y - G_Density < 0 Then DY = DY Or 2: .Y = G_Density + ((abs(.Y - G_Density) * G_FlowReaction) / 2) + (int((rnd * 10) + 1) / G_ChaosReaction)
If .X + G_Density > G_Room_Width Then
If G_FlowOff = 1 Then
DY = DY or 1
.X = (G_Room_Width - G_Density) - (abs((.X + G_Density) - G_Room_Width))' * G_FlowReaction) / 2) + (int((rnd * 10) + 1) / G_ChaosReaction)
Else: .V_InUse = 0
End If
End If
If .Y + G_Density > G_Room_Height Then DY = DY or 2: .Y = (G_Room_Height - G_Density) - (abs((.Y + G_Density) - G_Room_Height))' * G_FlowReaction) / 2) + (int((rnd * 10) + 1) / G_ChaosReaction)
If DY and 1 <> 0 Then
.InertiaX = (.X - .LX) / 4
.LX = .X
End If
If (DY And 2 <> 0) then
.InertiaY = (.Y - .LY) / 4
.LY = .Y
End If
' If .X - G_Density < 0 Then .X = (((-.X) + G_Density) * G_FlowReaction)) + (int((rnd * 10) + 1) / G_ChaosReaction)
' If .Y - G_Density < 0 Then .Y = G_Density + (int((rnd * 10) + 1) / G_ChaosReaction)
' If .X + G_Density > G_Room_Width Then .V_InUse = 0
' If .Y + G_Density > G_Room_Height Then .Y = G_Room_Height - G_Density - (int((rnd * 10) + 1) / G_ChaosReaction)
End If
End With
Next
End Sub
'dim t1 as FlowNet
't1.G_Room_Width = 600
't1.G_Room_Height = 400
'Screenres t1.G_Room_Width + 6, t1.G_Room_Height + 6, 24
Randomize Timer
Sub OnTickFlowNEt(FN as FlowNet ptr)
FN->G_Room_Width = FN->VWindow.Object->width - 6
FN->G_Room_Height = FN->VWindow.Object->height -26
FN->Particle_Calculate_Reorientation()
end sub
Sub ReDrawFlowNet(FN as FlowNet ptr)
Dim XCol as UInteger
Dim MX as Integer
Line FN->VWindow.Object->Buffer, (3, 24)-(FN->G_Room_Width , FN->G_Room_Height +24), RGB(0, 0, 0), BF
For X as integer = 1 to FN->G_ObjC
With FN->G_ObjD(X)
If .V_InUse = 1 Then Line FN->VWindow.Object->Buffer,(.X+3, .Y+24)-(.X + .Size+3, .Y + .Size+24), .TColor, BF
End With
Next
For X as integer = 1 to FN->G_ParticleC
With FN->G_ParticleD(X)
If .V_InUse = 1 Then
If FN->G_ShowTColor = 0 Then
MX = .V_Presure * 5
If MX > 255 Then MX = 255
If MX < 0 Then MX = 0
XCol = RGB(MX, 255 - MX, 0)
Else
XCol = .V_Color
End If
Circle FN->VWindow.Object->Buffer, (1 + .X+3, 1 + .Y+24),FN->G_ShowSize, XCol, , , , F
End If
End With
Next
end sub
'For X as integer = 1 to 200
' t1.Particle_Add()
'Next
'Do
' XParCount = 0
' For X = 1 to t1.G_ParticleC
' If t1.G_ParticleD(X).V_InUse = 1 Then XParCount += 1
'Next
't1.Particle_Calculate_Reorientation()
'ReDraw @t1
'put(0,0),t1.VWindow.Object->Buffer,PSET
'AKey = InKey()
'If AKey <> LKey Then
' Select Case asc(AKey)
' Case 27: Exit Do
' Case asc("a"): Particle_Add()
' Case asc("c")
' G_ParticleC = 0
' Redim G_ParticleD(G_ParticleC) as G_Particle_2D_Type
' Case asc("m")
' For X = 1 to 10
' Particle_Add()
' Next
' Case asc("o"): If G_ShowTColor = 0 Then G_ShowTColor = 1 Else G_ShowTColor = 0
' Case asc("n"): Obj_Add()
' Case asc("w"): If G_FlowOff = 0 Then G_FlowOff = 1 Else G_FlowOff = 0
' End Select
' LKey = AKey
'Else
' If AKey = "b" Then Particle_Add()
'End If
'GetMouse MX, MY, MZ, MB
'TZ = (MZ - MZL) * 5
'If MB > 0 or (MB = 0 and TZ <> 0) Then
' If LOBJID = 0 Then OBJID = Obj_GetOnMouse(MX, MY)
' If OBJID > 0 Then
' LOBJID = OBJID
' With G_ObjD(OBJID)
' If MB = 1 Then
' .X = MX - (.Size / 2)
' .Y = MY - (.Size / 2)
' End If
' .Size += TZ
' If .Size < 10 Then .Size = 10
' If .Size > 200 Then .Size = 200
' End With
' If MB = 2 Then G_ObjD(OBJID).V_InUse = 0
' End If
' MZL = MZ
'Else: If MB = 0 Then LOBJID = 0
'End If
'If XTot < Timer Then
' Sleep 1, 1
' XTot = Timer + 0.01
'End If
'Loop
'Screen 0
'End
constructor FlowNet(left as integer, top as integer,title as string)
VWindow.Object->ClassName = "FlowNet"
VWindow.Object->Left = left
VWindow.Object->top = top
VWindow.Object->MyObject = @This
VWindow.Object->DrawPriority = 0
VWindow.Object->PublicEvents->OnDraw = @RedrawFlowNet
VWindow.Object->PublicEvents->OnTick = @OnTickFlowNet
VWindow.title = title
G_Room_Width = VWindow.Object->width - 6
G_Room_Height = VWindow.Object->height -26
For X as integer = 1 to 200
Particle_Add()
Next
end constructor