MODULE BouncingBall; 
(* =========================================================================  
   Example GPCP .NET WinForms Graphics Program
   
   A ball bouncing off the borders of a resizable form
   
   Author : Chris Burrows 
   Created: Sep 2006 
   (c) 2006-2008 CFB Software
   http://www.cfbsoftware.com/gpcp
                                                                              
   ========================================================================= *)

IMPORT  
  Sys := "[mscorlib]System",
  Cpm := "[System]System.ComponentModel",
  Wfm := "[System.Windows.Forms]System.Windows.Forms",
  Drw := "[System.Drawing]System.Drawing",
  WinMain; 

CONST
  timerInterval = 20;
  
TYPE    
  MainForm = POINTER TO RECORD (Wfm.Form)
    components: Cpm.Container;
    timer: Wfm.Timer
  END;
  
  Ball = POINTER TO RECORD
    radius: INTEGER;
    xPos, yPos: INTEGER;
    xVelocity, yVelocity: INTEGER;
    color: Drw.Color
  END;

VAR     
  frm: MainForm;
  ball: Ball;

(* ==================================================================== *)
PROCEDURE (frm: MainForm) Dispose*(disposing: BOOLEAN);
BEGIN
  IF disposing THEN
    IF frm.components # NIL THEN
      frm.components.Dispose()
    END; 
    frm.Dispose^(disposing)
  END 
END Dispose;

(* ==================================================================== *)
PROCEDURE (ball: Ball) Init(xVelocity, yVelocity, radius: INTEGER; color: Drw.Color), NEW;
BEGIN
  ball.xPos := 0;
  ball.yPos := 0;
  ball.xVelocity := xVelocity;
  ball.yVelocity := yVelocity;
  ball.radius := radius;
  ball.color := color
END Init;

(* ==================================================================== *)
PROCEDURE (ball: Ball) UpdatePosition(), NEW;
BEGIN
  INC(ball.xPos, ball.xVelocity);
  INC(ball.yPos, ball.yVelocity)
END UpdatePosition;
  
(* ==================================================================== *)
PROCEDURE (ball: Ball) CheckBounce(width, height: INTEGER), NEW;
BEGIN
  IF ((ball.xPos + ball.radius) >= width) THEN
    ball.xVelocity := -ball.xVelocity;
    ball.xPos := width - ball.radius
  END;
  IF ((ball.xPos - ball.radius) <= 0) THEN
    ball.xVelocity := -ball.xVelocity;
    ball.xPos := ball.radius
  END;
  IF ((ball.yPos + ball.radius) >= height) THEN
    ball.yVelocity := -ball.yVelocity;
    ball.yPos := height - ball.radius
  END;
  IF ((ball.yPos - ball.radius) <= 0) THEN
    ball.yVelocity := -ball.yVelocity;
    ball.yPos := ball.radius
  END
END CheckBounce;

(* ==================================================================== *)
PROCEDURE (ball: Ball) Draw(frm: MainForm), NEW;
VAR
  g: Drw.Graphics;

  PROCEDURE FillCircle(g: Drw.Graphics; color: Drw.Color; x, y, radius: INTEGER);
  VAR 
    brush: Drw.Brush;
  BEGIN
    brush := Drw.SolidBrush.init(color);
    g.FillEllipse(brush, x - radius, y - radius, radius * 2, radius * 2);
    brush.Dispose()
  END FillCircle; 

BEGIN
  g := frm.CreateGraphics();
  (* Erase ball at old position *)
  FillCircle(g, frm.get_BackColor(), ball.xPos, ball.yPos, ball.radius); 
  ball.UpdatePosition();
  ball.CheckBounce(frm.get_ClientSize().get_Width(), frm.get_ClientSize().get_Height());
  (* Draw ball in new position *)
  FillCircle(g, ball.color, ball.xPos, ball.yPos, ball.radius);
  g.Dispose()
END Draw;

(* ==================================================================== *)
PROCEDURE (frm: MainForm) OnTimerTick(sender: Sys.Object; e: Sys.EventArgs), NEW;
BEGIN
  ball.Draw(frm)
END OnTimerTick;

(* ==================================================================== *)
PROCEDURE (frm: MainForm) InitializeComponent(), NEW;
CONST
  frmWidth = 600;
  frmHeight = 400;
BEGIN
  NEW(frm.components); 
  NEW(frm.timer);
  
  frm.SuspendLayout();

  frm.set_Text("Bouncing Ball");
  frm.set_AutoScaleBaseSize(Drw.Size.init(5, 13));
  frm.set_ClientSize(Drw.Size.init(frmWidth, frmHeight));
  frm.set_FormBorderStyle(Wfm.FormBorderStyle.Sizable);
  frm.set_BackColor(Drw.Color.get_White());
  frm.set_ResizeRedraw(TRUE);
  REGISTER(frm.timer.Tick, frm.OnTimerTick);

  frm.ResumeLayout(FALSE)
END InitializeComponent;

(* ==================================================================== *)
BEGIN
  NEW(frm);
  frm.InitializeComponent();

  NEW(ball);
  ball.Init(5, 5, 5, Drw.Color.get_Red());

  frm.timer.set_Interval(timerInterval);
  frm.timer.Start();

  Wfm.Application.Run(frm)

END BouncingBall.