Category : Files from Magazines
Archive   : PCTJ1086.ZIP
Filename : FONTBUMP.MOD

IMPLEMENTATION MODULE FontBumper;
(*
Title : FontBumper.mod
LastEdit: June 5, 1986
Author : John T. Cockerham, M.D.
System : LOGITECH MODULA-2/86
*)
FROM SYSTEM IMPORT CODE, ADDRESS, ADR, DOSCALL, SETREG, ES, BX,
DISABLE;
FROM FileSystem IMPORT File, Lookup, ReadNBytes, Close, Response;
FROM LowEGA IMPORT SetActiveFonts, LoadBiosFont, FontType,
SetUpAlpha, SetModeBios, WaitForVerticalRetrace, LoadUserFont;
FROM Opcodes IMPORT PushAX, PushBX, PushCX, PushDX, PushBP, PushES,
PushDS, PushFlags, PushSI, PushDI, PopAX, PopBX, PopCX, PopDX,
PopSI, PopDI, PopBP, PopES, PopDS, Iret;
FROM Pauses IMPORT Pause;
CONST
TimeHack = 01CH;
GetIntVector = 035H;
SetIntVector = 025H;
PreserveBit = 080H;
AlphaMode = 003H;

(* These are static variables preserved across interrupts *)
VAR CurrentFont : CARDINAL;
OldTimerVector : ADDRESS;
PointerToOldVector : ADDRESS;
FontBumpX : PROCEDURE;
FontBumpY : ADDRESS;
Count : CARDINAL;
AnotherFont : ARRAY [0 .. 0E00H] OF CHAR;
FontFile : File;
ChangeRate : CARDINAL;


(*$R-*)(*$S-*)(*$T-*)
(* This routine is meant to run as a separate interrupt handler.
At each time tick, the handler bumps a counter. When the
counter exceeds the variable ChangeRate, it changes the active
font on the EGA. It is installed when font bumping is turned
on. Disabling the M2 run time services makes the routine
fully reentrant. *)
PROCEDURE FontBump;
BEGIN
(* Compiler generated push bp. Save all of our registers *)
CODE (PushAX, PushCX, PushDX, PushBX, PushSI,
PushDI, PushES, PushDS);
IF Count >= ChangeRate THEN
SetActiveFonts(CurrentFont, CurrentFont);
INC(CurrentFont);
IF CurrentFont > 3 THEN CurrentFont := 0; END;
Count := 0;
END;
INC(Count);
SETREG(ES, PointerToOldVector.SEGMENT);
SETREG(BX, PointerToOldVector.OFFSET);
(* Here fudge the stack to look like an interrupt
by pushing the flags on the stack, then calling
es:bx who will return to us after the "call" which
looks like an interrupt. *)
CODE(PushFlags, 026H, 0FFH, 01FH);
(* Now set up to return from interrupt *)
CODE (PopDS, PopES, PopDI, PopSI, PopBX, PopDX, PopCX, PopAX,
(*Mov sp,bp *) 89H, 0ECH, PopBP, Iret);
END FontBump;
(*$R+*)(*$S+*)(*$T+*)

PROCEDURE GetUserFont(VAR Destination : ARRAY OF CHAR;
FileName : ARRAY OF CHAR;
NumberOfChars : CARDINAL;
Points : CARDINAL) : BOOLEAN;
VAR NewFile : BOOLEAN;
ActuallyRead : CARDINAL;
BEGIN
NewFile := FALSE;
Lookup(FontFile, FileName, NewFile);
IF FontFile.res = notdone THEN
Pause('Unable to read "othrfont.dat"');
RETURN FALSE;
END;
ReadNBytes(FontFile, ADR(Destination), NumberOfChars * Points,
ActuallyRead);
Close(FontFile);
RETURN TRUE;
END GetUserFont;

PROCEDURE SetUpFontBumping(Rate : CARDINAL) : BOOLEAN;
BEGIN
ChangeRate := Rate;
IF GetUserFont(AnotherFont, 'othrfont.dat', 0100H, 0EH) THEN
SetModeBios(AlphaMode + PreserveBit);
LoadBiosFont(MonochromeFont, FALSE, 1);
WaitForVerticalRetrace;
SetModeBios(AlphaMode + PreserveBit);
LoadUserFont(AnotherFont, FALSE, 2, 0100H, 0EH);
WaitForVerticalRetrace;
SetModeBios(AlphaMode + PreserveBit);
LoadUserFont(AnotherFont, FALSE, 3, 0100H, 0EH);
WaitForVerticalRetrace;
DOSCALL(GetIntVector, TimeHack, OldTimerVector);
DOSCALL(SetIntVector, FontBumpY, TimeHack);
SetUpAlpha;
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END SetUpFontBumping;


PROCEDURE ResetFontBumping;
BEGIN
DOSCALL(SetIntVector, OldTimerVector, TimeHack);
SetActiveFonts(0, 0);
END ResetFontBumping;

BEGIN
CurrentFont := 0;
ChangeRate := 4;
Count := 0;
PointerToOldVector := ADR(OldTimerVector);
FontBumpX := FontBump;
FontBumpY := ADDRESS(FontBumpX);
END FontBumper.