Category : Display Utilities
Archive   : HERC4390.ZIP
Filename : HERC4390.INC
(* HERC4390.INC Version 1.0 3/21/87 *)
(* by *)
(* Iram J. Weinstein *)
(* *)
(* This software is copyright 1987 by the author. Permission is given *)
(* for noncommercial use only. You are free to copy and distribute the *)
(* software as long as no fees are charged. *)
(* *)
(* Please let me know of any bugs or other problems. You can leave mess- *)
(* on the following Washington, D.C. area BBS's *)
(* *)
(* THE STERLING EXCHANGE PCBOARD (703) 435-0836 *)
(* Databit BBS (703) 370-9832 *)
(* *)
(****************************************************************************)
{This program is designed to provide a 43 row by 90 column text mode for
the Hercules Monochrome Graphics Card. The routines are written so that
the same calls can be used in this new mode and in the normal 25 x 80 Text
mode.
The 43 x 90 mode [x := 1..90; y := 1..43] uses the Hercules Graphics Mode.
Two pages of screen memory (0,1) are available. The system considers the
normal text mode to be page 2.
The graphics characters are available for screens 0 and 1 only if the
program GRAFTABL.COM (find this on your DOS disk) has been run. This is
the same procedure that is required to display graphics characters on the
CGA when in gaphics mode. This command increases the size of DOS in memory
by a little more than 1K bytes.
Turbo Pascal routines to setup the Hercules card are modeled after gen-
erally available assembler routines. I made use of the Hercules manual
and the Borland program HERC.ASM.
The package also contains a small number of plot routines that can be
mixed in with text (for screens 0 and 1 only). For these routines, the
Hercules screen is in a 720 x 348 pixel mode [x := 1..720; y := 1..348].
CAUTIONS
The program has been reasonably well-tested on several Hercules and Clone
Boards. No troubles have shown up, but I won't take any responsibility for
your problems. The Hercules manual does warn against using high-level
languages to program the board. But I have had absolutely no problems.
Remember:
1. If you want Graphics characters, you must run GRAFTABL before your
program. Otherwise you will get random dots.
2. You must call HWorkPage before using the HW or HWLN or they will
fill your screen with random junk.
3. If you run a program using these features on a PC with a CGA, don't
expect anything but pretty patterns on your screen.
++++++++++++++++++DEFINITIONS OF USER PROCEDURES AND FUNCTIONS++++++++++++++++
PROCEDURE HViewPage(Page : Byte);
Sets the Page currently displayed.
PROCEDURE HWorkPage(Page : Byte);
Sets the working page.
PROCEDURE HGoToXY(X,Y:Byte);
Moves the (invisible) cursor for the working page. Next Write will
start at this point. If the Workpage is changed, the cursor loc-
ation is saved and restored when the workpage is restored.
PROCEDURE HClrScr;
Clear the Workpage.
PROCEDURE HW;
This PROCEDURE emulates the Turbo Write(con,.............).
To use, first call a standard TURBO WRITE(USR, .............)
Then follow with a call to HW.
PROCEDURE HWLN;
This PROCEDURE emulates the Turbo WriteLn(con,.............).
To use, first call a standard TURBO WRITE(USR, .............)
NOTE: Not WRITELN(USR, ................)
Then follow with a call to HWLN.
FUNCTION HWhereX:Byte;
Returns X location of cursor on Workpage.
FUNCTION HWhereY:Byte;
Returns Y location of cursor on Workpage.
PROCEDURE HPlot(x,y:INTEGER);
Plots specified point only if both x and y are inside their bounds.
PROCEDURE HDraw(x1,y1,x2,y2:integer);
Draws specified line, plotting only points within x,y bounds.
PROCEDURE HDrawTo(x,y:INTEGER);
Draws a line from the end of the previous line (initialized to 1,1).
-----------------------------------------------------------------------------}
{+++++++++++++++ GLOBAL SYSTEM VARIABLES ++++++++++++++++++++++}
CONST HXGLB : ARRAY[0..2] OF Byte = (1, 1, 1);
HYGLB : ARRAY[0..2] OF Byte = (1, 1, 1);
HPXGLB : ARRAY[0..2] OF Integer = (1, 1, 1);
HPYGLB : ARRAY[0..2] OF Integer = (1, 1, 1);
HPageGLB : Byte = 2;
HTempStr : STRING[255] = '';
VAR HPage0Glb : ARRAY[0..$7FFF] OF Byte ABSOLUTE $B000 : $0000;
HPage1Glb : ARRAY[0..$7FFF] OF Byte ABSOLUTE $B800 : $0000;
PROCEDURE SaveWrite(ch : Char);
BEGIN
HTempStr := HTempStr+ch;
END {PROCEDURE SaveWrite(ch:char) } ;
{--------------------}
PROCEDURE HGoToXY(X, Y : Byte);
BEGIN
IF HPageGLB > 1 THEN GoToXY(X, Y) ELSE
BEGIN
HXGLB[HPageGLB] := X;
HYGLB[HPageGLB] := Y;
END;
END {PROCEDURE HGoToXY(X,Y:Byte) } ;
{--------------------}
FUNCTION HWhereX : Byte;
BEGIN
HWhereX := HXGLB[HPageGLB];
END; {FUNCTION HWhereX }
{--------------------}
FUNCTION HWhereY : Byte;
BEGIN
HWhereY := HYGLB[HPageGLB];
END; {FUNCTION HWhereY }
{--------------------}
PROCEDURE HWorkPage(Page : Byte);
BEGIN
UsrOutPtr := Ofs(SaveWrite);
IF Page < 2 THEN HPageGLB := Page ELSE HPageGLB := 2;
END {PROCEDURE HWorkPage(Page:Byte) } ;
{--------------------}
PROCEDURE HViewPage(Page : Byte);
{If Page =0,1 set Graphics mode, using the corresponding Hercules Graphics
Page. Otherwise, set Text Mode.}
CONST
IndexPort : Integer = $3B4;
DataPort : Integer = $3B5;
ControlPort = $3B8;
ConfigPort = $3BF;
HercGraphicsParms : ARRAY[0..11] OF Byte = ($35, $2d, $2e, 7, $5b, 2, $57, $57, 2, 3, 0, 0);
HercTextParms : ARRAY[0..11] OF Byte = ($61, $50, $52, $0F, $19, 6, $19, $19, 2, $0d, $0b, $0c);
VAR index : 0..11;
BEGIN
CASE Page OF
0, 1:BEGIN
Port[ConfigPort] := 1+2*Page; {Enable graphics and page 1 if Wanted}
Port[ControlPort] := $02; {Change mode to graphics, but with screen off}
FOR index := 0 TO 11 DO
BEGIN {initialize the 6845}
Port[IndexPort] := index;
Port[DataPort] := HercGraphicsParms[index];
Port[ControlPort] := $0A+Page*$80; {re-enable screen, and desired page}
END
END;
ELSE BEGIN
Port[ControlPort] := $20; {Change mode but with screen off}
FOR index := 0 TO 11 DO
BEGIN {initialize the 6845}
Port[IndexPort] := index;
Port[DataPort] := HercTextParms[index];
END;
Port[ControlPort] := $08; {re-enable screen}
END
END {CASE}
END {PROCEDURE HViewPage} ;
{--------------------}
PROCEDURE HClrScr;
BEGIN
CASE HPageGLB OF
0 : FillChar(HPage0Glb, $8000, 0);
1 : FillChar(HPage1Glb, $8000, 0);
ELSE ClrScr;
END {CASE} ;
HGoToXY(1, 1);
HPXGLB[HPageGLB] := 1;
HPYGLB[HPageGLB] := 1;
END {PROCEDURE HClrScr} ;
{--------------------}
PROCEDURE DisplayHerc(ch : Char;
HercIndex : Integer {starting location for first scanline}
);
{Get the 128 ASCII characters from the motherboard IBMROM. Get the graphics
characters by running the IBM program GRAFTABL, which loads these characters
at an address that it loads in a pointer at $0000:007C}
CONST
IBMROM = $F000;
AsciiCharTableOfs = $FA6E;
VAR index : Integer;
AsciiCharTable : ARRAY[0..1023] OF Byte ABSOLUTE IBMROM : AsciiCharTableOfs;
ScanLine : Byte;
GrafTablOfs : Integer ABSOLUTE $0000 : $007c;
GrafTablSeg : Integer ABSOLUTE $0000 : $007e;
BEGIN
IF HPageGLB > 1 THEN Write(Con, ch) ELSE
BEGIN
IF Ord(ch) < 128 THEN {ASCII char}
BEGIN
index := Ord(ch)*8;
IF HPageGLB = 0 THEN
BEGIN
FOR ScanLine := 0 TO 3 DO
BEGIN
HPage0Glb[HercIndex+ScanLine*$2000] := AsciiCharTable[index+ScanLine];
HPage0Glb[HercIndex+ScanLine*$2000+90] := AsciiCharTable[index+ScanLine+4];
END
END ELSE IF HPageGLB = 1 THEN
BEGIN
FOR ScanLine := 0 TO 3 DO
BEGIN
HPage1Glb[HercIndex+ScanLine*$2000] := AsciiCharTable[index+ScanLine];
HPage1Glb[HercIndex+ScanLine*$2000+90] := AsciiCharTable[index+ScanLine+4];
END
END;
END ELSE {Graphics Char}
BEGIN
index := (Ord(ch) AND $7F)*8;
IF HPageGLB = 0 THEN
BEGIN
FOR ScanLine := 0 TO 3 DO
BEGIN
HPage0Glb[HercIndex+ScanLine*$2000] := Mem[GrafTablSeg:GrafTablOfs+index+ScanLine];
HPage0Glb[HercIndex+ScanLine*$2000+90] := Mem[GrafTablSeg:GrafTablOfs+index+ScanLine+4];
END
END ELSE IF HPageGLB = 1 THEN
BEGIN
FOR ScanLine := 0 TO 3 DO
BEGIN
HPage1Glb[HercIndex+ScanLine*$2000] := Mem[GrafTablSeg:GrafTablOfs+index+ScanLine];
HPage1Glb[HercIndex+ScanLine*$2000+90] := Mem[GrafTablSeg:GrafTablOfs+index+ScanLine+4];
END
END
END
END;
END {PROCEDURE DisplayHerc} ;
{--------------------}
PROCEDURE HScroll;
{Scrolls Graphics screen up one row}
VAR I, J : Byte;
HercIndex : Integer;
BEGIN
CASE HPageGLB OF
0 : BEGIN
FOR I := 1 TO 42 DO
FOR J := 0 TO 3 DO
Move(HPage0Glb[J*$2000+I*180], HPage0Glb[J*$2000+(I-1)*180], 180);
END;
1 : BEGIN
FOR I := 1 TO 42 DO
FOR J := 0 TO 3 DO
Move(HPage1Glb[J*$2000+I*180], HPage1Glb[J*$2000+(I-1)*180], 180);
END
END {CASE} ;
HGoToXY(1, 43);
FOR HercIndex := 7560 TO 7649 DO DisplayHerc(Chr(0), HercIndex);
END {PROCEDURE HScroll } ;
{--------------------}
PROCEDURE HW;
VAR I, HercIndex : Integer;
BEGIN
HercIndex := (HYGLB[HPageGLB]-1)*180+HXGLB[HPageGLB]-1 {starting location for first scanline} ;
FOR I := 0 TO Length(HTempStr)-1 DO
BEGIN
DisplayHerc(HTempStr[I+1], HercIndex);
HercIndex := HercIndex+1;
IF HercIndex MOD 90 = 0 THEN HercIndex := HercIndex+90;
IF HercIndex > 7649 {42*180+89} THEN BEGIN
HercIndex := 7560;
HScroll;
END;
END;
HYGLB[HPageGLB] := HercIndex DIV 180+1;
HXGLB[HPageGLB] := HercIndex-HYGLB[HPageGLB]*180+181;
HTempStr := '';
END {PROCEDURE HW} ;
{--------------------}
PROCEDURE HWLN;
BEGIN
HW;
IF HPageGLB > 1 THEN WriteLn(Con) ELSE
BEGIN
HXGLB[HPageGLB] := 1;
HYGLB[HPageGLB] := HYGLB[HPageGLB]+1;
IF (HYGLB[HPageGLB] MOD 44) = 0 THEN
BEGIN
HScroll;
HYGLB[HPageGLB] := 43;
END;
END
END;
{--------------------}
PROCEDURE HPlot(X, Y : Integer);
CONST Mask : ARRAY[0..7] OF Byte = (128, 64, 32, 16, 8, 4, 2, 1);
VAR ScanLine, Row, Byt, bit : Byte;
Offset : Integer;
LABEL Done;
BEGIN
Y := Y-1; IF (Y < 0) OR (Y > 347) THEN GOTO Done;
X := X-1; IF (X < 0) OR (X > 719) THEN GOTO Done;
HPXGLB[HPageGLB] := X+1;
HPYGLB[HPageGLB] := Y+1;
Row := Y DIV 4;
ScanLine := Y MOD 4;
Byt := X DIV 8;
Offset := $2000*ScanLine+Row*90+Byt;
bit := X MOD 8;
CASE HPageGLB OF
0 : HPage0Glb[Offset] := HPage0Glb[Offset] OR Mask[bit];
1 : HPage1Glb[Offset] := HPage1Glb[Offset] OR Mask[bit];
END {CASE} ;
Done:
END {PROCEDURE HPlot(x,y:integer) } ;
{--------------------}
PROCEDURE HDraw(X1, Y1, X2, Y2 : Integer);
VAR n, X2Save, Y2Save : Integer;
a, b : Real;
PROCEDURE OrderX(VAR X1, Y1, X2, Y2 : Integer);
VAR temp : Integer;
BEGIN
IF X1 > X2 THEN
BEGIN
temp := X1;
X1 := X2;
X2 := temp;
temp := Y1;
Y1 := Y2;
Y2 := temp;
END
END {PROCEDURE OrderX} ;
{--------------------}
PROCEDURE OrderY(VAR X1, Y1, X2, Y2 : Integer);
VAR temp : Integer;
BEGIN
IF Y1 > Y2 THEN
BEGIN
temp := X1;
X1 := X2;
X2 := temp;
temp := Y1;
Y1 := Y2;
Y2 := temp;
END
END {PROCEDURE OrderY} ;
{--------------------}
BEGIN
IF HPageGLB < 2 THEN
BEGIN
X2Save := X2;
Y2Save := Y2;
IF X2 = X1 THEN
BEGIN
OrderY(X1, Y1, X2, Y2);
FOR n := Y1 TO Y2 DO HPlot(X1, n)
END
ELSE
IF Y2 = Y1 THEN
BEGIN
OrderX(X1, Y1, X2, Y2);
FOR n := X1 TO X2 DO HPlot(n, Y1)
END
ELSE
BEGIN
a := (Y2-Y1)/(X2-X1);
b := Y1-a*X1;
IF Abs(X2-X1) > Abs((Y2-Y1)) THEN
BEGIN
OrderX(X1, Y1, X2, Y2);
FOR n := X1 TO X2 DO HPlot(n, Round(a*n+b))
END
ELSE
BEGIN
OrderY(X1, Y1, X2, Y2);
FOR n := Y1 TO Y2 DO HPlot(Round((n-b)/a), n);
END
END
END;
HPXGLB[HPageGLB] := X2Save;
HPYGLB[HPageGLB] := Y2Save;
END {PROCEDURE HDraw} ;
{--------------------}
PROCEDURE HDrawTo(X, Y : Integer);
BEGIN
HDraw(HPXGLB[HPageGLB], HPYGLB[HPageGLB], X, Y);
END {PROCEDURE HDrawTo(X,Y:integer) } ;
{--------------------}
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/