Function DrawImageC(image,px,py,r,g,b,frame=0,tr=255,tg=0,tb=255)
    buffer0=ImageBuffer(image,frame)
    buffer1=GraphicsBuffer()
    xm=ImageWidth(image)
    ym=ImageHeight(image)
    LockBuffer buffer0
    LockBuffer buffer1
    crgb=r*$10000+g*$100+b
    For y=0 To ym-1
        For x=0 To xm-1
            rgb=ReadPixelFast(x,y,buffer0)
            nr=(rgb And $FF0000)/$10000
            ng=(rgb And $FF00)/$100
            nb=rgb And $FF
            If nr<>tr Or ng<>tg Or nb<>tb Then
     WritePixelFast x+px,y+py,crgb,buffer1
            EndIf
        Next
    Next
    UnlockBuffer buffer0
    UnlockBuffer buffer1
End Function

DrawImageC  ( Bild% , X-Position% , Y-Position% [, Frame%=0 , Transparentrotfarbe%=255 , Transparentrotfarbe%=0 , Transparentrotfarbe%=255 ] )

Function ColorText(x,y,Text$,xmid=0,ymid=0)
anf$ = Left(Text$,Instr(Text$,"[")-1)
Text$ = Right(Text$,Len(Text$)-Instr(Text$,"[")+1)
Text x,y,anf,xmid,ymid
x = x + StringWidth(anf)
While Instr(Text$,"]") > 0
t$ = Mid(Text$,Instr(Text$,"[")+1,Instr(Text$,"]")-Instr(Text$,"[")-1)
r = Left ( t$, Instr( t$,","))
t$ = Right( t$,Len(t$)-Instr( t$,","))
g = Left ( t$, Instr( t$,","))
t$ = Right( t$,Len(t$)-Instr( t$,","))
b = Left ( t$, Len(t$))
Color r,g,b
Text$ = Right(Text$,Len(Text$)-Instr(Text$,"]"))
n$ = Mid(Text$,1,Instr(Text$,"[")-1)
Text x,y,n$,xmid,ymid
x = x + StringWidth(n$)
Wend
Color 255,255,255
End Function

Colortext(x,y,String$,xmid,ymid) ; wie bei der Funktion Text.

Function Between$(s$,b$,e$,fl=1)
   f=Instr( s,b,fl )+Len(b)
   l=Instr( s,e,f )
   r$=Mid( s,f,l-f)
   Return r
End Function

Function AfterLast$(txt$,find$)
   While Not Instr(txt,find)=0
      txt=Mid(txt,Instr(txt,find)+Len(find))
   Wend
   Return txt
End Function

string$ = Between$(s$,b$,e$,[fl])
string$ = AfterLast$(txt$,find$)

Function WaitScan()
   Repeat
      For scan=1To 256
         If KeyHit(scan) Then Return scan
      Next
   Forever
End Function

Function GetScan()
   For scan=1To 256
      If KeyHit(scan) Then Return scan
   Next
End Function

key = Waitscan()
key = Getscan()

Function LoadTCPImage%(url$)
   host$="www"+Mid$(url$,Instr(url$,"."),Instr(url$,"/",8)-Instr(url$,"."))
   tcp=OpenTCPStream(host$,80)
   If Not tcp RuntimeError url$+Chr$(13)+"Fehlgeschlagen": WaitKey: End
   WriteLine tcp,"GET "+url$+" HTTP/1.0"+Chr(10)
   WriteLine tcp,"Host: "+host$+Chr(10)
   WriteLine tcp,Chr$(10)
   If Eof(tcp) RuntimeError url$+Chr$(13)+"Fehlgeschlagen": WaitKey: End
   Repeat
      z$=ReadLine$( tcp )
   Until z$=""
   
   dat=WriteFile("tcpimg")
   While Not Eof(tcp)
      byte=ReadByte( tcp )
      WriteByte Dat,byte
   Wend
   CloseFile dat
   CloseTCPStream tcp
   rn%=LoadImage%("tcpimg")
   DeleteFile "tcpimg"
   Return rn%
End Function

Function LoadTCPImage%(url$)
   host$="www"+Mid$(url$,Instr(url$,"."),Instr(url$,"/",8)-Instr(url$,"."))
   tcp=OpenTCPStream(host$,80)
   If Not tcp RuntimeError url$+Chr$(13)+"Fehlgeschlagen": WaitKey: End
   WriteLine tcp,"GET "+url$+" HTTP/1.0"+Chr(10)
   WriteLine tcp,"Host: "+host$+Chr(10)
   WriteLine tcp,Chr$(10)
   If Eof(tcp) RuntimeError url$+Chr$(13)+"Fehlgeschlagen": WaitKey: End
   Repeat
      z$=ReadLine$( tcp )
   Until z$=""
   
   dat=WriteFile("tcptex")
   While Not Eof(tcp)
      byte=ReadByte( tcp )
      WriteByte Dat,byte
   Wend
   CloseFile dat
   CloseTCPStream tcp
   rn%=LoadTexture%("tcptex")
   DeleteFile "tcptex"
   Return rn%
End Function

image1 = LoadTCPImage(URL$)
texture1 = LoadTCPTexture(URL$)

