Some older sources of modules

While looking for fils to throw away on my hard disk, I came across a zip file with, apparently, the source code for Modula-2 library modules:

• Barith
• Effects
• FileIO
• LowLevel
• Mouse
• Statistics
• Tijd
• Timer
• Xchar
• VGAlib
VGAlib, Statistics and Mouse have been cobered already in specific topics on this site. This section is about the remaining modules.

Barith : Binary Arithmetic

```DEFINITION MODULE barith;

(*  This is FREE software, as described in the GNU General Public Licences.
Therefore it comes WITH THE FULL SOURCES. Please feel free to improve this
code when necessary. You OWN this code. I am not Bill Gates.

I would appreciate that people let in this message when extending this
library, as a small tribute to me (for laying the foundation).

In case people need extra information, contact me via:

snail mail: Jan Verhoeven, 5012 GH 272, The Netherlands
electronic mail: jverhoeven@bigfoot.com

I remain full copyrights to these sources. If you want to send me a small
"thanks", please send me a postcard of your hometown to the above shown
snailmail address. Yes it is in code; the internal code of our national
mail deliverer.

Use this software at your own risk. Please find yourself a GNU GPL if you
are in any doubt. I use these functions for all my own software, but there
is NO GUARANTEE OF ANY KIND covering it.            *)

(*  Add support for bitwise logical operators to Modula-2.
Binary ARITHmatic.
*)

PROCEDURE and (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x AND y.
*)

PROCEDURE nand (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x AND not Y.
*)

PROCEDURE or (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x OR Y.
*)

PROCEDURE nor (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x OR NOT y.
*)

PROCEDURE xor (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x XOR y.
*)

PROCEDURE test (x, y : CARDINAL) : BOOLEAN;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := TEST (x, y).
*)

PROCEDURE shl (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := SHL x, y
*)

PROCEDURE shr (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := SHR x for y bits.
*)

PROCEDURE MulDiv (Mul1, Mul2, Div : CARDINAL) : CARDINAL;
(*
Calculate Mul1 * Mul2 / Div with 32 bit intermediate result.  *)

END barith.
```
And the implementation:
```IMPLEMENTATION MODULE barith;

(*  This is FREE software, as described in the GNU General Public Licences.
Therefore it comes WITH THE FULL SOURCES. Please feel free to improve this
code when necessary. You OWN this code. I am not Bill Gates.

I would appreciate that people let in this message when extending this
library, as a small tribute to me (for laying the foundation).

In case people need extra information, contact me via:

snail mail: Jan Verhoeven, 5012 GH 272, The Netherlands
electronic mail: jverhoeven@bigfoot.com

I remain full copyrights to these sources. If you want to send me a small
"thanks", please send me a postcard of your hometown to the above shown
snailmail address. Yes it is in code; the internal code of our national
mail deliverer.

Use this software at your own risk. Please find yourself a GNU GPL if you
are in any doubt. I use these functions for all my own software, but there
is NO GUARANTEE OF ANY KIND covering it.            *)

FROM    SYSTEM      IMPORT  ASSEMBLER;

PROCEDURE and (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x AND y.
*)

VAR Result  : CARDINAL;

BEGIN
ASM
MOV  AX, x
MOV  BX, y
AND  AX, BX
MOV  Result, AX
END;
RETURN Result;
END and;

PROCEDURE nand (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x AND not Y.
*)

VAR Result  : CARDINAL;

BEGIN
ASM
MOV  AX, x
MOV  BX, y
NOT  BX
AND  AX, BX
MOV  Result, AX
END;
RETURN Result;
END nand;

PROCEDURE or (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x OR Y.
*)

VAR Result  : CARDINAL;

BEGIN
ASM
MOV  AX, x
MOV  BX, y
OR   AX, BX
MOV  Result, AX
END;
RETURN Result;
END or;

PROCEDURE nor (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x OR NOT y.
*)

VAR Result  : CARDINAL;

BEGIN
ASM
MOV  AX, x
MOV  BX, y
NOT  BX
OR   AX, BX
MOV  Result, AX
END;
RETURN Result;
END nor;

PROCEDURE xor (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := x XOR y.
*)

VAR Result  : CARDINAL;

BEGIN
ASM
MOV  AX, x
MOV  BX, y
XOR  AX, BX
MOV  Result, AX
END;
RETURN Result;
END xor;

PROCEDURE test (x, y : CARDINAL) : BOOLEAN;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := TEST (x, y)
*)

VAR Result  : BOOLEAN;

BEGIN
ASM
MOV  DX, 0
MOV  AX, x
MOV  BX, y
TEST AX, BX
JZ   L0
INC  DX
L0: MOV  Result, DX
END;
RETURN Result;
END test;

PROCEDURE shl (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := SHL x, y
*)

VAR result  : CARDINAL;

BEGIN
ASM
MOV  AX, x
MOV  CX, y
AND  CX, 15
JCXZ ok
SHL  AX, CL
ok: MOV  result, AX
END;
RETURN result;
END shl;

PROCEDURE shr (x, y : CARDINAL) : CARDINAL;
(*
Perform binary arithmatic to operands x and y and return it.
Operation:  Result := SHR x for y bits.
*)

VAR result      : CARDINAL;

BEGIN
ASM
MOV  AX, x
MOV  CX, y
AND  CX, 15
JCXZ ok
SHR  AX, CL
ok: MOV  result, AX
END;
RETURN result;
END shr;

PROCEDURE MulDiv (Mul1, Mul2, Div : CARDINAL) : CARDINAL;
(*
Calculate Mul1 * Mul2 / Div with 32 bit intermediate result.  *)

VAR Result      : CARDINAL;

BEGIN
ASM
MOV  AX, Mul1
MOV  BX, Mul2
MUL  BX             (* DX:AX = result   *)
MOV  BX, Div
DIV  BX
MOV  Result, AX
END;
RETURN Result;
END MulDiv;

END barith.
```
Later it turned out to be that Modula-2 already has these functions inside, in the SET related functions...

