home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / ega / egatest.arc / LOWEGA.MOD < prev    next >
Text File  |  1986-12-23  |  28KB  |  774 lines
  1. IMPLEMENTATION MODULE LowEGA;
  2. (*
  3. Title   : LowEGA
  4.  
  5.           Low Level EGA Facilities
  6.           Supplies useful workarounds to the BIOS and
  7.           extensions thereto such as split screen.
  8. LastEdit: July 14, 1986
  9. Author  : John T. Cockerham, M.D.
  10. Syatem  : LOGITECH MODULA-2/86
  11. *)
  12.                   (* This is a low level module *)
  13.   FROM SYSTEM IMPORT INBYTE, OUTBYTE, OUTWORD, AX, BX, CX, DX, ES,
  14.        ADR, BP, GETREG, SETREG, SWI, ADDRESS, CODE, BYTE, WORD;
  15.   FROM PointLib IMPORT Point, MakePoint;
  16.   FROM Opcodes IMPORT PushBP, PopBP;
  17.   TYPE
  18.     Register = RECORD CASE BOOLEAN OF TRUE : X : CARDINAL;
  19.                                    | FALSE : L, H : CHAR; END; END;
  20.     ByteADRType = RECORD
  21.            CASE BOOLEAN OF  TRUE : adr : POINTER TO CHAR;
  22.                          | FALSE : off, seg : CARDINAL; END; END;
  23.  
  24.   CONST
  25.            TotalScanLinesEnhanced = 349;
  26.            VIDEO = 10H;
  27.            SetPageBiosCall = 005H;
  28.            SetPaletteCall  = 010H;
  29.            CharacterGeneratorFunction = 011H;
  30.            WriteTTY = 00EH;
  31.            SetCPos = 002H;
  32.            AlphaPageSize = 2048;
  33.            BottomOfScreen = 01FFH;
  34.  
  35.         (* This is the bit layout for Info And Info3 -- EGA
  36.            information bytes found the BIOS page *)
  37.            CursorEmulateBit = 0;   MonoAttachedBit = 1;
  38.            WaitForEnableBit = 2;   EGAIsActiveBit  = 3;
  39.            MemoryBit1       = 5;   MemoryBit2      = 6;
  40.            ModeSetClearBit  = 7;
  41.  
  42.            VerticalRetraceBit = 3;
  43.  
  44.         (* These are EGA I/O Registers *)
  45.     Graph1          = 03CCh; Graph2           = 03CAh;
  46.     Graph12         = 03CEh; MiscOut          = 03C2h;
  47.     Status0         = 03C3h; Sequencer        = 03C4h;
  48.     AttributeCntrl  = 03C0h; GraphData        = 03CFh;
  49.     StatusRegisterOffset = 6;
  50.         (* These are the names of the EGA indices *)
  51.         (* Sequencer controller first *)
  52.     SequenceReset     = 0;     SequenceClockMode = 1;
  53.     SequenceMapMask   = 2;     SequenceCharMap   = 3;
  54.     SequenceMemMode   = 4;
  55.         (* CRT controller registers *)
  56.     CRTHorizTotal    = 00h;     CRTHorizEnd       = 01h;
  57.     CRTHorizblStart  = 02h;     CRTHorizBlEnd     = 03h;
  58.     CRTHorizRetStart = 04h;     CRTHorizRetEnd    = 05h;
  59.     CRTVertTotal     = 06h;     CRTOvflo          = 07h;
  60.     CRTPreRowScan    = 08h;     CRTMaxScanLine    = 09h;
  61.     CRTCursorStart   = 0Ah;     CRTCursorEnd      = 0Bh;
  62.     CRTStartAddHi    = 0Ch;     CRTStartAddLo     = 0Dh;
  63.     CRTCursLocHi     = 0Eh;     CRTCursLocLo      = 0Fh;
  64.     CRTVertRetSt     = 10h;     CRTLightPenHi     = 10h;
  65.     CRTVertRetEnd    = 11h;     CRTLightPenLo     = 11h;
  66.     CRTVertDisEnd    = 12h;     CRTOffset         = 13h;
  67.     CRTUnderLoc      = 14h;     CRTVertBlSt       = 15h;
  68.     CRTVertBlEnd     = 16h;     CRTModeControl    = 17h;
  69.     CRTLineCompare   = 18h;
  70.        (* Graphics Controller indices *)
  71.     GraphReset       = 00h;     GraphEnable       = 01h;
  72.     GraphColorComp   = 02h;     GraphDataRotate   = 03h;
  73.     GraphReadMapSel  = 04h;     GraphModeReg      = 05h;
  74.     GraphMisc        = 06h;     GraphColorDC      = 07h;
  75.     GraphBitMask     = 08h;
  76.        (* Memory Mapping mode values *)
  77.     A000x128K        = 00h;     A000x64K          = 04h;
  78.     B000x32K         = 02h;     B800x32K          = 0Ch;
  79.     GraphicsModeBit  = 01h;     ChainEvenToOdd    = 02h;
  80.        (* Attribute Controller indices *)
  81.     AttrModeControl  = 10h;     AttrOverscan      = 11h;
  82.     AttrColorPlane   = 12h;     AttrHorizPelPan   = 13h;
  83.     PaletteOn        = 20h;
  84.  
  85.   VAR
  86.     VIDEORAM             : ByteADRType;
  87.     bitmasks             : ARRAY [0..7] OF CARDINAL;
  88.     Cursors              : ARRAY [0..7] OF Point;
  89.     ActivePageOffsets    : ARRAY [0..7] OF CARDINAL;
  90.     i                    : CARDINAL;
  91.     CRTCOverflowRegister : BITSET;
  92.     PelScrollColumn      : INTEGER;
  93.     VerticalScrollRow    : INTEGER;
  94.     SplitScreenLine      : CARDINAL;
  95.     EGA6845              : CARDINAL;
  96.  
  97. (*$S-*)(*$T-*)(*$R-  Turn off Stack Checking for performance
  98.                      and reentrancy reasons *)
  99.   PROCEDURE EGAOutWord(EGAPort, DeviceRegister, Value : CARDINAL);
  100.     (* Output two bytes to the EGA at two Successive I/O addresses *)
  101.     VAR A : Register;
  102.   BEGIN
  103.     A.L := CHR(DeviceRegister); A.H := CHR(Value);
  104.     OUTWORD(EGAPort, A.X);
  105.   END EGAOutWord;
  106.   PROCEDURE WaitForVerticalRetrace;
  107.     (* Wait in a tight loop for vertical retrace *)
  108.     VAR InputStatusRegister1 : BITSET;
  109.   BEGIN
  110.     REPEAT
  111.         INBYTE(EGA6845 + StatusRegisterOffset, InputStatusRegister1);
  112.     UNTIL NOT (VerticalRetraceBit IN InputStatusRegister1);
  113.   END WaitForVerticalRetrace;
  114.   PROCEDURE WaitForVerticalDisplay;
  115.     (* Wait in a tight loop for vertical display active *)
  116.     VAR InputStatusRegister1 : BITSET;
  117.   BEGIN
  118.     REPEAT
  119.         INBYTE(EGA6845 + StatusRegisterOffset, InputStatusRegister1);
  120.     UNTIL NOT (VerticalRetraceBit IN InputStatusRegister1);
  121.   END WaitForVerticalDisplay;
  122.   PROCEDURE SetPageOffset(where : CARDINAL);
  123.     (* Instruct the CRTC where the page starts after retrace *)
  124.     VAR A : Register;
  125.   BEGIN
  126.     A.X := ActivePageOffset;
  127.     EGAOutWord(EGA6845, CRTStartAddHi, ORD(A.H));
  128.     EGAOutWord(EGA6845, CRTStartAddLo, ORD(A.L));
  129.   END SetPageOffset;
  130.  
  131.   PROCEDURE SetActiveFonts(FontA, FontB : CARDINAL);
  132.     (* This routine changes the active character map for
  133.        text modes.  It is written as a reentrant procedure *)
  134.     VAR x : CARDINAL;
  135.   BEGIN
  136.     x := FontA * 2 + FontB;
  137.     WaitForVerticalRetrace;
  138.     EGAOutWord(Sequencer, SequenceCharMap, x);
  139.   END SetActiveFonts;
  140.   (*$S+*)(*$T+*)(*$R+ Turn run time services back on *)
  141.  
  142.   PROCEDURE InitEGA(EGAMonitor : MonitorType) : BOOLEAN;
  143.     (* This routine sets up the EGA for alpha Mode 3 *)
  144.   BEGIN
  145.     SetUpAlpha;   MemoryInstalled := 0;
  146.     IF MemoryBit2 IN EGABiosParams.InfoAndInfo3
  147.        THEN MemoryInstalled := 2 END;
  148.     IF MemoryBit1 IN EGABiosParams.InfoAndInfo3
  149.        THEN INC(MemoryInstalled) END;
  150.     IF EGAMonitor = Monochrome THEN
  151.       IF MonoAttachedBit IN EGABiosParams.InfoAndInfo3 THEN
  152.         EGA6845 := 03B4H;
  153.       ELSE
  154.         RETURN FALSE;
  155.       END;
  156.     ELSE
  157.       IF NOT (MonoAttachedBit IN EGABiosParams.InfoAndInfo3) THEN
  158.         EGA6845 := 03D4H;
  159.       ELSE
  160.         RETURN FALSE;
  161.       END;
  162.       RETURN TRUE;
  163.     END;
  164.   END InitEGA;
  165.  
  166.   PROCEDURE SetUpAlpha;
  167.     (* This is a non standard set up to the EGA to Alpha
  168.        80x25 on the graphics page (A000).  Assertion that EGA
  169.        is already in mode 3 and EGA is comfigured with 256K RAM *)
  170.     VAR
  171.       a, b : Register;
  172.   BEGIN
  173.     EGAOutWord(Graph12, GraphMisc,
  174.           A000x64K + ChainEvenToOdd); (* Map to the A000 map *)
  175.     EGAOutWord(EGA6845, CRTOvflo, 01FH);
  176.     CRTCOverflowRegister := {4, 3, 2, 1, 0};
  177.   END SetUpAlpha;
  178.  
  179.   PROCEDURE SetUpHiRes;
  180.     (* This routine changes the EGA operating mode to HiRes color
  181.        Graphics.  All of these register settings are from the
  182.        boards' documentation  *)
  183.   BEGIN
  184.     WaitForVerticalRetrace;
  185.     EGAOutWord(Sequencer, SequenceMapMask, 00FH);
  186.     EGAOutWord(Sequencer, SequenceMemMode, 006H);
  187.     EGAOutWord(EGA6845, CRTHorizRetStart, 052H);
  188.     EGAOutWord(EGA6845, CRTHorizRetEnd, 000H);
  189.     EGAOutWord(EGA6845, CRTOvflo,  01FH);
  190.     CRTCOverflowRegister := {4, 3, 2, 1, 0};
  191.     ResetVerticalScroll;
  192.     ResetSplitScreen;
  193.     EGAOutWord(EGA6845, CRTMaxScanLine, 000H);
  194.     EGAOutWord(EGA6845, CRTCursorStart, 01FH); (*Turn off cursor*)
  195.     EGAOutWord(EGA6845, CRTCursorEnd, 000H);
  196.     EGAOutWord(EGA6845, CRTVertBlSt, 05FH);
  197.     EGAOutWord(EGA6845, CRTModeControl, 0E3H); (*Byte Mode *)
  198.     EGAOutWord(EGA6845, CRTLineCompare, 0FFH);
  199.     EGAOutWord(Graph12, GraphModeReg, 000H);
  200.     EGAOutWord(Graph12, GraphMisc,  A000x64K + GraphicsModeBit);
  201.     EGAOutWord(Graph12, GraphColorDC,  00FH);
  202.     EGAOutWord(AttributeCntrl, AttrModeControl+PaletteOn, 001H);
  203.     ResetHorizScroll;
  204.     (* We are in writing mode 0 with all maps on this will
  205.        clear out the display buffer *)
  206.     FOR i := 0 TO 65500 DO DisplayBuffer[i] := 0C; END;
  207.   END SetUpHiRes;
  208.   (*----------------------------------------------------*)
  209.   (*        Position fiddling procedures                *)
  210.   (*            Warning for these routines:             *)
  211.   (*               Knowledge of exact mode              *)
  212.   (*               specifications including word/byte   *)
  213.   (*               count by 2 etc is essential to using *)
  214.   (*               these routines                       *)
  215.   (*----------------------------------------------------*)
  216.  
  217.   PROCEDURE SetLogicalRowSize(RowSizeInWords : CARDINAL);
  218.     (* This routine sets the offset register of the CTRC. Word/byte
  219.        issues play a role in its setting *)
  220.   BEGIN
  221.     EGAOutWord(EGA6845, CRTOffset, RowSizeInWords);
  222.   END SetLogicalRowSize;
  223.  
  224.   PROCEDURE SetUnderlineLocation(UnderlineScanLine : CARDINAL);
  225.     (* Set the CRTC's scan line for underlining *)
  226.   BEGIN
  227.     EGAOutWord(EGA6845, CRTUnderLoc, UnderlineScanLine);
  228.   END SetUnderlineLocation;
  229.  
  230.   (*----------------------------------------------------*)
  231.   (*      Mode Switching routines between the monitors  *)
  232.   (*      Warning -- Two monitor systems only           *)
  233.   (*                 Bad results can happen if on mono  *)
  234.   (*                   systems only!                    *)
  235.   (*----------------------------------------------------*)
  236.  
  237.   VAR
  238.           EquipFlag     [0:410H]   : BITSET;
  239.  
  240.   PROCEDURE SwitchToMonoBios;
  241.     (* Adjust the Equiptment Flag to indicate a Monochrome System *)
  242.   BEGIN
  243.     EquipFlag := EquipFlag + {4, 5};
  244.   END SwitchToMonoBios;
  245.  
  246.   PROCEDURE SwitchToColorBios;
  247.     (* Adjust the Equiptmant Flag to indicate Color system *)
  248.   BEGIN
  249.     EquipFlag := EquipFlag - {4} + {5};
  250.   END SwitchToColorBios;
  251.  
  252.   PROCEDURE ColorBiosMode() : BOOLEAN;
  253.     (* Return the status of the Flag. False = monochrome,
  254.        true = Color. *)
  255.   BEGIN
  256.     RETURN (NOT ((5 IN EquipFlag) AND (4 IN EquipFlag)));
  257.   END ColorBiosMode;
  258.   (*----------------------------------------------------*)
  259.   (*   Cursor Routines                                  *)
  260.   (*----------------------------------------------------*)
  261.  
  262.   PROCEDURE SetCursor(Page : CARDINAL);
  263.     (* Set the Cursor to display for the given page *)
  264.     VAR Off : Register;
  265.   BEGIN
  266.     Off.X := CursorOffset(Page) DIV 2;
  267.     EGAOutWord(EGA6845, CRTCursLocHi, ORD(Off.H));
  268.     EGAOutWord(EGA6845, CRTCursLocLo, ORD(Off.L));
  269.   END SetCursor;
  270.  
  271.   PROCEDURE CursorOffset(Page : CARDINAL) : CARDINAL;
  272.     (* Calculate cursor offset for CPU mappings: which is doubled
  273.        accouting for the attribute byte *)
  274.   BEGIN
  275.     RETURN ((ActivePageOffsets[Page] +
  276.       CARDINAL(Cursors[Page].y) * ORD(BiosCRTParams.CRTCols) +
  277.       CARDINAL(Cursors[Page].x)) * 2);
  278.   END CursorOffset;
  279.  
  280.   PROCEDURE BumpCursor(Page : CARDINAL);
  281.     (* Increment the cursor in the X direction one unit. If the cursor
  282.        falls off the row, reset to beginning of the next row. Rows
  283.        wrap around to the start of the screen *)
  284.   BEGIN
  285.     INC(Cursors[Page].x);
  286.     IF Cursors[Page].x >= INTEGER(BiosCRTParams.CRTCols) THEN
  287.       Cursors[Page].x := 0;
  288.       INC(Cursors[Page].y);
  289.       IF ORD(Cursors[Page].y) > ORD(RowsOnScreen) THEN
  290.         Cursors[Page].y := 0;
  291.       END;
  292.     END;
  293.     IF Page = ActivePage THEN SetCursor(Page); END;
  294.   END BumpCursor;
  295.  
  296.   PROCEDURE SetCursorPoint(Page : CARDINAL; p : Point);
  297.     (* Set the cursor to point 'p'. Don't allow it to fall off
  298.        either edge of the display *)
  299.   BEGIN
  300.     IF p.x < INTEGER(BiosCRTParams.CRTCols) THEN
  301.       Cursors[Page].x := p.x;
  302.     ELSE
  303.       Cursors[Page].x := INTEGER(BiosCRTParams.CRTCols) - 1;
  304.     END;
  305.     IF p.y <= INTEGER(ORD(RowsOnScreen)) THEN
  306.       Cursors[Page].y := p.y;
  307.     ELSE
  308.       Cursors[Page].y := ORD(RowsOnScreen);
  309.     END;
  310.     IF Page = ActivePage THEN SetCursor(Page); END;
  311.   END SetCursorPoint;
  312.  
  313.   PROCEDURE GetCursorPoint(VAR p : Point; Page : CARDINAL);
  314.     (* Return the cursor position for the given page *)
  315.   BEGIN
  316.     p := Cursors[Page];
  317.   END GetCursorPoint;
  318.  
  319.  
  320.   (*--------------------------------------------------*)
  321.   (*    Alpha mode write routines                     *)
  322.   (*--------------------------------------------------*)
  323.  
  324.   PROCEDURE Write(Page : CARDINAL; ch : CHAR; color : INTEGER);
  325.     (* Place one character into the display buffer at the
  326.        cursor. The cursor is moved to the next column.
  327.        Color represents the attribute byte *)
  328.     VAR   x : CARDINAL;
  329.   BEGIN
  330.     x := CursorOffset(Page);
  331.     DisplayBuffer[x] := ch;
  332.     DisplayBuffer[x+1] := CHR(color);
  333.     BumpCursor(Page);
  334.   END Write;
  335.  
  336.   PROCEDURE WriteString(Page : CARDINAL; s : ARRAY OF CHAR;
  337.                         c : CARDINAL);
  338.     (* Place a string into the display buffer at the cursor.
  339.        The string is written one character at a time with
  340.        the attribute byte of c *)
  341.     VAR i : CARDINAL;
  342.   BEGIN
  343.     i := 0;
  344.     WHILE i <= HIGH(s) DO
  345.       Write(Page, s[i], c);
  346.       INC(i);
  347.     END;
  348.   END WriteString;
  349.  
  350.   (*--------------------------------------------------*)
  351.   (*    Virtual page manipulation routines            *)
  352.   (*--------------------------------------------------*)
  353.  
  354.   PROCEDURE SetActivePage(page : CARDINAL);
  355.     (* Set the active display page to 'page' resetting
  356.        any scrolling etc. *)
  357.   BEGIN
  358.     ActivePage := page;
  359.     ResetHorizScroll;
  360.     ResetVerticalScroll;
  361.     IF page <= MaxVideoPages THEN
  362.       ActivePageOffset := ActivePageOffsets[page];
  363.       SetPageOffset(ActivePageOffset);
  364.       SetCursor(page);
  365.     END;
  366.   END SetActivePage;
  367.  
  368.   PROCEDURE MakeSecondGraphicsPage;
  369.     (* This routine abitrarily set the offset to the
  370.        second hi res graphics page *)
  371.   BEGIN
  372.     ActivePageOffset := 8000H;
  373.     SetPageOffset(ActivePageOffset);
  374.     SetBiosPage(1);
  375.   END MakeSecondGraphicsPage;
  376.  
  377.   PROCEDURE ResetVideoPage;
  378.     (* This routine resets the current video page, and
  379.        get rid of any scrolling and split screens, etc. *)
  380.   BEGIN
  381.     SetActivePage(ActivePage);
  382.       ResetSplitScreen;
  383.     END ResetVideoPage;
  384.   (*--------------------------------------------------*)
  385.   (*     Attribute manipulation routines              *)
  386.   (*--------------------------------------------------*)
  387.  
  388.   PROCEDURE SetPalette(Palette, Color : CARDINAL);
  389.     (* This routine sets up the palette RAM in the
  390.        attribute controller with the patern in Color *)
  391.   BEGIN
  392.     WaitForVerticalRetrace;
  393.     EGAOutWord(AttributeCntrl, Palette, Color);
  394.     EGAOutWord(AttributeCntrl, AttrColorPlane+PaletteOn, 0FH);
  395.   END SetPalette;
  396.  
  397.   PROCEDURE SetOverscan(Color : CARDINAL);
  398.     (* This routine sets up the overscan color for a border
  399.        with the patteren in Color *)
  400.   BEGIN
  401.     WaitForVerticalRetrace;
  402.     EGAOutWord(AttributeCntrl, AttrOverscan, Color);
  403.     EGAOutWord(AttributeCntrl, AttrColorPlane+PaletteOn, 0FH);
  404.   END SetOverscan;
  405.  
  406.   PROCEDURE TurnOnBlinking;
  407.   BEGIN
  408.     EGAOutWord(AttributeCntrl, AttrModeControl+PaletteOn, 09H);
  409.   END TurnOnBlinking;
  410.  
  411.   PROCEDURE TurnOffBlinking;
  412.   BEGIN
  413.     EGAOutWord(AttributeCntrl, AttrModeControl+PaletteOn, 01H);
  414.   END TurnOffBlinking;
  415.   (*--------------------------------------------------*)
  416.   (*     Horizontal scrolling routines                *)
  417.   (*--------------------------------------------------*)
  418.  
  419.   PROCEDURE HorScrollLeft;
  420.     (* Horizontal scrolling left means advancing the page offset
  421.        when falling off the pixel box.  The routine is specific
  422.        for 8 pixens per byte *)
  423.   BEGIN
  424.     INC(PelScrollColumn);
  425.     WaitForVerticalDisplay;
  426.     IF PelScrollColumn > 7 THEN
  427.       PelScrollColumn := 0;
  428.       INC(ActivePageOffset);
  429.       SetPageOffset(ActivePageOffset);  (* Does a Wait already *)
  430.       EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn,
  431.                  PelScrollColumn);
  432.     ELSE
  433.       WaitForVerticalDisplay;
  434.       EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn,
  435.                  PelScrollColumn);
  436.     END;
  437.   END HorScrollLeft;
  438.  
  439.   PROCEDURE HorScrollRight;
  440.   BEGIN
  441.     DEC(PelScrollColumn);
  442.     WaitForVerticalDisplay;
  443.     IF PelScrollColumn < 0 THEN
  444.       PelScrollColumn := 7;
  445.       DEC(ActivePageOffset);
  446.       SetPageOffset(ActivePageOffset);
  447.       EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn,
  448.                  PelScrollColumn);
  449.     ELSE
  450.       WaitForVerticalDisplay;
  451.       EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn,
  452.                  PelScrollColumn);
  453.     END;
  454.   END HorScrollRight;
  455.  
  456.   PROCEDURE HorizScroll(pixels : INTEGER);
  457.     VAR i : INTEGER;
  458.   BEGIN
  459.     IF pixels = 0 THEN RETURN; END;
  460.     IF pixels > 0 THEN
  461.       FOR i := 1 TO pixels DO HorScrollLeft; END;
  462.     ELSE
  463.       FOR i := -1 TO pixels BY -1 DO HorScrollRight; END;
  464.     END;
  465.   END HorizScroll;
  466.  
  467.   PROCEDURE ResetHorizScroll;
  468.   BEGIN
  469.     PelScrollColumn :=0;
  470.     WaitForVerticalRetrace;
  471.     EGAOutWord(AttributeCntrl, AttrHorizPelPan+PaletteOn, 0);
  472.   END ResetHorizScroll;
  473.  
  474.      (*-----------------------------------------------*)
  475.      (*         Vertical Scrolling                    *)
  476.      (*      only has meaning in alpha mode           *)
  477.      (*-----------------------------------------------*)
  478.  
  479.   PROCEDURE VerticalScrollUp;
  480.     (* Smooth vertical scroll uses the preset row scan regiater
  481.        in the CRTC. When the row is completely scrolled,
  482.        the offset pointer is advanced by one row size *)
  483.   BEGIN
  484.     INC(VerticalScrollRow); WaitForVerticalDisplay;
  485.     IF VerticalScrollRow >= INTEGER(BytesPerChar) THEN
  486.       ActivePageOffset := ActivePageOffset + BiosCRTParams.CRTCols;
  487.       VerticalScrollRow := 0;
  488.       SetPageOffset(ActivePageOffset);
  489.       EGAOutWord(EGA6845, CRTPreRowScan, VerticalScrollRow);
  490.     ELSE
  491.       WaitForVerticalRetrace;
  492.       EGAOutWord(EGA6845, CRTPreRowScan, VerticalScrollRow);
  493.     END;
  494.   END VerticalScrollUp;
  495.  
  496.   PROCEDURE VerticalScrollDown;
  497.     (* Vertical scrolling down is the same as up except the row
  498.        changes backward, each character row is brought down a line
  499.        at a time by setting the preset row scan register to the
  500.        high value and decrementing it. *)
  501.   BEGIN
  502.     DEC(VerticalScrollRow); WaitForVerticalDisplay;
  503.     IF VerticalScrollRow < 0 THEN
  504.       ActivePageOffset := ActivePageOffset - BiosCRTParams.CRTCols;
  505.       VerticalScrollRow := BytesPerChar - 1;
  506.       SetPageOffset(ActivePageOffset);
  507.       EGAOutWord(EGA6845, CRTPreRowScan, VerticalScrollRow);
  508.     ELSE
  509.       WaitForVerticalRetrace;
  510.       EGAOutWord(EGA6845, CRTPreRowScan, VerticalScrollRow);
  511.     END;
  512.   END VerticalScrollDown;
  513.  
  514.   PROCEDURE ResetVerticalScroll;
  515.   BEGIN
  516.     WaitForVerticalRetrace;
  517.     EGAOutWord(EGA6845, CRTPreRowScan, 0);
  518.     VerticalScrollRow := 0;
  519.   END ResetVerticalScroll;
  520.   (*--------------------------------------------------*)
  521.   (*    Split screen routines                         *)
  522.   (*         The split screen starts at offset in the *)
  523.   (*         display buffer                           *)
  524.   (*--------------------------------------------------*)
  525.  
  526.   PROCEDURE SplitScreenAt(ScanLine : CARDINAL);
  527.     (* Splitting the screen uses the Line Compare Register of
  528.        the CRTC. The overflow for the 9th bit is placed in the
  529.        CRTC's overflow register. The screen splits when the
  530.        current video scan line equals the designated value
  531.        in those two registers *)
  532.     VAR Line : Register;
  533.   BEGIN
  534.     Line.X := ScanLine;
  535.     IF Line.H <> 0C THEN
  536.       CRTCOverflowRegister := CRTCOverflowRegister + {4};
  537.     ELSE
  538.       CRTCOverflowRegister := CRTCOverflowRegister - {4}; END;
  539.     WaitForVerticalDisplay;  WaitForVerticalRetrace;
  540.     EGAOutWord(EGA6845, CRTLineCompare, ORD(Line.L));
  541.     EGAOutWord(EGA6845, CRTOvflo,
  542.                CARDINAL(CRTCOverflowRegister));
  543.     SplitScreenLine := ScanLine;
  544.   END SplitScreenAt;
  545.  
  546.   PROCEDURE RollSplitScreenUp(SplitSizeLines : CARDINAL);
  547.     (* Smoothly bring up the split screen with a delay between
  548.        each line as it is brought up.  *)
  549.     VAR Line : CARDINAL;
  550.   BEGIN
  551.     Line := TotalVerticalScanLines - 1;
  552.     WHILE Line > TotalVerticalScanLines - SplitSizeLines DO
  553.       SplitScreenAt(Line);
  554.       DEC(Line);
  555.        WaitForVerticalRetrace;
  556.      END;
  557.   END RollSplitScreenUp;
  558.  
  559.   PROCEDURE RollSplitScreenDown;
  560.     (* This routine smoothly rolls the split screen back down *)
  561.     VAR Line : CARDINAL;
  562.   BEGIN
  563.     Line := TotalVerticalScanLines + 1;
  564.     WHILE Line < TotalVerticalScanLines DO
  565.       SplitScreenAt(Line);
  566.       INC(Line);
  567.       WaitForVerticalRetrace;
  568.     END;
  569.   END RollSplitScreenDown;
  570.   PROCEDURE ResetSplitScreen;
  571.     (* This routine pops the split screen back down, no scrolling
  572.        is performed. *)
  573.   BEGIN
  574.     SplitScreenAt(BottomOfScreen);
  575.   END ResetSplitScreen;
  576.  
  577.   (*--------------------------------------------------*)
  578.   (*       Graphics routines                          *)
  579.   (*--------------------------------------------------*)
  580.  
  581.   PROCEDURE FillGraphicsPage(Color : CARDINAL);
  582.     (* Modify to use writing mode 2: Set every bit in bit plane N
  583.        Equal to Bit N of the data bytes. Useful for rapid flooding
  584.        of the display ram with a particular palette. *)
  585.     VAR x1, y1 : CARDINAL;
  586.   BEGIN
  587.     EGAOutWord(Graph12, GraphModeReg, 2);
  588.     FOR x1 := 0 TO BiosCRTParams.CRTCols -1 DO
  589.       FOR y1 := 0 TO 349 DO
  590.         DisplayBuffer[ActivePageOffset + x1 +
  591.                       BiosCRTParams.CRTCols * y1] := CHR(Color);
  592.       END;
  593.     END;
  594.     EGAOutWord(Graph12, GraphModeReg, 0);
  595.   END FillGraphicsPage;
  596.  
  597.   PROCEDURE DrawPointTutorial(p : Point; color : CARDINAL);
  598.   (* This procedure demonstrates the method for turning on
  599.      one pixel. A faster version is below with key parts reduced
  600.      to machine level code *)
  601.   (* Turn on a dot at 'p', setting its 'color'. *)
  602.     VAR rowbyte, bitmask, byteoffset : CARDINAL;
  603.         Temp : CHAR;
  604.   BEGIN
  605.     (* Here compute the address of the pixel byte to change,
  606.        and its bit offset within the byte. *)
  607.     rowbyte := p.x DIV 8;  bitmask := p.x MOD 8;
  608.     bitmask := bitmasks[bitmask];
  609.     byteoffset := CARDINAL(p.y) * BiosCRTParams.CRTCols + rowbyte
  610.                      + ActivePageOffset;
  611.     VIDEORAM.off := byteoffset;
  612.     (* Select Graphics Bit Mask Register to mask
  613.        out all but the desired pixel *)
  614.     EGAOutWord(Graph12, GraphBitMask, bitmask);
  615.     (* Select sequencer map mask to enable all four
  616.       maps and latches aven if 2 are present *)
  617.     EGAOutWord(Sequencer, SequenceMapMask, 0FH);
  618.     (* Now read the character to latch it in to the 4 EGA plane
  619.        latches. The value read is of no importance *)
  620.     Temp := VIDEORAM.adr^;
  621.     (* Now blank out the all bytes, to clear out the desired
  622.        pixel. Remember the other bits are still latched in, and
  623.        will be preserved during this operation. *)
  624.     VIDEORAM.adr^ := 0c;
  625.     (* Select sequencer Map Mask to enable only writing to those
  626.        bit planes with bits corresponding to the selected palette *)
  627.     EGAOutWord(Sequencer, SequenceMapMask, color);
  628.     (* Now write all bits out in parallel. The sequencer map
  629.        mask and the board latches preserve all pixels except
  630.        that to be set. *)
  631.     VIDEORAM.adr^ := CHR(0FFH);
  632.     (* Normalize the enviroment, by resetting the masks and
  633.        the data rotation redister *)
  634.     EGAOutWord(Sequencer, SequenceMapMask, 0FH);
  635.     EGAOutWord(Graph12, GraphDataRotate, 0);
  636.     EGAOutWord(Graph12, GraphBitMask, 0FFH);
  637.   END DrawPointTutorial;
  638.  
  639. (*$R-*)(*$S-*)(*$T-*)  (* Turn off overhead for calls to speed *)
  640.  
  641.   PROCEDURE DrawPoint(p : Point; color : CARDINAL);
  642.   (* Turn on a dot at 'p', with setting color *)
  643.     VAR
  644.       A : Register;
  645.       rowbyte, bitmask, byteoffset : CARDINAL;
  646.   BEGIN
  647.     rowbyte := p.x DIV 8; (* After a divide dx has modulus *)
  648.     GETREG(DX, bitmask);
  649.     bitmask := bitmasks[bitmask];
  650.     byteoffset := CARDINAL(p.y) * BiosCRTParams.CRTCols + rowbyte
  651.                  + ActivePageOffset;
  652.     SETREG(ES, VIDEORAM.seg);    SETREG(BX, byteoffset);
  653.     SETREG(CX, color);           SETREG(AX, bitmask);
  654.     CODE ( 88h, 0c4h, 0b0h, 08h, 0bah, 0ceh, 03h, 0efh, 0b8h, 02h,
  655.           0ffh, 0b2h, 0c4h, 0efh, 26h, 08ah, 2fh, 26h, 0c6h, 07h,
  656.           00h, 88h, 0cch, 0efh, 026h, 0c6h, 07h, 0ffh, 0b4h, 0ffh,
  657.           0efh, 0b2h, 0ceh, 0b8h, 03h, 00h, 0efh, 0b8h, 08h, 0ffh,
  658.           0efh);
  659.   END DrawPoint;
  660.  
  661. (*$R+*)(*$S+*)(*$T+*)
  662.  
  663.   (*--------------------------------------------------*)
  664.   (*         BIOS Interface Routines                  *)
  665.   (*--------------------------------------------------*)
  666.  
  667.   PROCEDURE LoadBiosFont(Font : FontType; ResetFlag : BOOLEAN;
  668.                          Block : CARDINAL);
  669.     VAR A : Register;
  670.   BEGIN
  671.     A.H := CHR(CharacterGeneratorFunction);
  672.     A.L := CHR(ORD(Font));
  673.     IF ResetFlag THEN A.L := CHR(ORD(A.L) + 011H);
  674.                  ELSE A.L := CHR(ORD(A.L) + 01H) END;
  675.     SETREG(AX, A.X);
  676.     SETREG(BX, Block);
  677.     SWI(VIDEO);
  678.   END LoadBiosFont;
  679.  
  680.   PROCEDURE LoadUserFont(VAR Font : ARRAY OF CHAR; ResetFlag : BOOLEAN;
  681.                          Block, Count, Points : CARDINAL);
  682.     VAR A, B : Register;
  683.         f : ADDRESS;
  684.   BEGIN
  685.     A.H := CHR(CharacterGeneratorFunction);
  686.     IF ResetFlag THEN A.L := CHR(010H);
  687.                  ELSE A.L := CHR(00H) END;
  688.     B.H := CHR(Points);    B.L := CHR(Block);
  689.     SETREG(CX, Count);     SETREG(BX, B.X);
  690.     SETREG(AX, A.X);       CODE(PushBP); (*Save out BP *)
  691.     SETREG(ES, f.SEGMENT); SETREG(DX, f.OFFSET);
  692.     CODE(89h, 0d5h); (* MOV bp, dx ;Set BP to point at font *)
  693.     SETREG(DX, 0);         SWI(VIDEO);
  694.     CODE(PopBP);  (*Restore the BP *)
  695.   END LoadUserFont;
  696.  
  697.   PROCEDURE GetAlternatePrintScreen;
  698.   BEGIN
  699.     SETREG(AX, 01200H);    SETREG(BX, 0020H);
  700.     SWI(VIDEO);
  701.   END GetAlternatePrintScreen;
  702.  
  703.   PROCEDURE SetBiosPage(Page : CARDINAL);
  704.     VAR A : Register;
  705.   BEGIN
  706.     A.H := CHR(SetPageBiosCall); A.L := CHR(Page);
  707.     SETREG(AX, A.X); SWI(VIDEO);
  708.   END SetBiosPage;
  709.  
  710.   PROCEDURE SetBiosPalette(Palette, Color : CARDINAL);
  711.     VAR A, B : Register;
  712.   BEGIN
  713.     A.H := CHR(SetPaletteCall); A.L := 0C;
  714.     B.H := CHR(Color); B.L := CHR(Palette);
  715.     SETREG(BX, B.X); SETREG(AX, A.X);
  716.     SWI(VIDEO);
  717.   END SetBiosPalette;
  718.  
  719.   PROCEDURE SetModeBios(Mode : CARDINAL);
  720.   BEGIN
  721.     SETREG(AX, Mode);
  722.     SWI(VIDEO);
  723.   END SetModeBios;
  724.  
  725.   PROCEDURE SetBiosCursorPoint(Page : CARDINAL; p : Point);
  726.     VAR A, B, D : Register;
  727.   BEGIN
  728.     A.H := CHR(SetCPos);  A.L := 0C;
  729.     A.H := CHR(Page);     B.L := 0C;
  730.     D.H := CHR(p.y);      D.L := CHR(p.x);
  731.     SETREG(DX, D.X);      SETREG(BX, B.X);
  732.     SETREG(AX, A.X);      SWI(VIDEO);
  733.   END SetBiosCursorPoint;
  734.  
  735.   PROCEDURE WriteBios(c : CHAR; color : CARDINAL);
  736.     VAR A, B : Register;
  737.   BEGIN
  738.     A.H := CHR(WriteTTY); A.L := c;
  739.     B.H := 0C;            B.L := CHR(color);
  740.     SETREG(BX, B.X);      SETREG(AX, A.X);
  741.     SWI(VIDEO);
  742.   END WriteBios;
  743.  
  744.   PROCEDURE WriteBiosString(msg : ARRAY OF CHAR; color : CARDINAL);
  745.     VAR i : CARDINAL;
  746.   BEGIN
  747.     i := 0;
  748.     WHILE i <= HIGH(msg) DO
  749.       WriteBios(msg[i], color);
  750.       INC(i);
  751.     END;
  752.   END WriteBiosString;
  753.  
  754.   PROCEDURE PrintScreen;
  755.   BEGIN
  756.     SWI(05H);
  757.   END PrintScreen;
  758.  
  759.  
  760. BEGIN
  761.   VIDEORAM.seg := 0a000H;    VIDEORAM.off := 0;
  762.   bitmasks[7] := 1;          bitmasks[6] := 2;
  763.   bitmasks[5] := 4;          bitmasks[4] := 8;
  764.   bitmasks[3] := 16;         bitmasks[2] := 32;
  765.   bitmasks[1] := 64;         bitmasks[0] := 128;
  766.   MakePoint(Cursors[0], 0, 0);
  767.   FOR i := 1 TO MaxVideoPages DO Cursors[i] := Cursors[0]; END;
  768.   FOR i := 0 TO MaxVideoPages DO
  769.        ActivePageOffsets[i] := i * AlphaPageSize; END;
  770.   PelScrollColumn := 0; VerticalScrollRow := 0;
  771.   TotalVerticalScanLines := TotalScanLinesEnhanced;
  772.   ActivePage := 0;
  773. END LowEGA.
  774.