Last updated: 15. 2.1998, 17:30
<*/NOWARN:F*>
MODULE Bounce;
(*---------------------------------------
BOUNCE.C --- Bouncing Ball Program
(c) Charles Petzold, 1996
Bounce.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
---------------------------------------*)
IMPORT WINUSER;
IMPORT WINGDI;
IMPORT WIN32;
IMPORT WINX;
IMPORT SYSTEM;
CONST
szAppName = "Bounce";
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
hBitmap : WIN32.HBITMAP;
cxClient, cyClient, xCenter, yCenter, cxTotal, cyTotal,
cxRadius, cyRadius, cxMove, cyMove, xPixel, yPixel : INTEGER;
hBrush : WIN32.HBRUSH;
hdc : WIN32.HDC;
hdcMem : WIN32.HDC;
iScale : INTEGER;
(*++++*****************************************************************)
PROCEDURE MaxInt (a,b : INTEGER) : INTEGER;
(**********************************************************************)
BEGIN
IF(a>b) THEN
RETURN a;
ELSE
RETURN b;
END;
END MaxInt;
(*++++*****************************************************************)
PROCEDURE MinInt (a,b : INTEGER) : INTEGER;
(**********************************************************************)
BEGIN
IF(a>b) THEN
RETURN b;
ELSE
RETURN a;
END;
END MinInt;
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE WndProc (hwnd : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];
BEGIN
CASE (iMsg) OF
| WINUSER.WM_CREATE :
hdc := WINUSER.GetDC (hwnd);
xPixel := WINGDI.GetDeviceCaps (hdc, WINGDI.ASPECTX);
yPixel := WINGDI.GetDeviceCaps (hdc, WINGDI.ASPECTY);
WINUSER.ReleaseDC (hwnd, hdc);
RETURN 0;
| WINUSER.WM_SIZE :
cxClient := WINUSER.LOWORD (lParam);
xCenter := cxClient / 2;
cyClient := WINUSER.HIWORD (lParam);
yCenter := cyClient / 2;
iScale := MinInt (cxClient * xPixel, cyClient * yPixel) / 16;
cxRadius := iScale / xPixel;
cyRadius := iScale / yPixel;
cxMove := MaxInt (1, cxRadius / 2);
cyMove := MaxInt (1, cyRadius / 2);
cxTotal := 2 * (cxRadius + cxMove);
cyTotal := 2 * (cyRadius + cyMove);
IF (hBitmap#NIL) THEN
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap));
END;
hdc := WINUSER.GetDC (hwnd);
hdcMem := WINGDI.CreateCompatibleDC (hdc);
hBitmap := WINGDI.CreateCompatibleBitmap (hdc, cxTotal, cyTotal);
WINUSER.ReleaseDC (hwnd, hdc);
WINGDI.SelectObject (hdcMem, SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap));
WINGDI.Rectangle (hdcMem, -1, -1, cxTotal + 1, cyTotal + 1);
hBrush := WINGDI.CreateHatchBrush (WINGDI.HS_DIAGCROSS, 0000h);
WINGDI.SelectObject (hdcMem, SYSTEM.CAST(WIN32.HGDIOBJ,hBrush));
WINGDI.SetBkColor (hdcMem, WINGDI.RGB (255, 0, 255));
WINGDI.Ellipse (hdcMem, cxMove, cyMove, cxTotal - cxMove,
cyTotal - cyMove);
WINGDI.DeleteDC (hdcMem);
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBrush));
RETURN 0;
| WINUSER.WM_TIMER :
IF (hBitmap#NIL) THEN
hdc := WINUSER.GetDC (hwnd);
hdcMem := WINGDI.CreateCompatibleDC (hdc);
WINGDI.SelectObject (hdcMem, SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap));
WINGDI.BitBlt (hdc, xCenter - cxTotal / 2,
yCenter - cyTotal / 2, cxTotal, cyTotal,
hdcMem, 0, 0, WINGDI.SRCCOPY);
WINUSER.ReleaseDC (hwnd, hdc);
WINGDI.DeleteDC (hdcMem);
xCenter := xCenter+cxMove;
yCenter := yCenter+cyMove;
IF ((xCenter + cxRadius >= cxClient) OR
(xCenter - cxRadius <= 0)) THEN
cxMove := -cxMove;
END;
IF ((yCenter + cyRadius >= cyClient) OR
(yCenter - cyRadius <= 0)) THEN
cyMove := -cyMove;
END;
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
| WINUSER.WM_DESTROY :
IF (hBitmap#NIL) THEN
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap));
END;
WINUSER.KillTimer (hwnd, 1);
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
BEGIN
wc.cbSize := SIZE(wc);
wc.style := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW;
wc.lpfnWndProc := WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := WINX.Instance;
wc.hIcon := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (NIL,WINUSER.IDI_APPLICATION^);
RETURN WINUSER.RegisterClassEx(wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (szAppName,
"Bouncing Ball: Translation to Stony Brook Modula-2",
WINUSER.WS_OVERLAPPEDWINDOW,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
NIL,
NIL,
WINX.Instance,
NIL);
IF(WINUSER.SetTimer (hwnd, 1, 50, NIL)=0) THEN
WINUSER.MessageBox (hwnd,
"Too many clocks or timers!",
szAppName,
WINUSER.MB_ICONEXCLAMATION BOR WINUSER.MB_OK);
RETURN FALSE;
END;
WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
WINUSER.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END Bounce.