Effects : various text windows thingies

The definition module :

```DEFINITION MODULE Effects;

PROCEDURE Frame		(TopY, TopX, BotY, BotX : CARDINAL; border : ARRAY OF CHAR);

PROCEDURE SpreidRegel	(regel	: ARRAY OF CHAR; 	breedte : CARDINAL);

PROCEDURE Wacht		(tijd	: CARDINAL);

PROCEDURE Roll		(reeks	: ARRAY OF CHAR; 	tijd : CARDINAL);

PROCEDURE ZekerWeten	(Actie	: ARRAY OF CHAR) : BOOLEAN;

PROCEDURE Bevestig	(opties	: ARRAY OF CHAR) : CHAR;

END Effects.
```
And the implementation module :
```IMPLEMENTATION MODULE Effects;

FROM ASCII      IMPORT  ESC;
FROM Display    IMPORT  GetCursorPosition, Goto, SetCursorPosition,
Write, WriteChar;
FROM InOut      IMPORT  WriteString;
FROM Keyboard   IMPORT  GetKey;
FROM Strings    IMPORT  Length;
FROM SYSTEM     IMPORT  ASSEMBLER;
FROM Windows    IMPORT  CloseWindow, OpenWindow, Window;

PROCEDURE Frame (TopY, TopX, BotY, BotX : CARDINAL;
border                 : ARRAY OF CHAR );

VAR pos     : CARDINAL;

BEGIN
SetCursorPosition (TopY, TopX);
Write (border [0]);
FOR pos := TopX + 1 TO BotX - 1 DO
Write (border [1]);
END;
Write (border [2]);
FOR pos := TopY + 1 TO BotY - 1 DO
SetCursorPosition (pos, TopX);
Write (border [3]);
SetCursorPosition (pos, BotX);
Write (border [5]);
END;
SetCursorPosition (BotY, BotX);
WriteChar (border [8]);
SetCursorPosition (BotY, TopX);
Write (border [6]);
FOR pos := TopX + 1 TO BotX - 1 DO
Write (border [7]);
END;
END Frame;

PROCEDURE SpreidRegel (regel : ARRAY OF CHAR; breedte : CARDINAL);

VAR     positie,
woorden,
Spaties,
TussenSpaties,
EindSpaties    : CARDINAL;

BEGIN
woorden := 0;
FOR positie := 0 TO Length (regel) -1 DO
IF regel [positie] = " " THEN
INC (woorden);
END;
END;
Spaties := breedte - Length (regel);
TussenSpaties   := Spaties DIV woorden;
EindSpaties     := Spaties MOD woorden;
FOR positie := 0 TO Length (regel) -1 DO
IF regel [positie] = " " THEN
FOR Spaties := 0 TO TussenSpaties DO
Write (" ");
END;
ELSIF regel [positie] = "_" THEN
Write (" ");
ELSE
Write (regel [positie]);
END;
END;
FOR positie := 1 TO EindSpaties DO
Write (" ");
END;
END SpreidRegel;

PROCEDURE Wacht (tijd : CARDINAL);
(*  Wait <tijd> klokticks   *)

BEGIN
ASM
PUSH    DS
MOV     BX, tijd
XOR     AX, AX
MOV     DS, AX
MOV     SI, 46CH        (* Address of 18 Hz timer   *)
MOV     AX, [SI]        (* Fetch current count      *)
ADD     BX, AX          (* compose END-time         *)
W8: MOV     AX, [SI]        (* Fetch new time           *)
CMP     AX, BX          (* And compare with target  *)
JNE     W8              (* Wait if not yet reached  *)
POP     DS
END;                        (* END of ASM *)
END Wacht;

PROCEDURE Roll (reeks : ARRAY OF CHAR; tijd : CARDINAL);
(*  Unroll text to the screen, centered and timed.  *)

VAR
ReeksLengte, index          : CARDINAL;
ScreenX, ScreenY, EndPos    : CARDINAL;
DoChar, CharsToDo           : CARDINAL;

BEGIN
ReeksLengte := Length (reeks);
GetCursorPosition (ScreenY, ScreenX);
EndPos := 40 + ReeksLengte DIV 2;       (* determine "exit" point   *)
FOR CharsToDo := 0 TO ReeksLengte DO
ScreenX := EndPos - CharsToDo;
SetCursorPosition (ScreenY, ScreenX);
FOR index := 0 TO CharsToDo DO
Write (reeks [index]);
END;                (* END of 2nd FOR   *)
Wacht (tijd);
END;                    (* END of main FOR  *)
END Roll;

PROCEDURE ZekerWeten (Actie : ARRAY OF CHAR) : BOOLEAN;

VAR w           : Window;
letter      : CHAR;
ok, geldig  : BOOLEAN;

BEGIN
OpenWindow (w, 3, 50, 5, 75, TRUE, Actie);
Goto (0, 2);    WriteString ("Ja of Nee");
REPEAT
geldig := TRUE;
GetKey (letter);
IF letter = 0C THEN     (* IF function key, THEN    *)
GetKey (letter);    (* dispose off key          *)
geldig := FALSE;
END;
letter := CAP (letter);
IF    geldig AND (letter = "J") THEN
ok := TRUE;
ELSIF geldig AND (letter = "N") THEN
ok := FALSE;
ELSE geldig := FALSE;
END;
IF letter = ESC THEN
ok      := FALSE;
geldig  := TRUE;
END;
UNTIL geldig = TRUE;
CloseWindow (w);
RETURN ok;
END ZekerWeten;

PROCEDURE Bevestig (opties : ARRAY OF CHAR) : CHAR;

VAR Toets           : CHAR;
Index, MaxLen   : CARDINAL;

BEGIN
MaxLen := Length (opties);
DEC (MaxLen);
LOOP
GetKey (Toets);
Toets := CAP (Toets);
FOR Index := 0 TO MaxLen DO
IF opties [Index] = Toets THEN
EXIT;
END;
END;
END;
END Bevestig;

END Effects.
```

