GlGraphics (1024,768,0)         ' OpenGl Grafik

'#########################OpenGl einstellen#######################
glDepthFunc(GL_LESS)
glDisable(GL_TEXTURE_2D)
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
glShadeModel(GL_SMOOTH)
glOrtho(0,GraphicsWidth(),GraphicsHeight(),0,-1,1)
glMatrixMode(GL_MODELVIEW)
glViewport(0,0,GraphicsWidth(),GraphicsHeight())
glDisable(GL_LIGHTING)
glClearColor 0.6,0.6,0.6,1
'################################Sonstige Sachen#######################
SeedRnd MilliSecs()

Global mx
Global my

Global intersection_x#
Global intersection_y#
Global intersection_ab#
Global intersection_cd#

Const eo# = 0.05
Global S_TIMESTEP:Float = 0.1

Global Llist:TList = CreateList()
Global objlist:TList = CreateList()
Global pointlist:TList = CreateList()       
Global linklist:TList = CreateList() 


Global tex = loadtexture("test.png")

'################################HAUPTSCHLEIFE###############################
While Not KeyHit(KEY_ESCAPE)
    fp = fps()
    mx = MouseX()
    my = MouseY()

    If KeyHit(KEY_A)
        CreateBox(rand(100,700),100)
    EndIf
   
   '##### EckPunkte bewegen mit maus'#####
    For Local p:TSPoint = EachIn pointlist
        If p.y > GraphicsHeight() Then
            p.y = GraphicsHeight()
            p.oldx = p.x
        EndIf
        If p.y < 0 Then
            p.y = 0
        End If
        If p.x < 0 Then
            p.x = 0
            ElseIf p.x > GraphicsWidth() Then
            p.x = GraphicsWidth()
        EndIf
       
        If MouseDown(1)
            If PointInRect( mx,my, p.x-10,p.y-10,20,20) Then
                mpoint:TSPoint = p
            EndIf
            If mpoint Then
                mpoint.x = mx
                mpoint.y = my
            EndIf
            If MouseHit(2) and mpoint <> null
                mpoint.active =  Not  mpoint.active
            End If
        Else
            mpoint=Null
        EndIf
    Next
   
   '##### Mit STRG+Mouse linien erstellen#####
    If KeyDown(KEY_LCONTROL)
        If MouseDown(1)
            If MouseHit(1)
                m1x = mx
                m1y = my
                asd1 = Line.Create(mx,my,mx,my)
            End If
            Line.SetPosition (asd1,m1x,m1y,mx,my)
        End If
    EndIf
   
    GLDrawText "Fps : "+fp ,20,20

    UpdateVerlet
    TSGroup.UpdateAll
    Line.Update
   
    Flip
    glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT)
Wend
         
'################################Funktionen###############################
         
Function UpdateVerlet()
   for local l2:Line = eachin llist
      For Local l:TSLink = EachIn linklist
         If LinesIntersect(l.p1.x , l.p1.y , l.p2.x , l.p2.y , l2.x1 , l2.y1 , l2.x2 , l2.y2)
            dis1# = distance(l.p1.x , l.p1.y , intersection_x , intersection_y)
            dis2# = distance(l.p2.x , l.p2.y , intersection_x , intersection_y)
            If dis1 < dis2
               l.p1.x = l.p1.oldx
               l.p1.y = l.p1.oldy
               If Not lineinrect(l2.x1 , l2.y1 , l2.x2 , l2.y2 , l.p1.x , l.p1.y , 1 , 1)
                  l.p1.translate(0 , - 2)
               EndIf
            Else
               l.p2.x = l.p2.oldx
               l.p2.y = l.p2.oldy
               If  Not lineinrect(l2.x1 , l2.y1 , l2.x2 , l2.y2 , l.p2.x , l.p2.y , 1 , 1)
                  l.p2.translate(0 , - 2)
               EndIf
            EndIf
         EndIf
      Next
   Next

   for Local o:TSGroup = EachIn objlist
      For Local obj2:tsgroup = EachIn objlist
         If obj2 <> o
            if rectsoverlap(obj2.x-5,obj2.y-5,obj2.w+10,obj2.h+10,o.x-5,o.y-5,o.w+10,o.h+10)
            For Local a:TsLink = EachIn   obj2.links
               for Local b:TsLink = EachIn o.links
                  If LinesIntersect(a.p1.x , a.p1.y , a.p2.x , a.p2.y , b.p1.x , b.p1.y , b.p2.x , b.p2.y) And Not o.links.contains(a)
                     If distance(a.p1.x,a.p1.y,intersection_x,intersection_y) < distance(a.p2.x,a.p2.y,intersection_x,intersection_y)
                        a.p1.x = a.p1.oldx
                        a.p1.y = a.p1.oldy
                     else
                        a.p2.x = a.p2.oldx
                        a.p2.y = a.p2.oldy
                     EndIf
                     
                     if linetopoly(a.p1.x,a.p1.y,a.p2.x,a.p2.y,o.poly)
                        winkel#=getwinkel(obj2.center[0],obj2.center[1],a.p1.x,a.p1.y)
                        a.p1.translate(cos(winkel),sin(winkel))      
                        winkel#=getwinkel(obj2.center[0],obj2.center[1],a.p2.x,a.p2.y)
                        a.p2.translate(cos(winkel),sin(winkel))
                     endif
                  endif
               next
            Next
            endif
         EndIf
      Next
   Next
