language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/util/settime.mod
MODULE SetTime;
(****************************************************************)
(* *)
(* Setting the real-time clock *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 18 March 1995 *)
(* Status: Working *)
(* Note: no provision at present for setting the century; *)
(* this version of the program always sets the century *)
(* to 19. *)
(* *)
(****************************************************************)
FROM SYSTEM IMPORT
(* type *) BYTE;
FROM TimeOfDay IMPORT
(* type *) TimeRecord,
(* proc *) ReadClock, SetClock, SetBinaryMode;
FROM MiscPMOS IMPORT
(* proc *) WriteCMOS;
FROM Windows IMPORT
(* type *) Window, Colour, FrameType, DividerType,
(* proc *) OpenWindow, CloseWindow, WriteString, WriteChar,
SetCursor, EraseLine, Blink, ColourSwap;
FROM NumericIO IMPORT
(* proc *) WriteHexByte;
FROM Lib IMPORT
(* proc *) Dos;
FROM Keyboard IMPORT
(* proc *) InKey;
FROM Timer IMPORT
(* proc *) Sleep;
FROM Semaphores IMPORT
(* type *) Semaphore,
(* proc *) CreateSemaphore, Wait, Signal;
FROM TaskControl IMPORT
(* proc *) CreateTask;
FROM LowLevel IMPORT
(* proc *) IANDB, IORB;
FROM MiscPMOS IMPORT
(* type *) RegisterPacket,
(* proc *) EnterCriticalSection, LeaveCriticalSection;
(************************************************************************)
TYPE CharSet = SET OF CHAR;
CONST
Nul = CHR(0); Esc = CHR(27);
Digits = CharSet {'0'..'9'};
TYPE
subscript = [0..8];
subset = SET OF subscript;
VAR
(* LocalTime is the local copy of the time record, as we edit it. *)
(* It is periodically updated from the "true" time supplied by *)
(* module CMOS. LTprotect gives critical section protection. *)
LocalTime: TimeRecord;
LTprotect: Semaphore;
(* Many of the procedures in this module work as if LocalTime were *)
(* an array of 9 bytes. Variable 'protected' gives the array *)
(* subscript of the entry which must not be automatically updated *)
(* since it is being edited, and 'blinking' is the array subscript *)
(* of the entry which should display as a blinking field. *)
protected, blinking: subscript;
(* Window editwindow is shared among the display and editing *)
(* procedures. Semaphore ScreenAccess protects access to it. *)
editwindow: Window;
ScreenAccess: Semaphore;
(************************************************************************)
(* SCREEN OPERATIONS *)
(************************************************************************)
PROCEDURE LocateCursor (j: subscript; VAR (*OUT*) row, column: CARDINAL);
(* Returns the screen coordinates of the place where LocalTime[j] *)
(* is displayed. *)
BEGIN
CASE j OF
0: row := 2; column := 12; (* ticks (not shown) *)
|
1: row := 4; column := 9; (* seconds *)
|
2: row := 4; column := 6; (* minutes *)
|
3: row := 4; column := 3; (* hours *)
|
4: row := 2; column := 1; (* day of week *)
|
5: row := 3; column := 3; (* day of month *)
|
6: row := 3; column := 6; (* month *)
|
7: row := 3; column := 9; (* year *)
END (*CASE*);
END LocateCursor;
(************************************************************************)
PROCEDURE InitialDisplay;
BEGIN
SetCursor (editwindow, 2, 3); WriteChar (editwindow, '=');
SetCursor (editwindow, 3, 5); WriteString (editwindow, "/ /");
SetCursor (editwindow, 4, 5); WriteString (editwindow, ": :");
END InitialDisplay;
(************************************************************************)
(* PROCEDURES TO WORK ON A TIME RECORD AS AN ARRAY *)
(************************************************************************)
PROCEDURE Get (VAR (*IN*) array: ARRAY OF BYTE; j: subscript): BYTE;
(* Returns the j'th entry of array. *)
BEGIN
RETURN array[j];
END Get;
(************************************************************************)
PROCEDURE Put (value: BYTE; VAR (*OUT*) array: ARRAY OF BYTE; j: subscript);
(* Stores value in array[j]. *)
BEGIN
array[j] := value;
END Put;
(************************************************************************)
(* TASK TO DISPLAY THE DATE AND TIME *)
(************************************************************************)
PROCEDURE WriteDay (w: Window; dayinweek: BYTE);
(* Writes the name of the day *)
BEGIN
CASE ORD(dayinweek) OF
1: WriteString (w, "Mon");
|
2: WriteString (w, "Tues");
|
3: WriteString (w, "Wednes");
|
4: WriteString (w, "Thurs");
|
5: WriteString (w, "Fri");
|
6: WriteString (w, "Satur");
|
7: WriteString (w, "Sun");
|
ELSE
WriteHexByte (w, dayinweek);
END (*CASE*);
WriteString (w, "day");
END WriteDay;
(************************************************************************)
PROCEDURE ShowTime;
(* Continuously displays the time and date on the screen. *)
VAR w: Window; row, column: CARDINAL;
j: subscript; value: BYTE;
copyoftime: TimeRecord;
BEGIN
LOOP
Sleep (500);
Wait (LTprotect);
ReadClock (copyoftime);
FOR j := 1 TO 7 DO
IF j <> protected THEN
value := Get (copyoftime, j);
Put (value, LocalTime, j);
Wait (ScreenAccess);
LocateCursor (j, row, column);
SetCursor (editwindow, row, column);
WriteHexByte (editwindow, value);
IF j = blinking THEN
Blink (editwindow, row, column, 2);
END (*IF*);
IF j = 4 THEN
SetCursor (editwindow, row, column+3);
WriteDay (editwindow, value);
EraseLine (editwindow, 1);
END (*IF*);
Signal (ScreenAccess);
END (*IF*);
END (*FOR*);
Signal (LTprotect);
END (*LOOP*);
END ShowTime;
(************************************************************************)
(* EDITING THE DATE AND TIME *)
(************************************************************************)
PROCEDURE CursorMovement (VAR (*INOUT*) j: subscript);
(* On entry, a Nul has already been read from the keyboard, so we *)
(* presume that that was the start of an arrow-key code. Adjusts *)
(* the field number j appropriately. Any keyboard code which makes *)
(* no sense as a cursor movement is treated as a no-operation. *)
(* To understand the cursor movements, note that the fields on the *)
(* screen display are laid out in the form: *)
(* 4 Looks strange, I know, but that's *)
(* 5 6 7 a compromise between what CMOS returns *)
(* 3 2 1 and the preferred human-readable form *)
VAR ch: CHAR;
BEGIN
ch := InKey();
IF ch = "H" THEN (* cursor up *)
IF j IN subset {5,6,7} THEN j := 4
ELSIF j<>4 THEN j := 8-j
END (*IF*);
ELSIF ch = "P" THEN (* cursor down *)
IF j = 4 THEN INC(j)
ELSIF j IN subset {5,6,7} THEN j := 8-j
END (*IF*);
ELSIF ch = "M" THEN (* cursor right *)
IF j IN subset {5,6} THEN INC(j)
ELSIF j IN subset {2,3} THEN DEC(j)
END (*IF*);
ELSIF ch = "K" THEN (* cursor left *)
IF j IN subset {1,2} THEN INC(j)
ELSIF j IN subset {6,7} THEN DEC(j)
END (*IF*);
END (*IF*);
END CursorMovement;
(************************************************************************)
PROCEDURE WriteHighlighted (j: subscript; value: BYTE);
(* Writes value on the screen, in reverse video, in the location *)
(* reserved for field j. *)
VAR row, column: CARDINAL;
BEGIN
LocateCursor (j, row, column);
Wait (ScreenAccess);
SetCursor (editwindow, row, column);
WriteHexByte (editwindow, value);
ColourSwap (editwindow, row, column, 2);
Signal (ScreenAccess);
END WriteHighlighted;
(************************************************************************)
(* EDITING PROCEDURES *)
(************************************************************************)
PROCEDURE EditField (j: subscript; ch: CHAR);
(* Edits field j, where the user has already typed character ch. *)
VAR value: BYTE;
BEGIN
protected := j;
(* Use ch to update the first digit of the current value. *)
value := IORB (IANDB (Get (LocalTime, j), 0FH),
BYTE (16*(ORD(ch)-ORD('0'))));
WriteHighlighted (j, value);
(* Now pick up and use the second digit. *)
ch := InKey();
IF ch IN Digits THEN
value := IORB (IANDB (value, 0F0H), BYTE (ORD(ch)-ORD('0')));
WriteHighlighted (j, value);
END (*IF*);
(* Update the master record of the time. *)
Wait (LTprotect);
Put (value, LocalTime, j);
Put (0, LocalTime, 0);
SetClock (LocalTime);
Signal (LTprotect);
protected := 0;
END EditField;
(************************************************************************)
PROCEDURE Edit;
(* The master editing routine. Allows the keyboard user to adjust *)
(* the displayed date and time fields. *)
VAR j: subscript;
row, col: CARDINAL;
ch: CHAR;
BEGIN
j := 4;
LOOP
blinking := j;
ch := InKey ();
blinking := 0;
IF ch = Esc THEN EXIT(*LOOP*)
ELSIF ch IN Digits THEN EditField(j, ch)
ELSIF ch = Nul THEN CursorMovement (j)
END(*IF*);
END (*LOOP*);
END Edit;
(************************************************************************)
(* SETTING THE MS-DOS DATE/TIME *)
(************************************************************************)
PROCEDURE binary (BCDvalue: BYTE): CARDINAL;
(* Converts a BCD value to binary. *)
VAR val: CARDINAL;
BEGIN
val := CARDINAL (BCDvalue);
RETURN 10*(val DIV 16) + val MOD 16;
END binary;
(************************************************************************)
PROCEDURE SetDosTime;
(* Sets the date and time kept by MS-DOS to agree with the values *)
(* held by CMOS. Note the important critical section problem: the *)
(* operations of setting the date and setting the time are separate *)
(* DOS functions, but of course we must do the setting in one *)
(* indivisible operation to avoid a problem which can occur at *)
(* midnight. *)
VAR copyoftime: TimeRecord;
args: RegisterPacket;
savedPSW: CARDINAL;
BEGIN
ReadClock (copyoftime);
savedPSW := EnterCriticalSection();
WITH copyoftime DO
WITH args DO
DH := BYTE(binary (month));
DL := BYTE(binary (dayofmonth));
CX := 100*binary(century) + binary(year);
AH := 43; (* Set Date *)
AL := 0;
END (*WITH*);
Dos (args);
WITH args DO
CH := BYTE(binary (hours));
CL := BYTE(binary (minutes));
DH := BYTE(binary (seconds));
DL := BYTE((25*binary(ticks) + 2) DIV 4);
AH := 45; (* Set Time *)
END (*WITH*);
Dos (args);
END (*WITH*);
LeaveCriticalSection (savedPSW);
END SetDosTime;
(************************************************************************)
(* MAIN PROCEDURE *)
(************************************************************************)
PROCEDURE SetTheClock;
VAR message: Window;
BEGIN
OpenWindow (message, blue, white, 5, 17, 14, 65, simpleframe,nodivider);
SetCursor (message, 1, 9);
WriteString (message, "Setting the CMOS real-time clock");
SetCursor (message, 2, 4);
WriteString (message,
"This version also sets the MS-DOS date/time");
SetCursor (message, 10, 13);
WriteString (message, "Use the Esc key to exit");
(* Temporary arrangement - the century field is constant. *)
WriteCMOS (032H, 019H);
Put (019H, LocalTime, 8);
(* Now let the user do any modifications. *)
Edit;
CloseWindow (message);
END SetTheClock;
(************************************************************************)
(* INITIALIZATION *)
(************************************************************************)
BEGIN
CreateSemaphore (ScreenAccess, 1);
CreateSemaphore (LTprotect, 1);
OpenWindow (editwindow, red, white, 9,14, 33,46, doubleframe, nodivider);
SetBinaryMode (FALSE);
protected := 0; blinking := 0;
InitialDisplay;
CreateTask (ShowTime, 2, "Show time");
SetTheClock;
SetDosTime;
END SetTime.