FileIO

The definition module :

```DEFINITION MODULE FileIo;

FROM FileSystem     IMPORT File;

PROCEDURE ReadString   (device      : File;
VAR String  : ARRAY OF CHAR;
delimiter   : CHAR  );

(*  Read a String from file 'device' until a 'delimiter' char is found  *)

PROCEDURE WriteString  (device      : File;
String      : ARRAY OF CHAR;
delimiter   : CHAR  );

(*  Write a String to file 'device' and add the specified 'delimiter'.  *)

PROCEDURE ReadCard     (device      : File;
VAR card    : CARDINAL  ) : BOOLEAN;

(*  Read a CARDINAL as text from file 'device' and store in 'card';      *)

PROCEDURE WriteCard    (device      : File;
card        : CARDINAL;
precision   : CARDINAL;
delimiter   : CHAR      );

(*  Write a CARDINAL to file 'device'       *)

END FileIo.
```
And the implementation module :
```IMPLEMENTATION MODULE FileIo;

FROM ASCII              IMPORT  EOL;
FROM FileSystem         IMPORT  File, ReadChar, WriteChar;
FROM NumberConversion   IMPORT  StringToCard, CardToString;

PROCEDURE ReadString (device        : File;
VAR String    : ARRAY OF CHAR;
delimiter     : CHAR  );
VAR char    : CHAR;
index   : CARDINAL;

BEGIN
index := 0;
REPEAT
String [index] := char;
INC (index);
UNTIL char = delimiter;
DEC (index);
String [index] := 0C;

PROCEDURE WriteString  (device      : File;
String      : ARRAY OF CHAR;
delimiter   : CHAR  );
VAR index   : CARDINAL;
Max     : CARDINAL;
Char    : CHAR;

BEGIN
index := 0;
Max := HIGH (String);
Char := String [index];
WHILE (Char # 0C) AND (index <= Max) DO
WriteChar (device, Char);
INC (index);
IF index <= Max THEN
Char := String [index];
END;
END;
WriteChar (device, delimiter);
END WriteString;

PROCEDURE ReadCard (device : File; VAR card : CARDINAL) : BOOLEAN;

VAR char    : CHAR;
index   : CARDINAL;
storage : ARRAY [0..7] OF CHAR;
ok      : BOOLEAN;

BEGIN
index := 0;
LOOP
CASE char OF
"0".."9"      : storage [index] := char;
|
",", EOL, " " : ok := TRUE; EXIT;
ELSE
ok := FALSE; EXIT;
END;
INC (index);
END;
storage [index] := 0C;
IF ok THEN
StringToCard (storage, card, ok);
END;
RETURN ok;

PROCEDURE WriteCard    (device      : File;
card        : CARDINAL;
precision   : CARDINAL;
delimiter   : CHAR      );

VAR storage     : ARRAY [0..9] OF CHAR;

BEGIN
CardToString (card, storage, precision);
WriteString (device, storage, delimiter);
END WriteCard;

END FileIo.
```