End Function
                   
Function CreateBox:tsgroup(x=0,y=0,g=-20,a=1)
   obj:tsgroup = tsgroup.Create( g,a)
   
   Local ps:tspoint[100]
   
   ps[1] = addpoint(obj , 0 , 0)
   ps[2] = addpoint(obj , 100 , 0)
   ps[3] = addpoint(obj , 100 , 100)
   ps[4] = addpoint(obj , 0 , 100)

   connectall(obj)

   obj.translate x,y,1
   obj.translate(rnd(-5,5),rnd(-5,5))
   obj.rotate(rnd(-5,5))
   Return obj
End Function
                   
Function Load:TsGroup(file$,x=0,y=0,f=true)
   local c:TsGroup=TsGroup.create(-20,f)
   c.translate(x,y,1)
   local pix:tpixmap = loadpixmap(file)
   
   w=Pixmapwidth(pix)
   h=PixmapHeight(pix)
   
   local points:tspoint[1000]
   
   for x = 0 to w-1
      for y = 0 to h-1 
         color = readpixel(pix,x,y)
         if color <> -1
            points[num]=addpoint(c,x,y)
            num:+1
         End If
      Next
   Next
   ConnectAll(c)
   return c
End Function
                  
Function LoadTexture(file$)
   Return GLTexFromPixmap(LoadPixmap(file))
End Function
                       
Function PolyToPoly( p1_xy:Float[], p2_xy:Float[] )
   
   If p1_xy.length<6 Or (p1_xy.length&1) Return False
   If p2_xy.length<6 Or (p2_xy.length&1) Return False
   
   For Local i:Int=0 Until p1_xy.Length Step 2
      If PointInPoly(p1_xy[i],p1_xy[i+1],p2_xy) Then Return True
   Next
   For Local i2:Int=0 Until p2_xy.Length Step 2
      If PointInPoly(p2_xy[i2],p2_xy[i2+1],p1_xy) Then Return True
   Next
   
   Local l1_x1:Float=p1_xy[p1_xy.Length-2]
   Local l1_y1:Float=p1_xy[p1_xy.Length-1]
   For Local i1:Int=0 Until p1_xy.Length Step 2
      Local l1_x2=p1_xy[i1]
      Local l1_y2=p1_xy[i1+1]
      
      Local l2_x1:Float=p2_xy[p2_xy.Length-2]
      Local l2_y1:Float=p2_xy[p2_xy.Length-1]
      For Local i3:Int=0 Until p2_xy.Length Step 2
         Local l2_x2=p2_xy[i3]
         Local l2_y2=p2_xy[i3+1]
         
         If LinesIntersect(l1_x1,l1_y1,l1_x2,l1_y2,l2_x1,l2_y1,l2_x2,l2_y2)
            Return True
         EndIf
         
         l2_x1=l2_x2
         l2_y1=l2_y2
      Next
      l1_x1=l1_x2
      l1_y1=l1_y2
   Next
   Return False
