'-----------------------------------------------------------------------
' Kleines BallSpiel in BlitzMax von M.Rauch 2005
'-----------------------------------------------------------------------

  'Color = SetColor <- beeinflußt auch Bilder wenn sie angezeigt werden !
  'Line  = DrawLine
  'Text  = DrawText

Strict
Graphics 800, 600,0, 72   'vorher 800,600,16,2
SeedRnd MilliSecs()
SetClsColor 64,128,64 'vorher ClsColor
 
AutoImageFlags MASKEDIMAGE

'-----------------------------------------------------------------------

'Local mFont=LoadFont("Tahoma",18,1) <- BlitzBasic
'SetFont mFont

'Global mFont:TImagefont=LoadImageFont("Arial",24,BOLDFONT) '???
'SetImageFont mFont

'------------------------------------------
Type CircleType
   Field x:Float,y:Float   'position
   Field ox:Float,oy:Float   'original position
   Field dx:Float,dy:Float   'x and y speed
   Field w:Float         'winkel
   Field wspeed:Float   
   Field speed:Float   'speed gesamt
   Field radius:Float   'radius of ball
   Field mass:Float   'mass of ball
   Field img:TImage
   Field hit:Int
   Field MoveBack:Int
   
   'Neue Struktur anlegen und in Liste anfügen
   Method New()
    clist.addlast Self
   End Method
      
   'Bild und Struktur freigeben und aus Liste entfernen
   Method Free()
    img=Null
    clist.remove Self
   End Method

    'Rollt aus und verschwindet   
   Method FreeAtHit()
     If Self.Hit=1 And Self.speed<1.0 Then Free
    End Method
   
End Type
'------------------------------------------

Global Punkte
Global LastOne
Global GameOver
Global cue:CircleType
Global clist:TList=CreateList() '= New TList

'-----------------------------------------------------------------------
Main()
End
'-----------------------------------------------------------------------

Function Main()

 Reset()

 While Not KeyHit(KEY_ESCAPE) 'Escape

  Cls

  SetBlend MASKBLEND
  SetAlpha 1
  DrawLine 0,GraphicsHeight()/2.0,GraphicsWidth()-1,GraphicsHeight()/2.0   
  UpdateCirclePhysics()
  RenderCircles()
  Ordnung()

  If KeyHit(KEY_N) Then 'N wie Neu oder New
   GameOver=1
  EndIf
   
  If GameOver=0 Then GameInput()

  '---------------------------------- Überblenden :-)

  SetColor 255,255,255
  SetBlend LIGHTBLEND
  SetAlpha 0.8
  Text 10, 10, "Punkte " + Punkte

  If GameOver=1 Then
   Text 10, 25, "Game Over"
   If MouseHit(1) Then
    Reset()
   EndIf
  EndIf

  '----------------------------------
   
  Flip
   
 Wend

End Function

'-----------------------------------------------------------------------

Function Reset()

 '-------------------------------

 Punkte=0
 LastOne=0
 GameOver=0

 '-------------------------------

 Local c:CircleType

 For c = EachIn clist
  c.free
 Next
 FlushMem 'alles was auf NULL gesetzt wurde wird jetzt entfernt

 '-------------------------------

 Local db=0
 Local ballTriangleSize=12
 Local xloop,yloop

 For xloop = ballTriangleSize To 1 Step -1
  db=db+1;If db>2 Then db=0
   For yloop = 1 To xloop
      c=New CircleType
      c.x = (5-xloop)*27 + 240
      c.y = yloop*32-16-(xloop*32)/2.0+GraphicsHeight()/2.0
      c.ox=c.x
      c.oy=c.y
      c.dx=0
      c.dy=0
      c.radius = 10
      c.mass =c.radius*2.0
      If db=1 Then
       c.radius = c.radius/2.0
       c.mass =c.radius*2.0
      EndIf
      If db=2 Then
       c.radius = c.radius/1.5
       c.mass = c.radius*2.0      
      EndIf
      CImage c
   Next
 Next

 '-------------------------------

 CueStart()

End Function

'-----------------------------------------------------------------------