The definition module :

```DEFINITION MODULE LowLevel;

(*  This is FREE software, as described in the GNU General Public Licences.
Therefore it comes WITH THE FULL SOURCES. Please feel free to improve this
code when necessary. You OWN this code. I am not Bill Gates.

I would appreciate that people let in this message when extending this
library, as a small tribute to me (for laying the foundation).

In case people need extra information, contact me via:

snail mail: Jan Verhoeven, 5012 GH 272, The Netherlands
electronic mail: jverhoeven@bigfoot.com

I remain full copyrights to these sources. If you want to send me a small
"thanks", please send me a postcard of your hometown to the above shown
snailmail address. Yes it is in code; the internal code of our national
mail deliverer.

Use this software at your own risk. Please find yourself a GNU GPL if you
are in any doubt. I use these functions for all my own software, but there
is NO GUARANTEE OF ANY KIND covering it.            *)

TYPE    IOsize      = (Byte, Word);

PROCEDURE InPort	(Port : CARDINAL;	Size : IOsize) : CARDINAL;

(*	Return value by reading I/O port 'Port'.	*)

PROCEDURE OutPort 	(Port, Value : CARDINAL; Size : IOsize);

(*	Send byte 'Value' to I/O port 'Port'.	*)

END LowLevel.
```
And the implementation module :
```IMPLEMENTATION MODULE LowLevel;

(*  This is FREE software, as described in the GNU General Public Licences.
Therefore it comes WITH THE FULL SOURCES. Please feel free to improve this
code when necessary. You OWN this code. I am not Bill Gates.

I would appreciate that people let in this message when extending this
library, as a small tribute to me (for laying the foundation).

In case people need extra information, contact me via:

snail mail: Jan Verhoeven, 5012 GH 272, The Netherlands
electronic mail: jverhoeven@bigfoot.com

I remain full copyrights to these sources. If you want to send me a small
"thanks", please send me a postcard of your hometown to the above shown
snailmail address. Yes it is in code; the internal code of our national
mail deliverer.

Use this software at your own risk. Please find yourself a GNU GPL if you
are in any doubt. I use these functions for all my own software, but there
is NO GUARANTEE OF ANY KIND covering it.            *)

FROM    SYSTEM      IMPORT  ASSEMBLER;

PROCEDURE InPort (Port : CARDINAL; Size : IOsize) : CARDINAL;

(*	Return value by reading I/O port 'Port'.	*)

VAR Result  : CARDINAL;

BEGIN
IF Size = Word THEN
ASM
MOV  DX, Port
IN   AX, DX
MOV  Result, AX
END;
ELSE
ASM
MOV  DX, Port
IN   AL, DX
MOV  AH, 0
MOV  Result, AX
END;
END;
RETURN Result;
END InPort;

PROCEDURE OutPort (Port, Value : CARDINAL; Size : IOsize);

(*	Send byte 'Value' to I/O port 'Port'.	*)

BEGIN
IF Size = Word THEN
ASM
MOV  DX, Port
MOV  AX, Value
OUT  DX, AX
END;
ELSE
ASM
MOV  DX, Port
MOV  AL, Value
OUT  DX, AL
END;
END;
END OutPort;

END LowLevel.
```