End Function

Function LineToPoly( line_x1:Float, line_y1:Float, line_x2:Float, line_y2:Float, xy:Float[] )
   
   If xy.length<6 Or (xy.length&1) Return False
   
   If PointInPoly(line_x1,line_y1,xy) Then Return True
   
   Local poly_x1:Float=xy[xy.Length-2]
   Local poly_y1:Float=xy[xy.Length-1]
   
   For Local i:Int=0 Until Len xy Step 2
      Local poly_x2:Float=xy[i]
      Local poly_y2:Float=xy[i+1]
      
      If LinesIntersect(line_x1,line_y1,line_x2,line_y2,..
                  poly_x1,poly_y1,poly_x2,poly_y2) Then Return True
      poly_x1=poly_x2
      poly_y1=poly_y2
   Next
   
   Return False
   
End Function

Function PointInPoly( point_x:Float, point_y:Float, xy:Float[] )
   
   If xy.length<6 Or (xy.length&1) Return False
   
   Local x1:Float=xy[xy.Length-2]
   Local y1:Float=xy[xy.Length-1]
   Local cur_quad:Int=GetQuad(point_x,point_y,x1,y1)
   Local next_quad:Int
   Local total:Int
   
   For Local i=0 Until Len xy Step 2
      Local x2:Float=xy[i]
      Local y2:Float=xy[i+1]
      next_quad=GetQuad(point_x,point_y,x2,y2)
      Local diff:Int=next_quad-cur_quad
      
      Select diff
      Case 2,-2
         If ( x2 - ( ((y2 - point_y) * (x1 - x2)) / (y1 - y2) ) )<point_x
            diff=-diff
         EndIf
      Case 3
         diff=-1
      Case -3
         diff=1
      End Select
      
      total:+diff
      cur_quad=next_quad
      x1=x2
      y1=y2
   Next
   
   If Abs(total)=4 Then Return True Else Return False
End Function

Function LineToCircle( x1:Float, y1:Float, x2:Float, y2:Float, px:Float, py:Float, r:Float )
   
   Local sx:Float = x2-x1
   Local sy:Float = y2-y1
   
   Local q:Float = ((px-x1) * (x2-x1) + (py - y1) * (y2-y1)) / (sx*sx + sy*sy)
   
   If q < 0.0 Then q = 0.0
   If q > 1.0 Then q = 1.0
   
   Local cx:Float=(1-q)*x1+q*x2
   Local cy:Float=(1-q)*y1 + q*y2
   
   
   If Distance(px,py,cx,cy) < r
      
      Return True
      
   Else
      
      Return False
      
   EndIf

   
End Function

Function GetQuad(axis_x:Float,axis_y:Float,vert_x:Float,vert_y:Float)
   If vert_x<axis_x
      If vert_y<axis_y
         Return 1
      Else
         Return 4
      EndIf
   Else
      If vert_y<axis_y
         Return 2
      Else
         Return 3
      EndIf   
   EndIf

End Function   

Function FPS:Int( l_in:Short = 1000)
   Global  gfps:Int, gtempfps:Int ,gtime:Int
   
   If MilliSecs()- gtime>l_in
      gfps = gtempfps
      gtempfps = 0
      gtime = MilliSecs()
   EndIf
   
   gtempfps:+1
   Return gfps
End Function

