Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
BetaSpot.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 18.12.2011 11:10:27 |
'##########################################################################################################################################################
'### nani - Naniten Simulation
'##########################################################################################################################################################
'### Autor: Martin Wiemann
'### DeltaLab's Germany - Technology Labratory for Experimental Computing
'### 2010.04.28 - 17:02:24
'##########################################################################################################################################################
'##########################################################################################################################################################
Dim Shared G_FieldWidth as UInteger = 800
Dim Shared G_FieldHeight as UInteger = 600
'##########################################################################################################################################################
Type SpoterBeta_Type
V_Next as SpoterBeta_Type Ptr
V_Prev as SpoterBeta_Type Ptr
V_CurrentPosX as Single
V_CurrentPosY as Single
V_TargetPosX as Single
V_TargetPosY as Single
End Type
'----------------------------------------------------------------------------------------------------------------------------------------------------------
Dim Shared G_SpoterBeta_F as SpoterBeta_Type Ptr
Dim Shared G_SpoterBeta_L as SpoterBeta_Type Ptr
'##########################################################################################################################################################
Sub SpoterBeta_CalcAll()
Dim TPtr as SpoterBeta_Type Ptr = G_SpoterBeta_F
Dim NPtr as SpoterBeta_Type Ptr
Dim TS as Single
Dim TSX as Single
Dim TSY as Single
Dim TX as Integer
Dim TY as Integer
Dim TSi as Single
Do Until TPtr = 0
With *TPtr
TS = Sqr((Abs(.V_CurrentPosX - .V_TargetPosX) ^ 2) + (Abs(.V_CurrentPosY - .V_TargetPosY) ^ 2)) / 5
If TS > 1 Then
.V_CurrentPosX += (.V_TargetPosX - .V_CurrentPosX) / TS
.V_CurrentPosY += (.V_TargetPosY - .V_CurrentPosY) / TS
TPtr = TPtr->V_Next
Else
NPtr = TPtr->V_Next
If TPtr->V_Next <> 0 Then TPtr->V_Next->V_Prev = TPtr->V_Prev
If TPtr->V_Prev <> 0 Then TPtr->V_Prev->V_Next = TPtr->V_Next
If G_SpoterBeta_F = TPtr Then G_SpoterBeta_F = TPtr->V_Next
If G_SpoterBeta_L = TPtr Then G_SpoterBeta_L = TPtr->V_Prev
DeAllocate(TPtr)
TPtr = NPtr
End If
End With
Loop
End Sub
'----------------------------------------------------------------------------------------------------------------------------------------------------------
Sub SpoterBeta_Add(V_CurrentPosX as Integer, V_CurrentPosY as Integer, V_Energy as Single)
If G_SpoterBeta_L <> 0 Then
G_SpoterBeta_L->V_Next = CAllocate(SizeOf(SpoterBeta_Type))
G_SpoterBeta_L->V_Next->V_Prev = G_SpoterBeta_L
G_SpoterBeta_L = G_SpoterBeta_L->V_Next
Else
G_SpoterBeta_L = CAllocate(SizeOf(SpoterBeta_Type))
G_SpoterBeta_F = G_SpoterBeta_L
End If
With *G_SpoterBeta_L
.V_CurrentPosX = V_CurrentPosX
.V_CurrentPosY = V_CurrentPosY
'Zufälliges Partikelziel anhand energetischem Niveu berechnen
.V_TargetPosX = V_CurrentPosX + (Int((Rnd * V_Energy * 2) + 1) - V_Energy)
.V_TargetPosY = V_CurrentPosY + (Int((Rnd * V_Energy * 2) + 1) - V_Energy)
'Wenn Zielpunkt auserhalb des Felds, dann Neues Ziel von Feldrand aus berechnen
If .V_TargetPosX > G_FieldWidth Then .V_TargetPosX = G_FieldWidth - Int((Rnd * V_Energy) + 1)
If .V_TargetPosY > G_FieldHeight Then .V_TargetPosY = G_FieldHeight - Int((Rnd * V_Energy) + 1)
If .V_TargetPosX < 0 Then .V_TargetPosX = Int((Rnd * V_Energy) + 1)
If .V_TargetPosY < 0 Then .V_TargetPosY = Int((Rnd * V_Energy) + 1)
'Wenn Zielpunkt immernoch auserhalb des Felds, dann Energiniveu zu hoch und ziel mit Feldgröse berechnen
If .V_TargetPosX > G_FieldWidth Then .V_TargetPosX = G_FieldWidth - Int((Rnd * G_FieldWidth) + 1)
If .V_TargetPosY > G_FieldHeight Then .V_TargetPosY = G_FieldHeight - Int((Rnd * G_FieldHeight) + 1)
If .V_TargetPosX < 0 Then .V_TargetPosX = Int((Rnd * G_FieldWidth) + 1)
If .V_TargetPosY < 0 Then .V_TargetPosY = Int((Rnd * G_FieldHeight) + 1)
'Wenn immernoch auserhalb, dann abschneiden
If .V_TargetPosX > G_FieldWidth Then .V_TargetPosX = G_FieldWidth
If .V_TargetPosY > G_FieldHeight Then .V_TargetPosY = G_FieldHeight
If .V_TargetPosX < 0 Then .V_TargetPosX = 0
If .V_TargetPosY < 0 Then .V_TargetPosY = 0
End With
End Sub
'----------------------------------------------------------------------------------------------------------------------------------------------------------
Sub SpoterBeta_Draw()
ScreenLock()
CLS()
Dim TPtr as SpoterBeta_Type Ptr = G_SpoterBeta_F
Do Until TPtr = 0
With *TPtr
PSet(.V_CurrentPosX, .V_CurrentPosY), &HFFFFFF
End With
TPtr = TPtr->V_Next
Loop
ScreenUnLock()
End Sub
'##########################################################################################################################################################
Sub Main()
ScreenRes G_FieldWidth, G_FieldHeight, 32
Dim TMouseR as Integer
Dim TMouseX as Integer
Dim TMouseY as Integer
Dim TMouseZ as Integer
Dim TMouseB as Integer
Do Until InKey() = Chr(27)
TMouseR = GetMouse(TMouseX, TMouseY, TMouseZ, TMouseB)
If TMouseB = 1 Then
For X as UInteger = 1 to 10
SpoterBeta_Add(TMouseX, TMouseY, 400)
Next
End If
SpoterBeta_CalcAll()
SpoterBeta_Draw()
Sleep 10, 1
Loop
Screen 0
End Sub
'##########################################################################################################################################################
Main()
End 0