Last updated: 19. 1.1998, 22:42
<* +M2EXTENSIONS *>
MODULE BigJob2;
(*------------------------------------------
BIGJOB2.C --- Multithreading Demo
(c) Charles Petzold, 1996
BigJob2.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
------------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
IMPORT Threads;
IMPORT ElapsedTime;
IMPORT RealMath;
CONST REP =100000;
CONST TEST =300;
CONST STATUS_READY =0;
CONST STATUS_WORKING =1;
CONST STATUS_DONE =2;
CONST WM_CALC_DONE =(Windows.WM_USER + 0);
CONST WM_CALC_ABORTED =(Windows.WM_USER + 1);
TYPE
PARAMS = RECORD
hwnd : Windows.HWND;
hEvent : Windows.HANDLE;
bContinue : BOOLEAN;
END;
PPARAMS = POINTER TO PARAMS;
TYPE
Line = ARRAY[0..50] OF CHAR;
MsgArray = ARRAY[0..2] OF Line;
CONST
szAppName = "BigJob2";
VAR
szMessage : MsgArray;
lTime : Windows.LONG;
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
iStatus : INTEGER;
params : PARAMS;
MessageThread : Threads.Thread;
hEvent : Windows.HANDLE;
(*+++******************************************************************)
PROCEDURE Thread (pvoid : Windows.PVOID): CARDINAL;
(**********************************************************************)
VAR
A : LONGREAL;
i : INTEGER;
lTime2 : Windows.LONG;
pparams : PPARAMS;
ok : BOOLEAN;
code : CARDINAL;
lTime1 : Windows.LONG;
BEGIN
A := 1.0;
pparams := SYSTEM.CAST(PPARAMS,pvoid);
WHILE (TRUE) DO
Windows.WaitForSingleObject (pparams^.hEvent, Windows.INFINITE);
lTime1 := ElapsedTime.GetTime ();
i := 0;
LOOP
IF(i=REP) THEN
EXIT;
END;
END;
IF (i = REP) THEN
lTime2 := ElapsedTime.GetTime ();
lTime1 := SYSTEM.CAST(CARDINAL,(SYSTEM.CAST(INTEGER,lTime2) - SYSTEM.CAST(INTEGER,lTime1)));
Windows.SendMessage (pparams^.hwnd, WM_CALC_DONE, 0, lTime1);
ELSE
Windows.SendMessage (pparams^.hwnd, WM_CALC_ABORTED, 0, 0);
END;
IF(TRUE) THEN
RETURN 0;
END;
END;
END Thread;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc(hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
szBuffer : ARRAY[0..63] OF CHAR;
hdc : Windows.HDC;
ps : Windows.PAINTSTRUCT;
rect : Windows.RECT;
ok : BOOLEAN;
code : CARDINAL;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
(* !!!!
hEvent := Windows.CreateEvent (SYSTEM.CAST(Windows.SECURITY_ATTRIBUTES,NIL), FALSE, FALSE, NIL);
*)
params.hwnd := hwnd;
params.hEvent := hEvent;
params.bContinue := FALSE;
Threads.CreateThread(MessageThread, Thread, SYSTEM.ADR(params), 8192, TRUE);
RETURN 0;
| Windows.WM_LBUTTONDOWN :
IF (iStatus = STATUS_WORKING) THEN
Windows.MessageBeep (0);
RETURN 0;
END;
iStatus := STATUS_WORKING;
params.bContinue := TRUE;
Windows.SetEvent (hEvent);
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| Windows.WM_RBUTTONDOWN :
params.bContinue := FALSE;
RETURN 0;
| WM_CALC_DONE :
lTime := lParam;
iStatus := STATUS_DONE;
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| WM_CALC_ABORTED :
iStatus := STATUS_READY;
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| Windows.WM_PAINT :
hdc := Windows.BeginPaint (hwnd, ps);
Windows.GetClientRect (hwnd, rect);
(* Windows.wsprintf (szBuffer, szMessage[iStatus], REP, lTime); *)
Windows.wsprintf (szBuffer, szMessage[iStatus], lTime, REP);
Windows.DrawText (hdc, szBuffer, -1, rect,
Windows.DT_SINGLELINE + Windows.DT_CENTER + Windows.DT_VCENTER);
Windows.EndPaint (hwnd, ps);
RETURN 0;
| Windows.WM_DESTROY :
ok := Threads.KillThread(MessageThread,code);
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 *)
"Multithreading 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;
BEGIN
szMessage[0] := "Ready (left mouse button begins)";
szMessage[1] := "Working (right mouse button aborts)";
szMessage[2] := "%d repetitions in %d msec";
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END BigJob2.