DigClock.mod: Translation to Stony Brook Modula-2

Last updated: 15. 1.1998, 21:42

<*/NOWARN:F*>
MODULE DigClock;
(*-----------------------------------------
   DIGCLOCK.C      --- Digital Clock Program
                   (c) Charles Petzold, 1996
   DigClock.mod    --- Translation to Stony Brook Modula-2
                   (c) Peter Stadler,   1997
  -----------------------------------------*)

IMPORT WINUSER;
IMPORT WINGDI;
IMPORT WIN32;
IMPORT WINX;
IMPORT SYSTEM;
IMPORT SysClock;
IMPORT Str;

CONST ID_TIMER = 1;

VAR
  sDate : ARRAY[0..1] OF CHAR;
  sTime : ARRAY[0..1] OF CHAR;
  sAMPM : ARRAY[0..1],[0..4] OF CHAR;
  iTime : INTEGER;
  iDate : INTEGER;
CONST szAppName = "DigClock";
CONST cName = "intl";
TYPE szDay  = ARRAY[0..2] OF CHAR;
TYPE szWeek = ARRAY[0..6] OF szDay;
VAR szWday : szWeek =
               {"Sun",
	        "Mon",
	        "Tue",
	        "Wed",
	        "Thu",
	        "Fri",
	        "Sat"};
VAR
   hwnd            :  WIN32.HWND;
   msg             :  WINUSER.MSG;
   wc              :  WINUSER.WNDCLASSEX;
   xStart          :  INTEGER;
   yStart          :  INTEGER;
   xClient         :  INTEGER;
   yClient         :  INTEGER;

(*++++*****************************************************************)
PROCEDURE SizeTheWindow (VAR xStart : INTEGER;
                         VAR yStart : INTEGER;
                         VAR xClient: INTEGER;
                         VAR yClient: INTEGER);
(**********************************************************************)
VAR
  hdc :  WIN32.HDC;
  tm  :  WINGDI.TEXTMETRIC;
BEGIN
     hdc := WINGDI.CreateIC ("DISPLAY", WINX.NIL_ASTR, WINX.NIL_ASTR, WINX.NIL_DEVMODEA);
     WINGDI.GetTextMetrics (hdc, tm);
     WINGDI.DeleteDC (hdc);

     xClient := 2 * WINUSER.GetSystemMetrics (WINUSER.SM_CXDLGFRAME) + 16*tm.tmAveCharWidth;
     xStart  :=     WINUSER.GetSystemMetrics (WINUSER.SM_CXSCREEN)   - xClient;
     yClient := 2 * WINUSER.GetSystemMetrics (WINUSER.SM_CYDLGFRAME) + 2*tm.tmHeight;
     yStart  :=     0;