Tijd

The definition module :

```DEFINITION MODULE Tijd;

PROCEDURE Seconde	(VAR sec   : CARDINAL);

PROCEDURE Minuut	(VAR min   : CARDINAL);

PROCEDURE Uur		(VAR uur   : CARDINAL);

PROCEDURE DagVdMaand	(VAR dag   : CARDINAL);

PROCEDURE Maand		(VAR maand : CARDINAL);

PROCEDURE Jaar		(VAR jaar  : CARDINAL);

PROCEDURE DagenVanaf95	(dag, maand, jaar : CARDINAL) : CARDINAL;

PROCEDURE MaakDatum	( VAR dag, maand, jaar    : CARDINAL;
delta                   : CARDINAL) ;

PROCEDURE Random (VAR   waarde  : CARDINAL;
grens   : CARDINAL  );

(*	bepaal het volgende RANDOM getal en sla dit op in "waarde".
"waarde" is altijd kleiner dan "grens".
*)

(*  PROCEDURE WeekDag (dag, maand, jaar) : CARDINAL;   *)

END Tijd.
```
And the implementation module :
```IMPLEMENTATION MODULE Tijd;

FROM SYSTEM         IMPORT  ASSEMBLER;

PROCEDURE Seconde (VAR sec : CARDINAL);
BEGIN
ASM
opnieuw:
MOV     AL, 0
OUT     70H, AL
IN      AL, 71H
MOV     BH, AL
MOV     BL, 10
AND     AL, 0F0H
AND     BH, 00FH
MOV     CL, 4
SHR     AL, CL
MUL     BL
CMP     AL, 60
JAE     opnieuw
LES     DI, sec
STOSW
END;
END Seconde;

PROCEDURE Minuut (VAR min : CARDINAL);
BEGIN
ASM
opnieuw:
MOV     AL, 2
OUT     70H, AL
IN      AL, 71H
MOV     BH, AL
MOV     BL, 10
AND     AL, 0F0H
AND     BH, 00FH
MOV     CL, 4
SHR     AL, CL
MUL     BL
CMP     AL, 60
JAE     opnieuw
LES     DI, min
STOSW
END;
END Minuut;

PROCEDURE Uur (VAR uur : CARDINAL);
BEGIN
ASM
opnieuw:
MOV     AL, 4
OUT     70H, AL
IN      AL, 71H
MOV     BH, AL
MOV     BL, 10
AND     AL, 0F0H
AND     BH, 00FH
MOV     CL, 4
SHR     AL, CL
MUL     BL
CMP     AL, 24
JAE     opnieuw
LES     DI, uur
STOSW
END;
END Uur;

PROCEDURE DagVdMaand (VAR dag : CARDINAL);
BEGIN
ASM
opnieuw:
MOV     AL, 7
OUT     70H, AL
IN      AL, 71H
MOV     BH, AL
MOV     BL, 10
AND     AL, 0F0H
AND     BH, 00FH
MOV     CL, 4
SHR     AL, CL
MUL     BL
CMP     AL, 31
JAE     opnieuw
LES     DI, dag
STOSW
END;
END DagVdMaand;

PROCEDURE Maand (VAR maand : CARDINAL);
BEGIN
ASM
opnieuw:
MOV     AL, 8
OUT     70H, AL
IN      AL, 71H
MOV     BH, AL
MOV     BL, 10
AND     AL, 0F0H
AND     BH, 00FH
MOV     CL, 4
SHR     AL, CL
MUL     BL
CMP     AL, 12
JAE     opnieuw
LES     DI, maand
STOSW
END;
END Maand;

PROCEDURE Jaar (VAR jaar : CARDINAL);
BEGIN
ASM
opnieuw:
MOV     AL, 9
OUT     70H, AL
IN      AL, 71H
MOV     BH, AL
MOV     BL, 10
AND     AL, 0F0H
AND     BH, 00FH
MOV     CL, 4
SHR     AL, CL
MUL     BL
CMP     AX, 165
JE      opnieuw
LES     DI, jaar
STOSW
END;
END Jaar;

PROCEDURE DagenVanaf95 (dag, maand, jaar : CARDINAL) : CARDINAL;

VAR totaal  : CARDINAL;

BEGIN
totaal := dag;
WHILE jaar > 1995 DO
DEC (jaar);
INC (totaal, 365);
IF jaar MOD 4 = 0 THEN
INC (totaal);
END;
END;
WHILE maand > 1 DO
DEC (maand);
CASE maand OF
1, 3, 5, 7,
8, 10, 12 : INC (totaal, 31);
|
4, 6,
9, 11     : INC (totaal, 30);
|
2         : INC (totaal, 28);
IF (jaar MOD 4 = 0) THEN
INC (totaal);
END;
END;
END;
DEC (totaal);
END DagenVanaf95;

PROCEDURE MaakDatum (VAR dag, maand, jaar   : CARDINAL; delta : CARDINAL);

VAR MaxDag      : CARDINAL;

BEGIN
INC (dag, delta);
LOOP
CASE maand OF
1, 3, 5, 7,
8, 10, 12   : MaxDag := 31;
|
4, 6, 9, 11 : MaxDag := 30;
ELSE
IF jaar MOD 4 = 0 THEN
MaxDag := 28;
ELSE
MaxDag := 29;
END;
END;
IF dag > MaxDag THEN
DEC (dag, MaxDag);
INC (maand);
IF maand > 12 THEN
maand := 1;
INC (jaar);
END;
ELSE
EXIT;
END;
END;
END MaakDatum;

PROCEDURE Random (VAR waarde    : CARDINAL;
grens     : CARDINAL  );
BEGIN
ASM
XOR     DX, DX
MOV     ES, DX
MOV     BX, 46CH
MOV     AX, ES:[BX]
MOV     BX, grens
next:
SUB     AX, BX
CMP     AX, BX
JA      next
LES     DI, waarde
STOSW
END;
END Random;

(*  PROCEDURE WeekDag (dag, maand, jaar) : CARDINAL;   *)

END Tijd.
```

