Last updated: 19. 1.1998, 22:42
<* +M2EXTENSIONS *>
MODULE Multi2;
(*---------------------------------------
MULTI2.C --- Multitasking Demo
(c) Charles Petzold, 1996
Multi2.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
---------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
IMPORT Lib;
IMPORT Threads;
IMPORT ElapsedTime;
IMPORT RealMath;
VAR
cyChar : INTEGER;
CONST
szAppName = "Multi2";
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
TYPE
PARAMS = RECORD
hwnd : Windows.HWND;
cxClient : INTEGER;
cyClient : INTEGER;
cyChar : INTEGER;
bKill : BOOLEAN;
END;
PPARAMS = POINTER TO PARAMS;
VAR
iNum,iLine : INTEGER;
cyClient : INTEGER;
cxClient : INTEGER;
iNext : INTEGER;
params1 : PARAMS;
params2 : PARAMS;
params3 : PARAMS;
params4 : PARAMS;
ok : BOOLEAN;
code : INTEGER;
VAR
hwndChild : ARRAY[0..3] OF Windows.HWND;
TYPE
CHILD = ARRAY[0..5] OF CHAR;
CHILDPROC = ARRAY[0..3] OF Windows.HINSTANCE;
CHILDCLASS = ARRAY[0..3] OF CHILD;
CONST
szChildClass = CHILDCLASS
{ "Child1",
"Child2",
"Child3",
"Child4"
};
VAR
MessageThread : Threads.Thread;
(*++++*****************************************************************)
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 : Windows.HWND; cyClient,cyChar : INTEGER; iLine : INTEGER) : INTEGER;
(**********************************************************************)
BEGIN
IF (iLine * cyChar + cyChar > cyClient) THEN
Windows.InvalidateRect (hwnd, NIL, TRUE);
Windows.UpdateWindow (hwnd);
iLine := 0;
END;
RETURN iLine;
END CheckBottom;
(* Window 1: Display increasing sequence of numbers *)
(* ************************************************ *)
(*+++******************************************************************)
PROCEDURE Thread1 (pvoid : Windows.PVOID): CARDINAL;
(**********************************************************************)
VAR
iNum : INTEGER;
iLine : INTEGER;
szBuffer : ARRAY[0..15] OF CHAR;
hdc : Windows.HDC;
pparams : PPARAMS;
BEGIN
iNum := 0;
iLine := 0;
pparams := SYSTEM.CAST(PPARAMS,pvoid);
WHILE NOT (pparams^.bKill) DO
IF (iNum < 0) THEN
iNum := 0;
END;
iLine := CheckBottom (pparams^.hwnd, pparams^.cyClient,
pparams^.cyChar, iLine);
INC(iNum);
Windows.wsprintf (szBuffer, "%d", iNum);
hdc := Windows.GetDC (pparams^.hwnd);
Windows.TextOut (hdc, 0, iLine * pparams^.cyChar,
szBuffer, LENGTH (szBuffer));
Windows.ReleaseDC (pparams^.hwnd, hdc);
INC(iLine);
END;
ok := Threads.KillThread(MessageThread,code);
IF(ok) THEN
RETURN 0;
END;
END Thread1;
(* *)
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc1(hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT (* *)[EXPORT] (* *);
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
params1.hwnd := hwnd;
params1.cyChar := Windows.HIWORD (Windows.GetDialogBaseUnits ());
Threads.CreateThread(MessageThread, Thread1, SYSTEM.ADR(params1), 8192, TRUE);
RETURN 0;
| Windows.WM_SIZE :
params1.cyClient := Windows.HIWORD (lParam);
RETURN 0;
| Windows.WM_DESTROY :
params1.bKill := TRUE;
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc1;
(* Window 2: Display increasing sequence of prime numbers *)
(* ****************************************************** *)
(*+++******************************************************************)
PROCEDURE Thread2 (pvoid : Windows.PVOID): CARDINAL;
(**********************************************************************)
VAR
iNum : INTEGER;
iLine : INTEGER;
i : INTEGER;
iSqrt : INTEGER;
szBuffer : ARRAY[0..15] OF CHAR;
hdc : Windows.HDC;
pparams : PPARAMS;
BEGIN
iNum := 1;
iLine := 0;
pparams := SYSTEM.CAST(PPARAMS,pvoid);
WHILE NOT (pparams^.bKill) DO
REPEAT
INC(iNum);
IF (iNum < 0) THEN
iNum := 0;
END;
iSqrt := VAL(INTEGER,RealMath.sqrt (FLOAT(iNum)));
i := 2;
LOOP
IF (iNum MOD i = 0) THEN
EXIT;
END;
INC(i);
IF(i>iSqrt) THEN
EXIT;
END;
END;
UNTIL (i > iSqrt);
iLine := CheckBottom (pparams^.hwnd, pparams^.cyClient,
pparams^.cyChar, iLine);
Windows.wsprintf (szBuffer, "%d", iNum);
hdc := Windows.GetDC (pparams^.hwnd);
Windows.TextOut (hdc, 0, iLine * pparams^.cyChar,
szBuffer, LENGTH(szBuffer));
Windows.ReleaseDC (pparams^.hwnd, hdc);
INC(iLine);
END;
ok := Threads.KillThread(MessageThread,code);
IF(ok) THEN
RETURN 0;
END;
END Thread2;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc2(hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT (* *)[EXPORT] (* *);
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
params2.hwnd := hwnd;
params2.cyChar := Windows.HIWORD (Windows.GetDialogBaseUnits ());
Threads.CreateThread(MessageThread, Thread2, SYSTEM.ADR(params2), 8192, TRUE);
RETURN 0;
| Windows.WM_SIZE :
params2.cyClient := Windows.HIWORD (lParam);
RETURN 0;
| Windows.WM_DESTROY :
params2.bKill := TRUE;
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc2;
(* Window 3: Display increasing sequence of Fibonacci numbers *)
(* *********************************************************- *)
(*+++******************************************************************)
PROCEDURE Thread3 (pvoid : Windows.PVOID): CARDINAL;
(**********************************************************************)
VAR
iNum : INTEGER;
iLine : INTEGER;
iTemp : INTEGER;
szBuffer : ARRAY[0..15] OF CHAR;
hdc : Windows.HDC;
pparams : PPARAMS;
BEGIN
iNum := 1;
iLine := 0;
pparams := SYSTEM.CAST(PPARAMS,pvoid);
WHILE NOT (pparams^.bKill) DO
IF (iNum < 0) THEN
iNum := 0;
iNext := 1;
END;
iLine := CheckBottom (pparams^.hwnd, pparams^.cyClient,
pparams^.cyChar, iLine);
Windows.wsprintf (szBuffer, "%d", iNum);
hdc := Windows.GetDC (pparams^.hwnd);
Windows.TextOut (hdc, 0, iLine * pparams^.cyChar,
szBuffer, LENGTH (szBuffer));
Windows.ReleaseDC (pparams^.hwnd, hdc);
iTemp := iNum;
iNum := iNext;
iNext := iNext+iTemp;
INC(iLine);
END;
ok := Threads.KillThread(MessageThread,code);
IF(ok) THEN
RETURN 0;
END;
END Thread3;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc3(hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT (* *)[EXPORT] (* *);
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
params3.hwnd := hwnd;
params3.cyChar := Windows.HIWORD (Windows.GetDialogBaseUnits ());
Threads.CreateThread(MessageThread, Thread3, SYSTEM.ADR(params3), 8192, TRUE);
RETURN 0;
| Windows.WM_SIZE :
params3.cyClient := Windows.HIWORD (lParam);
RETURN 0;
| Windows.WM_DESTROY :
params3.bKill := TRUE;
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc3;
(* Window 4: Display circles of random radii *)
(* ***************************************-- *)
(*+++******************************************************************)
PROCEDURE Thread4 (pvoid : Windows.PVOID): CARDINAL;
(**********************************************************************)
VAR
iDiameter : INTEGER;
hdc : Windows.HDC;
pparams : PPARAMS;
BEGIN
pparams := SYSTEM.CAST(PPARAMS,pvoid);
WHILE NOT (pparams^.bKill) DO
Windows.InvalidateRect (pparams^.hwnd, NIL, TRUE);
Windows.UpdateWindow (pparams^.hwnd);
iDiameter := SYSTEM.CAST(INTEGER,Lib.RANDOM(1000) REM VAL(CARDINAL,MaxInt(1,MinInt(pparams^.cxClient,pparams^.cyClient))));
hdc := Windows.GetDC (pparams^.hwnd);
Windows.Ellipse (hdc, (pparams^.cxClient - iDiameter) DIV 2,
(pparams^.cyClient - iDiameter) DIV 2,
(pparams^.cxClient + iDiameter) DIV 2,
(pparams^.cyClient + iDiameter) DIV 2);
Windows.ReleaseDC (pparams^.hwnd, hdc);
END;
ok := Threads.KillThread(MessageThread,code);
IF(ok) THEN
RETURN 0;
END;
END Thread4;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc4(hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT (* *)[EXPORT] (* *);
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
params4.hwnd := hwnd;
params4.cyChar := Windows.HIWORD (Windows.GetDialogBaseUnits ());
Threads.CreateThread(MessageThread, Thread4, SYSTEM.ADR(params4), 8192, TRUE);
RETURN 0;
| Windows.WM_SIZE :
params4.cxClient := Windows.LOWORD (lParam);
params4.cyClient := Windows.HIWORD (lParam);
RETURN 0;
| Windows.WM_DESTROY :
params4.bKill := TRUE;
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc4;
(* Main window to create child windows *)
(* *********************************-- *)
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
hInstance : Windows.HINSTANCE;
i : INTEGER;
cxClient : INTEGER;
cyClient : INTEGER;
wc : Windows.WNDCLASSEX;
rc : CARDINAL;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
hInstance := SYSTEM.CAST(Windows.HINSTANCE,Windows.GetWindowLong (hwnd, Windows.GWL_HINSTANCE));
wc.cbSize := SIZE (wc);
wc.style := Windows.CS_HREDRAW + Windows.CS_VREDRAW;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := hInstance;
wc.hIcon := NIL;
wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW);
wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH, Windows.GetStockObject (Windows.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.hIconSm := NIL;
FOR i := 0 TO 4-1 DO
wc.lpfnWndProc := SYSTEM.CAST(Windows.WNDPROC,ChildProc[i]);
wc.lpszClassName := SYSTEM.ADR(szChildClass[i]);
rc := Windows.RegisterClassEx(wc);
hwndChild[i] := Windows.CreateWindow (szChildClass[i], "",
Windows.WS_CHILDWINDOW + Windows.WS_BORDER + Windows.WS_VISIBLE,
0, 0, 0, 0, hwnd, SYSTEM.CAST(Windows.HMENU,i), hInstance, NIL);
END;
cyChar := Windows.HIWORD (Windows.GetDialogBaseUnits ());
Windows.SetTimer (hwnd, 1, 10, NIL);
RETURN 0;
| Windows.WM_SIZE :
cxClient := Windows.LOWORD (lParam);
cyClient := Windows.HIWORD (lParam);
FOR i := 0 TO 4-1 DO
IF(i>1) THEN
Windows.MoveWindow (hwndChild[i], (i REM 2) * cxClient DIV 2,
1 * cyClient DIV 2,
cxClient DIV 2, cyClient DIV 2, TRUE);
ELSE
Windows.MoveWindow (hwndChild[i], (i REM 2) * cxClient DIV 2,
0,
cxClient DIV 2, cyClient DIV 2, TRUE);
END;
END;
RETURN 0;
| Windows.WM_CHAR :
IF (wParam = 27) (* '\x1B'*) THEN
Windows.DestroyWindow (hwnd);
END;
RETURN 0;
| Windows.WM_DESTROY :
Windows.KillTimer (hwnd, 1);
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 *)
"Multitasking Demo: 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;
CONST
ChildProc = CHILDPROC
{ SYSTEM.CAST(Windows.HINSTANCE,WndProc1),
SYSTEM.CAST(Windows.HINSTANCE,WndProc2),
SYSTEM.CAST(Windows.HINSTANCE,WndProc3),
SYSTEM.CAST(Windows.HINSTANCE,WndProc4)
};
BEGIN
Lib.RANDOM(1000);
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END Multi2.