END SizeTheWindow;
(*++++*****************************************************************)
PROCEDURE SetInternational();
(**********************************************************************)
BEGIN
     iDate := WIN32.GetProfileInt (cName, "iDate", 0);
     iTime := WIN32.GetProfileInt (cName, "iTime", 0);

     WIN32.GetProfileString (cName, "sDate",  "\", sDate,    2);
     WIN32.GetProfileString (cName, "sTime",  ":", sTime,    2);
     WIN32.GetProfileString (cName, "s1159", "AM", sAMPM[0], 5);
     WIN32.GetProfileString (cName, "s2359", "PM", sAMPM[1], 5);
END SetInternational;

(*++++*****************************************************************)
PROCEDURE WndPaint(hwnd        : WIN32.HWND;
(**********************************************************************)
          hdc         : WIN32.HDC);
VAR
  cBuffer1 : ARRAY[0..25] OF CHAR;
  cBuffer2 : ARRAY[0..25] OF CHAR;
  cBuffer  : ARRAY[0..50] OF CHAR;
  iLength : INTEGER;
  rect    : WIN32.RECT;
  dateTime: WIN32.SYSTEMTIME;
  datetime:SysClock.DateTime;
  weekDay : ARRAY[0..5] OF CHAR;
BEGIN
     WIN32.GetSystemTime(dateTime);
     SysClock.GetClock(datetime);
     Str.Copy(weekDay,szWday[dateTime.wDayOfWeek]); 
     IF(iDate=1) THEN
          iLength := WINUSER.wsprintf (cBuffer1, "  %s  %d%s%02d%s%02d",
	       weekDay,
	       datetime.day, sDate,
               datetime.month,  sDate,
               datetime.year REM 100);
     ELSIF(iDate=2) THEN
          iLength := WINUSER.wsprintf (cBuffer1, "  %s  %d%s%02d%s%02d",
               szWday[dateTime.wDayOfWeek],
               datetime.year REM 100, sDate,
               datetime.month,  sDate,
               datetime.day);
     ELSE
          iLength := WINUSER.wsprintf (cBuffer1, "  %s  %d%s%02d%s%02d",
               szWday[dateTime.wDayOfWeek],
               datetime.month, sDate,
               datetime.day,  sDate,
               datetime.year REM 100);
     END;


     IF (iTime = 1) THEN
          iLength := WINUSER.wsprintf (cBuffer2, "  %02d%s%02d%s%02d  ",
                               datetime.hour,
                               sTime,
                               datetime.minute,
                               sTime,
                               datetime.second);
     ELSE
	  IF(datetime.hour REM 12#0) THEN
	  
	       iLength := WINUSER.wsprintf (cBuffer2, "  %d%s%02d%s%02d %s  ",
                               datetime.hour REM 12,
                               sTime,
                               datetime.minute,
			       sTime,
                               datetime.second,
                               sAMPM[datetime.hour DIV 12]);
          ELSE
               iLength := WINUSER.wsprintf (cBuffer2, "  %d%s%02d%s%02d %s  ",
                               12,
                               sTime,
                               datetime.minute,
			       sTime,
                               datetime.second,
                               sAMPM[datetime.hour DIV 12]);
     			       
          END;
     END;
     WINUSER.GetClientRect (hwnd, rect);
     Str.Append(cBuffer1,CHR(13));
     Str.Append(cBuffer1,CHR(10));
     Str.Concat(cBuffer,cBuffer1,cBuffer2);
     WINUSER.DrawText (hdc, cBuffer, -1, rect, WINUSER.DT_CENTER BOR WINUSER.DT_NOCLIP);
END WndPaint;

<*/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
      hdc    : WIN32.HDC;
      ps     : WINUSER.PAINTSTRUCT;
BEGIN
     CASE (iMsg) OF
          | WINUSER.WM_CREATE :
               SetInternational ();
               RETURN 0;

          | WINUSER.WM_TIMER :
               WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, FALSE);
               RETURN 0;

          | WINUSER.WM_PAINT :
               hdc := WINUSER.BeginPaint (hwnd, ps);
               WndPaint (hwnd, hdc);
               WINUSER.EndPaint (hwnd, ps);
               RETURN 0;

          | WINUSER.WM_WININICHANGE :
               SetInternational ();
               WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
               RETURN 0;

          | WINUSER.WM_DESTROY :
               WINUSER.KillTimer (hwnd, ID_TIMER);
               WINUSER.PostQuitMessage (0);
               RETURN 0;
     ELSE
        RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
     END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)

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         := NIL;
  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       := NIL;

  RETURN WINUSER.RegisterClassEx(wc)#0;
END InitApplication;

(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
  SizeTheWindow (xStart, yStart, xClient, yClient);
  hwnd := WINUSER.CreateWindow (szAppName,
                        "DigClock Demo: Translation to Stony Brook Modula-2",
                        WINUSER.WS_POPUP BOR WINUSER.WS_DLGFRAME BOR WINUSER.WS_SYSMENU,
                        xStart,  yStart,
                        xClient, yClient,
                        NIL,
                        NIL,
                        WINX.Instance,
                        NIL);

  WHILE(WINUSER.SetTimer (hwnd, ID_TIMER, 1000, NIL)=0) DO
      WINUSER.MessageBox (hwnd,
                "Too many clocks or timers!",
                szAppName,
                WINUSER.MB_ICONEXCLAMATION BOR WINUSER.MB_OK);
      RETURN FALSE;
  END;
  WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWNOACTIVATE);
  WINUSER.UpdateWindow (hwnd);
  RETURN TRUE;
END InitMainWindow;


BEGIN
  IF InitApplication()  AND  InitMainWindow() THEN
    WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
      WINUSER.TranslateMessage(msg);
      WINUSER.DispatchMessage(msg);
    END;
  END;
END DigClock.