Timer

The definition module :

```DEFINITION MODULE Timer;

PROCEDURE OpenTimer;                    (*  open timer chip in mode 2   *)

PROCEDURE CloseTimer;                   (*  close timer chip in mode 2  *)

PROCEDURE ReadTimer () : CARDINAL;      (*  read timer chip in mode 2   *)

PROCEDURE Wait (ms : CARDINAL);         (*  wait for 'ms' milliseconds  *)

PROCEDURE LongWait (time : CARDINAL);   (*  wait for time ms; time > 55 *)

END Timer.
```
And the implementation module :
```IMPLEMENTATION MODULE Timer;

FROM    SYSTEM          IMPORT  ASSEMBLER;

PROCEDURE OpenTimer;

BEGIN
ASM
MOV  AL, 34H            (*  open timer chip in mode 2   *)
OUT  43H, AL
XOR  AL, AL
OUT  40H, AL
OUT  40H, AL
END;
END OpenTimer;

PROCEDURE CloseTimer;           (*  close timer chip in mode 2   *)

BEGIN
ASM
MOV  AL, 36H
OUT  43H, AL
XOR  AL, AL
OUT  40H, AL
OUT  40H, AL
END;
END CloseTimer;

PROCEDURE ReadTimer () : CARDINAL;     (*  read timer chip in mode 2    *)

VAR     Time        : CARDINAL;

BEGIN
ASM
MOV  AL, 6
OUT  43H, AL
IN   AL, 40H
MOV  AH, AL
IN   AL, 40H
XCHG AH, AL
MOV  [Time], AX
END;
RETURN Time;

PROCEDURE Wait (ms : CARDINAL);         (*  wait for 'ms' milliseconds  (ms < 55)   *)

VAR     MaxCount    : CARDINAL;

BEGIN
MaxCount := 0FFFFH - ms * 1193;
OpenTimer;
WHILE ReadTimer () > MaxCount DO
(*  absolutely nothing  *)
END;
CloseTimer;
END Wait;

PROCEDURE LongWait (time : CARDINAL);   (*  wait for more than 55 ms    *)

VAR     i       : CARDINAL;

BEGIN
FOR i := 1 TO time DO
Wait (1)
END
END LongWait;

END Timer.
```

