Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
PixelCrash.bas
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 15.05.2010 05:40:19 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts PixelCrash, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'#############################################################################################################################
'By: ThePuppetMaster
'Licence: Do What The Fuck U Want
'2010.05.15-05:18:11
'#############################################################################################################################
Dim Shared G_Width as UInteger = 640
Dim Shared G_Height as UInteger = 480
'#############################################################################################################################
Type PC_Pixel_Type
V_Next as PC_Pixel_Type Ptr
V_Prev as PC_Pixel_Type Ptr
V_Color as UInteger
V_CurPosX as Single
V_CurPosY as Single
V_SpeedX as Single
V_SpeedY as Single
V_Size as UInteger
V_Times as UInteger
T_Crashed as UByte
T_Size as UInteger
T_Times as UInteger
T_Shoter as UByte
End Type
'-----------------------------------------------------------------------------------------------------------------------------
Dim Shared G_Pixel_F as PC_Pixel_Type Ptr
Dim Shared G_Pixel_L as PC_Pixel_Type Ptr
Dim Shared G_PixelCount as UInteger
Dim Shared G_Points as Integer
'#############################################################################################################################
Dim Shared G_Level as UInteger
Dim Shared G_DestCount as UInteger
Dim Shared G_Fired as UByte
Dim Shared G_CrashC as UInteger
'#############################################################################################################################
Sub CreateLevel(V_Level as UInteger)
G_Fired = 0
G_CrashC = 0
Do Until G_Pixel_F = 0
G_Pixel_L = G_Pixel_F->V_Next
DeAllocate(G_Pixel_F)
G_Pixel_F = G_Pixel_L
Loop
Select Case V_Level
Case 1: G_PixelCount = 10: G_DestCount = 1
Case 2: G_PixelCount = 20: G_DestCount = 5
Case 3: G_PixelCount = 25: G_DestCount = 10
Case 4: G_PixelCount = 30: G_DestCount = 15
Case 5: G_PixelCount = 35: G_DestCount = 20
Case 6: G_PixelCount = 40: G_DestCount = 30
Case 7: G_PixelCount = 45: G_DestCount = 38
Case 8: G_PixelCount = 50: G_DestCount = 45
Case 9: G_PixelCount = 55: G_DestCount = 51
Case 10: G_PixelCount = 55: G_DestCount = 52
Case 11: G_PixelCount = 55: G_DestCount = 53
Case 12: G_PixelCount = 60: G_DestCount = 56
Case 13: G_PixelCount = 60: G_DestCount = 57
Case 14: G_PixelCount = 60: G_DestCount = 58
Case 15: G_PixelCount = 60: G_DestCount = 59
Case 16: G_PixelCount = 60: G_DestCount = 60
Case 17: G_PixelCount = 45: G_DestCount = 42
Case 18: G_PixelCount = 40: G_DestCount = 35
Case 19: G_PixelCount = 30: G_DestCount = 26
Case 20: G_PixelCount = 10: G_DestCount = 8
End Select
For X as UInteger = 1 to G_PixelCount
If G_Pixel_L <> 0 Then
G_Pixel_L->V_Next = CAllocate(SizeOf(PC_Pixel_Type))
G_Pixel_L->V_Next->V_Prev = G_Pixel_L
G_Pixel_L = G_Pixel_L->V_Next
Else
G_Pixel_L = CAllocate(SizeOf(PC_Pixel_Type))
G_Pixel_F = G_Pixel_L
End If
With *G_Pixel_L
.V_Color = RGB(100 + Int((Rnd * 155) + 1), 100 + Int((Rnd * 155) + 1), 100 + Int((Rnd * 155) + 1))
.V_CurPosX = Int((Rnd * G_Width) + 1)
.V_CurPosY = Int((Rnd * G_Height) + 1)
If Int(Rnd * 2) = 0 Then
.V_SpeedX = (Int((Rnd * 10) + 1) / 10)
Else: .V_SpeedX = -(Int((Rnd * 10) + 1) / 10)
End If
If Int(Rnd * 2) = 0 Then
.V_SpeedY = (Int((Rnd * 10) + 1) / 10)
Else: .V_SpeedY = -(Int((Rnd * 10) + 1) / 10)
End If
.V_Size = 5 + Int((Rnd * 25) + 1)
.V_Times = 500 + (Int((Rnd * 50) + 1) * 10)
.T_Size = 5
End With
Next
End Sub
'#############################################################################################################################
Function GetCrashCount() as UInteger
Dim C as UInteger
Dim TPtr as PC_Pixel_Type Ptr = G_Pixel_F
Do Until TPtr = 0
If TPtr->T_Crashed > 0 Then C += 1
TPtr = TPtr->V_Next
Loop
Return C
End Function
'#############################################################################################################################
Sub DoDraw()
ScreenLock()
CLS()
Dim TPtr as PC_Pixel_Type Ptr = G_Pixel_F
Do Until TPtr = 0
With *TPtr
Line (.V_CurPosX - .T_Size, .V_CurPosY - .T_Size)-(.V_CurPosX + .T_Size, .V_CurPosY + .T_Size), .V_Color, BF
End With
TPtr = TPtr->V_Next
Loop
Draw String (3, 3), "Level: " & Str(G_Level) & " Punkte: " & Str(G_Points) & " Ziel: " & Str(G_DestCount) & " Aktuell: " & Str(G_CrashC) & " Gesammt: " & Str(G_PixelCount)
ScreenUnLock()
End Sub
'#############################################################################################################################
Sub DoCalc()
Dim TPtr as PC_Pixel_Type Ptr = G_Pixel_F
Dim XPtr as PC_Pixel_Type Ptr
Dim NPtr as PC_Pixel_Type Ptr
Do Until TPtr = 0
NPtr = TPtr->V_Next
With *TPtr
If .T_Crashed > 0 Then
If .T_Times >= .V_Times Then
If .T_Size <= 0 Then
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_Pixel_F = TPtr Then G_Pixel_F = TPtr->V_Next
If G_Pixel_L = TPtr Then G_Pixel_L = TPtr->V_Prev
DeAllocate(TPtr)
Else: .T_Size -= 1
End If
Else
If .T_Size >= .V_Size Then
.T_Times += 1
Else: .T_Size += 1
End If
End If
Else
If .V_SpeedX > 0 Then
If (.V_CurPosX + .V_SpeedX) > G_Width Then .V_SpeedX = -.V_SpeedX
.V_CurPosX += .V_SpeedX
Else
If (.V_CurPosX + .V_SpeedX) < 0 Then .V_SpeedX = -.V_SpeedX
.V_CurPosX += .V_SpeedX
End If
If .V_SpeedY > 0 Then
If (.V_CurPosY + .V_SpeedY) > G_Height Then .V_SpeedY = -.V_SpeedY
.V_CurPosY += .V_SpeedY
Else
If (.V_CurPosY + .V_SpeedY) < 0 Then .V_SpeedY = -.V_SpeedY
.V_CurPosY += .V_SpeedY
End If
XPtr = G_Pixel_F
Do Until XPtr = 0
If XPtr <> TPtr Then
With *XPtr
If .T_Crashed = 1 Then
If ((TPtr->V_CurPosX + TPtr->T_Size) >= (.V_CurPosX - .T_Size)) and ((TPtr->V_CurPosX - TPtr->T_Size) <= (.V_CurPosX + .T_Size)) Then
If ((TPtr->V_CurPosY + TPtr->T_Size) >= (.V_CurPosY - .T_Size)) and ((TPtr->V_CurPosY - TPtr->T_Size) <= (.V_CurPosY + .T_Size)) Then
TPtr->T_Crashed = 1
G_CrashC += 1
G_Points += 10
If G_CrashC > G_DestCount Then G_Points += G_CrashC - G_DestCount
End If
End If
End If
End With
End If
XPtr = XPtr->V_Next
Loop
End If
End With
TPtr = NPtr
Loop
End Sub
'#############################################################################################################################
Sub Main()
Randomize Timer()
ScreenRes G_Width, G_Height, 32
Dim TKey as String
Dim TKey1 as UByte
Dim TKey2 as UByte
Dim TMX as Integer
Dim TMY as Integer
Dim TMZ as Integer
Dim TMB as Integer
Dim TMR as Integer
G_Fired = 1
Do
TKey = InKey()
TKey1 = Asc(Left(TKey, 1))
TKey2 = Asc(Mid(TKey, 2, 1))
Select Case TKey1
Case 0
Case 27: Exit Do
Case 255
Select Case TKey2
Case 107: Exit Do
End Select
End Select
If G_Fired = 0 Then
TMR = GetMouse(TMX, TMY, TMZ, TMB)
If TMR = 0 Then
If TMB = 1 Then
If G_Pixel_L <> 0 Then
G_Pixel_L->V_Next = CAllocate(SizeOf(PC_Pixel_Type))
G_Pixel_L->V_Next->V_Prev = G_Pixel_L
G_Pixel_L = G_Pixel_L->V_Next
Else
G_Pixel_L = CAllocate(SizeOf(PC_Pixel_Type))
G_Pixel_F = G_Pixel_L
End If
With *G_Pixel_L
.V_Color = RGB(100 + Int((Rnd * 155) + 1), 100 + Int((Rnd * 155) + 1), 100 + Int((Rnd * 155) + 1))
.V_CurPosX = TMX
.V_CurPosY = TMY
.V_SpeedX = 0
.V_SpeedY = 0
.V_Size = 25
.V_Times = 500
.T_Size = .V_Size
.T_Crashed = 1
.T_Shoter = 1
End With
G_Fired = 1
End If
End If
End If
DoCalc()
If G_Fired = 1 Then
If GetCrashCount = 0 Then
If G_CrashC >= G_DestCount Then
ScreenLock()
CLS()
G_Level += 1
If G_Level > 20 Then
Print "Erfolgreich Beendet!!!"
Print
Print "Du hast ALLE LEVELs Erfolgreich absolviert!"
Print
Print "Dein Punktestand ist: " & Str(G_Points)
ScreenUnLock()
Sleep
End 0
End If
CreateLevel(G_Level)
Print "Erfolgreich!"
Print
Print "Level: " & Str(G_Level) & " --- " & Str(G_DestCount) & " von " & Str(G_PixelCount)
ScreenUnLock()
Sleep 3000, 1
Else
ScreenLock()
CLS()
G_Level += 1
CreateLevel(G_Level)
G_Points -= (G_DestCount * 5)
Print "FEHLGESCHLAGEN!!! Nochmal!"
Print
Print "Level: " & Str(G_Level) & " --- " & Str(G_DestCount) & " von " & Str(G_PixelCount)
ScreenUnLock()
Sleep 3000, 1
End If
End If
End If
DoDraw()
Sleep 10, 1
Loop
Screen 0
End 0
End Sub
'#############################################################################################################################
Main()