home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l048 / 1.ddi / GRAPHIX.IBM < prev    next >
Encoding:
Text File  |  1986-06-13  |  16.5 KB  |  513 lines
  1. (***********************************************************)
  2. (*                                                         *)
  3. (*                TURBO GRAPHIX version 1.06A              *)
  4. (*                                                         *)
  5. (*      Graphics module for IBM Color/Graphics Adapter     *)
  6. (*                  Module version  1.06A                  *)
  7. (*                                                         *)
  8. (*                  Copyright (C) 1985 by                  *)
  9. (*                  BORLAND International                  *)
  10. (*                                                         *)
  11. (***********************************************************)
  12.  
  13. const
  14.   XMaxGlb        = 79;      { Number of bytes -1 in one screen line }
  15.   XScreenMaxGlb  = 639;     { Number of pixels -1 in one screen line }
  16.   YMaxGlb        = 199;     { Number of lines -1 on the screen }
  17.   ScreenSizeGlb  = 8191;    { Total size in integers of the screen }
  18.   GrafMode       = $0006;   { BIOS Interrupt 10 AX register }
  19.                             {   high byte specifies function 0 }
  20.                             {   low byte selects graphics mode }
  21.   AspectFactor   = 0.44;    { Aspect ratio for a true circle }
  22.   IVStepGlb      = 2;       { Initial value of VStepGlb }
  23.  
  24.   HardwareGrafBase   : integer = $B800; { Location of the hardware screen }
  25.   FontLoaded         : boolean = false; { Flag: has the font been loaded yet? }
  26.   MinForeground      : integer = 0;     { Lowest allowable foreground color }
  27.   MaxForeground      : integer = 15;    { Highest allowable foreground color }
  28.   MinBackground      : integer = 0;     { Lowest allowable background color }
  29.   MaxBackground      : integer = 0;     { Highest allowable background color }
  30.   SaveStateGlb       : integer = 10;
  31.   ForegroundColorGlb : integer = 15;
  32.  
  33. type
  34.   ScreenType        = array[0..ScreenSizeGlb] of integer;
  35.   ScreenPointer     = ^ScreenType;
  36.   FontChar          = array[0..7] of byte;
  37.   GrfFont           = array[0..255] of FontChar;
  38.   WindowStackRecord = record
  39.                         W : WindowType;
  40.                         Contents : ScreenPointer;
  41.                       end;
  42.    Stacks           = array[1..MaxWindowsGlb] of WindowStackRecord;
  43.  
  44. var
  45.   FontHeightGlb : byte;
  46.   LineDistGlb   : integer;
  47.   ScreenGlb     : ScreenPointer;
  48.   ConOutPtrSave : integer;
  49.   Font          : GrfFont;
  50.   Stack         : Stacks;
  51.   DisplayType   : (IBMPCjr, IBMCGA, IBMEGA, NoDisplay);
  52.   RowBase       : array[0..YMaxGlb] of integer;
  53.  
  54. function BaseAddress(Y : integer) : integer;
  55. { Calculate address of scanline Y }
  56. begin
  57.   BaseAddress:=(Y and 1) shl 13 + (Y and -2) shl 5 + (Y and -2) shl 3;
  58. end; { BaseAddress }
  59.  
  60. procedure Error(ErrProc, ErrCode : integer); forward; { Code in KERNEL.SYS }
  61.  
  62. function HardwarePresent : boolean;
  63. { Test for the presence of a graphics card }
  64. var
  65.   I, EquipFlag    : integer;
  66.   Info, EGASwitch : byte;
  67.   HP              : boolean;
  68.   Regs            : record case integer of
  69.                       1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer);
  70.                       2 : (AL,AH,BL,BH,CL,CH,DL,DH : byte);
  71.                     end;
  72.  
  73. begin
  74.   HP := false;
  75.   DisplayType := NoDisplay;
  76.   with Regs do
  77.   begin
  78.     Intr($11, Regs);
  79.     EquipFlag := AX;
  80.     AH := $12;
  81.     BL := $10;
  82.     Intr($10, Regs);
  83.     EGASwitch := CL;
  84.     Info := BH;
  85.   end;
  86.   if Mem[$F000:$FFFE] = $FD then                             { PCjr }
  87.     begin
  88.       MinForeground := 0;        { Actually only 0 and 15 are valid }
  89.       MaxForeground := 15;
  90.       MinBackground := 0;
  91.       MaxBackground := 15;
  92.       DisplayType := IBMPCjr;
  93.       HP := true;
  94.     end
  95.   else if ((EquipFlag and 52) in [0,16,32]) and (Info = 0) then
  96.     begin                       { EGA present, active, and in color }
  97.       MinForeground := 0;
  98.       MaxForeground := 15;
  99.       MinBackground := 0;
  100.       MaxBackground := 15;
  101.       DisplayType := IBMEGA;
  102.       HP := true;
  103.     end;
  104.   if not HP then
  105.     if ((EquipFlag and 48) in [16,32]) or                     { CGA }
  106.        (((EquipFlag and 52) = 4) and           { EGA but not active }
  107.        (EGASwitch in [4,5,10,11])) then               { EGA is mono }
  108.       begin
  109.         MinForeground := 0;
  110.         MaxForeground := 15;
  111.         MinBackground := 0;
  112.         MaxBackground := 0;
  113.         DisplayType := IBMCGA;
  114.         HP := true;
  115.       end;
  116.     HardwarePresent := HP;
  117. end; { HardwarePresent }
  118.  
  119. procedure AllocateRAMScreen;
  120. { Allocates the RAM screen and makes sure that
  121.   ScreenGlb is on a segment (16 byte) boundary }
  122. var
  123.   Test : ^integer;
  124. begin
  125.   New(ScreenGlb);
  126.   while Ofs(ScreenGlb^) <> 0 do   { Make absolutely certain that ScreenGlb }
  127.   begin                           {  is on a segment (16 byte) boundary! }
  128.     Dispose(ScreenGlb);
  129.     New(Test);
  130.     New(ScreenGlb);
  131.   end;
  132. end; { AllocateRAMScreen }
  133.  
  134. procedure LeaveGraphic;
  135. { Exit from graphics mode and clear the screen }
  136. var
  137.   Regs : record case integer of
  138.            1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer);
  139.            2 : (AL,AH,BL,BH,CL,CH,DL,DH : byte);
  140.          end;
  141. begin
  142.   Regs.AX := SaveStateGlb;
  143.   Intr($10, Regs);
  144.   if GrafModeGlb then
  145.     ConOutPtr := ConOutPtrSave;
  146.   GrafModeGlb := false;
  147. end; { LeaveGraphic }
  148.  
  149. procedure DC(C: byte);
  150. { Draw the character C at the position XTextGlb, YTextGlb }
  151. begin inline(
  152.     $A1/ YTextGlb           { MOV     AX,  YTextGlb              }
  153.    /$48                     { DEC     AX                         }
  154.    /$8B/$3E/LineDistGlb     { MOV DI, LineDistGlb                }
  155.    /$F7/$E7                 { MUL     DI                         }
  156.    /$D1/$E0                 { SHL     AX,  1                     }
  157.    /$97                     { XCHG    AX,  DI                    }
  158.  
  159.    /$8A/$9E/ C              { MOV     BL, C                      }
  160.    /$B7/$00                 { MOV     BH, 00                     }
  161.    /$D1/$E3                 { SHL     BX,1                       }
  162.    /$D1/$E3                 { SHL     BX,1                       }
  163.    /$D1/$E3                 { SHL     BX,1                       }
  164.    /$81/$C3/Font            { ADD     BX,Font                    }
  165.    /$8A/$16/XTextGlb        { MOV     DL,XTextGlb                }
  166.    /$FE/$CA                 { DEC     DL                         }
  167.    /$B6/$00                 { MOV     DH,00                      }
  168.    /$A1/GrafBase            { MOV     AX,GrafBase                }
  169.    /$8E/$C0                 { MOV     ES,AX                      }
  170.    /$8A/$2E/FontHeightGlb   { MOV     CH,FontHeightGlb           }
  171.  
  172.    /$8B/$B5/RowBase         { NextRow:MOV     SI,  [DI+RowBase]  }
  173.    /$01/$D6                 {         ADD     SI,DX              }
  174.    /$8A/$07                 {         MOV     AL,[BX]            }
  175.    /$26                     {         ES:                        }
  176.    /$88/$04                 {         MOV     [SI],AL            }
  177.    /$43                     {         INC     BX                 }
  178.    /$47                     {         INC     DI                 }
  179.    /$47                     {         INC     DI                 }
  180.    /$FE/$CD                 {         DEC     CH                 }
  181.    /$75/$EE);               {         JNZ     NextRow            }
  182. end; { DC }
  183.  
  184. procedure DisplayChar(C : byte);
  185. { Same as DC. Intended for internal use by the graphics system }
  186. begin
  187.   if C = 8 then
  188.     begin
  189.       if XTextGlb > 1 then
  190.         XTextGlb := XTextGlb - 1;
  191.     end
  192.   else
  193.     if C = 10 then
  194.     begin
  195.       if YTextGlb < 25 then
  196.         YTextGlb := YTextGlb + 1;
  197.     end
  198.   else
  199.     if C = 13 then
  200.       XTextGlb := 1
  201.     else
  202.       begin
  203.         DC(C);
  204.         if XTextGlb < 80 then
  205.           XTextGlb := XTextGlb + 1;
  206.       end;
  207. end; { DisplayChar }
  208.  
  209. procedure SetIBMPalette(PaletteNumber, Color : integer);
  210. { Set up the palette registers on the IBM CGA }
  211. var
  212.   Regs : record case integer of
  213.            1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer);
  214.            2 : (Al,AH,BL,BH,CL,CH,DL,DH : byte);
  215.          end;
  216. begin
  217.   with Regs do
  218.   begin
  219.     if PaletteNumber <> 2 then
  220.       begin
  221.         AH := $0B;
  222.         BL := Color;
  223.         BH := PaletteNumber;
  224.       end
  225.     else
  226.       begin
  227.         AX := $1000;
  228.         BL := 1;
  229.         BH := Color;
  230.       end;
  231.     Intr($10, Regs);
  232.   end;
  233. end; { SetIBMPalette }
  234.  
  235. procedure SetForegroundColor(Color : integer);
  236. { Set the foreground color }
  237. begin
  238.   case DisplayType of
  239.     IBMPCjr : SetIBMPalette(1, 1 - (Color and 1));
  240.     IBMCGA  : SetIBMPalette(0, Color);
  241.     IBMEGA  : SetIBMPalette(2, Color);
  242.   end;
  243.   ForegroundColorGlb := Color;
  244. end; { SetForegroundColor }
  245.  
  246. procedure SetBackgroundColor(Color : integer);
  247. { Set the background color }
  248. begin
  249.   case DisplayType of
  250.     IBMPCjr,
  251.     IBMEGA  : SetIBMPalette(0, Color);
  252.   end;
  253.   if DisplayType = IBMEGA then
  254.     SetIBMPalette(2, ForegroundColorGlb);
  255. end; { SetBackgroundColor }
  256.  
  257. procedure ClearScreen;
  258. { Clear the displayed screen }
  259. begin
  260.   FillChar(Mem[GrafBase:0000], ScreenSizeGlb shl 1, 0);
  261. end; { ClearScreen }
  262.  
  263. procedure EnterGraphic;
  264. { Enter graphics mode }
  265. type
  266.   Reg = record case integer of
  267.           1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer);
  268.           2 : (AL,AH,BL,BH,CL,CH,DL,DH : byte);
  269.         end;
  270. var
  271.   Regs     : Reg;
  272.   FontFile : file of GrfFont;
  273.   I        : integer;
  274. begin
  275.   if not FontLoaded then
  276.   begin
  277.     for  I := 0 to YMaxGlb do
  278.       RowBase[I] := BaseAddress(I);
  279.     Assign(FontFile, '8x8.FON');
  280.     {$I-} Reset(FontFile); {$I+}
  281.     if IOresult = 0 then
  282.       begin
  283.         Read(FontFile, Font);
  284.         Close(FontFile);
  285.         lineDistGlb := 8;
  286.         FontHeightGlb := 8;
  287.       end
  288.     else
  289.       FillChar(Font, SizeOf(Font), 0);
  290.     FontLoaded := true;
  291.   end;
  292.   Regs.AX := $0F00;
  293.   Intr($10, Regs);
  294.   if (Regs.AL < 4) or (SaveStateGlb = 10) then
  295.     SaveStateGlb := Regs.AL;
  296.   Regs.AX := GrafMode;
  297.   Intr($10, Regs);
  298.   SetForegroundColor(MaxForeground);
  299.   if not GrafModeGlb then
  300.     ConOutPtrSave := ConOutPtr;
  301.   ConOutPtr := Ofs(DisplayChar);
  302.   GrafModeGlb := true;
  303. end; { EnterGraphic }
  304.  
  305. var
  306.   LastAddress : integer;
  307.  
  308. procedure DP(X, Y : integer);
  309. { Plot a pixel at (X, Y) }
  310. begin
  311.   inline(
  312.     $8B/$46/ <Y             {  MOV     AX,  Y                          }
  313.    /$D1/$E0                 {  SHL     AX,  1                          }
  314.    /$97                     {  XCHG    AX,  DI                         }
  315.    /$8B/$85/RowBase         {  MOV     AX,  [DI+RowBase]               }
  316.  
  317.                             {               AX has RowBase(Y)          }
  318.  
  319.    /$8B/$5E/ <X             {  MOV     BX, X                           }
  320.    /$89/$DA                 {  MOV     DX,BX   Save X in DX            }
  321.    /$B1/$03                 {  MOV     CL,03                           }
  322.    /$D3/$EB                 {  SHR     BX,CL   BX = X div 8            }
  323.    /$01/$C3                 {  ADD     BX,AX                           }
  324.  
  325.                             {              AX has RowBase(Y) + X div 8 }
  326.  
  327.    /$88/$D1                 {  MOV     CL,DL                           }
  328.    /$80/$E1/$07             {  AND     CL,07                           }
  329.    /$B2/$80                 {  MOV     DL,80                           }
  330.    /$D2/$EA                 {  SHR     DL,CL                           }
  331.    /$8E/$06/GrafBase        {  MOV     ES,GrafBase                     }
  332.    /$80/$3E/ColorGlb/$FF    {  JMP     ColorGlb,FF                     }
  333.    /$75/$05                 {  JNZ     ZeroPix                         }
  334.  
  335.    /$26                     {          ES:                             }
  336.    /$08/$17                 {          OR     [BX],DL                  }
  337.    /$EB/$05                 {          JMP     3420                    }
  338.                             {  ZeroPix:                                }
  339.    /$F6/$D2                 {          NOT     DL                      }
  340.    /$26                     {          ES:                             }
  341.    /$20/$17                 {          AND     [BX],DL                 }
  342.  
  343.    /$89/$1E/LastAddress);   {  Done:   MOV   LastAddress,BX            }
  344. end; { DP }
  345.  
  346. function PD(X, Y : integer) : boolean;
  347. { Return true if the color of the pixel at (X, Y) matches ColorGlb }
  348. begin
  349.   PD := (ColorGlb = 0) xor (Mem[GrafBase:BaseAddress(Y) + X shr 3]
  350.                        and (128 shr (X and 7)) <> 0);
  351. end; { PD }
  352.  
  353. procedure SetBackground8(Background : BackgroundArray);
  354. { Fills the active display with the specified bit pattern }
  355. var
  356.   I : integer;
  357. begin
  358.   for I := Y1RefGlb to Y2RefGlb do
  359.     FillChar(Mem[GrafBase:BaseAddress(I) + X1RefGlb], X2RefGlb - X1RefGlb + 1,
  360.              Background[I and 7]);
  361. end; { SetBackground8 }
  362.  
  363. procedure SetBackground(Byt : byte);
  364. { Determines the background pattern of the active window }
  365. var
  366.   Bk : BackgroundArray;
  367. begin
  368.   FillChar(Bk, 8, Byt);
  369.   SetBackground8(Bk);
  370. end; { SetBackground }
  371.  
  372. procedure DrawStraight(X1, X2, Y : integer);
  373. { Draw a horizontal line from X1,Y to X2,Y }
  374. var
  375.   I, X          : integer;
  376.   DirectModeLoc : boolean;
  377. begin
  378.   if (not ((X1 < 0) or (X1 > XMaxGlb shl 3 + 7)) and not ((X2 < 0) or
  379.      (X2 > XMaxGlb shl 3 + 7)) and ((Y >= 0) and (Y <= YMaxGlb))) then
  380.   begin
  381.     DirectModeLoc := DirectModeGlb;
  382.     DirectModeGlb := true;
  383.     if X1 > X2 then
  384.     begin
  385.       X := X1;
  386.       X1 := X2;
  387.       X2 := X;
  388.     end;
  389.     if X2 - X1 < 16 then
  390.       for X := X1 to X2 do
  391.         DP(X, Y)
  392.     else
  393.       begin
  394.         X1 := X1 + 8;
  395.         for I := (X1 - 8) to (X1 and -8) do
  396.           DP(I, Y);
  397.         for I := (X2 and -8) to X2 do
  398.           DP(I, Y);
  399.         FillChar(Mem[GrafBase:BaseAddress(Y) + (X1 shr 3)],
  400.                 (X2 shr 3) - (X1 shr 3), ColorGlb);
  401.       end;
  402.     DirectModeGlb := DirectModeLoc;
  403.   end;
  404. end; { DrawStraight }
  405.  
  406. procedure SaveScreen(FileName : WrkString);
  407. { Save the current screen on disk using FileName }
  408. type
  409.   PicFile = file of ScreenType;
  410. var
  411.   Picture     : ScreenPointer;
  412.   PictureFile : PicFile;
  413.   IOErr       : boolean;
  414.  
  415. procedure IOCheck;
  416. begin
  417.   IOErr := IOresult <> 0;
  418.   if IOErr then
  419.     Error(27, 5);
  420. end; { IOCheck }
  421.  
  422. begin
  423.   IOErr := false;
  424.   Picture := Ptr(GrafBase, 0);
  425.   Assign(PictureFile, FileName);
  426.   {$I-} Rewrite(PictureFile); {$I+}
  427.   IOCheck;
  428.   if not IOErr then
  429.   begin
  430.     {$I-} Write(PictureFile, Picture^); {$I+}
  431.     IOCheck;
  432.   end;
  433.   if not IOErr then
  434.   begin
  435.     {$I-} Close(PictureFile); {$I+}
  436.     IOCheck;
  437.   end;
  438. end; { SaveScreen }
  439.  
  440. procedure LoadScreen(FileName : WrkString);
  441. { Load screen from file FileName }
  442. type
  443.   PicFile = file of ScreenType;
  444. var
  445.   Picture     : ScreenPointer;
  446.   PictureFile : PicFile;
  447. begin
  448.   Picture := Ptr(GrafBase, 0);
  449.   Assign(PictureFile, FileName);
  450.   {$I-} Reset(PictureFile); {$I+}
  451.   if IOresult <> 0 then
  452.     Error(11, 5)
  453.   else
  454.     begin
  455.       Read(PictureFile, Picture^);
  456.       Close(PictureFile);
  457.     end;
  458. end; { LoadScreen }
  459.  
  460. procedure SwapScreen;
  461. { Exchanges the contents the of the displayed
  462.   screen with the contents of the RAM screen  }
  463. var
  464.   ScanLine,
  465.   LineBase,
  466.   RamScrSeg  : integer;
  467.   LineBuffer : array[0..XMaxGlb] of byte;
  468. begin
  469.   if RamScreenGlb then
  470.   begin
  471.     RamScrSeg := Seg(ScreenGlb^);
  472.     for ScanLine := 0 to YMaxGlb do
  473.     begin
  474.       LineBase := RowBase[Scanline];
  475.       Move(Mem[GrafBase:LineBase], LineBuffer, XMaxGlb + 1);
  476.       Move(Mem[RamScrSeg:LineBase], Mem[GrafBase:LineBase], XMaxGlb + 1);
  477.       Move(LineBuffer, Mem[RamScrSeg:LineBase], XMaxGlb + 1);
  478.     end;
  479.   end;
  480. end; { SwapScreen }
  481.  
  482. procedure CopyScreen;
  483. { Copies the active screen onto the inactive screen }
  484. var
  485.   ToBase : integer;
  486. begin
  487.   if RamScreenGlb then
  488.   begin
  489.     if GrafBase = HardwareGrafBase then
  490.       ToBase := Seg(ScreenGlb^)
  491.     else
  492.       ToBase := HardwareGrafBase;
  493.     Move(Mem[GrafBase:0000], Mem[ToBase:0000], ScreenSizeGlb shl 1);
  494.   end;
  495. end; { CopyScreen }
  496.  
  497. procedure InvertScreen;
  498. { Inverts the image on the active screen }
  499. begin
  500.   inline(
  501.           $1E                {  PUSH    DS                    }
  502.          /$A1/ GrafBase      {  MOV     AX,[0382]             }
  503.          /$8E/$D8            {  MOV     DS,AX                 }
  504.          /$B9/ ScreenSizeGlb {  MOV     CX,4000               }
  505.          /$31/$DB            {  XOR     BX,BX                 }
  506.  
  507.          /$F7/$17            {  Label:  NOT    WORD PTR [BX]  }
  508.          /$43                {          INC     BX            }
  509.          /$43                {          INC     BX            }
  510.          /$E2/$FA            {          LOOP    Label         }
  511.          /$1F);              {          POP     DS            }
  512.   end; { InvertScreen }
  513.