Last updated: 15. 2.1998, 18: 3
<*/NOWARN:F*>
MODULE BigJob2;
(*------------------------------------------
BIGJOB2.C --- Multithreading Demo
(c) Charles Petzold, 1996
BigJob2.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
------------------------------------------*)
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINX;
IMPORT WINGDI;
IMPORT SYSTEM;
IMPORT Threads;
IMPORT ElapsedTime;
IMPORT RealMath;
CONST REP =100000;
CONST STATUS_READY =0;
CONST STATUS_WORKING =1;
CONST STATUS_DONE =2;
CONST WM_CALC_DONE =(WINUSER.WM_USER + 0);
CONST WM_CALC_ABORTED =(WINUSER.WM_USER + 1);
TYPE
PARAMS = RECORD
hwnd : WIN32.HWND;
hEvent : WIN32.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 : WIN32.LONG;
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
iStatus : INTEGER;
params : PARAMS;
MessageThread : Threads.Thread;
hEvent : WIN32.HANDLE;
(*+++******************************************************************)
PROCEDURE Thread (pvoid : WIN32.PVOID): CARDINAL;
(**********************************************************************)
VAR
A : LONGREAL;
i : INTEGER;
lTime2 : WIN32.LONG;
pparams : PPARAMS;
lTime1 : WIN32.LONG;
BEGIN
A := 1.0;
pparams := SYSTEM.CAST(PPARAMS,pvoid);
WHILE (TRUE) DO
WIN32.WaitForSingleObject (pparams^.hEvent, WIN32.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)));
WINUSER.SendMessage (pparams^.hwnd, WM_CALC_DONE, 0, lTime1);
ELSE
WINUSER.SendMessage (pparams^.hwnd, WM_CALC_ABORTED, 0, 0);
END;
IF(TRUE) THEN
RETURN 0;
END;
END;
END Thread;
<*/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];
VAR
szBuffer : ARRAY[0..63] OF CHAR;
hdc : WIN32.HDC;
ps : WINUSER.PAINTSTRUCT;
rect : WIN32.RECT;
ok : BOOLEAN;
code : CARDINAL;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_CREATE :
(* !!!!
hEvent := WIN32.CreateEvent (SYSTEM.CAST(WIN32.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;
| WINUSER.WM_LBUTTONDOWN :
IF (iStatus = STATUS_WORKING) THEN
WINUSER.MessageBeep (0);
RETURN 0;
END;
iStatus := STATUS_WORKING;
params.bContinue := TRUE;
WIN32.SetEvent (hEvent);
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| WINUSER.WM_RBUTTONDOWN :
params.bContinue := FALSE;
RETURN 0;
| WM_CALC_DONE :
lTime := lParam;
iStatus := STATUS_DONE;
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| WM_CALC_ABORTED :
iStatus := STATUS_READY;
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| WINUSER.WM_PAINT :
hdc := WINUSER.BeginPaint (hwnd, ps);
WINUSER.GetClientRect (hwnd, rect);
(* WINUSER.wsprintf (szBuffer, szMessage[iStatus], REP, lTime); *)
WINUSER.wsprintf (szBuffer, szMessage[iStatus], lTime, REP);
WINUSER.DrawText (hdc, szBuffer, -1, rect,
WINUSER.DT_SINGLELINE BOR WINUSER.DT_CENTER BOR WINUSER.DT_VCENTER);
WINUSER.EndPaint (hwnd, ps);
RETURN 0;
| WINUSER.WM_DESTROY :
ok := Threads.KillThread(MessageThread,code);
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
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 (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^);
rc := WINUSER.RegisterClassEx(wc);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (
szAppName, (* window class name *)
"Multithreading 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 *)
NIL, (* parent window handle *)
NIL, (* 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
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 (WINUSER.GetMessage(msg,NIL,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END BigJob2.