Function LinesIntersect(ax#, ay#, bx#, by#, cx#, cy#, dx#, dy#)
    rn# = (ay#-cy#)*(dx#-cx#) - (ax#-cx#)*(dy#-cy#)
    rd# = (bx#-ax#)*(dy#-cy#) - (by#-ay#)*(dx#-cx#)
    If rd# = 0
        Return False
    Else
        sn# = (ay#-cy#)*(bx#-ax#) - (ax#-cx#)*(by#-ay#)
        intersection_ab# = rn# / rd#
        intersection_cd# = sn# / rd#
        intersection_x#  = ax# + intersection_ab#*(bx#-ax#)
        intersection_y#  = ay# + intersection_ab#*(by#-ay#)
        If intersection_ab#>0 And intersection_ab#<1 And intersection_cd#>0 And intersection_cd#<1 Then    Return True
    EndIf
End Function
   
Function LineInRect(ax# , ay# , bx# , by# , x# , y# , w , h)
     If linesintersect(ax , ay , bx , by , x , y , x + w , y) Return True
     If linesintersect(ax , ay , bx , by , x , y , x , y + h) Return True
     If linesintersect(ax , ay , bx , by , x + w , y , x + w , y + h) Return True
     If linesintersect(ax , ay , bx , by , x+w , y+h , x , y + h) Return True
End Function

Function Distance(x1#,y1#,x2#,y2#)
   disx# = x2-x1
   disy# = y2-y1
   Return Abs(Sqr(disx^2+disy^2))
End Function

Function RectsOverlap(x1,y1,w1,h1,x2,y2,w2,h2)
   If x1 > (x2+w2) Or (x1+w1) < x2 Return False
   If y1 > (y2+h2) Or (y1+h1) < y2 Return False
   Return True
End Function

Function GetWinkel#(Zielpunkt_X#,Zielpunkt_Y#,Ausgangspunkt_X#,Ausgangspunkt_Y# )
   grad# =ATan2(Zielpunkt_Y -Ausgangspunkt_Y, Zielpunkt_X -Ausgangspunkt_X)
   grad# = (grad#+360) mod 360
   Return grad#
End Function

Function DrawTexturedPoly (Frame:Int, xy#[],uv#[])
   If xy.length<6 Return
      
   glDisable( GL_DEPTH_TEST )
    glEnable( GL_BLEND )
   glblendfunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
   
   glBindTexture GL_TEXTURE_2D, Frame
   glEnable GL_TEXTURE_2D

   glBegin GL_POLYGON
   
      For i = 0 To xy.length - 1 Step 2
          gltexcoord2f uv[i],uv[i+1]
         glcolor3f  255,255,255
          glvertex2f xy[i] , xy[i + 1]
      Next
      
   glEnd
   glEnable(GL_DEPTH_TEST)
   glDisable(GL_BLEND)
                              
End Function

Function DrawPoly (xy#[],r#=255,g#=255,b#=255,a#=1)
   If xy.length<6 Return
      
   glDisable( GL_DEPTH_TEST )
    glEnable( GL_BLEND )
   glblendfunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
   
   gldisable GL_TEXTURE_2D

   glBegin GL_POLYGON
   
      For i = 0 To xy.length - 1 Step 2
         glcolor4f r/255,g/255,b/255,a
          glvertex2f xy[i] , xy[i + 1]
      Next
      
   glEnd
   glEnable(GL_DEPTH_TEST)
   glDisable(GL_BLEND)
                              
End Function

Function DrawLine(x1 , y1 , x2 , y2,r#=255,g#=255,b#=255)
    gldisable gl_texture_2d
    glbegin gl_line_loop
      glcolor3f (r/255,g/255,b/255)
         glvertex2f x1 , y1
       glvertex2f x2,y2
    glend()
   glloadidentity()
End Function

Function ConnectAll(obj:tsgroup)
   for i = 0 to obj.curp-1
      for i2=0 to obj.curp-1
         if i2<>i
            addlink obj,obj.poi[i],obj.poi[i2]
         endif
      Next
   Next
End Function
                 
                       
Function PointInRect:Int( px:Int,py:Int, x,y,w,h)
      
   Return (px >= x) And (py >= y) And (px < x + w) And (py < y + h)
 
End Function
   
Function AddLink(obj:TSGroup,p1:TSPoint,p2:TSPoint,k#=eo)

   obj.AddLink( TSLink.Create( p1 , p2 , k))

End Function   

Function AddPoint:TSPoint(obj:TSGroup,x,y,mss1#=1,ac=1)
   Local p:TSPoint = TSPoint.Create(x,y,mss1,ac)
      
   obj.AddPoint (p)
   
   Return p

End Function

'##########################TYPES   (Physik berechnungen nicht von mir!!!! Aus dem englischen Forum!!!###############################
Type TSPoint 
   Field x:Float,y:Float
    Field oldx:Float,oldy:Float
    Field fx:Float,fy:Float
    Field mass:Float
    Field active:Int
   Field nx#
   Field ny#

    
    Function Create:TSPoint( x:Float,y:Float, mass:Float, active:Int = True)
       Local p:TSPoint = New TSPoint
       p.x = x
       p.y = y
       p.oldx = x
       p.oldy = y
       p.mass = mass
       p.active = active 
       
       pointlist.AddLast p
       Return p   
    End Function
   
         
    Method Update()
       If Not active Then Return
       
       Local tmpx1:Float = x
       Local tmpy1:Float = y   
       Local tmpx2:Float = fx * S_TIMESTEP * S_TIMESTEP
       Local tmpy2:Float = fy * S_TIMESTEP * S_TIMESTEP
       oldx :+ tmpx2
       oldy :+ tmpy2
       x :- oldx
   
       y :- oldy
       x :+ tmpx1
       y :+ tmpy1
       oldx = tmpx1
       oldy = tmpy1
       fx = 0
       fy = 0.5
 
    End Method
          
    Method Translate( x:Float,y:Float, Reset:Int = False)
          Self.x :+ x

          Self.y :+ y   
          If Reset   
              oldx = Self.x
              oldy = Self.y
           EndIf
    EndMethod
       
    Method Rotate( dir:Float, center:Float[], Reset:Int = False)    
        Local xr:Float = x - center[0]
        Local yr:Float = y - center[1]
        x = xr * Cos(dir) - yr * Sin(dir)
        y = xr * Sin(dir) + yr * Cos(dir)
        x :+ center[0]
            y :+ center[1]
   
        If Reset Then      
           oldx = x
   
           oldy = y
        EndIf
    End Method
 End Type 
       
Type TSLink
    Field p1:TSPoint
    Field p2:TSPoint
    Field restLength:Float
    Field k:Float
    Field stress:Float
    
    Function Create:TSLink( p1:TSPoint, p2:TSPoint, k:Float)
        Local l:TSLink = New TSLink
        l.p1 = p1   l.p2 = p2   
        l.k = k
        l.CalcRestLength()
        
      
        linklist.AddLast l
        Return l
    End Function
              
     Method Update()

       Local dx:Float = p1.x - p2.x
       Local dy:Float = p1.y - p2.y

       Local dist:Float = Sqr( dx*dx + dy*dy)
       Local w:Float = p1.mass + p2.mass
       If p1.active Then 
          p1.x :- ((dx / dist) * ((dist - restLength) * k)) * (p1.mass / w)
          p1.y :- ((dy / dist) * ((dist - restLength) * k)) * (p1.mass / w)
       EndIf   
       If p2.active Then
          p2.x :+ ((dx / dist) * ((dist - restLength) * k)) * (p2.mass / w)
          p2.y :+ ((dy / dist) * ((dist - restLength) * k)) * (p2.mass / w)
       EndIf

       stress = (dist - restLength) / restLength
   '   DrawLine p1.x,p1.y,p2.x,p2.y
    End Method
              
     Method CalcRestLength()
       restLength = Sqr((p1.x - p2.x) * (p1.x - p2.x) + (p1.y - p2.y) * (p1.y - p2.y))
    EndMethod   
 End Type
       
Type TSGroup
    Field poi:TSPoint[1000]
    Field links:TList = New TList   
    Field gravity:Float
    Field active:Int
   Field uv#[1000]
   Field curp
    Field center:Float[2]
    Field wire=1
   Field Poly#[]
   field x,y,w,h
    
   
    Function Create:TSGroup( gravity:Float = 0.0, active:Int = True)
       Local g:TSGroup = New TSGroup
       g.gravity = gravity
       g.wire = 1
       g.active = 1
       g.CalcCenterPoint()
       
       If Not objlist Then objlist = CreateList()
       objlist.AddLast (g)

       Return g
    End Function
    
    Method AddPoint( p:TSPoint)
       poi[curp] = p
      curp:+ 1
      For Local i=0 To curp-1 
          uv[i*2]=poi[i].x/100
          uv[i*2+1]=poi[i].y/100
      Next
    End Method
    
    Method AddLink( l:TSLink)
       If l Then links.AddLast( l)    
    EndMethod   
    
      
   Method CalcBoundingBox()
      x = $FFFFFFF
      y = $FFFFFFF
      w = 0
      h = 0
      For Local p:TSPoint = EachIn poi
         x = Min( x, p.x)
         y = Min( y, p.y)
         w = Max( w, p.x)
         h = Max( h, p.y)
      Next
      w :- x
      h :- y
   EndMethod
    
   Method Update()
      CalcBoundingBox()
       CalcCenterPoint()

       If Not active Then Return

       For Local p:TSPoint = EachIn poi
          p.fy = gravity
         p.nx = center[0] - p.x
         p.ny = center[1]-p.y
          p.Update()
          Next
       For Local l:TSLink = EachIn links      
           l.Update()
   
        Next
    EndMethod   
    
    Method Render()
      Local Poly#[curp*2]
      For Local i=0 To curp-1 
             Poly[i*2]=poi[i].x
             Poly[i*2+1]=poi[i].y
      Next
      
      self.Poly=poly
      DrawtexturedPoly(tex, Poly,uv )
      'Drawpoly(poly,0,255,0,0.5)
'      For a=0 To curp-1
'         If a=curp - 1
'            DrawLine poi[a].X , poi[a].Y  , poi[0].X , poi[0].Y,0,255,0
'         Else
'            DrawLine poi[a].X , poi[a].Y , poi[a + 1].X , poi[a + 1].Y,0,255,0
'         End If
'      Next
    EndMethod   
    
    Method Translate( x:Float,y:Float, Reset:Int = False)
       For Local p:TSPoint = EachIn poi
          p.Translate( x,y, Reset)
       Next   
       CalcCenterPoint()
    EndMethod
       
    Method Rotate( dir:Float, Reset:Int = False)
       For Local p:TSPoint = EachIn poi
             p.Rotate( dir, center, Reset)
       Next
       CalcCenterPoint()
    EndMethod   
    
    Method CalcCenterPoint()
       Local xtmp:Float,ytmp:Float, sz:Int = curp
       For Local p:TSPoint = EachIn poi
          xtmp :+ p.x
          ytmp :+ p.y

       Next
       center[0] = xtmp / sz
       center[1] = ytmp / sz
    EndMethod 
    
    Method GetX()
       Return center[0]
    End Method 
    
    Method GetY()
       Return center[1]
    End Method
   
    
    Function UpdateAll()
       For Local o:TSGroup = EachIn objlist
          o.Update
          o.Render
       Next
    End Function
 EndType


Type Line
    Field x1#
    Field x2#
    Field y1#
    Field y2#
    Field colx#
    Field coly#
   
    Method Draw()
        DrawLine(x1,y1,x2,y2)
    End Method
   
    Function Create:Line(x1#,y1#,x2#,y2#)
        Local l:Line = New Line
        l.x1 = x1
        l.y1 = y1
        l.y2 = y2
        l.x2 = x2
       
        Llist.AddLast (l)
        Return l
    End Function
   
    Function Update()
        For Local l:Line = EachIn Llist
            l.Draw()
        Next
    End Function
   
    Function Collided(l1:Line,l2:Line)
        If LinesIntersect(l1.x1,l1.y1,l1.x2,l1.y2,l2.x1,l2.y1,l2.x2,l2.y2)
            l1.colx = intersection_x
            l1.coly = intersection_y
            l2.colx = intersection_x
            l2.coly = intersection_y
            Return True
        End If
    End Function
   
    Function SetPosition(l:Line,x1#,y1#,x2#,y2#)
        l.x1 = x1
        l.y1 = y1
        l.x2 = x2
        l.y2 = y2
    End Function
   
    Function CollisionX(l:Line)
        Return l.colx
    End Function
   
    Function CollisionY(l:Line)
        Return l.coly
    End Function
   
End Type

Function LoadTexture(file$)
   Return GLTexFromPixmap(LoadPixmap(file))
End Function