home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / SVGADC30 / SVGA.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-03  |  42KB  |  1,603 lines
  1. Unit SVGA;
  2.  
  3. INTERFACE
  4.  
  5. const
  6.    ButtonL = 0; ButtonR = 1; ButtonM = 2;
  7.    OFF      = 0;  ON       = 1;
  8.  
  9. Type
  10.   RGB = record
  11.         Red, Grn, Blu : byte
  12.         end;
  13.   PaletteRegister = array[0..255] of RGB;
  14.   SetTypes = ( FutureFont, StandardFont );
  15.   ResType = ( VGA, SVGA6440, SVGA6448, SVGA8060, SVGA1076 );
  16.   Position = record
  17.                BtnStatus,
  18.                opCount,
  19.                XPos, YPos : integer;
  20.              end;
  21.   EventRec = record
  22.                Event,
  23.                BtnStatus,
  24.                XPos, YPos : word;
  25.              end;
  26.   YPtr = ^YType;
  27.   YType = record
  28.             Col1, Col2, Col3, Col4 : byte; { Due to TP's memory }
  29.             NextY : YPtr;                  { memory management }
  30.           end;                             { pointers are multiples}
  31.    XPtr = ^XType;                           { of 8 bytes }
  32.    XType = record
  33.              NextX : XPtr;
  34.              Y : YPtr;
  35.            end;
  36.  
  37.   GenMouse = object
  38.       procedure SetAccel( threshold : integer );
  39.         { Set Acceleration of mouse }
  40.       procedure Getposition( var BtnStatus, XPos, YPos : integer );
  41.         { Gets the Position of the mouse and returns button status }
  42.       procedure QueryBtnDn( button : integer; var mouse : Position );
  43.         { Checks if queried button was pressed }
  44.       procedure QueryBtnUp( button : integer; var mouse : Position );
  45.         { Checks if queried button is released }
  46.       procedure ReadMove( var XMove, YMove : integer );
  47.         { Reports absolute mouse movement since last call to ReadMove }
  48.       procedure Reset( var Status : boolean; var BtnCount : integer );
  49.         { Resets the mouse to default conditions }
  50.       procedure SetRatio( horPix, verPix : integer );
  51.         { Sets speed of mouse }
  52.       procedure SetLimits( XPosMin, YPosMin, XPosMax, YPosMax : integer );
  53.         { Creates View Port for which mouse can operate in }
  54.       procedure SetPosition( XPos, YPos : integer );
  55.         { Puts mouse to desired point on screen }
  56.    end;
  57.  
  58.   GraphicMouse = object( GenMouse )
  59.     procedure Initialize;
  60.       { Sets default conditons for graphics mouse }
  61.     procedure Show( ShowM : boolean );
  62.       { Either shows or hides the graphics mouse }
  63.     procedure MPlot( xx, yy : integer );
  64.     procedure CheckMouse;
  65.       { Checks if mouse has been moved since last call and moves mouse accordingly }
  66.     procedure ExitSVGA;
  67.       { Exits Graphics mouse and resets it back to text mode }
  68.   end;
  69.  
  70. procedure SetMode( Mode : Restype );
  71.   { Sets Graphics card to desired mode }
  72. function WhichBank( x, y : integer ): byte;
  73.  
  74. procedure LoadWriteBank( Segment : byte );
  75.   { Loads particular bank for read/write operations }
  76. procedure Plot( x, y : integer; Color : byte );
  77.   { Plots a point to screen }
  78. procedure PutImage( x, y : integer; Img : XPtr );
  79.   { Puts an image in memory to screen at point (x,y), top left hand corner }
  80. procedure LoadImage( ImageName : string; var ImagePtr : XPtr );
  81.   { Loads image from disk and puts into memory }
  82. procedure DisposeImage( var Img : XPtr );
  83.   { Deletes image from memory }
  84. procedure SetColor( PalNum: byte; Hue : RGB );
  85.   { Sets Color of a particular pallette }
  86. function  GetPixel( x, y : integer ) : byte;
  87.   { Returns color of a pixel }
  88. procedure SetPalette( Hue : PaletteRegister );
  89.   { Sets all 256 pallette registers to desired pallette }
  90. procedure CyclePalette;
  91.   { Rotates all colors in the pallette in repetitive cycle }
  92. procedure Circle( x, y, Radius : word; Color : byte );
  93.   { Draws a circle }
  94. procedure Line( xx1, yy1, xx2, yy2 : integer; Color : byte );
  95.   { Draws a line }
  96. procedure ClearDevice;
  97.  
  98. procedure ClearPort( x1, y1, x2, y2 : integer );
  99.   { Clears a Section of the screen }
  100. procedure Rectangle( x1, y1, x2, y2 : word; Color : byte );
  101.   { Draws a rectangle outline i.e not solid }
  102. procedure RectFill( x1, y1, x2, y2 : integer; Color : byte );
  103.   { Draws a solid Rectangle }
  104. procedure ExitGraphics;
  105.   { Exits SVGA Graphics and returns to normal text mode }
  106. procedure OutTextXY( x, y : integer; word : string );
  107.   { Writes text to screen at point X, Y }
  108. procedure LoadFont( CharSetName: SetTypes );
  109.   { Loads a particular Font for use }
  110. procedure SetFont( Font : SetTypes );
  111.   { If two or more fonts are in memory this allows you to choose one }
  112. procedure SetFontColor( Color, BackCol : byte; Trans : boolean );
  113.   { Set forground & background color of text & transparent background or not }
  114.   { i.e write background to screen or skip it and only write letter          }
  115. procedure LoadPalette( PaletteName : string );
  116.   { Loads a particular pallette from disk }
  117.  
  118. var  Color : PaletteRegister;
  119.      Bytes_per_Line, GetMaxX, GetMaxY : integer;
  120.      mEvent : EventRec;
  121.      PresentSeg : byte;
  122.  
  123. IMPLEMENTATION
  124.  
  125. Uses Dos, Crt;
  126.  
  127. type  FCharType = array[ 0..15, 0..12 ] of boolean;
  128.       FCharSetType = array[ 0..95 ] of FCharType;
  129.       SCharType = array[ 0..7, 0..9 ] of boolean;
  130.       SCharSetType = array[ 0..95 ] of SCharType;
  131.       CardType = ( AheadA, AheadB, ATI, ChipsTech, Everex, Genoa,
  132.                   Paradise, Trident, Tseng3000, Tseng4000, Video7 );
  133.       NameType = string[30];
  134.  
  135. var
  136.   Mxx, Mxy, Mnx, Mny, XRes, YRes, X, Y, OldX, OldY : integer;
  137.   regs : registers;
  138.   Future : ^FCharSetType;
  139.   Standard : ^SCharSetType;
  140.   Width, Height, FontColor, BackGroundColor : byte;
  141.   PresentSet : SetTypes;
  142.   ShowMouse, Transparent, Sused, Fused : boolean;
  143.   Card : CardType;
  144.   MP, ColOld : array[ 0..3, 0..3 ] of byte;
  145.  
  146.  
  147. function Ahead : NameType;
  148.  
  149.   begin
  150.     Portw[$3CE] := $200F;
  151.     if Port[$3CF] = $20 then Ahead := 'Ahead A'
  152.       else if Port[$3CF] = $21 then Ahead := 'Ahead B'
  153.         else Ahead := 'False';
  154.   end;
  155.  
  156. function AnATI : NameType;
  157.  
  158.   var s : NameType;
  159.       Temp : string;
  160.  
  161.   begin
  162.     s[0] := #9;
  163.     move(mem[$C000:$31],s[1],9);
  164.     if s = '761295520'then
  165.       begin
  166.         Temp := 'ATI';
  167.         if memw[$C000:$40] = $3331 then
  168.           begin
  169.             Temp := Temp + ' Super VGA';
  170.             Regs.AH := $12;
  171.             Regs.BX := $5506;
  172.             Regs.AL := $55;
  173.             Regs.BP := $FFFF;
  174.             Regs.SI := $0;
  175.             intr( $10, Regs );
  176.             if Regs.BP = $FFFF then Temp := Temp + ' Revision 1'
  177.               else Temp := Temp + ' Revision 2/3';
  178.           end
  179.         else
  180.           Temp := 'False';
  181.         AnATI := Temp;
  182.       end
  183.     else AnATI := 'False';
  184.   end;
  185.  
  186. function AChipsTech : Nametype;
  187.  
  188.   var OldValue, Value : byte;
  189.       Temp : string;
  190.  
  191.   begin
  192.     Port[$3C3] := Port[$3C3] or 16;
  193.     if Port[$104] = $A5 then
  194.       begin
  195.         Temp:= 'Chips & Technologies';
  196.         Port[$3C3] := Port[$3C3] and $EF;
  197.         Port[$3D6] := 0;
  198.         case Port[$3D7] shr 4 of
  199.           2 : Temp := Temp + ' 82c455';
  200.           3 : Temp := Temp + ' 82c453';
  201.           5 : Temp := Temp + ' 82c456';
  202.           1 : begin
  203.                 Port[$3D6] := $3A;
  204.                 OldValue := Port[$3D7];
  205.                 Port[$3D7] := $AA;
  206.                 Value := Port[$3D7];
  207.                 Port[$3D7] := OldValue;
  208.                 if Value = $AA then Temp := Temp + ' 82c452'
  209.                   else Temp := Temp + ' 82c451';
  210.               end;
  211.           end;
  212.         AChipsTech := Temp;
  213.       end
  214.     else AChipsTech := 'False';
  215.   end;
  216.  
  217. function AnEverex : NameType;
  218.  
  219.   var Value : byte;
  220.       s : NameType;
  221.  
  222.   begin
  223.     Regs.AX := $7000;
  224.     Regs.BX := 0;
  225.     intr( $10, Regs );
  226.     if Regs.AL = $70 then
  227.       begin
  228.         Value := Regs.DX shr 4;
  229.         if Value = $678 then AnEverex := 'Everex Ev678'
  230.           else if Value = $236 then AnEverex := 'Everex Ev236'
  231.             else begin
  232.                    str( Value, s );
  233.                    AnEverex := 'Everex Ev'+ s;
  234.                  end;
  235.       end
  236.     else AnEverex := 'False';
  237.   end;
  238.  
  239. function AGenoa : Nametype;
  240.  
  241.   begin
  242.     if (meml[$C000:mem[$C000:$37]] and $FFFF00FF) = $66990077 then
  243.       begin
  244.         case mem[$C000:mem[$C000:$37] + 1] of
  245.           $33, $55 : AGenoa := 'Tseng ET3000';
  246.                $22 : AGenoa := 'Genoa 6100';
  247.                  0 : AGenoa := 'Genoa 6200/6300';
  248.                $11 : AGenoa := 'Genoa 6400/6600';
  249.           end;
  250.       end
  251.     else AGenoa := 'False';
  252.   end;
  253.  
  254. function AParadise : NameType;
  255.  
  256.   var OldValue, NewValue, New1, New2 : byte;
  257.       Base : word;
  258.       Temp : string;
  259.  
  260.    begin
  261.      if meml[$C000:$7D] = $3D414756 then
  262.        begin
  263.          Temp := 'Paradise';
  264.          if odd(Port[$3CC]) then Base:= $3D4
  265.            else Base := $3B4;
  266.          Port[Base] := $2B;  OldValue := Port[Base+1];
  267.          Port[Base+1] := $AA; NewValue := Port[Base+1];
  268.          Port[Base+1] := OldValue;
  269.          if NewValue <> $AA then Temp := Temp + ' PVGA1A'
  270.            else
  271.              begin
  272.                Port[$3C4] := $12; OldValue := Port[$3C5];
  273.                Port[$3C5] := OldValue and $BF; New1 := Port[$3C5] and 64;
  274.                Port[$3C5] := OldValue or $40;  New2 := Port[$3C5] and 64;
  275.                Port[$3C5] := OldValue;
  276.                if (New1 <> 0) or (New2 = 0) then Temp := Temp + ' WD90C00'
  277.                  else
  278.                    begin
  279.                      Port[$3C4] := $10; OldValue := Port[$3C5];
  280.                      Port[$3C5] := OldValue and $FB; New1 := Port[$3C5] and 4;
  281.                      Port[$3C5] := OldValue or 4;    New2 := Port[$3C5] and 4;
  282.                      Port[$3C5] := OldValue;
  283.                      if (New1 <> 0) or (New2 = 0) then Temp := Temp + ' WD90C10'
  284.                        else Temp := Temp + ' WD90C11';
  285.                    end;
  286.              end;
  287.          AParadise := Temp;
  288.        end
  289.      else AParadise := 'False';
  290.    end;
  291.  
  292. function ATrident : NameType;
  293.  
  294.    var OldValue, Value : byte;
  295.        Temp : string;
  296.  
  297.    begin
  298.      Port[$03C4] := $E;
  299.      OldValue := Port[$03C5];
  300.      Port[$03C5] := 0;
  301.      Value := Port[$03C5] AND $F;
  302.      Port[$03C5] := OldValue;
  303.      if Value = $2 then
  304.        begin
  305.          Temp := 'Trident';
  306.          Port[$3C4] := 11;
  307.          if Port[$3C5] = 35 then Temp := Temp + ' 9000'
  308.           else if Port[$3C5] = 3 then Temp := Temp + ' 8900'
  309.            else if Port[$3C5] = 2 then Temp := Temp + ' 8800CS'
  310.             else if Port[$3C5] = 1 then Temp := Temp + ' 8800BR';
  311.          ATrident := Temp;
  312.        end
  313.      else ATrident := 'False';
  314.   end;
  315.  
  316. function ATseng : NameType;
  317.  
  318.   var OldValue, NewValue, Value : byte;
  319.       Base : word;
  320.       Temp : string;
  321.  
  322.   begin
  323.     OldValue := Port[$3CD];
  324.     Port[$3CD] := $55;
  325.     NewValue := Port[$3CD];
  326.     Port[$3CD] := OldValue;
  327.     if NewValue = $55 then
  328.       begin
  329.         Temp := 'Tseng';
  330.         if odd( Port[$3CC] ) then Base := $3C4
  331.           else Base := $3B4;
  332.         Port[Base] := $33; OldValue := Port[Base+1];
  333.         NewValue := OldValue xor 15;
  334.         Port[Base+1] := NewValue;
  335.         Value := Port[Base+1];
  336.         Port[Base+1] := OldValue;
  337.         if Value = NewValue then Temp := Temp + ' ET4000'
  338.           else Temp := Temp + ' ET3000';
  339.         ATseng := Temp;
  340.       end
  341.     else ATseng := 'False';
  342.   end;
  343.  
  344.  
  345. function AVideo7 : NameType;
  346.  
  347.   var Value, OldValue, NewValue : byte;
  348.       Base : word;
  349.       Temp : string;
  350.  
  351.   begin
  352.     if odd( Port[$3CC] ) then Base := $3D4
  353.       else Base := $3B4;
  354.     Port[Base] := 12; OldValue := Port[Base+1];
  355.     Port[Base+1] := $55; NewValue := Port[Base+1];
  356.     Port[Base] := $1F; Value := Port[Base+1];
  357.     Port[Base] := 12; Port[Base+1] := OldValue;
  358.     if Value = byte( $55 xor $EA ) then
  359.       begin
  360.         Temp := 'Video7';
  361.         Port[$3C4] := $8E;
  362.         case Port[$3C5] of
  363.           $80..$FF : Temp := Temp + ' VEGA VGA';
  364.           $70..$7F : Temp := Temp + ' V7VGA FASTWRITE/VRAM';
  365.           $50..$59 : Temp := Temp + ' V7VGA Version 5';
  366.           $41..$49 : Temp := Temp + ' 1024i';
  367.         end;
  368.         AVideo7 := Temp;
  369.       end
  370.     else AVideo7 := 'False';
  371.   end;
  372.  
  373.  
  374. procedure NoMode;
  375.  
  376.   begin
  377.     writeln;
  378.     write( ' Mode not supported.' );
  379.     Halt(1);
  380.   end;
  381.  
  382.  
  383. procedure SetMode( Mode : ResType );
  384.  
  385.   var ModeNum, i : byte;
  386.       Tp: NameType;
  387.       Tmp : real;
  388.  
  389.   begin
  390.     TextColor( LightRed );  writeln; writeln;
  391.     if Ahead <> 'False' then
  392.       begin
  393.         Tp := Ahead;
  394.         if Tp = 'Ahead A' then Card := AheadA
  395.           else Card := AheadB;
  396.         case Mode of
  397.           VGA      : ModeNum := $13;
  398.           SVGA6440 : ModeNum := $60;
  399.           SVGA6448 : ModeNum := $61;
  400.           SVGA8060 : ModeNum := $62;
  401.           SVGA1076 : ModeNum := $63;
  402.         end;
  403.         if (ModeNum = $63) and (Card = AheadA) then NoMode;
  404.       end
  405.     else if AnATI <> 'False' then
  406.       begin
  407.         Tp := AnATI;
  408.         case Mode of
  409.           VGA      : ModeNum := $13;
  410.           SVGA6440 : ModeNum := $61;
  411.           SVGA6448 : ModeNum := $62;
  412.           SVGA8060 : ModeNum := $63;
  413.         end;
  414.         if Mode=SVGA1076 then NoMode;
  415.         Card := ATI;
  416.       end
  417.     else if AChipsTech <> 'False' then
  418.       begin
  419.         Tp := AChipsTech;
  420.         if ((Tp='Chips & Technologies 82c452') or
  421.             (Tp='Chips & Technologies 82c453')) then
  422.            begin
  423.              case Mode of
  424.                VGA      : ModeNum := $13;
  425.                SVGA6440 : ModeNum := $78;
  426.                SVGA6448 : ModeNum := $79;
  427.                SVGA8060 : ModeNum := $7C;
  428.                SVGA1076 : ModeNum := $7E;
  429.              end;
  430.              if (Mode=SVGA1076) or ((Mode in [SVGA8060,SVGA1076]) and
  431.                 (Tp = 'Chips & Technologies 82c452')) then
  432.                   NoMode;
  433.              Card := ChipsTech;
  434.            end
  435.         else
  436.           NoMode;
  437.       end
  438.     else if AnEverex <> 'False' then
  439.       begin
  440.         Tp := AnEverex;
  441.         case Mode of
  442.           VGA      : ModeNum := $13;
  443.           SVGA6440 : ModeNum := $14;
  444.           SVGA6448 : ModeNum := $30;
  445.           SVGA8060 : ModeNum := $31;
  446.           SVGA1076 : ModeNum := $32;
  447.         end;                            { ??? How about Trident Chips }
  448.         if (Tp = 'Everex Ev678') or (Tp = 'Everex Ev236') then
  449.           Card := Trident   { 678, 236 Chips use Trident }
  450.         else Card := Everex;
  451.       end
  452.     else if AGenoa <> 'False' then
  453.       begin
  454.         Tp := AGenoa;
  455.         if Tp = 'Tseng 3000' then
  456.           begin
  457.             case Mode of
  458.               VGA      : ModeNum := $13;
  459.               SVGA6440 : ModeNum := $2F;
  460.               SVGA6448 : ModeNum := $2E;
  461.               SVGA8060 : ModeNum := $30;
  462.             end;
  463.             if Mode=SVGA1076 then NoMode;
  464.             Card := Tseng3000;
  465.           end
  466.         else
  467.           begin
  468.             case Mode of
  469.               VGA      : ModeNum := $13;
  470.               SVGA6440 : ModeNum := $7E;
  471.               SVGA6448 : ModeNum := $5C;
  472.               SVGA8060 : ModeNum := $6C;
  473.             end;
  474.             if Mode=SVGA1076 then NoMode;
  475.             Card := Genoa;
  476.           end;
  477.       end
  478.     else if AParadise <> 'False' then
  479.       begin
  480.         Tp := AParadise;
  481.         case Mode of
  482.           VGA      : ModeNum := $13;
  483.           SVGA6440 : ModeNum := $5E;
  484.           SVGA6448 : ModeNum := $5F;
  485.           SVGA8060 : ModeNum := $5C;
  486.         end;
  487.         if (Mode=SVGA1076) or ((Mode=SVGA8060) and not(Tp='Paradise WD90C11')) then
  488.           NoMode;
  489.         Card := Paradise;
  490.       end
  491.     else if ATrident <> 'False'then
  492.       begin
  493.         Tp := ATrident;
  494.         case Mode of
  495.           VGA      : ModeNum := $13;
  496.           SVGA6440 : ModeNum := $5C;
  497.           SVGA6448 : ModeNum := $5D;
  498.           SVGA8060 : ModeNum := $5E;
  499.           SVGA1076 : ModeNum := $62;
  500.         end;
  501.         if (Mode in [SVGA8060,SVGA1076]) and ((Tp='Trident 8800CS') or (Tp='Trident 8800CS')) then
  502.           NoMode;
  503.         Card := Trident;
  504.       end
  505.     else if ATseng <> 'False' then
  506.       begin
  507.         Tp := ATseng;
  508.         case Mode of
  509.           VGA      : ModeNum := $13;
  510.           SVGA6440 : ModeNum := $2F;
  511.           SVGA6448 : ModeNum := $2E;
  512.           SVGA8060 : ModeNum := $30;
  513.           SVGA1076 : ModeNum := $38;
  514.         end;
  515.         if (Mode=SVGA1076) and (Tp='Tseng ET3000') then
  516.           NoMode;
  517.         if Tp = 'Tseng ET3000' then Card := Tseng3000
  518.           else Card := Tseng4000;
  519.       end
  520.     else if AVideo7 <> 'False' then
  521.       begin
  522.         Tp := AVideo7;
  523.         case Mode of
  524.           VGA      : ModeNum := $13;
  525.           SVGA6440 : ModeNum := $66;
  526.           SVGA6448 : ModeNum := $67;
  527.           SVGA8060 : ModeNum := $69;
  528.         end;
  529.         if Mode = SVGA1076 then NoMode;
  530.         Card := Video7;
  531.       end
  532.     else
  533.       begin
  534.         write( 'Graphics card Unrecognizable......' );
  535.         Halt( 1 );
  536.       end;
  537.     case Mode of
  538.       VGA      : begin
  539.                    Bytes_per_line := 320;
  540.                    GetMaxX := 319;
  541.                    GetMaxY := 199;
  542.                  end;
  543.       SVGA6440 : begin
  544.                    Bytes_per_line := 640;
  545.                    GetMaxX := 639;
  546.                    GetMaxY := 399;
  547.                  end;
  548.       SVGA6448 : begin
  549.                    Bytes_per_line := 640;
  550.                    GetMaxX := 639;
  551.                    GetMaxY := 479;
  552.                  end;
  553.       SVGA8060 : begin
  554.                    Bytes_per_line := 800;
  555.                    GetMaxX := 799;
  556.                    GetMaxY := 599;
  557.                  end;
  558.       SVGA1076 : begin
  559.                    Bytes_per_line := 1024;
  560.                    GetMaxX := 1023;
  561.                    GetMaxY := 767;
  562.                  end;
  563.     end;
  564.     write( Tp, ' Card Detected' );
  565.     delay( 10 );
  566.     if Card <> Video7 then
  567.       begin
  568.         Regs.AH := 0;
  569.         Regs.AL := ModeNum;
  570.         intr( $10, Regs );
  571.       end;
  572.     if Card = ATI then                { Certain cards have to be  }
  573.       asm                             { initialized before use    }
  574.         push es
  575.         push bx
  576.         mov ax, 0c000h
  577.         mov es, ax
  578.         mov bx, 10h
  579.         mov dx, es:[bx]
  580.         pop bx
  581.         pop es
  582.         mov al, 0beh
  583.         out dx, al
  584.         inc dl
  585.         in al, dx
  586.         mov ah, al
  587.         and ah, 0f7h
  588.         dec dl
  589.         mov al, 0beh
  590.         out dx, ax
  591.       end;
  592.       if Card = ChipsTech then
  593.         asm
  594.           mov dx, 3d6h
  595.           mov al, 0bh
  596.           out dx, al
  597.           in al, dx
  598.           and al, 0fdh
  599.           out dx, al
  600.         end;
  601.       if Card = Paradise then
  602.         asm
  603.           mov dx, 3ceh
  604.           mov al, 0fh
  605.           mov ah, 05h
  606.           out dx, ax
  607.           add dx, 4
  608.           mov al, 29h
  609.           mov ah, 85h
  610.           out dx, ax
  611.           mov dx, 3c4h
  612.           mov al, 06h
  613.           mov ah, 48h
  614.           out dx, ax
  615.           mov dx, 3c4h
  616.           mov al, 11h
  617.           out dx, al
  618.           inc dx
  619.           in  al, dx
  620.           and al, 7fh
  621.           out dx, al
  622.           mov dx, 3ceh
  623.           mov al, 0bh
  624.           out dx, al
  625.           inc dx
  626.           in  al, dx
  627.           and al, 0f7h
  628.           out dx, al
  629.         end;
  630.       if Card = Video7 then
  631.          asm
  632.            mov bx, 67h
  633.            mov ax, 6f05h
  634.            int 10h
  635.            mov dx, 3c4h
  636.            mov al, 6
  637.            mov ah, 0eah
  638.            out dx, ax
  639.          end;
  640.   end;
  641.  
  642. procedure LoadWriteBank( Segment : byte );
  643.  
  644.  
  645.   begin
  646.     PresentSeg := Segment;
  647.     if Card = Trident then
  648.         asm
  649.           mov bl, Segment
  650.           mov dx, 3c4h
  651.           mov al, 0eh
  652.           xor bl, 02
  653.           mov ah, bl
  654.           out dx, ax
  655.         end
  656.     else if Card = Tseng3000 then
  657.         asm
  658.           mov bl, Segment
  659.           mov dx, 3cdh
  660.           in  al, dx
  661.           and al, 0f8h
  662.           and bl, 07h
  663.           or  al, bl
  664.           out dx, al
  665.         end
  666.     else if Card = Tseng4000 then
  667.         asm
  668.           mov bl, Segment
  669.           mov dx, 3cdh
  670.           in  al, dx
  671.           and al, 0f0h
  672.           and bl, 0fh
  673.           or  al, bl
  674.           out dx, al
  675.         end
  676.       else if Card = Paradise then
  677.         asm
  678.           mov bl, Segment
  679.           mov dx, 3ceh
  680.           mov al, 09h
  681.           mov ah, bl
  682.           shl ah, 1
  683.           shl ah, 1
  684.           shl ah, 1
  685.           shl ah, 1
  686.           out dx, ax
  687.         end
  688.       else if Card = Genoa then
  689.         asm
  690.           mov bl, Segment
  691.           mov dx, 3c4h
  692.           mov al, 06h
  693.           out dx, al
  694.           inc dx
  695.           in  al, dx
  696.           and al, 0c7h
  697.           and bl, 07h
  698.           shl bl, 1
  699.           shl bl, 1
  700.           shl bl, 1
  701.           or  al, bl
  702.           out dx, al
  703.         end
  704.       else if Card = ChipsTech then
  705.         asm
  706.           mov bl, Segment
  707.           mov dx, 3d6h
  708.           mov al, 10h
  709.           mov ah, bl
  710.           shl ah, 1
  711.           shl ah, 1
  712.           out dx, ax
  713.         end
  714.       else if Card = ATI then
  715.         asm
  716.           mov bl, Segment
  717.           push es
  718.           push bx
  719.           mov ax, 0c000h
  720.           mov es, ax
  721.           mov bx, 10h
  722.           mov dx, es:[bx]
  723.           pop bx
  724.           pop es
  725.           mov al, 0b2h
  726.           out dx, al
  727.           inc dl
  728.           in al, dx
  729.           mov ah, al
  730.           and ah, 0e1h
  731.           shl bl, 1
  732.           or ah, bl
  733.           mov al, 0b2h
  734.           dec dl
  735.           out dx, ax
  736.         end
  737.       else if Card = Video7 then
  738.       { This is for the V7VGA Chip Versions 1-3 }
  739.       { Version 4 is different }
  740.         asm
  741.           mov bl, Segment
  742.           mov dx, 3c4h
  743.           mov ah, bl
  744.           and ah, 1
  745.           mov al, 0f9h
  746.           out dx, ax
  747.  
  748.           mov ah, bl
  749.           and ah, 2
  750.           shl ah, 1
  751.           shl ah, 1
  752.           shl ah, 1
  753.           shl ah, 1
  754.           mov dx, 3cch
  755.  
  756.           in  al, dx
  757.           and al, 0dfh
  758.           mov dx, 3c2h
  759.  
  760.           or  al, ah
  761.           out dx, al
  762.  
  763.           mov dx, 3c4h
  764.           mov al, 0f6h
  765.           out dx, al
  766.           inc dx
  767.           in  al, dx
  768.  
  769.           mov ah, al
  770.           and ah, 0fch
  771.           shr bl, 1
  772.  
  773.           shr bl, 1
  774.           and bl, 3
  775.           or  ah, bl
  776.           mov al, ah
  777.           out dx, al
  778.         end;
  779.   end;
  780. { *** }
  781.  
  782. function WhichBank( x, y : integer ): byte;
  783.  
  784.   begin
  785.     WhichBank := (longint( Bytes_per_line) * y + x) shr 16;
  786.   end;
  787.  
  788. procedure Plot( x, y : integer; Color : byte );
  789.  
  790.   var Segment : byte;
  791.  
  792.   begin
  793.    Segment := WhichBank( x, y );
  794.    if Segment <> PresentSeg then LoadWriteBank( Segment );
  795.     asm
  796.       mov ax, Bytes_per_Line
  797.       mov bx, y
  798.       mul bx
  799.       add ax, x
  800.       mov di, ax
  801.       mov ax, 0a000h
  802.       mov es, ax
  803.       mov al, Color
  804.       mov es:[di], al
  805.     end;
  806.   end;
  807.  
  808. procedure PutImage( x, y : integer; Img : XPtr );
  809.  
  810.   var xx, yy : integer;
  811.       Offset, bank : longint;
  812.  
  813.  
  814.   procedure TraverseYPtr( Yp : YPtr );
  815.  
  816.     begin
  817.       if Yp <> nil then
  818.         begin
  819.  
  820.           Bank := Offset shr 16;
  821.           if Bank <> PresentSeg then LoadWriteBank( Bank );
  822.           MEM[$A000:Offset] := Yp^.Col1;
  823.  
  824.           inc( Offset, Bytes_per_line );
  825.           Bank := Offset shr 16;
  826.           if Bank <> PresentSeg then LoadWriteBank( Bank );
  827.           MEM[$A000:Offset] := Yp^.Col2;
  828.  
  829.           inc( Offset, Bytes_per_line );
  830.           Bank := Offset shr 16;
  831.           if Bank <> PresentSeg then LoadWriteBank( Bank );
  832.           MEM[$A000:Offset] := Yp^.Col3;
  833.  
  834.           inc( Offset, Bytes_per_line );
  835.           Bank := Offset shr 16;
  836.           if Bank <> PresentSeg then LoadWriteBank( Bank );
  837.           MEM[$A000:Offset] := Yp^.Col4;
  838.  
  839.           inc( Offset, Bytes_per_line );
  840.           inc( yy, 4 );
  841.           TraverseYPtr( Yp^.NextY );
  842.         end;
  843.     end;
  844.  
  845.   procedure TraverseXPtr( Xp : XPtr );
  846.  
  847.     begin
  848.       if Xp <> nil then
  849.         begin
  850.           Offset := (longint(yy)*Bytes_per_line)+xx;
  851.           TraverseYPtr( Xp^.Y );
  852.           yy := y;
  853.           inc( xx );
  854.           TraverseXPtr( Xp^.NextX );
  855.         end;
  856.     end;
  857.  
  858.   begin
  859.     xx := x;
  860.     yy := y;
  861.     TraverseXPtr( Img );
  862.   end;
  863.  
  864. procedure LoadImage( ImageName : string; var ImagePtr : XPtr );
  865.  
  866.   var f : file of byte;
  867.       MaxWidth, MaxHeight, Col1, Col2, Col3, Col4, th : byte;
  868.  
  869.   procedure ReadY( var Yp : YPtr );
  870.  
  871.     var TmpY : YPtr;
  872.  
  873.     begin
  874.       new( TmpY );
  875.       read( f, Col1, Col2, Col3, Col4 );
  876.       TmpY^.Col1 := Col1;
  877.       TmpY^.Col2 := Col2;
  878.       TmpY^.Col3 := Col3;
  879.       TmpY^.Col4 := Col4;
  880.       inc( th, 4 );
  881.       if th < MaxHeight then
  882.         ReadY( TmpY^.NextY )
  883.       else
  884.         TmpY^.NextY := nil;
  885.       Yp := TmpY;
  886.     end;
  887.  
  888.   procedure ReadX( var Xp : XPtr );
  889.  
  890.     var TmpX : XPtr;
  891.  
  892.     begin
  893.       if not eof( f ) then
  894.         begin
  895.           new( TmpX );
  896.           ReadY( TmpX^.Y );
  897.           th := 1;
  898.           ReadX( TmpX^.NextX );
  899.           Xp := TmpX;
  900.         end
  901.       else
  902.         Xp := nil;
  903.     end;
  904.  
  905.   begin
  906.     assign( f, ImageName );
  907.     reset( f );
  908.     read( f, MaxWidth, MaxHeight );
  909.     th := 1;
  910.     ReadX( ImagePtr );
  911.     close( f );
  912.   end;
  913.  
  914. procedure DisposeImage( var Img : XPtr );
  915.  
  916.   procedure TraverseYPtr( Yp : YPtr );
  917.  
  918.     begin
  919.       if Yp <> nil then
  920.         begin
  921.           TraverseYPtr( Yp^.NextY );
  922.           Dispose( Yp );
  923.         end;
  924.     end;
  925.  
  926.   procedure TraverseXPtr( Xp : XPtr );
  927.  
  928.     begin
  929.       if Xp <> nil then
  930.         begin
  931.           TraverseXPtr( Xp^.NextX );
  932.           TraverseYPtr( Xp^.Y );
  933.         end;
  934.     end;
  935.  
  936.   begin
  937.     TraverseXPtr( Img );
  938.     Img := nil;
  939.   end;
  940.  
  941. procedure SetColor( PalNum: byte; Hue : RGB );
  942.  
  943.   begin
  944.     Color[ PalNum ] := Hue;
  945.     with regs do
  946.       begin
  947.         AX := $1010;
  948.         BX := PalNum;
  949.         CH := Hue.Grn;
  950.         CL := Hue.Blu;
  951.         DH := Hue.Red;
  952.       end;
  953.     intr( $10, regs );
  954.   end;
  955.  
  956. function GetPixel( x, y : integer ) : byte;
  957.  
  958.   var Segment : byte;
  959.       Offset : longint;
  960.  
  961.   begin
  962.     Segment := WhichBank( x, y );
  963.     if Segment <> PresentSeg then LoadWriteBank( Segment );
  964.     Offset := longint( Bytes_per_line) * y + x ;
  965.     GetPixel := Mem[$A000:Offset];
  966.   end;
  967.  
  968. procedure SetPalette( Hue : PaletteRegister );
  969.  
  970.   begin
  971.     Color := Hue;
  972.     with Regs do
  973.       begin
  974.         AX := $1012;
  975.         BX := 0;
  976.         CX := 256;
  977.         ES := Seg( Hue );
  978.         DX := Ofs( Hue );
  979.       end;
  980.     intr( $10, Regs );
  981.   end;
  982.  
  983. procedure CyclePalette;
  984.  
  985.   var
  986.     i   : byte;
  987.     Tmp : RGB;
  988.  
  989.   begin
  990.     Tmp := Color[1];
  991.     for i := 2 to 251 do
  992.         Color[i-1] := Color[i];
  993.     Color[251] := Tmp;
  994.     SetPalette( Color )
  995.   end;
  996.  
  997. procedure Swap( var First, Second : integer );
  998.  
  999.   var
  1000.     temp : integer;
  1001.  
  1002.   begin
  1003.     temp   := first;
  1004.     first  := second;
  1005.     second := temp
  1006.   end;
  1007.  
  1008.  
  1009. procedure Circle( x, y, Radius : word; Color : byte );
  1010.  
  1011.   var
  1012.     a, af, b, bf, target, r2 : integer;
  1013.  
  1014.   begin
  1015.     target := 0;
  1016.     a := radius;
  1017.     b := 0;
  1018.     r2 := Sqr( radius );
  1019.     while a >= b do
  1020.       begin
  1021.         b := Round( Sqrt( r2 - sqr(a)));
  1022.         Swap( target, b );
  1023.         while b < target do
  1024.           begin
  1025.             af := (100*a) div 100;
  1026.             bf := (100*b) div 100;
  1027.             Plot( x+af, y+b, color );
  1028.             Plot( x+bf, y+a, color );
  1029.             Plot( x-af, y+b, color );
  1030.             Plot( x-bf, y+a, color );
  1031.             Plot( x-af, y-b, color );
  1032.             Plot( x-bf, y-a, color );
  1033.             Plot( x+af, y-b, color );
  1034.             Plot( x+bf, y-a, color );
  1035.             b := b + 1
  1036.           end;
  1037.         a := a - 1
  1038.       end
  1039.   end;
  1040.  
  1041. procedure Line( xx1, yy1, xx2, yy2 : integer; color : byte );
  1042.  
  1043.   var
  1044.     LgDelta, ShDelta, Cycle, LgStep, ShStep, Dtotal : integer;
  1045.  
  1046.   procedure VertLine( x, y1, y2: integer; color : byte );
  1047.  
  1048.     var  NumNextBank : integer;
  1049.  
  1050.     begin
  1051.       NumNextBank := Whichbank( x, y1 );
  1052.       if NumNextBank <> PresentSeg then LoadWriteBank( NumNextBank );
  1053.       inc( NumNextBank );
  1054.       asm
  1055.             mov ax, bytes_per_line
  1056.             mov bx, y1
  1057.             mul bx
  1058.             add ax, x
  1059.             mov di, ax
  1060.             mov ax, 0a000h
  1061.             mov es, ax
  1062.             mov al, color
  1063.             mov dx, y1
  1064.       @L01: mov es:[di], al
  1065.             inc dx
  1066.             cmp dx, y2
  1067.             ja  @L02
  1068.             add di, bytes_per_line
  1069.             jnc @L01
  1070.             push es
  1071.             push di
  1072.             push dx
  1073.             push ax
  1074.             mov ax, NumNextBank
  1075.             push ax
  1076.             call LoadWriteBank
  1077.             inc NumNextBank
  1078.             pop ax
  1079.             pop dx
  1080.             pop di
  1081.             pop es
  1082.             jmp @L01
  1083.       @L02: nop;
  1084.       end;
  1085.     end;
  1086.  
  1087.   procedure HorzLine( x1, x2, y: integer; color : byte );
  1088.  
  1089.     var  NumNextBank : integer;
  1090.  
  1091.     begin
  1092.       NumNextBank := Whichbank( x1, y );
  1093.       if NumNextBank <> PresentSeg then LoadWriteBank( NumNextBank );
  1094.       inc( NumNextBank );
  1095.       asm
  1096.             mov ax, bytes_per_line
  1097.             mov bx, y
  1098.             mul bx
  1099.             add ax, x1
  1100.             mov di, ax
  1101.             mov ax, 0a000h
  1102.             mov es, ax
  1103.             mov al, color
  1104.             mov dx, x1
  1105.       @L01: mov es:[di], al
  1106.             inc dx
  1107.             cmp dx, x2
  1108.             ja  @L02
  1109.             add di, 1
  1110.             jnc @L01
  1111.             push es
  1112.             push di
  1113.             push dx
  1114.             push ax
  1115.             mov ax, NumNextBank
  1116.             push ax
  1117.             call LoadWriteBank
  1118.             inc NumNextBank
  1119.             pop ax
  1120.             pop dx
  1121.             pop di
  1122.             pop es
  1123.             jmp @L01
  1124.       @L02: nop;
  1125.       end;
  1126.     end;
  1127.  
  1128.   begin
  1129.     if xx1 > xx2 then swap( xx1, xx2 );
  1130.     if yy1 > yy2 then swap( yy1, yy2 );
  1131.     if xx1 = xx2 then VertLine( xx1, yy1, yy2, Color )
  1132.       else if yy1 = yy2 then HorzLine( xx1, xx2, yy1, Color )
  1133.         else
  1134.           begin
  1135.             LgDelta := xx2 - xx1;
  1136.             ShDelta := yy2 - yy1;
  1137.             if LgDelta < 0 then
  1138.               begin
  1139.                 LgDelta := -LgDelta;
  1140.                 LgStep := -1
  1141.               end
  1142.             else
  1143.               LgStep := 1;
  1144.               if ShDelta < 0 then
  1145.                 begin
  1146.                   ShDelta := -ShDelta;
  1147.                   ShStep := -1
  1148.                 end
  1149.               else
  1150.                 ShStep := 1;
  1151.               if ShDelta < LgDelta then
  1152.                 begin
  1153.                   Cycle := LgDelta shr 1;
  1154.                   while xx1 <> xx2 do
  1155.                     begin
  1156.                       Plot( xx1, yy1, color );
  1157.                       Cycle := Cycle + ShDelta;
  1158.                       if Cycle > LgDelta then
  1159.                         begin
  1160.                           Cycle := Cycle - LgDelta;
  1161.                           yy1 := yy1 + ShStep
  1162.                         end;
  1163.                       xx1 := xx1 + LgStep
  1164.                     end;
  1165.                   Plot( xx1, yy1, color )
  1166.                 end
  1167.               else
  1168.                 begin
  1169.                   Cycle := ShDelta shr 1;
  1170.                   Swap( LgDelta, ShDelta );
  1171.                   Swap( LgStep, ShStep );
  1172.                   while yy1 <> yy2 do
  1173.                     begin
  1174.                       Plot( xx1, yy1, color );
  1175.                       Cycle := Cycle + ShDelta;
  1176.                       if Cycle > LgDelta then
  1177.                         begin
  1178.                           Cycle := Cycle - LgDelta;
  1179.                           xx1 := xx1 + ShStep
  1180.                         end;
  1181.                       yy1 := yy1 + LgStep
  1182.                     end;
  1183.                   Plot( xx1, yy1, color )
  1184.                 end;
  1185.           end;
  1186.   end;
  1187.  
  1188. procedure ClearDevice;
  1189.  
  1190.   var i : byte;
  1191.  
  1192.   begin
  1193.     for i := 0 to 11 do
  1194.       begin
  1195.         LoadWriteBank( i );
  1196.         asm
  1197.           mov ax, 0a000h
  1198.           mov es, ax
  1199.           xor di, di
  1200.           mov cx, 0ffffh
  1201.           mov al, 000h
  1202.           rep stosb
  1203.           stosb
  1204.        end;
  1205.       end;
  1206.   end;
  1207.  
  1208. procedure ClearPort( x1, y1, x2, y2 : integer );
  1209.  
  1210.   var i, j, Temp : integer;
  1211.  
  1212.   begin
  1213.     if y1 > y2 then Swap( y1, y2 );
  1214.     for i := 0 to 19 do
  1215.       for j := 0 to 23 do
  1216.         begin
  1217.           Temp := y1+i+j*20;
  1218.           if Temp <= y2 then
  1219.             Line( x1, Temp, x2, Temp, 0 );
  1220.         end;
  1221.   end;
  1222.  
  1223. procedure Rectangle( x1, y1, x2, y2 : word; Color : byte );
  1224.  
  1225.   begin
  1226.     Line( x1, y1, x2, y1, Color );
  1227.     Line( x2, y1, x2, y2, Color );
  1228.     Line( x2, y2, x1, y2, Color );
  1229.     Line( x1, y2, x1, y1, Color );
  1230.   end;
  1231.  
  1232. procedure RectFill( x1, y1, x2, y2 : integer; Color : byte );
  1233.  
  1234.   var  PBank : integer;
  1235.  
  1236.     begin
  1237.       if x2 < x1 then Swap( x1, x2 );
  1238.       if y2 < y1 then Swap( y1, y2 );
  1239.       asm
  1240.             mov cx, y1
  1241.       @L00: mov ax, x1
  1242.             push cx
  1243.             push ax
  1244.             push cx
  1245.             call WhichBank
  1246.             cmp al, PresentSeg
  1247.             je  @L04
  1248.             push ax
  1249.             call LoadWriteBank
  1250.       @L04: pop cx
  1251.             mov ax, bytes_per_line
  1252.             mul cx
  1253.             add ax, x1
  1254.             mov di, ax
  1255.             mov ax, 0a000h
  1256.             mov es, ax
  1257.             mov al, color
  1258.             mov dx, x1
  1259.       @L01: mov es:[di], al
  1260.             inc dx
  1261.             cmp dx, x2
  1262.             ja  @L02
  1263.             add di, 1
  1264.             jnc @L01
  1265.             push es
  1266.             push di
  1267.             push cx
  1268.             push dx
  1269.             push ax
  1270.             push dx
  1271.             push cx
  1272.             call WhichBank
  1273.             push ax
  1274.             call LoadWriteBank
  1275.             pop ax
  1276.             pop dx
  1277.             pop cx
  1278.             pop di
  1279.             pop es
  1280.             jmp @L01
  1281.       @L02: inc cx
  1282.             cmp cx, y2
  1283.             ja  @L03
  1284.             jmp @L00
  1285.       @L03: nop;
  1286.       end;
  1287.     end;
  1288.  
  1289. procedure ExitGraphics;
  1290.  
  1291.   begin
  1292.     Regs.AH := 0;
  1293.     Regs.AL := 3;
  1294.     intr( $10, Regs );
  1295.     if Fused then dispose( Future );
  1296.     if Sused then dispose( Standard );
  1297.   end;
  1298.  
  1299. procedure OutTextXY( x, y : integer; word : string );
  1300.  
  1301.   var i, j, k, symbol : byte;
  1302.       LetterX, LetterY, xx, yy : integer;
  1303.  
  1304.   begin
  1305.     LetterX := x;
  1306.     LetterY := y;
  1307.     if PresentSet = FutureFont then
  1308.       begin
  1309.          for i := 1 to length( word ) do
  1310.            begin
  1311.              symbol := ord(word[i])-ord(' ');
  1312.              for j := 0 to Width do
  1313.                for k := 0 to Height do
  1314.                    if Future^[symbol][j,k] then
  1315.                          Plot( LetterX+j, LetterY+k, FontColor )
  1316.                    else if not Transparent then
  1317.                          Plot( LetterX+j, LetterY+k, BackGroundColor );
  1318.              LetterX := LetterX + Width + 2;
  1319.            end;
  1320.       end;
  1321.     if PresentSet = StandardFont then
  1322.       begin
  1323.          for i := 1 to length( word ) do
  1324.            begin
  1325.              symbol := ord(word[i])-ord(' ');
  1326.              for j := 0 to Width do
  1327.                for k := 0 to Height do
  1328.                    if Standard^[symbol][j,k] then
  1329.                          Plot( LetterX+j, LetterY+k, FontColor )
  1330.                    else if not Transparent then
  1331.                          Plot( LetterX+j, LetterY+k, BackGroundColor );
  1332.              LetterX := LetterX + Width + 2;
  1333.            end;
  1334.       end;
  1335.   end;
  1336.  
  1337. procedure LoadFont( CharSetName: SetTypes );
  1338.  
  1339.   var Sfil : file of SCharSetType;
  1340.       Ffil : file of FCharSetType;
  1341.       Color : byte;
  1342.  
  1343.   begin
  1344.     if CharSetName = FutureFont then
  1345.       begin
  1346.         GetMem( Future, 19968 );
  1347.         assign( Ffil, 'future.chr' );
  1348.         reset( Ffil );
  1349.         Read( Ffil, Future^ );
  1350.         Close( Ffil );
  1351.         Fused := True;
  1352.       end;
  1353.     if CharSetName = StandardFont then
  1354.       begin
  1355.         GetMem( Standard, 7680 );
  1356.         assign( Sfil, 'standard.chr' );
  1357.         reset( Sfil );
  1358.         Read( Sfil, Standard^ );
  1359.         Close( Sfil );
  1360.         Sused := True;
  1361.       end;
  1362.   end;
  1363.  
  1364. procedure SetFont( Font : SetTypes );
  1365.  
  1366.   begin
  1367.     if Font = FutureFont then
  1368.       begin
  1369.         Width := 15;
  1370.         Height := 12;
  1371.         PresentSet := FutureFont;
  1372.       end;
  1373.     if Font = StandardFont then
  1374.       begin
  1375.         Width := 7;
  1376.         Height := 9;
  1377.         PresentSet := StandardFont;
  1378.       end;
  1379.   end;
  1380.  
  1381. procedure SetFontColor( Color, BackCol : byte; Trans : boolean );
  1382.   begin
  1383.     FontColor := Color;
  1384.     BackGroundColor := BackCol;
  1385.     Transparent := Trans;
  1386.   end;
  1387.  
  1388. procedure LoadPalette( PaletteName : string  );
  1389.  
  1390.   var Fil : File of PaletteRegister;
  1391.  
  1392.   begin
  1393.     assign( fil, PaletteName );
  1394.     reset( fil );
  1395.     read( fil, Color );
  1396.     Close( fil );
  1397.     SetPalette( Color );
  1398.   end;
  1399.  
  1400. procedure MouseHandler( Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP : word );
  1401.  
  1402.    INTERRUPT;
  1403.    begin
  1404.       mEvent.Event     := AX;
  1405.       mEvent.BtnStatus := BX;
  1406.       mEvent.xPos      := CX;
  1407.       mEvent.yPos      := DX;
  1408.       inline( $8B/$E5/$5D/$07/$1F/$5F/$5E/$5A/$59/$5B/$58/$CB );
  1409.    end;
  1410.  
  1411. procedure GenMouse.Reset( var Status : boolean; var BtnCount : integer );
  1412.    begin
  1413.       regs.AX := $00;
  1414.       intr($33,regs);
  1415.       Status   := regs.AX <> 0;
  1416.       BtnCount := regs.BX;
  1417.    end;
  1418.  
  1419. procedure GenMouse.SetAccel( threshold : integer );
  1420.    begin
  1421.       regs.AX := $13;
  1422.       regs.DX := threshold;
  1423.       intr($33,regs);
  1424.    end;
  1425.  
  1426. procedure GenMouse.GetPosition( var BtnStatus, XPos, YPos : integer );
  1427.    begin
  1428.       regs.AX := $03;
  1429.       intr($33,regs);
  1430.       Btnstatus := regs.BX;
  1431.       XPos := X; YPos := Y;
  1432.    end;
  1433.  
  1434. procedure GenMouse.SetPosition( XPos, YPos : integer );
  1435.    begin
  1436.      X := XPos;
  1437.      Y := YPos;
  1438.    end;
  1439.  
  1440. procedure GenMouse.SetRatio( horPix, verPix : integer );
  1441.   begin
  1442.      regs.AX := $0F;
  1443.      regs.CX := horPix;
  1444.      regs.DX := verPix;
  1445.      intr($33,regs);
  1446.   end;
  1447.  
  1448. procedure GenMouse.QueryBtnDn( button : integer; var mouse : Position );
  1449.    begin
  1450.       regs.AX := $05;
  1451.       regs.BX := button;
  1452.       intr($33,regs);
  1453.       mouse.BtnStatus := regs.AX;
  1454.       mouse.opCount := regs.BX;
  1455.       mouse.XPos    := regs.CX;
  1456.       mouse.YPos    := regs.DX;
  1457.    end;
  1458.  
  1459. procedure GenMouse.QueryBtnUp( button : integer; var mouse : Position );
  1460.    begin
  1461.       regs.AX := $06;
  1462.       regs.BX := button;
  1463.       intr($33,regs);
  1464.       mouse.BtnStatus := regs.AX;
  1465.       mouse.opCount := regs.BX;
  1466.       mouse.XPos    := regs.CX;
  1467.       mouse.YPos    := regs.DX;
  1468.    end;
  1469.  
  1470. procedure GenMouse.SetLimits( XPosMin, YPosMin, XPosMax, YPosMax : integer );
  1471.    begin
  1472.      Mxx := XPosMax;
  1473.      Mxy := YPosMax;
  1474.      Mnx := XPosMin;
  1475.      Mny := YPosMin;
  1476.    end;
  1477.  
  1478. procedure GenMouse.ReadMove( var XMove, Ymove : integer );
  1479.    begin
  1480.       regs.AX := $0B;
  1481.       intr($33,regs);
  1482.       XMove := regs.CX;
  1483.       Ymove := regs.DX;
  1484.    end;
  1485.  
  1486.  
  1487. procedure GraphicMouse.MPlot( xx, yy : integer );
  1488.  
  1489.   var TX, TY, x, y : integer;
  1490.  
  1491.   begin
  1492.     for TY := 0 to 3 do
  1493.       begin
  1494.         y := yy + TY;
  1495.         if y < GetMaxY then
  1496.         for TX := 0 to 3 do
  1497.           begin
  1498.             x := xx + TX;
  1499.             if (MP[TX,TY] <> 0) AND (x < GetMaxX) then
  1500.                 Plot( x, y, MP[TX,TY] );
  1501.           end;
  1502.       end;
  1503.   end;
  1504.  
  1505. procedure GraphicMouse.Show( ShowM : boolean );
  1506.  
  1507.   var i, j, x, y : integer;
  1508.  
  1509.   begin
  1510.     ShowMouse := ShowM;
  1511.     if ShowM then
  1512.       begin
  1513.         for i := 0 to 3 do
  1514.           for j := 0 to 3 do
  1515.             ColOld[ i, j ] := GetPixel( OldX + i, OldY + j );
  1516.         MPlot( OldX, OldY );
  1517.       end
  1518.     else
  1519.       for i := 0 to 3 do
  1520.         begin
  1521.           x := OldX + i;
  1522.           for j := 0 to 3 do
  1523.             begin
  1524.               y := OldY + j;
  1525.               Plot( x, y, ColOld[i,j] );
  1526.             end;
  1527.         end;
  1528.   end;
  1529.  
  1530. procedure GraphicMouse.CheckMouse;
  1531.  
  1532.   var XNew, YNew, i, j : integer;
  1533.  
  1534.   begin
  1535.     ReadMove( XNew, YNew );
  1536.     if ((X+XNew) <> X) OR ((Y+YNew) <> Y) then
  1537.       begin
  1538.         if ((X + XNew) > Mxx-1) then X := Mxx-1
  1539.           else if ((X + XNew) < Mnx) then X := Mnx
  1540.             else inc( X, XNew );
  1541.         if ((Y + YNew) > Mxy-1) then Y := Mxy-1
  1542.           else if ((Y + YNew) < Mny) then Y := Mny
  1543.             else inc( Y, YNew );
  1544.         if ShowMouse then
  1545.           begin
  1546.             Show( False );
  1547.             ShowMouse := True;
  1548.             for i := 0 to 3 do
  1549.               for j := 0 to 3 do
  1550.                 ColOld[ i, j ] := GetPixel( X + i, Y + j );
  1551.             MPlot( X, Y );
  1552.           end;
  1553.         OldX := X; OldY := Y;
  1554.       end;
  1555.   end;
  1556.  
  1557. procedure GraphicMouse.Initialize;
  1558.  
  1559.    var mStatus : boolean;
  1560.        Btn : integer;
  1561.  
  1562.    begin
  1563.       Reset( mStatus, Btn );
  1564.       if mStatus then
  1565.         begin
  1566.           X := GetMaxX div 2;
  1567.           Y := GetMaxY div 2;
  1568.           OldX := X; OldY := Y;
  1569.           SetLimits( 0, 0, GetMaxX, GetMaxY );
  1570.           SetPosition( X, Y );
  1571.           MP[0,0] := 255; MP[0,1] := 255;  {     0 1 2 3  }
  1572.           MP[0,2] := 255; MP[0,3] := 255;  {  0  # # # #  }
  1573.           MP[1,0] := 255; MP[1,1] := 1;    {  1  # * * #  }
  1574.           MP[1,2] := 1;   MP[1,3] := 255;  {  2  # *      }
  1575.           MP[2,0] := 255; MP[2,1] := 1;    {  3  # #      }
  1576.           MP[2,2] := 0;   MP[2,3] := 0;    { Mouse Pointer }
  1577.           MP[3,0] := 255; MP[3,1] := 255;
  1578.           MP[3,2] := 0;   MP[3,3] := 0;
  1579.           Show( True );                    { Transparent = 0 }
  1580.         end;                               { White = 255     }
  1581.    end;                                    { Black = 1       }
  1582.  
  1583. procedure GraphicMouse.ExitSVGA;
  1584.    begin
  1585.       SetLimits( lo(WindMin)*8, hi(WindMin)*8, lo(WindMax)*8, hi(WindMax)*8);
  1586.       regs.AX := $0A;
  1587.       regs.BX := 1;
  1588.       regs.CX := 6;
  1589.       regs.DX := 7;
  1590.       intr($33,regs);
  1591.       SetPosition( 0, 0 );
  1592.       regs.AX := $02;
  1593.       intr($33,regs);
  1594.    end;
  1595.  
  1596.  
  1597. begin
  1598.   SetFont( StandardFont );
  1599.   SetFontColor( 253, 0, True );
  1600.   PresentSeg := 0;
  1601.   Sused := False;
  1602.   Fused := False;
  1603. end.