Last updated: 4. 3.1998, 23:49
<*/NOWARN:F*>
MODULE Multi1;
(*---------------------------------------
MULTI1.C -- Multitasking Demo
(c) Charles Petzold, 1996
MULTI1.MOD -- Translation to Stony Brook Modula-2
(c) Peter Stadler, 30.08.1997
---------------------------------------*)
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINX;
IMPORT WINGDI;
IMPORT SYSTEM;
IMPORT RandomNumbers;
IMPORT Threads;
IMPORT ElapsedTime;
IMPORT RealMath;
VAR
cyChar : INTEGER;
CONST
szAppName = "Multi1";
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
VAR
iNum,iLine : INTEGER;
cyClient : INTEGER;
cxClient : INTEGER;
iNext : 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;
(**********************************************************************)
PROCEDURE CheckBottom (hwnd : WIN32.HWND; cyClient : INTEGER; iLine : INTEGER) : INTEGER;
(**********************************************************************)
BEGIN
IF (iLine * cyChar + cyChar > cyClient) THEN
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
WINUSER.UpdateWindow (hwnd);
iLine := 0;
END;
RETURN iLine;
END CheckBottom;
(* Window 1: Display increasing sequence of numbers *)
(* ************************************************ *)
(* *)
<*/CALLS:WIN32SYSTEM*>
(* *)
(*++++*****************************************************************)
PROCEDURE WndProc1(hwnd : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.LRESULT (* *)[EXPORT] (* *);
VAR
szBuffer : ARRAY[0..15] OF CHAR;
hdc : WIN32.HDC;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_SIZE :
cyClient := WINUSER.HIWORD (lParam);
RETURN 0;
| WINUSER.WM_TIMER :
IF (iNum < 0) THEN
iNum := 0;
END;
iLine := CheckBottom (hwnd, cyClient, iLine);
WINUSER.wsprintf (szBuffer, "%d", iNum);
INC(iNum);
hdc := WINUSER.GetDC (hwnd);
WINGDI.TextOut (hdc, 0, iLine * cyChar, szBuffer, LENGTH(szBuffer));
WINUSER.ReleaseDC (hwnd, hdc);
INC(iLine);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc1;
(* *)
(* *)
(* Window 2: Display increasing sequence of prime numbers *)
(* ****************************************************** *)
(* *)
(* *)
(*++++*****************************************************************)
PROCEDURE WndProc2(hwnd : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.LRESULT (* *)[EXPORT](* *);
VAR
szBuffer : ARRAY[0..15] OF CHAR;
hdc : WIN32.HDC;
i,iSqrt : INTEGER;
BEGIN
iNum := 1;
CASE (iMsg) OF
| WINUSER.WM_SIZE :
cyClient := WINUSER.HIWORD (lParam);
RETURN 0;
| WINUSER.WM_TIMER :
REPEAT
INC(iNum);
IF (iNum < 0) THEN
iNum := 0;
END;
iSqrt := VAL(INTEGER,RealMath.sqrt (FLOAT(iNum)));
i := 2;
LOOP
IF (iNum REM i = 0) THEN
EXIT;
END;
INC(i);
IF(i>iSqrt) THEN
EXIT;
END;
END;
UNTIL (i <= iSqrt);
iLine := CheckBottom (hwnd, cyClient, iLine);
WINUSER.wsprintf (szBuffer, "%d", iNum);
hdc := WINUSER.GetDC (hwnd);
WINGDI.TextOut (hdc, 0, iLine * cyChar, szBuffer, LENGTH(szBuffer));
WINUSER.ReleaseDC (hwnd, hdc);
INC(iLine);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc2;
(* *)
(* *)
(* Window 3: Display increasing sequence of Fibonacci numbers *)
(* *********************************************************- *)
(* *)
(* *)
(*++++*****************************************************************)
PROCEDURE WndProc3(hwnd : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.LRESULT (* *)[EXPORT](* *);
VAR
szBuffer : ARRAY[0..15] OF CHAR;
hdc : WIN32.HDC;
iTemp : INTEGER;
BEGIN
iNum := 0;
iNext := 1;
CASE (iMsg) OF
| WINUSER.WM_SIZE :
cyClient := WINUSER.HIWORD (lParam);
RETURN 0;
| WINUSER.WM_TIMER :
IF (iNum < 0) THEN
iNum := 0;
iNext := 1;
END;
iLine := CheckBottom (hwnd, cyClient, iLine);
WINUSER.wsprintf (szBuffer, "%d", iNum);
hdc := WINUSER.GetDC (hwnd);
WINGDI.TextOut (hdc, 0, iLine * cyChar, szBuffer, LENGTH(szBuffer));
WINUSER.ReleaseDC (hwnd, hdc);
iTemp := iNum;
iNum := iNext;
iNext := iNext+iTemp;
INC(iLine);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc3;
(* *)
(* *)
(* Window 4: Display circles of random radii *)
(* ***************************************-- *)
(* *)
(* *)
(*++++*****************************************************************)
PROCEDURE WndProc4(hwnd : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.LRESULT (* *)[EXPORT](* *);
VAR
hdc : WIN32.HDC;
iDiameter: INTEGER;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_SIZE :
cxClient := WINUSER.LOWORD (lParam);
cyClient := WINUSER.HIWORD (lParam);
RETURN 0;
| WINUSER.WM_TIMER :
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
WINUSER.UpdateWindow (hwnd);
iDiameter := VAL(INTEGER,RandomNumbers.Random(0,1000) REM VAL(CARDINAL,MaxInt(1,MinInt(cxClient,cyClient))));
hdc := WINUSER.GetDC (hwnd);
WINGDI.Ellipse (hdc, (cxClient - iDiameter) DIV 2,
(cyClient - iDiameter) DIV 2,
(cxClient + iDiameter) DIV 2,
(cyClient + iDiameter) DIV 2);
WINUSER.ReleaseDC (hwnd, hdc);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc4;
(* *)
(* *)
(* Main window to create child windows *)
(* *********************************-- *)
(*++++*****************************************************************)
VAR
hwndChild : ARRAY[0..3] OF WIN32.HWND;
PROCEDURE WndProc (hwnd : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];
TYPE
CHILD = ARRAY[0..5] OF CHAR;
CHILDPROC = ARRAY[0..3] OF WIN32.HINSTANCE;
CHILDCLASS = ARRAY[0..3] OF CHILD;
CONST
szChildClass = CHILDCLASS
{ "Child1",
"Child2",
"Child3",
"Child4"
};
ChildProc = CHILDPROC
{ SYSTEM.CAST(WIN32.HINSTANCE,WndProc1),
SYSTEM.CAST(WIN32.HINSTANCE,WndProc2),
SYSTEM.CAST(WIN32.HINSTANCE,WndProc3),
SYSTEM.CAST(WIN32.HINSTANCE,WndProc4)
};
VAR
hInstance : WIN32.HINSTANCE;
i : INTEGER;
cxClient : INTEGER;
cyClient : INTEGER;
wc : WINUSER.WNDCLASSEX;
rc : CARDINAL;
INTBool : INTEGER;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_CREATE :
hInstance := SYSTEM.CAST(WIN32.HINSTANCE,WINUSER.GetWindowLong (hwnd, WINUSER.GWL_HINSTANCE));
wc.cbSize := SIZE (wc);
wc.style := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := hInstance;
wc.hIcon := NIL;
wc.hCursor := WINUSER.LoadCursor (WINX.NULL_HINSTANCE, WINUSER.IDC_ARROW^);
wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.hIconSm := NIL;
FOR i := 0 TO 4-1 DO
wc.lpfnWndProc := SYSTEM.CAST(WINUSER.WNDPROC,ChildProc[i]);
wc.lpszClassName := SYSTEM.ADR(szChildClass[i]);
rc := WINUSER.RegisterClassEx(wc);
hwndChild[i] := WINUSER.CreateWindow (szChildClass[i], "",
WINUSER.WS_CHILDWINDOW BOR WINUSER.WS_BORDER BOR WINUSER.WS_VISIBLE,
0, 0, 0, 0, hwnd, SYSTEM.CAST(WIN32.HMENU,i), hInstance, NIL);
END;
cyChar := WINUSER.HIWORD (WINUSER.GetDialogBaseUnits ());
WINUSER.SetTimer (hwnd, 1, 10, SYSTEM.CAST(WINUSER.TIMERPROC, NIL));
RETURN 0;
| WINUSER.WM_SIZE :
cxClient := WINUSER.LOWORD (lParam);
cyClient := WINUSER.HIWORD (lParam);
FOR i := 0 TO 4-1 DO
IF i > 1 THEN
INTBool := 1;
ELSE
INTBool := 0;
END;
WINUSER.MoveWindow (hwndChild[i], (i REM 2) * cxClient DIV 2,
(INTBool) * cyClient DIV 2,
cxClient DIV 2, cyClient DIV 2, TRUE);
END;
RETURN 0;
| WINUSER.WM_TIMER :
FOR i := 0 TO 4-1 DO
WINUSER.SendMessage (hwndChild[i], WINUSER.WM_TIMER, wParam, lParam);
END;
RETURN 0;
| WINUSER.WM_CHAR :
IF (wParam = 27) (* '\x1B'*) THEN
WINUSER.DestroyWindow (hwnd);
END;
RETURN 0;
| WINUSER.WM_DESTROY :
WINUSER.KillTimer (hwnd, 1);
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
rc : CARDINAL;
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 (WINX.NULL_HINSTANCE, WINUSER.IDI_APPLICATION^);
wc.hCursor := WINUSER.LoadCursor (WINX.NULL_HINSTANCE, 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 (WINX.NULL_HINSTANCE,WINUSER.IDI_APPLICATION^);
rc := WINUSER.RegisterClassEx(wc);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (
szAppName, (* window class name *)
"Multitasking Demo: Translation to Stony Brook Modula-2",
(* window caption *)
WINUSER.WS_OVERLAPPEDWINDOW, (* window style *)
WINUSER.CW_USEDEFAULT, (* initial x position *)
WINUSER.CW_USEDEFAULT, (* initial y position *)
WINUSER.CW_USEDEFAULT, (* initial x size *)
WINUSER.CW_USEDEFAULT, (* initial y size *)
WINX.NULL_hwnd, (* parent window handle *)
WINX.NULL_HMENU, (* window menu handle *)
wc.hInstance, (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
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,WINX.NULL_hwnd,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END Multi1.