Last updated: 17. 1.1998, 20:23
<* +M2EXTENSIONS *>
MODULE Clover;
(*--------------------------------------------------
CLOVER.C --- Clover Drawing Program using Regions
(c) Charles Petzold, 1996
Clover.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
--------------------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
IMPORT RealMath;
CONST TWO_PI = 2.0 * 3.14159;
CONST szAppName = "Clover";
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
hRgnClip : Windows.HRGN;
cxClient : INTEGER;
cyClient : INTEGER;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc(hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
fAngle : CARDINAL;
fRadius : REAL;
fx : REAL;
fy : REAL;
hCursor : Windows.HCURSOR;
hdc : Windows.HDC;
hRgnTemp : ARRAY[0..5] OF Windows.HRGN;
i : INTEGER;
ps : Windows.PAINTSTRUCT;
BEGIN
CASE (iMsg) OF
| Windows.WM_SIZE:
cxClient := Windows.LOWORD (lParam);
cyClient := Windows.HIWORD (lParam);
hCursor := Windows.SetCursor (Windows.LoadCursor (NIL, Windows.IDC_WAIT));
Windows.ShowCursor (TRUE);
IF (hRgnClip#NIL) THEN
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hRgnClip) );
END;
hRgnTemp[0] := Windows.CreateEllipticRgn (0, cyClient / 3,
cxClient / 2, 2 * cyClient / 3);
hRgnTemp[1] := Windows.CreateEllipticRgn (cxClient / 2, cyClient / 3,
cxClient, 2 * cyClient / 3);
hRgnTemp[2] := Windows.CreateEllipticRgn (cxClient / 3, 0,
2 * cxClient / 3, cyClient / 2);
hRgnTemp[3] := Windows.CreateEllipticRgn (cxClient / 3, cyClient / 2,
2 * cxClient / 3, cyClient);
hRgnTemp[4] := Windows.CreateRectRgn (0, 0, 1, 1);
hRgnTemp[5] := Windows.CreateRectRgn (0, 0, 1, 1);
hRgnClip := Windows.CreateRectRgn (0, 0, 1, 1);
Windows.CombineRgn (hRgnTemp[4], hRgnTemp[0], hRgnTemp[1], Windows.RGN_OR);
Windows.CombineRgn (hRgnTemp[5], hRgnTemp[2], hRgnTemp[3], Windows.RGN_OR);
Windows.CombineRgn (hRgnClip, hRgnTemp[4], hRgnTemp[5], Windows.RGN_XOR);
FOR i := 0 TO 6-1 DO
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hRgnTemp[i]));
END;
Windows.SetCursor (hCursor);
Windows.ShowCursor (FALSE);
RETURN 0;
| Windows.WM_PAINT:
hdc := Windows.BeginPaint (hwnd, ps);
Windows.SetViewportOrgEx (hdc, cxClient / 2, cyClient / 2, NIL);
Windows.SelectClipRgn (hdc, hRgnClip);
fx := VAL(REAL,(cxClient*cxClient))/4.0;
fy := VAL(REAL,(cyClient*cyClient))/4.0;
fRadius := RealMath.sqrt(fx+fy);
FOR fAngle := 0 TO 360-1 DO
Windows.MoveToEx (hdc, 0, 0, NIL);
Windows.LineTo (hdc, VAL(INTEGER,(fRadius * RealMath.cos (VAL(REAL,fAngle)*TWO_PI/360.) + 0.5)),
VAL(INTEGER,(-fRadius * RealMath.sin (VAL(REAL,fAngle)*TWO_PI/360.) + 0.5)));
END;
Windows.EndPaint (hwnd, ps);
RETURN 0;
| Windows.WM_DESTROY:
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hRgnClip));
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
rc : CARDINAL;
BEGIN
wc.cbSize := SIZE(wc);
wc.style := Windows.CS_HREDRAW + Windows.CS_VREDRAW;
wc.lpfnWndProc := WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := Windows.MyInstance();
wc.hIcon := Windows.LoadIcon (NIL, Windows.IDI_APPLICATION);
wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW);
wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH, Windows.GetStockObject (Windows.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := Windows.LoadIcon (NIL,Windows.IDI_APPLICATION);
rc := Windows.RegisterClassEx(wc);
RETURN rc #0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := Windows.CreateWindow (
szAppName, (* window class name *)
"Draw a Clover: Translation to XDS Modula-2",
(* window caption *)
Windows.WS_OVERLAPPEDWINDOW, (* window style *)
Windows.CW_USEDEFAULT, (* initial x position *)
Windows.CW_USEDEFAULT, (* initial y position *)
Windows.CW_USEDEFAULT, (* initial x size *)
Windows.CW_USEDEFAULT, (* initial y size *)
NIL, (* parent window handle *)
NIL, (* window menu handle *)
wc.hInstance, (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
RETURN FALSE;
END;
Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT);
Windows.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END Clover.