Function Ordnung()

 Local c:CircleType
 Local x#,y#,dx#,dy#,entf#
 For c = EachIn clist
  If c<>cue Then
    If c.hit=1 And c.MoveBack=1 Then c.MoveBack=0
    If c.hit=0 And (c.speed<0.5 Or c.MoveBack=1) Then
     dx=c.ox-c.x
     dy=c.oy-c.y
     entf=Sqr(dx*dx+dy*dy)
     If entf<=4 Then
      c.MoveBack=0
      c.speed=c.speed*0.5
     EndIf
     If entf>4 Or c.MoveBack=1 Then
      c.MoveBack=1
      c.w=ATan2(c.ox-c.x,c.oy-c.y)
      c.speed=entf/10.0
      If c.speed>2 Then c.speed=2
      c.dx = Sin(c.w)*c.speed
      c.dy = Cos(c.w)*c.speed
     EndIf
    EndIf
  EndIf
 Next

End Function

'-----------------------------------------------------------------------

Function CueStart()

 'Spiel Ball
 cue=New CircleType
 cue.x = GraphicsWidth()-32
 cue.y = GraphicsHeight()/2.0
 cue.w=-90
 cue.wspeed=1.0
 cue.dx = Sin(cue.w)*cue.speed
 cue.dy = Cos(cue.w)*cue.speed
 cue.speed= 2
 cue.radius =15
 cue.mass = cue.radius*2.0
 CImage cue

End Function

'-----------------------------------------------------------------------

Function GameInput()

 Local dx:Float,dy:Float

   '---------------------------------------------
     'Richtung Maus schießen
   If MouseHit(1) Then
     cue.w=ATan2(MouseX()-cue.x,MouseY()-cue.y)
     cue.speed=20
     cue.dx = Sin(cue.w)*cue.speed
     cue.dy = Cos(cue.w)*cue.speed
   End If
   '---------------------------------------------
     'Bis Maus bewegen
   If MouseDown(2) Then
     cue.w=ATan2(MouseX()-cue.x,MouseY()-cue.y)
     dx=MouseX()-cue.x
     dy=MouseY()-cue.y
     cue.speed=Sqr(dx*dx+dy*dy)
     If cue.speed>10 Then cue.speed=10
     cue.dx = Sin(cue.w)*cue.speed
     cue.dy = Cos(cue.w)*cue.speed
   End If
   '---------------------------------------------

End Function

'-----------------------------------------------------------------------

Function UpdateCirclePhysics()

  Local anz=0
  Local c:CircleType
  Local c2:CircleType

   For c = EachIn clist

       anz=anz+1

       c.dx = Sin(c.w)*c.speed
       c.dy = Cos(c.w)*c.speed
   
      'update positions
      c.x=c.x+c.dx
      c.y=c.y+c.dy
      
      'gradually slow down
      c.speed=c.speed*0.98
      
      '------------------------------------------
      'COLLISION CHECKING
      '------------------------------------------
      ' Check each circle in the loop against
      ' every other (c against c2)
      For c2= EachIn clist
      
        If c<>c2 Then
      
         Local collisionDistance# = c.radius+c2.radius
         Local actualDistance# = Sqr((c2.x-c.x)^2.0+(c2.y-c.y)^2.0)
         
         'Collided or not?
         If actualDistance<collisionDistance Then
            
            Local collNormalAngle#=ATan2(c2.x-c.x, c2.y-c.y)

            'Position exactly touching, no intersection
            Local moveDist1#=(collisionDistance-actualDistance)*(c2.mass/Float((c.mass+c2.mass)))
            Local moveDist2#=(collisionDistance-actualDistance)*(c.mass/Float((c.mass+c2.mass)))
            c.x=c.x + moveDist1*Sin(collNormalAngle+180.0)
            c.y=c.y + moveDist1*Cos(collNormalAngle+180.0)
            c2.x=c2.x + moveDist2*Sin(collNormalAngle)
            c2.y=c2.y + moveDist2*Cos(collNormalAngle)
            
            'Hit and Points
            If (c2.mass<c.mass And LastOne=0) Or (c2.mass<=c.mass Or LastOne=1) Then
             If (c2<>cue And c<>cue) Or (c2<>cue And LastOne=1) Then
              If c2.Hit=0 Then
               c2.Hit=1
                 If c2.mass<c.mass Then punkte=punkte+c.mass*2.0
                If c2.mass=c.mass Then punkte=punkte+(c2.mass/2.0)
                  EndIf
             EndIf
            EndIf
            
            If 1=1 Then 'wenn die Kugeln sich auch bewegen sollen
                           
               '------------------------------------------
               'COLLISION RESPONSE
               '------------------------------------------
               'n = vector connecting the centers of the circles.
               'we are finding the components of the normalised vector n
               Local nX#=Sin(collNormalAngle)
               Local nY#=Cos(collNormalAngle)
               
               'now find the length of the components of each movement vectors
               'along n, by using dot product.
               Local a1# = c.dx*nX  +  c.dy*nY
               Local a2# = c2.dx*nX +  c2.dy*nY
               
               'optimisedP = 2(a1 - a2)
               '             ----------
               '              m1 + m2
               Local optimisedP# = (2.0 * (a1-a2)) / (c.mass + c2.mass)
               
               'now find out the resultant vectors
               'r1 = c1\v - optimisedP * mass2 * n
               c.dx = c.dx - (optimisedP*c2.mass*nX)
               c.dy = c.dy - (optimisedP*c2.mass*nY)
               
               'r2 = c2\v - optimisedP * mass1 * n
               c2.dx = c2.dx - (optimisedP*c.mass*-nX)
               c2.dy = c2.dy - (optimisedP*c.mass*-nY)
   
                c.w=collNormalAngle+180.0
               SpeedFromDXDY(c)
                    c2.w=collNormalAngle
               SpeedFromDXDY(c2)
   
              EndIf 'Move or Not

         EndIf 'colli ?

            EndIf 'c<>c2     

      Next 'c2

      '------------------------------------------
      '------------------------------------------
      
      If 1=1 Then 'Wand Colli An/Aus
      
         'Simple Bouncing off walls.
         If c.x<c.radius Then
            c.x=c.radius
            c.dx=-c.dx
            c.w=ATan2(c.dx,c.dy)
               SpeedFromDXDY(c)
            c.speed=c.speed*0.9
         End If
         If c.x>GraphicsWidth()-c.radius Then
            c.x=GraphicsWidth()-c.radius
            c.dx=-c.dx
            c.w=ATan2(c.dx,c.dy)
            SpeedFromDXDY(c)
            c.speed=c.speed*0.9
         End If
         If c.y<c.radius Then
            c.y=c.radius
            c.dy=-c.dy
            c.w=ATan2(c.dx,c.dy)
            SpeedFromDXDY(c)
            c.speed=c.speed*0.9
         End If
         If c.y>GraphicsHeight()-c.radius Then
            c.y=GraphicsHeight()-c.radius
            c.dy=-c.dy
            c.w=ATan2(c.dx,c.dy)
            SpeedFromDXDY(c)
            c.speed=c.speed*0.9
         End If
      
      EndIf
      
      c.FreeAtHit      
      
   Next

   If anz=2 Then LastOne=1
   If anz=1 Then GameOver=1

