Graphics 800,600
SeedRnd 4

Global boden=CreateImage(800,600),hausmap=CreateImage(800,600),ari=LoadFont("Arial",128)
Global s.schnee,wind#,hauses
Const schwarz=0*$10000+0*$100+0*$1, weiss=255*$10000+255*$100+255*$1

Dim haus(30,2)

MoveMouse(400,525)
crhaus()

Color 0,255,0
SetBuffer ImageBuffer(boden)
y=550
For x=0 To 799
y=y+Rnd(-1,1)
Line x,600,x,y
Next

SetFont ari
Text 400,300,"Schneefall",1,1

SetBuffer BackBuffer()
SeedRnd MilliSecs()

Type schnee
Field x#,y,r#
End Type

While Not KeyHit(1)

kh#=KeyDown(205)-KeyDown(203)
wind#=wind+kh/100

cnt=cnt+1
If (cnt Mod 5)=0 create()
If (cnt Mod 25)=0 testhaus()

up()
If MouseHit(2) And hauses<30 crhaus()

Flip
Cls
Wend
End

Function create()
s=New schnee
s\x=Rnd(800)
If MouseDown(2) s\x=Rnd(-20,20)+MouseX()
End Function

Function up()
LockBuffer ImageBuffer(boden)
LockBuffer BackBuffer()
For s=Each schnee
s\y=s\y+1
s\x=s\x+wind*(Abs(s\r)<>1)+s\r
s\r=s\r*Rnd(.98,.99)

If s\x<799 And s\x>0
WritePixelFast(s\x,s\y,weiss,BackBuffer())
u=ReadPixelFast(s\x,s\y+1,ImageBuffer(boden))*$10000+ReadPixelFast(s\x,s\y+1,ImageBuffer(hausmap))*$10000
If u<>0
r=ReadPixelFast(s\x+1,s\y+1,ImageBuffer(boden))*$10000+ReadPixelFast(s\x+1,s\y+1,ImageBuffer(hausmap))*$10000
l=ReadPixelFast(s\x-1,s\y+1,ImageBuffer(boden))*$10000+ReadPixelFast(s\x-1,s\y+1,ImageBuffer(hausmap))*$10000


If r<>0 And l=0
rr=Rnd(10)

If rr=1
WritePixelFast(s\x,s\y,weiss,ImageBuffer(boden))
Delete s
Else
s\r=-1
EndIf

ElseIf l<>0 And r=0
rr=Rnd(10)

If rr=1
WritePixelFast(s\x,s\y,weiss,ImageBuffer(boden))
Delete s
Else
s\r=1
EndIf

ElseIf r<>0 And l<>0
WritePixelFast(s\x,s\y,weiss,ImageBuffer(boden))
Delete s
Else

Repeat
s\r=Rand(-1,1)
Until s\r<>0

EndIf

EndIf

Else
Delete s
EndIf

Next

UnlockBuffer BackBuffer()
UnlockBuffer ImageBuffer(boden)

If MouseHit(1)
SetBuffer ImageBuffer(boden)
For x=1 To 3
Line MouseX(),MouseY()-10+x,MouseX()-10,MouseY()+10+x
Line MouseX(),MouseY()-10+x,MouseX()+10,MouseY()+10+x
Next

SetBuffer BackBuffer()
EndIf

DrawImage hausmap,0,0
DrawImage boden,0,0
End Function

Function crhaus()
SetBuffer ImageBuffer(hausmap)
Color 128,10,0
xp=MouseX()
yp=MouseY()+16

hauses=hauses+1
haus(hauses,1)=xp
haus(hauses,2)=yp

Line xp-16,yp,xp-16,yp-20
Line xp+16,yp,xp+16,yp-20
Line xp-15,yp-20,xp,yp-26
Line xp+16,yp-20,xp,yp-26

Line xp-15,yp,xp-15,yp-20
Line xp+15,yp,xp+15,yp-20
Line xp-15,yp-19,xp,yp-25
Line xp+16,yp-19,xp,yp-25

SetBuffer BackBuffer()
End Function

Function testhaus()
LockBuffer ImageBuffer(boden)
For x=1 To hauses
ct=0
xp=haus(x,1)
yp=haus(x,2)

For x1=xp-14 To xp+14
For y1=yp-45 To yp-20
z=ReadPixelFast(x1,y1,ImageBuffer(boden))*$10000
If z<>0 ct=ct+1
Next
Next

If ct>180 mhkpt(xp,yp)

Next
UnlockBuffer ImageBuffer(boden)
End Function

Function mhkpt(xp,yp)
SetBuffer ImageBuffer(hausmap)
Color 0,0,0
Rect xp-14,yp-30,28,10
SetBuffer BackBuffer()

For x1=xp-14 To xp+14
For y1=yp-45 To yp-20
z=ReadPixelFast(x1,y1,ImageBuffer(boden))*$10000
If z<>0
s=New schnee
s\x=x1
s\y=y1
WritePixel(x1,y1,schwarz,ImageBuffer(boden))
EndIf


Next
Next

End Function