Graphics 800,600,32
SeedRnd MilliSecs()
SetBlend alphablend

MoveMouse 800,600

Const frames=200

Global rlist:TList=CreateList()
Global plist:TList=CreateList()
Global r:rak
Global p:part
Global time

Local timer=CreateTimer(25)

mx=MouseX()
my=MouseY()

While  MouseX()=mx And MouseY()=my
time:+40

If count<time
count=time+Rnd(3000,5000)
neu()
EndIf

t=MilliSecs()

update()
draw()
WaitTimer timer
Wend
End

Type rak
Field x#,y#,xm#,ym#,r#,s#,ts,te,ta,p
Field pe,pa,pc[3,4]

Function create(x1#,y1#,r1#,s1#,ts1,te1,ta1,pe1,pa1,pc1[,])
r=New rak
ListAddLast(rlist,r)
r.x=x1 r.y=y1 r.r=r1 r.s=s1
r.ts=ts1 r.te=te1 r.ta=ta1
r.pe=pe1 r.pa=pa1
For x2=0 To 2
For y2=0 To 3
r.pc[x2,y2]=pc1[x2,y2]
Next
Next
EndFunction

Method shoot()
p=1
xm=Sin(r)*5
ym=Cos(r)*5
EndMethod

Method explo()
Local c2[3,2]

For x1=1 To pe

If (pa Mod 10)=1 Or (pa Mod 10)=4 Or pa=17
a1#=1
ElseIf (pa Mod 10)=2 Or (pa Mod 10)=5
a2=1
ElseIf (pa Mod 10)=3
a1=Rnd(1,7)/10
a2=1
EndIf


If pa>10
st#=Rnd(.1,5)
ri=Rnd(360)
If pa=14 ri=Rnd(r-180,r)+(x1>pe/2)*180
If pa=17 st=Rnd(.1,2.5)+(x1>pe/2)*2.4
Else
st#=Rnd(2,5)
ri=Rnd(r-45,r+45)
If pa=4 ri=Rnd(r-45,r)++(x1>pe/2)*45
EndIf
xm1#=Sin(ri)*st
ym1#=Cos(ri)*st

For x3=0 To 2
For y1=(x1>pe/2)*2 To (x1>pe/2)*2+1
c2[x3,y2]=pc[x3,y1]
y2=1
Next
Next
y2=0

'         x,y,move.........,alpha,art,farbe
part.create(x,y,xm+xm1,ym+ym1,a1,a2,pa ,c2)
Next
p=2
End Method

Method fly()
ym:+.05
r#=richtung(0,0,xm,ym)
s=distanz(0,0,xm,ym)
xm:+xm*s/500.0
ym:+ym*s/500.0
x:+xm
y:+ym

If x<0 x=0 xm=-xm
If x>GraphicsWidth() x=GraphicsWidth() xm=-xm
Local c[3,2]
c[0,0]=255
c[1,0]=255
c[0,1]=255
c[1,1]=255
part.create(x,y,xm+Sin(r+180)*Rnd(8,10),ym+Cos(r+180)*Rnd(8,10),1,0,1,c)
EndMethod

Method update()
If time>=ts And p=0
shoot()
ElseIf p=1
Select ta
Case 1
If time>=te
explo()
EndIf
Case 2
If y<=te
explo()
EndIf
EndSelect
EndIf

If p=1 fly()

EndMethod

End Type

Type part
Field x#,y#,xm#,ym#,a#,pa,r#,g#,b#,tot
Field a1#,a2#,c[3,2]

Function create(x1#,y1#,xm1#,ym1#,a11#,a21,pa1,c1[,])
p=New part
ListAddLast(plist,p)
p.x=x1 p.y=y1 p.xm=xm1 p.ym=ym1
p.a1=Float(a11) p.a2=Float(a21)
p.pa=pa1

For x2=0 To 2
For y2=0 To 1
p.c[x2,y2]=c1[x2,y2]
Next
Next

p.a=a11
p.r=p.c[0,0]
p.g=p.c[1,0]
p.b=p.c[2,0]
End Function

Method fly()
If (time Mod 50)<10 ym:+.2

xm:*.99
ym:*.99
x:+xm
y:+ym

EndMethod

Method draw()
SetAlpha a
SetColor r,g,b
DrawOval x-1,y-1,3,3
EndMethod

Method update()
If Abs(r-c[0,1])<1 And Abs(g-c[1,1])<1 And Abs(b-c[2,1])<1 And Abs(a1-a2)<=Abs(a1-a)
p.tot=1
Else
If (pa Mod 10)=1 Or (pa Mod 10)=4 Or pa=17

If a<>a2 a:+Float(+a2-a1)/frames

If r<>c[0,1] r:+Float(+c[0,1]-c[0,0])/frames
If g<>c[1,1] g:+Float(+c[1,1]-c[1,0])/frames
If b<>c[2,1] b:+Float(+c[2,1]-c[2,0])/frames
ElseIf (pa Mod 10)=2 Or (pa Mod 10)=3

a:+1.0/frames

If a>.9
r=c[0,1] g=c[1,1] b=c[2,1]
a=1
a1=0
Else
r=0 g=0 b=0
EndIf

ElseIf (pa Mod 10)=5

If a<>a2 a:+Float(+a2-a1)/frames

If r+g+b=0
r=c[0,1] g=c[1,1] b=c[2,1]
Else
r=0 g=0 b=0
EndIf

EndIf

fly()
EndIf
EndMethod

EndType

Function draw()
For x=1 To 2
For p=EachIn plist
p.draw()
Next
SetAlpha .126
SetColor 0,0,0
DrawRect 0,0,GraphicsWidth(),GraphicsHeight()
Flip
Next
End Function

Function update()
For r=EachIn rlist
r.update
If r.p=2 ListRemove(rlist,r)
Next
For p=EachIn plist
p.update
If p.tot Or p.x<0 Or p.x>GraphicsWidth() Or p.y<-50 Or p.y>GraphicsHeight() ListRemove(plist,p)
Next

End Function

Function neu()

Local col[3,4]
col[0,0]=Rnd(256)
col[1,0]=Rnd(256)
col[2,0]=Rnd(256)

col[0,1]=Rnd(256)
col[1,1]=Rnd(256)
col[2,1]=Rnd(256)

col[0,2]=Rnd(256)
col[1,2]=Rnd(256)
col[2,2]=Rnd(256)

col[0,3]=Rnd(256)
col[1,3]=Rnd(256)
col[2,3]=Rnd(256)

r1=Rand(1,2)
If r1=2 r1=Rand(2,5)
d=Rand(0,2)
If d=2 d=1

rd=r1+d*10
rd1=Rand(0,11)
If rd1=11 rd=17

rak.create(Rnd(800),600,Rnd(160,200),Rnd(200-(rd<10)*150,300-(rd<10)*200),time,Rnd(time+1000,time+3000),1,Rnd(500,1000),rd,col)

End Function

Function Richtung(x1#,y1#,x2#,y2#)
richtt#=Sqr(((x1-x2)*(x1-x2))+((y1-y2)*(y1-y2)))
If y1>y2
richtt2#=ASin((x1-x2)/richtt)-180
Else
richtt2=ACos((x1-x2)/richtt)-90
EndIf

While richtt2<0
richtt2:+360
Wend

Return richtt2
End Function

Function Distanz(x1#,y1#,x2#,y2#)
richtt#=richtung(x1,y1,x2,y2)

If (richtt Mod 180)>0
richtt2#=((x2-x1)/Sin(richtt))
Else
richtt2=((y2-y1)/Cos(richtt))
EndIf

Return richtt2
End Function

Graphics 1024,768,32
SetBlend alphablend
SeedRnd MilliSecs()
MoveMouse 1024,768

Type rak
Field x#,y#,xm#,ym#,f
End Type

Type parti
Field x#,y#,xm#,ym#,r,g,b
End Type

Global tr,img:Timage=CreateImage(1024,768)
Global p:parti,r:rak
Global gx=GraphicsWidth(),gy=GraphicsHeight()
Global list:TList=CreateList()
Global list2:TList=CreateList()

Local mx%=MouseX()
Local my%=MouseY()

tr=MilliSecs()

timer=CreateTimer(25)
zeit=MilliSecs()
While MouseHit(1)=0 And MouseHit(2)=0 And MouseX()=mx And my=MouseY()


If tr<MilliSecs()
tr=MilliSecs()+Rand(1000,5000)
crrak()
EndIf

uprak()
upparti()
gfx()
WaitTimer(timer)
Wend
End

Function crrak()
r=New rak
r.x=Rand(gx)
r.y=gy

r.f=Rand(-30,35)

rich=Rand(150,210)

speed=Rnd(15,35)

r.xm=Sin(rich)*speed
r.ym=Cos(rich)*speed
ListAddLast(list,r)
End Function

Function uprak()
For r=EachIn list
r.f=r.f+1

r.x=r.x+r.xm
r.y=r.y+r.ym
r.ym=r.ym+.4

If r.x<0 Or r.x>gx r.xm=-r.xm
If r.y<0 r.ym=0 explo()

r2# = Sqr(((r.xm)^2)+((r.ym)^2))
If r.ym<0
rich=360-ASin((r.xm)/r2)
Else
rich=180-ACos((r.xm)/r2)+90
EndIf

If r.f<40
crparti(1,rich,0)
Else
explo()
EndIf

Next
End Function

Function crparti(x,ri,f)
p=New parti
p.x=r.x
p.y=r.y
If x=1
p.xm=Sin(ri+Rnd(-10,10))*20
p.ym=Cos(ri+Rnd(-10,10))*20
p.r=255
p.g=255
p.b=0
Else
power=Rand(30)
rich=Rand(360)
p.xm=r.xm+Sin(rich)*power
p.ym=r.ym+Cos(rich)*power
Select f
Case 1 p.r=255 p.g=255
Case 2 p.g=255
Case 3 p.r=255
Case 4 p.b=255
Case 5 p.r=255 p.b=255
Case 6 p.r=255 p.g=128
Case 7 p.g=255 p.b=255
End Select
If f>7 p.r=255 p.g=255 p.b=255
EndIf

ListAddLast(list2,p)
End Function

Function upparti()
For p=EachIn list2

p.x=p.x+p.xm
p.y=p.y+p.ym
p.ym=p.ym+.5
p.xm=p.xm*.95
p.ym=p.ym*.95

'If p.x<0 p.x=0 p.xm=-p.xm
'If p.y<0 p.ym=Abs(p.ym) p.y=2
'If p.x>gx p.x=gx p.xm=-p.xm

If p.b
p.b=p.b-10
If p.b<0 p.b=0
ElseIf p.g
p.g=p.g-10
If p.g<0 p.g=0
Else
p.r=p.r-10
If p.r<0 p.r=0
EndIf

If p.r+p.g+p.b=0 ListRemove(list2,p)
Next
End Function

Function gfx()
For x%=1 To 2
For p=EachIn list2
SetColor p.r,p.g,p.b
DrawOval p.x-1,p.y-1,3,3
Next

SetAlpha Abs(Sin((MilliSecs()-zeit)/300))*.2
SetColor 0,0,0
DrawRect 0,0,1024,768
SetAlpha 1
Flip
Next
End Function

Function explo()
d=Rnd(1,10)
For x=1 To 200
crparti(2,rich,d)
Next
ListRemove(list,r)
End Function