End Function

'-----------------------------------------------------------------------

Function SpeedFromDXDY(c:CircleType)

 c.Speed=Sqr(c.dx^2.0+c.dy^2.0)
 c.dx = Sin(c.w)*c.speed
 c.dy = Cos(c.w)*c.speed

End Function

'-----------------------------------------------------------------------

Function RenderCircles()

  'Bilder können jetzt in BlitzMax eingefärbt angezeigt werden !

  Local c:CircleType

  For c:CircleType= EachIn clist
   If c=cue Then
    SetColor 255,255,0 'Gelb
   Else
    If c.hit=0 Then
     SetColor 255,255,255 'Weiß
    Else
     SetColor 255,128,64 'Orange
    EndIf
   EndIf   
   DrawImage c.img,c.x-c.radius,c.y-c.radius
  Next
   
End Function

'-----------------------------------------------------------------------

Function CImage(c:CircleType)

 'in Bild Speicher malen geht wohl nicht mehr
 'aber den Backbuffer kann ich nutzen :-)

  SetBlend MASKBLEND
  SetAlpha 1


 SetClsColor 0,0,0

 Cls

 c.img=CreateImage(c.radius*2,c.radius*2,DYNAMICIMAGE)

 Local r:Float
 Local f:Float
 Local o:Float
 f=128
 o=0
 For r=c.radius To 1.0 Step -1.0
  SetColor f,f,f
  If c.radius=r Then SetColor 4,4,4
  f=f+(128.0/(c.radius))
  Oval c.radius-r-o,c.radius-r-o,r*2.0,r*2.0,True
  If c.radius<>r Then o=o+0.5
 Next

 GrabImage c.img,0,0

 SetClsColor 64,128,64 'vorher ClsColor

 Cls

End Function

'-----------------------------------------------------------------------

Function Text(x:Int,y:Int,t:String)

 'BB3D kompatibel

 DrawText t$,x,y

End Function

Function Oval(x:Float,y:Float,r1:Float,r2:Float,fill:Float)

 'BB3D 50% kompatibel weil immer gefüllt

  DrawOval x,y,r1,r2 ',fill ?
 
End Function