;___/CreateWheel%(Minimum Ausdehnung#,Maximum Ausdehnung#,Abweichnung von normal#,Gradzahl der Zackenhäufung%,Radius des Loches#,Dicke#)\___
Function CreateWheel(min#=20,max#=25,aus#=3,z%=40,mr#=3,d#=3)
   w=0
   wheel=CreateMesh()
   surface=CreateSurface(wheel)
   While w<=360
      AddTr surface,Cos(w)*min,d/2,Sin(w)*min,Cos(w-z/2)*min,d/2,Sin(w-z/2)*min,Cos(w)*mr,d/2,Sin(w)*mr
      AddTr surface,Cos(w-z/2)*min,-d/2,Sin(w-z/2)*min,Cos(w)*min,-d/2,Sin(w)*min,Cos(w)*mr,-d/2,Sin(w)*mr
      AddTr surface,Cos(w)*min,d/2,Sin(w)*min,Cos(w+z/2)*mr,d/2,Sin(w+z/2)*mr,Cos(w+z/2)*min,d/2,Sin(w+z/2)*min
      AddTr surface,Cos(w)*min,-d/2,Sin(w)*min,Cos(w+z/2)*min,-d/2,Sin(w+z/2)*min,Cos(w+z/2)*mr,-d/2,Sin(w+z/2)*mr
      AddTr surface,Cos(w+z/2)*mr,d/2,Sin(w+z/2)*mr,Cos(w)*min,d/2,Sin(w)*min,Cos(w)*mr,d/2,Sin(w)*mr
      AddTr surface,Cos(w+z/2)*mr,-d/2,Sin(w+z/2)*mr,Cos(w)*mr,-d/2,Sin(w)*mr,Cos(w)*min,-d/2,Sin(w)*min
      AddTr surface,Cos(w)*mr,d/2,Sin(w)*mr,Cos(w-z/2)*min,d/2,Sin(w-z/2)*min,Cos(w-z/2)*mr,d/2,Sin(w-z/2)*mr
      AddTr surface,Cos(w)*mr,-d/2,Sin(w)*mr,Cos(w-z/2)*mr,-d/2,Sin(w-z/2)*mr,Cos(w-z/2)*min,-d/2,Sin(w-z/2)*min
      AddTr surface,Cos(w)*mr,d/2,Sin(w)*mr,Cos(w-z/2)*mr,-d/2,Sin(w-z/2)*mr,Cos(w)*mr,-d/2,Sin(w)*mr
      AddTr surface,Cos(w-z/2)*mr,d/2,Sin(w-z/2)*mr,Cos(w-z/2)*mr,-d/2,Sin(w-z/2)*mr,Cos(w)*mr,d/2,Sin(w)*mr
      AddTr surface,Cos(w+z/2)*mr,d/2,Sin(w+z/2)*mr,Cos(w)*mr,-d/2,Sin(w)*mr,Cos(w+z/2)*mr,-d/2,Sin(w+z/2)*mr
      AddTr surface,Cos(w)*mr,d/2,Sin(w)*mr,Cos(w)*mr,-d/2,Sin(w)*mr,Cos(w+z/2)*mr,d/2,Sin(w+z/2)*mr
      AddTr surface,Cos(w+z/2-aus)*max,d/2,Sin(w+z/2-aus)*max,Cos(w+aus)*max,d/2,Sin(w+aus)*max,Cos(w+z/2)*min,d/2,Sin(w+z/2)*min
      AddTr surface,Cos(w+z/2-aus)*max,-d/2,Sin(w+z/2-aus)*max,Cos(w+z/2)*min,-d/2,Sin(w+z/2)*min,Cos(w+aus)*max,-d/2,Sin(w+aus)*max
      AddTr surface,Cos(w+aus)*max,d/2,Sin(w+aus)*max,Cos(w)*min,d/2,Sin(w)*min,Cos(w+z/2)*min,d/2,Sin(w+z/2)*min
      AddTr surface,Cos(w+aus)*max,-d/2,Sin(w+aus)*max,Cos(w+z/2)*min,-d/2,Sin(w+z/2)*min,Cos(w)*min,-d/2,Sin(w)*min
      AddTr surface,Cos(w+z/2-aus)*max,d/2,Sin(w+z/2-aus)*max,Cos(w+z/2-aus)*max,-d/2,Sin(w+z/2-aus)*max,Cos(w+aus)*max,-d/2,Sin(w+aus)*max
      AddTr surface,Cos(w+z/2-aus)*max,d/2,Sin(w+z/2-aus)*max,Cos(w+aus)*max,-d/2,Sin(w+aus)*max,Cos(w+aus)*max,d/2,Sin(w+aus)*max
      AddTr surface,Cos(w)*min,d/2,Sin(w)*min,Cos(w)*min,-d/2,Sin(w)*min,Cos(w-z/2)*min,-d/2,Sin(w-z/2)*min
      AddTr surface,Cos(w)*min,d/2,Sin(w)*min,Cos(w-z/2)*min,-d/2,Sin(w-z/2)*min,Cos(w-z/2)*min,d/2,Sin(w-z/2)*min
      AddTr surface,Cos(w+z/2-aus)*max,d/2,Sin(w+z/2-aus)*max,Cos(w+z/2)*min,-d/2,Sin(w+z/2)*min,Cos(w+z/2-aus)*max,-d/2,Sin(w+z/2-aus)*max
      AddTr surface,Cos(w+z/2-aus)*max,d/2,Sin(w+z/2-aus)*max,Cos(w+z/2)*min,d/2,Sin(w+z/2)*min,Cos(w+z/2)*min,-d/2,Sin(w+z/2)*min
      AddTr surface,Cos(w+aus)*max,d/2,Sin(w+aus)*max,Cos(w+aus)*max,-d/2,Sin(w+aus)*max,Cos(w)*min,-d/2,Sin(w)*min
      AddTr surface,Cos(w+aus)*max,d/2,Sin(w+aus)*max,Cos(w)*min,-d/2,Sin(w)*min,Cos(w)*min,d/2,Sin(w)*min
      w=w+z
   Wend
   UpdateNormals wheel
   Return wheel
End Function
;_____________________________________________________________________________________________________________________


;___/Benötigte Zusatzfunktion zum Hinzufügen von Dreiecken auf einfache Art und Weise\________________________________
Function AddTr(surface,x1#,y1#,z1#,x2#,y2#,z2#,x3#,y3#,z3#)
   AddTriangle surface,AddVertex(surface,x1#,y1#,z1#),AddVertex(surface,x2#,y2#,z2#),AddVertex(surface,x3#,y3#,z3#)
End Function

Graphics3D 800,600,32,2
SetBuffer BackBuffer()

piv=CreatePivot()
cam=CreateCamera(piv)
MoveEntity cam,0,0,-35
TurnEntity piv,45,0,0

wh=CreateWheel()
timer=CreateTimer(24)

While Not KeyHit(1)
   If KeyHit(17) Then
      wf=1-wf
      WireFrame wf
   EndIf
   If KeyDown(200) Then TurnEntity wh,-1,0,0,1
   If KeyDown(208) Then TurnEntity wh,1,0,0,1
   If KeyDown(203) Then TurnEntity wh,0,1,0
   If KeyDown(205) Then TurnEntity wh,0,-1,0
   If KeyDown(30) Then MoveEntity cam,0,0,1
   If KeyDown(44) Then MoveEntity cam,0,0,-1
   UpdateWorld
   RenderWorld
   Text 0,0,"'W' für Wireframe"
   Text 0,20,"Pfeiltasten zum Begutachten"
   Text 0,40,"'A' und 'Y' zum Zoomem"
   Text 0,60,"'ESC' zum Beenden"
   Flip
   WaitTimer timer
Wend

End

Function Calc#(f$)
   f$=Lower$(f$)
   .a1
   zo=0
   z1=Instr(f$,"+",2)
   z2=Instr(f$,"-",2)
   z3=Instr(f$,"*",2)
   z4=Instr(f$,"/",2)
   z5=Instr(f$,"(",1)
   For z=1 To Len(f$)
      If Mid$(f$,z,1)="(" Then
         zo=zo+1
      ElseIf Mid$(f$,z,1)=")" And zo>1 Then
         zo=zo-1
      ElseIf Mid$(f$,z,1)=")" And zo=1 Then
         z6=z
         Goto a2
      EndIf
   Next
   .a2
   z7=Instr(f$,"^")
   If z5>0 And z6>0 Then
      If Instr(f$,"sin")<z5 And Instr(f$,"sin")>0 Then
         f$=Mid$(f$,1,z5-4)+Sin#(Calc#(Mid$(f$,z5+1,z6-z5)))+Mid$(f$,z6+1)
      ElseIf Instr(f$,"asin")<z5 And Instr(f$,"asin")>0 Then
         f$=Mid$(f$,1,z5-5)+ASin(Calc#(Mid$(f$,z5+1,z6-z5)))+Mid$(f$,z6+1)
      ElseIf Instr(f$,"cos")<z5 And Instr(f$,"cos")>0 Then
         f$=Mid$(f$,1,z5-4)+Cos(Calc#(Mid$(f$,z5+1,z6-z5)))+Mid$(f$,z6+1)
      ElseIf Instr(f$,"acos")<z5 And Instr(f$,"acos")>0 Then
         f$=Mid$(f$,1,z5-5)+ACos(Calc#(Mid$(f$,z5+1,z6-z5)))+Mid$(f$,z6+1)
      ElseIf Instr(f$,"tan")<z5 And Instr(f$,"tan")>0 Then
         f$=Mid$(f$,1,z5-4)+Tan(Calc#(Mid$(f$,z5+1,z6-z5)))+Mid$(f$,z6+1)
      ElseIf Instr(f$,"atan")<z5 And Instr(f$,"atan")>0 Then
         f$=Mid$(f$,1,z5-5)+ATan(Calc#(Mid$(f$,z5+1,z6-z5)))+Mid$(f$,z6+1)
      ElseIf Instr(f$,"sqr")<z5 And Instr(f$,"sqr")>0 Then
         f$=Mid$(f$,1,z5-4)+Sqr(Calc#(Mid$(f$,z5+1,z6-z5)))+Mid$(f$,z6+1)
      Else
         f$=Mid$(f$,1,z5-1)+Calc#(Mid$(f$,z5+1,z6-z5))+Mid$(f$,z6+1)
      EndIf
      Goto a1
   EndIf
   If (z1>z2 And z1>0) Or (z1<z2 And z2=0) Then
      rn#=Calc#(Mid$(f$,1,z1-1))+Calc#(Mid$(f$,z1+1))
   ElseIf (z2>z1 And z2>0) Or (z2<z1 And z1=0) Then
      rn#=Calc#(Mid$(f$,1,z2-1))-Calc#(Mid$(f$,z2+1))
   ElseIf (z3>z4 And z3>0) Or (z3<z4 And z4=0) Then
      rn#=Calc#(Mid$(f$,1,z3-1))*Calc#(Mid$(f$,z3+1))
   ElseIf (z4>z3 And z4>0) Or (z4<z3 And z3=0) Then
      rn#=Calc#(Mid$(f$,1,z4-1))/Calc#(Mid$(f$,z4+1))
   ElseIf z7>0 Then
      rn#=Calc#(Mid$(f$,1,z7-1))^Calc#(Mid$(f$,z7+1))
   Else
      rn#=f$
   EndIf
   Return rn#
End Function

Print Calc#(Input$("Rechnnung?: "))
WaitKey
End

Function CreateBusch(mz=100,r#=0.5,seg=8,trans#=1,rc=0,gc=1,bc=0,sh#=0)
   mesh=CreatePivot()
   For z=0 To mz
      w=Rand(360)
      g=Rand(25)
      x#=Cos#(w)*g
      y#=Sin#(w)*g
      l3d=Line3D(x#/10,0,y#/10,x#,Rand(30)+20-(BVFloat#(x#,-x#)/4+BVFloat#(y#,-y#)/4),y#,r#,seg,Rand(20+180*rc)+10+45*rc,Rand(20+180*gc)+10+45*gc,Rand(20+180*bc)+10+45*bc)
      EntityAlpha l3d,trans#
      EntityParent l3d,mesh
      EntityShininess l3d,sh#
   Next
   Return mesh
End Function

Function Line3D(x1#,y1#,z1#,x2#,y2#,z2#,r#=1,segments=32,red=255,green=255,blue=255,texture=0)
   cc=CreateCylinder(segments)
   PositionEntity cc,x1,y1,z1
   p=CreatePivot()
   PositionEntity p,x2,y2,z2
   PointEntity cc,p
   TurnEntity cc,90,0,0
   MoveEntity cc,0,Seglen3D#(x1,y1,z1,x2,y2,z2)/2,0
   ScaleEntity cc,r#,Seglen3D#(x1,y1,z1,x2,y2,z2)/2,r#
   EntityColor cc,red,green,blue
   If texture Then EntityTexture cc,texture
   Return cc
End Function

Function Seglen3D#(x1#,y1#,z1#,x2#,y2#,z2#)
   Return Sqr((x1#-x2#)*(x1#-x2#)+(y1#-y2#)*(y1#-y2#)+(z1#-z2#)*(z1#-z2#))
End Function

Function BVFloat#(v1#,v2#)
   If v1#>v2# Then rn#=v1#
   If v2#>v1# Then rn#=v2#
   Return rn#
End Function

AppTitle "SträucherMaker"


Print "SträucherMaker0.63 by Lobby"
Print
Print "-+Zusatzparameter(d=Standart)"
Print "  |"
z1=Int(Input$("  +Anzahl der Halme?(d=500): "))
Print "    |"
z2#=Float#(Input$("    +Radius der halme?(d=0.5): "))
Print "    |"
z3=Int(Input$("    +Anzahl der Segmente?(d=6): "))
Print "    |"
z4#=Float#(Input$("    +Transparenz?(d=0.2): "))
Print "      |"
rcs$=Input$("      +Farbe Rot?(d=0): ")
Print "      |"
gcs$=Input$("      +Farbe Grün?(d=1): ")
Print "      |"
bcs$=Input$("      +Farbe Blau?(d=0): ")
Print "      |"
shs$=Input$("      +Glanzeffekt?(d=0): ")

If z1=0 Then z1=500
If z2=0 Then z2#=0.5
If z3=0 Then z3=6
If z4=0 Then z4#=0.2
If Asc(rcs)<0 Then rc=0 Else rc=rcs
If Asc(gcs)<0 Then gc=1 Else gc=gcs
If Asc(bcs)<0 Then bc=0 Else bc=bcs
If Asc(shs)<0 Then sh#=0 Else sh#=Float#(shs)


Graphics3D 800,600,32,2

SeedRnd MilliSecs()
grass_tex=CreateTexture(64,64)
SetBuffer TextureBuffer(grass_tex)
ClsColor 60,50,0
Cls
Color 50,200,50
For z=0 To 100
   Plot Rand(65)-1,Rand(65)-1
Next
ClsColor 0,0,0
Color 255,255,255
Flip

SetBuffer BackBuffer()

ScaleTexture grass_tex,40,40

pcam=CreatePivot()
cam=CreateCamera(pcam)
CameraClsColor cam,160,200,255
MoveEntity cam,0,0,-50
MoveEntity pcam,0,20,0
TurnEntity pcam,20,0,0

cb=CreateBusch(z1,z2,z3,z4,rc,gc,bc,sh#)
ScaleEntity cb,0.8,0.8,0.8

p=CreatePlane()
EntityTexture p,grass_tex
EntityAlpha p,0.9
m=CreateMirror()

l=CreateLight()
MoveEntity l,0,30,-60

EntityType cam,1
EntityType p,2
Collisions 1,2,3,3

timer=CreateTimer(24)
While Not KeyHit(1)
   If KeyDown(200) Then TurnEntity pcam,1,0,0
   If KeyDown(208) Then TurnEntity pcam,-1,0,0
   If KeyDown(203) Then TurnEntity pcam,0,-1,0,1
   If KeyDown(205) Then TurnEntity pcam,0,1,0,1
   If KeyDown(30) Then MoveEntity cam,0,0,1
   If KeyDown(44) Then MoveEntity cam,0,0,-1
   
   If KeyHit(17) Then
      wf=wf=0
      WireFrame wf
   EndIf
   ;TurnEntity cb,0,2,0
   UpdateWorld
   RenderWorld
   
   fps#=(19*fps#+(1000./(MilliSecs()-FPS_LAST)))/20.:FPS_LAST=MilliSecs()
   Text 0,0,(fps#)+" FPS"
   Text 0,11,TrisRendered()+" Triangles"
   Text 0,30,z1+" Halme"
   Text 0,41,z2+" Radius"
   Text 0,52,z3+" Segmente"
   Text 0,63,z4+" Transparenz"
   
   Flip
   If WaitTimer(timer)>1 Then
      If m Then
         FreeEntity m
         m=0
      EndIf
   EndIf
Wend

Function Createsnow(h,r,g,b)
For m=0 To h Step 1
rx=Rnd(0,800)
ry=Rnd(0,600)
Color 255,255,255
Oval rx,ry,Rnd(2,5),Rnd(2,5)
Next
Color r,g,b
End Function

Function CreateRain(h,r,g,b)
For m=0 To h
rx=Rnd(0,800)
ry=Rnd(0,600)
Color 0,44,115
Line rx,ry,rx+Rnd(2,5),ry+Rnd(20,50)
Color 0,0,155
Line rx+1,ry+1,rx+Rnd(2,5)+1,ry+Rnd(20,50)+1
Next
Color r,g,b
End Function

Graphics 800,600,16,2
SetBuffer BackBuffer()



While Not KeyHit(1)
Cls
CreateRain(2,0,0,0)
createsnow(5,0,0,0)
Flip
Delay 20
Wend
End

Function ScaleMaskImage(img,scale#,maskr,maskg,maskb)
   ;Nur von 0.33 bis 1.0!!!
   ;Andere Scale-Parameter leider nicht sinnvoll in dem Code
   Local faktor#=100/(100*scale#)
   If scale#>1 Then Return 0
   If faktor#<=3 Then
      Local range=1
   Else
      Return 0
   EndIf
   
   Local x,y,dx,dy,col
   Local tmpa,tmpr,tmpg,tmpb
   Local gesr,gesg,gesb
   Local w=ImageWidth(img)
   Local h=ImageHeight(img)
   Local imgbuffer=ImageBuffer(img)
   Local returnimg=CreateImage(w/faktor#,h/faktor#)
   If returnimg=0 Then Return 0
   Local img2buffer=ImageBuffer(returnimg)
   Local colfaktor=(2*range+1)*(2*range+1) ;=9
   LockBuffer imgbuffer
   LockBuffer img2buffer
   
   For x=0 To w-1
      For y=0 To h-1
         gesr=0 : gesg=0 : gesb=0 : colfaktor=(2*range+1)*(2*range+1) ;=9
         If x<range Or x>w-1-range Or y<range Or y>h-1-range Then
            ;Wenn man am Rand ist, Pixel nicht in die Berechnung nehmen
            colfaktor=0
            WritePixelFast(x/faktor#,y/faktor#,ReadPixelFast(x,y,imgbuffer),img2buffer)
         Else
            ;Um das Pixel herum Farbwerte ermitteln
            For dx=-range To range
               For dy=-range To range
                  ;Pixel mit ReadPixelFast auslesen und in Bestandteile zerlegen
                  col=ReadPixelFast(x+dx,y+dy,imgbuffer)
                  tmpa=col Shr 24
                  tmpr=(col-(tmpa Shl 24)) Shr 16
                  tmpg=(col-(tmpa Shl 24)-(tmpr Shl 16)) Shr 8
                  tmpb=col-(tmpa Shl 24)-(tmpr Shl 16)-(tmpg Shl 8)
                 
                  If tmpr=maskr And tmpg=maskg And tmpb=maskb Then
                     colfaktor=colfaktor-1
                  Else
                     gesr=gesr+tmpr
                     gesg=gesg+tmpg
                     gesb=gesb+tmpb
                  EndIf
                  If dx=0 And dy=0 And tmpr=maskr And tmpg=maskg And tmpb=maskb Then
                     ;Wenn aktuelles Pixel gemasked ist
                     colfaktor=0
                     Exit
                  EndIf
               Next
               If colfaktor=0 Then Exit
            Next
         EndIf
         
         If colfaktor=0 Then
            ;Wenn lauter MaskPixel da sind, Originalfarbe nehmen
            WritePixelFast(x/faktor#,y/faktor#,ReadPixelFast(x,y,imgbuffer),img2buffer)
         Else
            ;Ansonten Durchschnitt aus allen "nicht-gemaskten" Pixeln einzeichnen
            WritePixelFast(x/faktor#,y/faktor#,(gesr/colfaktor) Shl 16+(gesg/colfaktor) Shl 8+gesb/colfaktor,img2buffer)
         EndIf
      Next
   Next
   
   UnlockBuffer imgbuffer
   UnlockBuffer img2buffer
   MaskImage returnimg,maskr,maskg,maskb
   Return returnimg
End Function

; Dient nur der Veranschaulichung ------->
Graphics 800,600,0,2
SetBuffer BackBuffer()

Local examplescale#=0.7

Local image=LoadImage("test.png")
MaskImage image,255,0,255
Local scaledimage=ScaleMaskImage(image,examplescale#,255,0,255)

;Vergleich zeichnen
TFormFilter 1
ScaleImage image,examplescale#,examplescale#
DrawImage image,ImageWidth(scaledimage),0
FreeImage image
image=LoadImage("test.png")
MaskImage image,255,0,255
TFormFilter 0
ScaleImage image,examplescale#,examplescale#
DrawImage image,ImageWidth(scaledimage)*2,0
DrawImage scaledimage,0,0
Flip 0
WaitKey()
End
; <------- Dient nur der Veranschaulichung

Function WinkelPos#(x1#,y1#,x2#,y2#)
   x2=x2-x1
   y2=y2-y1
   r#=Sqr#(x2*x2+y2*y2)
   rn#=ACos(x2/r#)
   If y2+y1<y1 Then rn#=rn#+(180-rn#)*2
   If rn#="NaN" Then rn#=-1
   Return rn#
End Function

Function Seglen#(x1#,y1#,x2#,y2#)
   x2=x2-x1
   y2=y2-y1
   Return Sqr#(x2^2+y2^2)
End Function

Type Particel
   Field x#,y#
   Field nx#,ny#
   Field mass#
   Field w#
   Field g#
   Field use%
End Type

Type Emitter
   Field x#,y#
   Field mass#
   Field w#
   Field g#
   Field ran#,real%
   Field force#
   Field use%
End Type

Function CreateEmitter%(x#,y#,mass#,w#=0,g#=0,ran#=0,force#=1,use%=1)
   E.Emitter=New Emitter
   E\x#=x#
   E\y#=y#
   E\mass#=mass#
   E\w#=w#
   E\g#=g#
   E\ran#=ran#
   E\real%=0
   E\force#=force#
   E\use%=use%
   Return Handle(E.Emitter)
End Function

Function CreateParticel%(x#,y#,mass#,w#=0,g#=0,use%=1)
   P.Particel=New Particel
   P\x#=x#
   P\y#=y#
   P\mass#=mass#
   P\w#=w#
   P\g#=g#
   P\use%=use%
   Return Handle(P.Particel)
End Function

Function CalcParticel%(hwd%)
   P.Particel=Object.Particel(hwd%)
   Px#=P\x
   Py#=P\y
   For P2.Particel=Each Particel
      If Handle(P2.Particel)<>Handle(P.Particel) Then
         g#=Seglen#(P\x,P\y,P2\x,P2\y)*(P\mass*P2\mass)*0.001
         w#=WinkelPos#(P\x,P\y,P2\x,P2\y)
         Px=Px+Cos(w#)*g#
         Py=Py+Sin(w#)*g#
      EndIf
   Next
   P\x=Px
   P\y=Py
End Function

Function CalcEmitter%(hwd%)
   E.Emitter=Object.Emitter(hwd%)
   If E\force#>=1 Then
      For z=0 To E\force#
         CreateParticel%(E\x#,E\y#,E\mass#,E\w#+Rnd(E\ran#)-E\ran#/2,E\g#,E\use%)
      Next
   Else
      E\real%=E\real%+1
      If E\real%=1/E\force# Then
         CreateParticel%(E\x#,E\y#,E\mass#,E\w#+Rnd(E\ran#)-E\ran#/2,E\g#,E\use%)
         E\real%=0
      EndIf
   EndIf
End Function

Function PositionParticel(hwd%,x#,y#)
   P.Particel=Object.Particel(hwd%)
   P\x#=x#
   P\y#=y#
End Function

Function MoveParticel(hwd%,x#,y#)
   P.Particel=Object.Particel(hwd%)
   P\x#=P\x#+x#
   P\y#=P\y#+y#
End Function

Function RotateParticel(hwd%,w#)
   P.Particel=Object.Particel(hwd%)
   P\w#=w#
End Function

Function TurnParticel(hwd%,w#)
   P.Particel=Object.Particel(hwd%)
   P\w#=P\w#+w#
End Function

Function ParticelX#(hwd%)
   P.Particel=Object.Particel(hwd%)
   Return P\x#
End Function

Function ParticelY#(hwd%)
   P.Particel=Object.Particel(hwd%)
   Return P\y#
End Function

Function ParticelTurn#(hwd%)
   P.Particel=Object.Particel(hwd%)
   Return P\w#
End Function

Function ParticelMass#(hwd%)
   P.Particel=Object.Particel(hwd%)
   Return P\mass#
End Function

Function ParticelSpeed#(hwd%)
   P.Particel=Object.Particel(hwd%)
   Return P\g#
End Function

Function ParticelUse%(hwd%)
   P.Particel=Object.Particel(hwd%)
   Return P\use%
End Function

Function ModifyParticel(hwd%,x#,y#,mass#,w#=0,g#=0,use%=1)
   P.Particel=Object.Particel(hwd%)
   P\x#=x#
   P\y#=y#
   P\mass#=mass#
   P\w#=w#
   P\g#=g#
   P\use%=use%
End Function

Function PositionEmitter(hwd%,x#,y#)
   E.Emitter=Object.Emitter(hwd%)
   E\x#=x#
   E\y#=y#
End Function

Function MoveEmitter(hwd%,x#,y#)
   E.Emitter=Object.Emitter(hwd%)
   E\x#=E\x#+x#
   E\y#=E\y#+y#
End Function

Function RotateEmitter(hwd%,w#)
   E.Emitter=Object.Emitter(hwd%)
   E\w#=w#
End Function

Function TurnEmitter(hwd%,w#)
   E.Emitter=Object.Emitter(hwd%)
   E\w#=E\w#+w#
End Function

Function EmitterX#(hwd%)
   E.Emitter=Object.Emitter(hwd%)
   Return E\x#
End Function

Function EmitterY#(hwd%)
   E.Emitter=Object.Emitter(hwd%)
   Return E\y#
End Function

Function EmitterTurn#(hwd%)
   E.Emitter=Object.Emitter(hwd%)
   Return E\w#
End Function

Function EmitterSpeed#(hwd%)
   E.Emitter=Object.Emitter(hwd%)
   Return E\g#
End Function

Function EmitterRand#(hwd%)
   E.Emitter=Object.Emitter(hwd%)
   Return E\ran#
End Function

Function EmitterForce#(hwd%)
   E.Emitter=Object.Emitter(hwd%)
   Return E\force#
End Function

Function EmitterUse%(hwd%)
   E.Emitter=Object.Emitter(hwd%)
   Return E\use%
End Function

Function ModifyEmitter%(hwd%,x#,y#,mass#,w#,g#,ran#=0,force#=1,use%=1)
   E.Emitter=Object.Emitter(hwd%)
   E\x#=x#
   E\y#=y#
   E\mass#=mass#
   E\w#=w#
   E\g#=g#
   E\ran#=ran#
   E\real%=0
   E\force#=force#
   E\use%=use%
End Function

Function UpdateParticels%(gr#=0,ab#=0.25)
   For E.Emitter=Each Emitter
      If E\force#>=1 Then
         For z=0 To Int(E\force#)
            CreateParticel%(E\x#,E\y#,E\mass#,E\w#+Rnd(E\ran#)-E\ran#/2,E\g#,E\use%)
         Next
      Else
         E\real%=E\real%+1
         If E\real%>=1/E\force# Then
            CreateParticel%(E\x#,E\y#,E\mass#,E\w#+Rnd(E\ran#)-E\ran#/2,E\g#,E\use%)
            E\real%=0
         EndIf
      EndIf
   Next
   For P.Particel=Each Particel
      w#=P\w#
      g#=P\g#/1.1
      Px#=P\x#+Cos#(w#)*g#
      Py#=P\y#+Sin#(w#)*g#-(gr#*P\mass#)
      For P2.Particel=Each Particel
         If Handle(P2.Particel)<>Handle(P.Particel) And P\use%=1 Then
            g#=-Seglen#(P\x,P\y,P2\x,P2\y)/500000+((P\mass*P2\mass)/100)
            w#=WinkelPos#(P\x,P\y,P2\x,P2\y)
            If w#=-1 Then g#=0
            If P\mass#<0 Then w#=w#+180
            j=0
            While j=0
               .aw
               nPx#=Px#+Cos(w#)*g#
               nPy#=Py#+Sin(w#)*g#
               For P3.Particel=Each Particel
                  If Int(nPx/ab)*ab=Int(P3\x/ab)*ab And Int(nPy/ab)*ab=Int(P3\y/ab)*ab And Handle(P.Particel)<>Handle(P3.Particel) Then
                     g#=g#-1
                     j=0
                     Goto aw
                  Else
                     j=1
                     Px=aPx+Int(nPx/ab)*ab
                     Py=aPy+Int(nPy/ab)*ab
                     Goto e
                  EndIf
               Next
            Wend
            .e
         EndIf
         Next
      P\nx#=Px
      P\ny#=Py
      P\w#=WinkelPos#(P\x#,P\y#,P\nx#,P\ny#)
      P\g#=Seglen#(P\x#,P\y#,P\nx#,P\ny#)
   Next
   For P.Particel=Each Particel
      P\x=P\nx
      P\y=P\ny
   Next
End Function

Function FadeField(vx,vy,vxw,vyw,vi=1,buf=0)
If buf=0 Then buf=GraphicsBuffer()
LockBuffer buf
For z=1 To vi
For x=vx To vx+vxw
   For y=vy To vy+vyw
   rgb=ReadPixelFast(x,y,buf)
   r0=(rgb And $FF0000)/$10000
   g0=(rgb And $FF00)/$100
   b0=rgb And $FF
   rgb=ReadPixelFast(x,y-1,buf)
   r1=(rgb And $FF0000)/$10000
   g1=(rgb And $FF00)/$100
   b1=rgb And $FF
   rgb=ReadPixelFast(x+1,y,buf)
   r2=(rgb And $FF0000)/$10000
   g2=(rgb And $FF00)/$100
   b2=rgb And $FF
   rgb=ReadPixelFast(x,y+1,buf)
   r3=(rgb And $FF0000)/$10000
   g3=(rgb And $FF00)/$100
   b3=rgb And $FF
   rgb=ReadPixelFast(x-1,y,buf)
   r4=(rgb And $FF0000)/$10000
   g4=(rgb And $FF00)/$100
   b4=rgb And $FF
   nr=(r0+r1+r2+r3+r4)/5
   ng=(g0+g1+g2+g3+g4)/5
   nb=(b0+b1+b2+b3+b4)/5
   nrgb=nr*$10000+ng*$100+nb
   WritePixelFast x,y,nrgb,buf
      Next
Next
Next
UnlockBuffer buf
End Function

Graphics 400,305,32,2
SetBuffer BackBuffer()


For x=20 To 380 Step 40
   For y=20 To 280 Step 40
      CreateParticel%(x,y,3.6)
   Next
Next

;pa=CreateParticel%(0,0,-10,0,0,0)
;CreateParticel%(200,300,1,270,20)

CreateEmitter%(240,299,0.5,270,10,20,0.5,0)
CreateEmitter%(0,240,0.5,0,10,20,0.5,0)
le=CreateEmitter%(200,150,2,250,10,20,2,0)

timer=CreateTimer(24)

While Not KeyHit(1)
   s=s+1
   TurnEmitter le,5
   PositionEmitter le,200+Cos(s)*100,150+Sin(s)*50
   Cls
   Color 10,10,10
   Oval 100,100,200,100,0
   ;PositionParticel pa,MouseX(),MouseY()
   UpdateParticels(-0.2)
   For E.Emitter=Each Emitter
      Color 255,0,0
      Line E\x#+Cos#(E\w#+90)*E\ran#,E\y#+Sin#(E\w#+90)*E\ran#,E\x#+Cos#(E\w#-90)*E\ran#,E\y#+Sin#(E\w#-90)*E\ran#
   Next
   For P.Particel=Each Particel
      Color 150-P\w,150-P\w,255
      Plot P\x,P\y
      If fa=1 Then FadeField P\x-1,P\y-1,3,3
      If P\y>=300 Then Delete P.Particel
   Next
   Color 255,255,255
   Text 0,0,"'F' für AntiAlias"
   Color 255,0,0
   Rect 4,18,8,8
   Color 255,255,255
   Text 15,15,"Emitter"
   Color 100,100,255
   Rect 4,33,8,8
   Color 255,255,255
   Text 15,30,"Partikel"
   Flip
   WaitTimer timer
   If KeyHit(33) Then fa=1-fa
Wend
End

;by Robert Hierl / www.mein-murks.de / 30.12.2007
Type tVertexVector

   Field vertex
   Field x#
   Field y#
   Field z#
   
End Type


Type tVertexTree

   Field x#
   Field y#
   Field z#
   Field vertices.tVertexVector[50]
   Field octree.tVertexTree[7]

End Type



Function UpdateNormalsAngle( pMesh, pAngle# = 89 )
;This function is used much like the regular UpdateNormals in B3D. Unlike the original function,
;it doesn't just smooth all edges, but provides an option to set an angle, to which two faces are smoothed.
;So it's a very easy way to improve shading on a mesh, without setting up each normal manually.
;Author Robert Hierl / www.mein-murks.de

   Local surf, numSurface
   Local vert, numVertex
   Local vertexTree.tVertexTree
   
   Local triNormal.tVertexVector
   
   
   Local v1.tVertexVector, v2.tVertexVector, v3.tVertexVector

   ;handle special ones
   If pAngle# =  0   Then UpdateNormalsFlat( pMesh ) : Return
   ;regular UpdateNormals works only, when mesh was modified, so line is commented for this example
   ;If pAngle# >= 180 Then UpdateNormals( pMesh ) : Return


   For numSurface = 1 To CountSurfaces( pMesh )

      surf = GetSurface( pMesh, numSurface )

      Delete Each tVertexTree
      vertexTree = New tVertexTree

      ;gather all possible vertex coordinates with their triangle normal      
      For numTriangle = 0 To CountTriangles( surf ) - 1

         v1 = GetVertexVector(surf, TriangleVertex( surf, numTriangle, 0 ))
         v2 = GetVertexVector(surf, TriangleVertex( surf, numTriangle, 1 ))
         v3 = GetVertexVector(surf, TriangleVertex( surf, numTriangle, 2 ))   
         
         ;calculate triangle normal
         triNormal = GetTriangleNormal(surf, v1\vertex, v2\vertex, v3\vertex)
         
         ;add each vertex with calculated normal
         AddVertex2Tree(vertexTree, v1, triNormal)
         AddVertex2Tree(vertexTree, v2, triNormal)
         AddVertex2Tree(vertexTree, v3, triNormal)
            
         ;clean up
         Delete triNormal
         Delete v1
         Delete v2
         Delete v3
      
      Next

      ;calculate and set new vertex normals         
      For vertexTree = Each tVertexTree   
      
         SetNormalsMulti(vertexTree, surf, pAngle#)

      Next

      ;clean up
      Delete Each tVertexTree
      Delete Each tVertexVector

   Next

End Function


Function UpdateNormalsFlat(mesh)
;This simple function is used to disable smoothing on a mesh. It is faster than UpdateNormalsAngle with value 0.

   Local surf, numSurface, numTriangle
   Local v1, v2, v3
   Local triNormal.tVertexVector

   For numSurface = 1 To CountSurfaces(mesh)

      surf = GetSurface(mesh, numSurface)
      
      For numTriangle = 0 To CountTriangles( surf ) - 1
      
         ;calculate normal for each triangle
           v1   = TriangleVertex(surf, numTriangle, 0)
           v2   = TriangleVertex(surf, numTriangle, 1)
           v3   = TriangleVertex(surf, numTriangle, 2)

         triNormal = GetTriangleNormal(surf, v1, v2, v3)
      
         ;set normals for vertex
         VertexNormal surf, v1, triNormal\x, triNormal\y, triNormal\z
 
         ;when using EntityFX 4, only the first vertex normal is relevant, in this case just comment the following two lines
         VertexNormal surf, v2, triNormal\x, triNormal\y, triNormal\z
         VertexNormal surf, v3, triNormal\x, triNormal\y, triNormal\z
         
      Next
     Next

End Function



Function SetNormalsMulti(vertexTree.tVertexTree, surf, pAngle#)
   ;calculate new normals
   
   Local ax#, ay#, az#
   Local lx#, ly#, lz#
   Local nx#, ny#, nz#
   Local factor#, merged
   Local diffAngle#, vertex.tVertexVector
   
   Local i, l


      Repeat
      
         merged = False

         For i = 0 To 50   
   
            If vertexTree\vertices[i] = Null Then Exit
            
            vertexcount = 0
            nx# = 0
            ny# = 0
            nz# = 0      
   
            For l = 0 To 50
            
               If vertexTree\vertices[l] = Null Then Exit   
                           
               diffAngle# = VectorAngle#(vertexTree\vertices[l], vertexTree\vertices[i])
               
               If diffAngle# <= pAngle# Then
               
                  If diffAngle# > 0 Then merged = True;                  

                  vertex.tVertexVector = vertexTree\vertices[l]
                  vertexcount = vertexcount + 1
                  nx# = nx# + vertex\x
                  ny# = ny# + vertex\y
                  nz# = nz# + vertex\z
                  
               EndIf
            
            Next
         
            nx# = nx# / vertexcount
            ny# = ny# / vertexcount
            nz# = nz# / vertexcount

            
            ;normalize result
            factor# = Sqr((nx# * nx#)+(ny# * ny#)+(nz# * nz#))   
            nx# = nx# / factor#
            ny# = ny# / factor#
            nz# = nz# / factor#
            
            
            VertexNormal surf, vertexTree\vertices[i]\vertex, nx#, ny#, nz#
         Next


         If Not merged Then Exit
                  
         For i = 0 To 50   
   
            If vertexTree\vertices[i] = Null Then Exit   
            
            vertex = vertexTree\vertices[i]
                        
            vertex\x = VertexNX(surf, vertex\vertex)
            vertex\y = VertexNY(surf, vertex\vertex)
            vertex\z = VertexNZ(surf, vertex\vertex)
            
         Next                     
         

      Forever


End Function


Function GetVertexVector.tVertexVector(pSurface, pVertex)
   ;this one provides the coordinate of a given vertex as vector
   Return VertexVector(VertexX#(pSurface, pVertex), VertexY#(pSurface, pVertex), VertexZ#(pSurface, pVertex), pVertex)

End Function


Function AddVertex2Tree( pNode.tVertexTree, pVertex.tVertexVector, pNormal.tVertexVector)
   ;adds a vertex to our octree
   Local i, treePosition

   ;if our coordinate matches, we just add the given vertex normal to the list
   If pNode\x = pVertex\x And pNode\y = pVertex\y And pNode\z = pVertex\z Then
   
      For i = 0 To 50
         If pNode\vertices[i] = Null Then
            pNode\vertices[i] = VertexVector(pNormal\x#, pNormal\y#, pNormal\z#, pVertex\vertex)
            Return
         EndIf      
      Next
      
   Else

      If pNode\x >= pVertex\x Then treePosition = treePosition Or 1
      If pNode\y >= pVertex\y Then treePosition = treePosition Or 2
      If pNode\z >= pVertex\z Then treePosition = treePosition Or 4   

      If pNode\octree[treePosition] = Null Then
      
         pNode\octree[treePosition]       = New tVertexTree
         pNode\octree[treePosition]\x#    = pVertex\x#
            pNode\octree[treePosition]\y#    = pVertex\y#
         pNode\octree[treePosition]\z#    = pVertex\z#
         pNode\octree[treePosition]\vertices[0]    = VertexVector(pNormal\x#, pNormal\y#, pNormal\z#, pVertex\vertex)
   
      Else
   
         AddVertex2Tree( pNode\octree[treePosition], pVertex, pNormal)   
   
      EndIf

   EndIf

End Function




Function GetTriangleNormal.tVertexVector(pSurface, v1, v2, v3)
   ;return normal of given triangle as vector
   Local factor#

   ;v1 to v2 as vector     
   Local lx# = VertexX#(pSurface,v1) - VertexX#(pSurface,v2)
   Local ly# = VertexY#(pSurface,v1) - VertexY#(pSurface,v2)
   Local lz# = VertexZ#(pSurface,v1) - VertexZ#(pSurface,v2)

   ;v1 to v3 as vector 
   Local ax# = VertexX#(pSurface,v1) - VertexX#(pSurface,v3)
   Local ay# = VertexY#(pSurface,v1) - VertexY#(pSurface,v3)
   Local az# = VertexZ#(pSurface,v1) - VertexZ#(pSurface,v3)

   ;cross product of these two vectors
   Local nx# = (ly# * az#)-(lz# * ay#)
   Local ny# = (lz# * ax#)-(lx# * az#)
   Local nz# = (lx# * ay#)-(ly# * ax#)
      
   ;normalize result ( set vector length to 1 )
   factor# = Sqr((nx# * nx#)+(ny# * ny#)+(nz# * nz#))   
   nx# = nx# / factor#
   ny# = ny# / factor#
   nz# = nz# / factor#

   Return VertexVector(nx#, ny#, nz#)

End Function


Function VertexVector.tVertexVector(x#, y#, z#, pVertex = -1)
   ;creates a VertexVector type, storing coordinates and related mesh vertex

   Local Vector.tVertexVector
   
   Vector       = New tVertexVector
   Vector\x#     = x#
   Vector\y#     = y#
   Vector\z#     = z#
   Vector\vertex = pVertex

   Return Vector

End Function


Function VectorAngle#(v1.tVertexVector,v2.tVertexVector)
   ;returns angle between two normalized vectors
   ;dot product is converted to integer and back to avoid some weird float issues
   ;(as a matter of fact I don't know what the problem is exactly, maybe rounding differences, maybe NaN)
   Local dot = ((v1\X * v2\X) + ( v1\Y * v2\Y) + (v1\Z*v2\Z)) * 10000
   Return ACos#( dot / 10000.0 )   
         
End Function