home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PACKOBJ / VGABIOS.PAS < prev   
Pascal/Delphi Source File  |  1992-05-07  |  10KB  |  401 lines
  1. { VGABIOS - Interface to VGA BIOS routines (c) Wilbert van Leijen 1990-91 }
  2.  
  3. Unit VGABios;
  4.  
  5. Interface
  6.  
  7. Const
  8.   MinIntensity = 0;
  9.   MaxIntensity = 63;
  10.  
  11. Type
  12.   ColPageMode  = (_4x64, _16x16);
  13.   DisplayPage  = 0..7;
  14.   FontBlock    = 0..7;
  15.   CharSetType  = (INT1F, INT43, ROM8x14, ROM8x8lo, ROM8x8hi, ROM9x14,
  16.                  ROM8x16, ROM9x16);
  17.   ScanLineType = (CGA200, EGA350, VGA400);
  18.   ColourRange  = MinIntensity..MaxIntensity;
  19.   RGBType      = Record
  20.                    r, g, b   : ColourRange;
  21.                  end;
  22.   RGB64Type    = Array[0..63] of RGBType;
  23.   PaletteType  = Record
  24.                    ColourReg : Array[0..15] of Byte;
  25.                    Border    : Byte;
  26.                  end;
  27. Var
  28.   VGAStatus    : (NotVGA, VGAMono, VGAColour);
  29.  
  30. Function GetVideoMode : Byte;
  31. Procedure SetVideoMode(mode : Byte);
  32. Function GetDisplayPage : Byte;
  33. Procedure SetDisplayPage(page : DisplayPage);
  34. Function GetRegister(register : Byte) : ColourRange;
  35. Procedure SetRegister(register : Byte; colour : ColourRange);
  36. Function GetBorderColour : ColourRange;
  37. Procedure SetBorderColour(colour : ColourRange);
  38. Procedure GetPalette(Var palette : PaletteType);
  39. Procedure SetPalette(palette : PaletteType);
  40. Procedure GetRGBValue(register : Byte; Var RGB : RGBType);
  41. Procedure SetRGBValue(register : Byte; RGB : RGBType);
  42. Function GetColourPage : Byte;
  43. Procedure SetColourPage(page : Byte);
  44. Function GetPageMode : ColPageMode;
  45. Procedure SetPageMode(pagemode : ColPageMode);
  46. Procedure GetColourBlock(Var RGBBlock : RGB64Type);
  47. Procedure SetColourBlock(RGBBlock : RGB64Type);
  48. Procedure SetBlink;
  49. Procedure SetIntensity;
  50. Procedure SaveCurrentPalette(enable : Boolean);
  51. Procedure SetScanLine(scanlines : ScanLineType);
  52. Procedure SumGrayScale(enable : Boolean);
  53. Procedure CursorEmulation(emulate : Boolean);
  54. Procedure GetFontBlock(Var primary, secondary : FontBlock);
  55. Procedure SetFontBlock(primary, secondary : FontBlock);
  56. Procedure LoadFont8x8;
  57. Function GetFontPtr(charset : CharSetType) : Pointer;
  58. Procedure LoadFont(block : FontBlock;
  59.                startchar : Char;
  60.     numofchars, charsize : Integer;
  61.                  charptr : Pointer);
  62.  
  63. Implementation
  64.  
  65. {$R-,S-,I- }
  66.  
  67. Function GetVideoMode; External;
  68. Function GetDisplayPage; External;
  69. Procedure GetColourBlock; External;
  70. Procedure SetColourBlock; External;
  71. Procedure SetBlink; External;
  72. Procedure SetIntensity; External;
  73. Procedure GetPalette; External;
  74. Procedure SetPalette; External;
  75. Function GetColourPage; External;
  76. Procedure SetColourPage; External;
  77. Function GetPageMode; External;
  78. Procedure SetPageMode; External;
  79. {$L VGABIOS.OBJ }
  80.  
  81. { Switch the default display page }
  82.  
  83. Procedure SetDisplayPage(page : DisplayPage); Assembler;
  84.  
  85. ASM
  86.         MOV     AL, page
  87.         MOV     AH, 5
  88.         INT     10h
  89. end;  { SetDisplayPage }
  90.  
  91. { Switch cursor emulation }
  92.  
  93. Procedure CursorEmulation(emulate : Boolean); Assembler;
  94.  
  95. ASM
  96.         MOV     DL, emulate
  97.         XOR     AX, AX
  98.         MOV     ES, AX
  99.         MOV     SI, ES:[0487h]
  100.         OR      DL, DL
  101.         JZ      @1
  102.         AND     Byte Ptr ES:[SI], (not 1)
  103.         JMP     @2
  104. @1:     OR      Byte Ptr ES:[SI], 1
  105. @2:
  106. end;  { CursorEmulation }
  107.  
  108. { Set the current video mode.  You must call this procedure to switch
  109.   some VGA features on or off }
  110.  
  111. Procedure SetVideoMode(mode : Byte); Assembler;
  112.  
  113. ASM
  114.   { Get current cursor location }
  115.  
  116.         CALL    Far Ptr GetDisplayPage
  117.         MOV     AH, 3
  118.         INT     10h
  119.  
  120.         MOV     AL, mode
  121.         MOV     AH, 0
  122.         INT     10h
  123.  
  124.   { Restore cursor location }
  125.  
  126.         MOV     AH, 2
  127.         INT     10h
  128.  
  129.   { Set cursor to underline }
  130.  
  131.         MOV     CX, 0607h
  132.         MOV     AH, 1
  133.         INT     10h
  134. end;  { SetVideoMode }
  135.  
  136. { Select the vertical scan line.  Select either CGA, EGA or VGA
  137.   resolution }
  138.  
  139. Procedure SetScanLine(scanlines : ScanLineType); Assembler;
  140.  
  141. ASM
  142.         MOV     AL, scanlines
  143.         MOV     AH, 12h
  144.         MOV     BL, 30h
  145.         INT     10h
  146. end;  { SetScanLine }
  147.  
  148. { Sum all colours to gray scales.  Changes will take effect after
  149.   next call to SetVideoMode }
  150.  
  151. Procedure SumGrayScale(enable : Boolean); Assembler;
  152.  
  153. ASM
  154.         MOV     AL, enable
  155.         OR      AL, AL
  156.         JZ      @1
  157.         DEC     AX
  158.         JMP     @2
  159. @1:     INC     AX
  160. @2:     MOV     AH, 12h
  161.         MOV     BL, 33h
  162.         INT     10h
  163. end;  { SumGrayScale }
  164.  
  165. { Determine whether a call to SetVideoMode should reset the colours to
  166.   their default values or not }
  167.  
  168. Procedure SaveCurrentPalette(enable : Boolean); Assembler;
  169.  
  170. ASM
  171.         MOV     AL, enable
  172.         MOV     AH, 12h
  173.         MOV     BL, 31h
  174.         INT     10h
  175. end;  { SaveCurrentPalette }
  176.  
  177. { Get colour information from a DAC register }
  178.  
  179. Function GetRegister(register : Byte) : ColourRange; Assembler;
  180.  
  181. ASM
  182.         XOR     BX, BX
  183.         MOV     BL, register
  184.         MOV     AX, 1007h
  185.         INT     10h
  186.         MOV     AL, BH
  187. end;  { GetRegister }
  188.  
  189. { Store colour information to DAC register }
  190.  
  191. Procedure SetRegister(register : Byte; colour : ColourRange); Assembler;
  192.  
  193. ASM
  194.         MOV     BH, colour
  195.         MOV     BL, register
  196.         MOV     AX, 1000h
  197.         INT     10h
  198. end;  { SetRegister }
  199.  
  200. { Get the current border colour }
  201.  
  202. Function GetBorderColour : ColourRange; Assembler;
  203.  
  204. ASM
  205.         MOV     AX, 1008h
  206.         INT     10h
  207.         MOV     AL, BH
  208. end;  { GetBorderColour }
  209.  
  210. { Store the current border colour }
  211.  
  212. Procedure SetBorderColour(colour : ColourRange); Assembler;
  213.  
  214. ASM
  215.         MOV     BH, colour
  216.         MOV     AX, 1001h
  217.         INT     10h
  218. end;  { SetBorderColour }
  219.  
  220. { Get the Red, Green and Blue intensity from a DAC register }
  221.  
  222. Procedure GetRGBValue(register : Byte; Var RGB : RGBType); Assembler;
  223.  
  224. ASM
  225.         LES     DI, RGB
  226.         XOR     BX, BX
  227.         MOV     BL, register
  228.         MOV     AX, 1015h
  229.         INT     10h
  230.         MOV     AL, DH
  231.         STOSB
  232.         XCHG    AX, CX
  233.         XCHG    AH, AL
  234.         STOSW
  235. end;  { GetRGBValue }
  236.  
  237. { Store the Red, Green and Blue intensity into a DAC register }
  238.  
  239. Procedure SetRGBValue(register : Byte; RGB : RGBType); Assembler;
  240.  
  241. ASM
  242.         PUSH    DS
  243.         LDS     SI, RGB
  244.         XOR     BX, BX
  245.         MOV     BL, register
  246.         LODSB
  247.         MOV     DH, AL
  248.         LODSW
  249.         XCHG    CX, AX
  250.         XCHG    CH, CL
  251.         MOV     AX, 1010h
  252.         INT     10h
  253.         POP     DS
  254. end;  { SetRGBValue }
  255.  
  256. { Get font block index of current (resident) and alternate character set.
  257.   Up to two fonts can be active at the same time }
  258.  
  259. Procedure GetFontBlock(Var primary, secondary : FontBlock); Assembler;
  260.  
  261. ASM
  262.  
  263. {  Get character map select register:
  264. (VGA sequencer port 3C4h/3C5h index 3)
  265.  
  266. 7  6  5  4  3  2  1  0
  267.       │  │  │  │  │  │
  268.       │  │  │  │  └──┴──   Primary font   (lower 2 bits)
  269.       │  │  └──┴────────   Secondary font (lower 2 bits)
  270.       │  └──────────────   Primary font   (high bit)
  271.       └─────────────────   Secondary font (high bit)     }
  272.  
  273.         MOV     AL, 3
  274.         MOV     DX, 3C4h
  275.         OUT     DX, AL
  276.         INC     DX
  277.         IN      AL, DX
  278.         MOV     BL, AL
  279.         PUSH    AX
  280.  
  281. {  Get secondary font number: add up bits 5, 3 and 2  }
  282.  
  283.         SHR     AL, 1
  284.         SHR     AL, 1
  285.         AND     AL, 3
  286.         TEST    BL, 00100000b
  287.         JZ      @1
  288.         ADD     AL, 4
  289. @1:     LES     DI, secondary
  290.         STOSB
  291.  
  292. {  Get primary font number: add up bits 4, 1 and 0  }
  293.  
  294.         POP     AX
  295.         AND     AL, 3
  296.         TEST    BL, 00010000b
  297.         JZ      @2
  298.         ADD     AL, 4
  299. @2:     LES     DI, primary
  300.         STOSB
  301. end;  { GetFontBlock }
  302.  
  303. { Store the font block index }
  304.  
  305. Procedure SetFontBlock(primary, secondary : FontBlock); Assembler;
  306.  
  307. ASM
  308.         MOV     CH, primary
  309.         MOV     CL, secondary
  310.         XOR     BX, BX
  311.         MOV     AX, CX
  312.  
  313. {  Code primary font into bits 4, 1 and 0  }
  314.  
  315.         AND     AH, 3
  316.         TEST    CH, 00000100b
  317.         JZ      @1
  318.         ADD     BL, 10h
  319. @1:     ADD     BL, AH
  320.  
  321. {  Code secondary font into bits 5, 3 and 2  }
  322.  
  323.         AND     AL, 3
  324.         SHL     AL, 1
  325.         SHL     AL, 1
  326.         TEST    CL, 00000100b
  327.         JZ      @2
  328.         ADD     BL, 20h
  329. @2:     ADD     BL, AL
  330.  
  331. {  Set block specifier  }
  332.  
  333.         MOV     AX, 1103h
  334.         INT     10h
  335. end;  { SetFontBlock }
  336.  
  337. { Load the resident 8x8 font }
  338.  
  339. Procedure LoadFont8x8; Assembler;
  340.  
  341. ASM
  342.         MOV     AX, 1112h
  343.         MOV     BL, 0
  344.         INT     10h
  345. end;  { LoadFont8x8 }
  346.  
  347. { Get a pointer to one of the eight resident VGA fonts }
  348.  
  349. Function GetFontPtr(charset : CharSetType) : Pointer; Assembler;
  350.  
  351. ASM
  352.         MOV     BH, charset
  353.         MOV     AX, 1130h
  354.         INT     10h
  355.         MOV     DX, ES
  356.         MOV     AX, BP
  357. end;  { GetFontPtr }
  358.  
  359. { Load (a part of) a font.  When loaded into the active blocks, changes will
  360.   affect display output }
  361.  
  362. Procedure LoadFont(block : FontBlock;
  363.             startchar : Char;
  364.  numofchars, charsize : Integer;
  365.               charptr : Pointer); Assembler;
  366. ASM
  367.         MOV     BL, block
  368.         XOR     DH, DH
  369.         MOV     DL, startchar
  370.         MOV     CX, numofchars
  371.         MOV     BH, Byte Ptr charsize
  372.         LES     BP, charptr
  373.         MOV     AX, 1100h
  374.         INT     10h
  375. end;  { LoadFont }
  376.  
  377. Begin  { VGABios }
  378. ASM
  379.  
  380. {  Determine whether active video system is VGA  }
  381.  
  382.         MOV     AX, 1A00h
  383.         INT     10h
  384.         MOV     AH, BL
  385.         CMP     AX, 081Ah
  386.         JE      @1
  387.         MOV     DL, NotVGA
  388.         JMP     @2
  389. @1:     MOV     DL, VGAColour
  390.  
  391. {  VGA found, determine if registers are mapped to mono  }
  392.  
  393.         MOV     AX, 1200h
  394.         MOV     BL, 10h
  395.         INT     10h
  396.         OR      BH, BH
  397.         JZ      @2
  398.         MOV     DL, VGAMono
  399. @2:     MOV     [VGAStatus], DL
  400. end;
  401. end.  { VGABios }