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.