Xchar

The definition module :

```DEFINITION MODULE Xchar;

(*  This is FREE software, as described in the GNU General Public Licences.
Therefore it comes WITH THE FULL SOURCES. Please feel free to improve this
code when necessary. You OWN this code. I am not Bill Gates.

I would appreciate that people let in this message when extending this
library, as a small tribute to me (for laying the foundation).

In case people need extra information, contact me via:

snail mail: Jan Verhoeven, 5012 GH 272, The Netherlands
electronic mail: jverhoeven@bigfoot.com

I remain full copyrights to these sources. If you want to send me a small
"thanks", please send me a postcard of your hometown to the above shown
snailmail address. Yes it is in code; the internal code of our national
mail deliverer.

Use this software at your own risk. Please find yourself a GNU GPL if you
are in any doubt. I use these functions for all my own software, but there
is NO GUARANTEE OF ANY KIND covering it.            *)

PROCEDURE Lower (Char : CHAR) : CHAR;
(*
Convert any case character to lower case.
*)

PROCEDURE IsDigit (Char : CHAR) : BOOLEAN;
(*
Check whether Char is a digit or not.
Return TRUE if so, FALSE otherwise
*)

PROCEDURE IsHexDigit (Char : CHAR) : BOOLEAN;
(*
Check whether Char is a valid hexdigit or not.
Return TRUE if so, FALSE otherwise
*)

PROCEDURE IsLetter (Char : CHAR) : BOOLEAN;
(*
Check if Char is a Letter.
Return TRUE if so, FALSE otherwise.
*)

PROCEDURE LowerString (VAR String : ARRAY OF CHAR);
(*
Convert complete String to lower case.
*)

PROCEDURE UpperString (VAR String : ARRAY OF CHAR);
(*
Convert complete String to upper case.
*)

PROCEDURE KeyW8 (Token  : CHAR);

(*  Wait for key 'Token' was pressed	*)

PROCEDURE SkipUntil (letter  : CHAR);

(*  Skip all characters until "letter"    *)

PROCEDURE Print (s  : ARRAY OF CHAR);

(*  Colourful version of WriteString.
This routine uses "displayAttr" which must be IMPORTed from Display.
*)

PROCEDURE ReadName (VAR buffer : ARRAY OF CHAR);

(*  Read a quoted name from the (redirected) terminal.
The function waits until a quote is entered, takes up letters and
stops after the second quote (") is received.
*)

PROCEDURE CompressName (in  : ARRAY OF CHAR; VAR out  : ARRAY OF CHAR);

(*  Remove spaces from the string "in" and store the result in  string "out".    *)

END Xchar.
```
And the implementation module :
```IMPLEMENTATION MODULE Xchar;

(*  This is FREE software, as described in the GNU General Public Licences.
Therefore it comes WITH THE FULL SOURCES. Please feel free to improve this
code when necessary. You OWN this code. I am not Bill Gates.

I would appreciate that people let in this message when extending this
library, as a small tribute to me (for laying the foundation).

In case people need extra information, contact me via:

snail mail: Jan Verhoeven, 5012 GH 272, The Netherlands
electronic mail: jverhoeven@bigfoot.com

I remain full copyrights to these sources. If you want to send me a small
"thanks", please send me a postcard of your hometown to the above shown
snailmail address. Yes it is in code; the internal code of our national
mail deliverer.

Use this software at your own risk. Please find yourself a GNU GPL if you
are in any doubt. I use these functions for all my own software, but there
is NO GUARANTEE OF ANY KIND covering it.            *)

IMPORT  Display;

FROM    InOut           IMPORT  Read;
FROM    Keyboard        IMPORT  GetKey;

PROCEDURE Lower (Char : CHAR) : CHAR;

BEGIN
CASE Char OF
"A".."Z" : Char := CHR ( ORD (Char) + 32)
END;
RETURN Char
END Lower;

PROCEDURE IsDigit (Char : CHAR) : BOOLEAN;

BEGIN
CASE Char OF
"0".."9" : RETURN TRUE
ELSE
RETURN FALSE
END
END IsDigit;

PROCEDURE IsHexDigit (Char : CHAR) : BOOLEAN;

BEGIN
CASE Char OF
"0".."9",
"A".."F",
"a".."f"  : RETURN TRUE
ELSE
RETURN FALSE
END
END IsHexDigit;

PROCEDURE IsLetter (Char : CHAR) : BOOLEAN;

BEGIN
CASE Char OF
"A".."Z",
"a".."z" : RETURN TRUE
ELSE
RETURN FALSE
END
END IsLetter;

PROCEDURE LowerString (VAR String : ARRAY OF CHAR);

VAR index   : CARDINAL;
Max     : CARDINAL;
Char    : CHAR;

BEGIN
index := 0;
Char := String [index];
Max := HIGH (String);
WHILE (Char # 0C) AND (index <= Max) DO
String [index] := Lower (Char);
INC (index);
Char := String [index]
END
END LowerString;

PROCEDURE UpperString (VAR String : ARRAY OF CHAR);

VAR index   : CARDINAL;
Max     : CARDINAL;
Char    : CHAR;

BEGIN
index := 0;
Char := String [0];
Max := HIGH (String);
WHILE (Char # 0C) AND (index <= Max) DO
Char := String [index];
String [index] := CAP (Char);
INC (index)
END
END UpperString;

PROCEDURE KeyW8 (soll  : CHAR);             (*  Wait for a keypress     *)

VAR     ist     : CHAR;

BEGIN
LOOP
GetKey (ist);
IF ist = soll THEN EXIT END
END
END KeyW8;

PROCEDURE SkipUntil (soll  : CHAR);         (*  Skip all tokens until "soll"    *)

VAR     ist     : CHAR;

BEGIN
REPEAT
UNTIL ist = soll
END SkipUntil;

PROCEDURE Print (s  : ARRAY OF CHAR);       (*  Colourful version of WriteString    *)

VAR     n       : CARDINAL;

BEGIN
n := 0;
LOOP
IF (n > HIGH (s)) OR (s [n] = 0C) THEN EXIT END;
Display.Write (s [n]);
INC (n)
END
END Print;

PROCEDURE ReadName (VAR buffer : ARRAY OF CHAR);

(*  Read a quoted name from the (redirected) terminal       *)

VAR     ch      : CHAR;
n       : CARDINAL;

BEGIN
n := 0;
REPEAT
UNTIL ch = '"';                     (*  get rid of spaces   *)
LOOP
IF ch = '"' THEN EXIT END;      (*  If ch = '"' THEN exit loop  *)
buffer [n] := ch;               (*  Else store ch in Array      *)
INC (n)
END;
IF n <= HIGH (buffer) THEN
buffer [n] := 0C
END

PROCEDURE CompressName (in  : ARRAY OF CHAR; VAR out  : ARRAY OF CHAR);

(*  Remove ALL spaces and control characters from the string       *)

VAR     i, j    : CARDINAL;

BEGIN
j := 0;
FOR i := 0 TO HIGH (in) DO
IF in [i] > ' ' THEN            (*  IF alphanum THEN store in array OUT     *)
out [j] := in [i];
INC (j)
END
END;
out [j] := 0C
END CompressName;

END Xchar.
```

Page created August 26, 2010 and