home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / ZIP2OBJ.ZIP / VGABIOS.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-12  |  10KB  |  405 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.  
  115. {  Get current cursor location  }
  116.  
  117.         CALL    Far Ptr GetDisplayPage
  118.         MOV     AH, 3
  119.         INT     10h
  120.  
  121. {  Set leftmost bit on to preserve screen contents  }
  122.  
  123.         MOV     AL, mode
  124.         OR      AL, 80h
  125.         MOV     AH, 0
  126.         INT     10h
  127.  
  128. {  Restore cursor location  }
  129.  
  130.         MOV     AH, 2
  131.         INT     10h
  132.  
  133. {  Set cursor to underline  }
  134.  
  135.         MOV     CX, 0607h
  136.         MOV     AH, 1
  137.         INT     10h
  138. end;  { SetVideoMode }
  139.  
  140. { Select the vertical scan line.  Select either CGA, EGA or VGA
  141.   resolution }
  142.  
  143. Procedure SetScanLine(scanlines : ScanLineType); Assembler;
  144.  
  145. ASM
  146.         MOV     AL, scanlines
  147.         MOV     AH, 12h
  148.         MOV     BL, 30h
  149.         INT     10h
  150. end;  { SetScanLine }
  151.  
  152. { Sum all colours to gray scales.  Changes will take effect after
  153.   next call to SetVideoMode }
  154.  
  155. Procedure SumGrayScale(enable : Boolean); Assembler;
  156.  
  157. ASM
  158.         MOV     AL, enable
  159.         OR      AL, AL
  160.         JZ      @1
  161.         DEC     AX
  162.         JMP     @2
  163. @1:     INC     AX
  164. @2:     MOV     AH, 12h
  165.         MOV     BL, 33h
  166.         INT     10h
  167. end;  { SumGrayScale }
  168.  
  169. { Determine whether a call to SetVideoMode should reset the colours to
  170.   their default values or not }
  171.  
  172. Procedure SaveCurrentPalette(enable : Boolean); Assembler;
  173.  
  174. ASM
  175.         MOV     AL, enable
  176.         MOV     AH, 12h
  177.         MOV     BL, 31h
  178.         INT     10h
  179. end;  { SaveCurrentPalette }
  180.  
  181. { Get colour information from a DAC register }
  182.  
  183. Function GetRegister(register : Byte) : ColourRange; Assembler;
  184.  
  185. ASM
  186.         XOR     BX, BX
  187.         MOV     BL, register
  188.         MOV     AX, 1007h
  189.         INT     10h
  190.         MOV     AL, BH
  191. end;  { GetRegister }
  192.  
  193. { Store colour information to DAC register }
  194.  
  195. Procedure SetRegister(register : Byte; colour : ColourRange); Assembler;
  196.  
  197. ASM
  198.         MOV     BH, colour
  199.         MOV     BL, register
  200.         MOV     AX, 1000h
  201.         INT     10h
  202. end;  { SetRegister }
  203.  
  204. { Get the current border colour }
  205.  
  206. Function GetBorderColour : ColourRange; Assembler;
  207.  
  208. ASM
  209.         MOV     AX, 1008h
  210.         INT     10h
  211.         MOV     AL, BH
  212. end;  { GetBorderColour }
  213.  
  214. { Store the current border colour }
  215.  
  216. Procedure SetBorderColour(colour : ColourRange); Assembler;
  217.  
  218. ASM
  219.         MOV     BH, colour
  220.         MOV     AX, 1001h
  221.         INT     10h
  222. end;  { SetBorderColour }
  223.  
  224. { Get the Red, Green and Blue intensity from a DAC register }
  225.  
  226. Procedure GetRGBValue(register : Byte; Var RGB : RGBType); Assembler;
  227.  
  228. ASM
  229.         LES     DI, RGB
  230.         XOR     BX, BX
  231.         MOV     BL, register
  232.         MOV     AX, 1015h
  233.         INT     10h
  234.         MOV     AL, DH
  235.         STOSB
  236.         XCHG    AX, CX
  237.         XCHG    AH, AL
  238.         STOSW
  239. end;  { GetRGBValue }
  240.  
  241. { Store the Red, Green and Blue intensity into a DAC register }
  242.  
  243. Procedure SetRGBValue(register : Byte; RGB : RGBType); Assembler;
  244.  
  245. ASM
  246.         PUSH    DS
  247.         LDS     SI, RGB
  248.         XOR     BX, BX
  249.         MOV     BL, register
  250.         LODSB
  251.         MOV     DH, AL
  252.         LODSW
  253.         XCHG    CX, AX
  254.         XCHG    CH, CL
  255.         MOV     AX, 1010h
  256.         INT     10h
  257.         POP     DS
  258. end;  { SetRGBValue }
  259.  
  260. { Get font block index of current (resident) and alternate character set.
  261.   Up to two fonts can be active at the same time }
  262.  
  263. Procedure GetFontBlock(Var primary, secondary : FontBlock); Assembler;
  264.  
  265. ASM
  266.  
  267. {  Get character map select register:
  268. (VGA sequencer port 3C4h/3C5h index 3)
  269.  
  270. 7  6  5  4  3  2  1  0
  271.       │  │  │  │  │  │
  272.       │  │  │  │  └──┴──   Primary font   (lower 2 bits)
  273.       │  │  └──┴────────   Secondary font (lower 2 bits)
  274.       │  └──────────────   Primary font   (high bit)
  275.       └─────────────────   Secondary font (high bit)     }
  276.  
  277.         MOV     AL, 3
  278.         MOV     DX, 3C4h
  279.         OUT     DX, AL
  280.         INC     DX
  281.         IN      AL, DX
  282.         MOV     BL, AL
  283.         PUSH    AX
  284.  
  285. {  Get secondary font number: add up bits 5, 3 and 2  }
  286.  
  287.         SHR     AL, 1
  288.         SHR     AL, 1
  289.         AND     AL, 3
  290.         TEST    BL, 00100000b
  291.         JZ      @1
  292.         ADD     AL, 4
  293. @1:     LES     DI, secondary
  294.         STOSB
  295.  
  296. {  Get primary font number: add up bits 4, 1 and 0  }
  297.  
  298.         POP     AX
  299.         AND     AL, 3
  300.         TEST    BL, 00010000b
  301.         JZ      @2
  302.         ADD     AL, 4
  303. @2:     LES     DI, primary
  304.         STOSB
  305. end;  { GetFontBlock }
  306.  
  307. { Store the font block index }
  308.  
  309. Procedure SetFontBlock(primary, secondary : FontBlock); Assembler;
  310.  
  311. ASM
  312.         MOV     CH, primary
  313.         MOV     CL, secondary
  314.         XOR     BX, BX
  315.         MOV     AX, CX
  316.  
  317. {  Code primary font into bits 4, 1 and 0  }
  318.  
  319.         AND     AH, 3
  320.         TEST    CH, 00000100b
  321.         JZ      @1
  322.         ADD     BL, 10h
  323. @1:     ADD     BL, AH
  324.  
  325. {  Code secondary font into bits 5, 3 and 2  }
  326.  
  327.         AND     AL, 3
  328.         SHL     AL, 1
  329.         SHL     AL, 1
  330.         TEST    CL, 00000100b
  331.         JZ      @2
  332.         ADD     BL, 20h
  333. @2:     ADD     BL, AL
  334.  
  335. {  Set block specifier  }
  336.  
  337.         MOV     AX, 1103h
  338.         INT     10h
  339. end;  { SetFontBlock }
  340.  
  341. { Load the resident 8x8 font }
  342.  
  343. Procedure LoadFont8x8; Assembler;
  344.  
  345. ASM
  346.         MOV     AX, 1112h
  347.         MOV     BL, 0
  348.         INT     10h
  349. end;  { LoadFont8x8 }
  350.  
  351. { Get a pointer to one of the eight resident VGA fonts }
  352.  
  353. Function GetFontPtr(charset : CharSetType) : Pointer; Assembler;
  354.  
  355. ASM
  356.         MOV     BH, charset
  357.         MOV     AX, 1130h
  358.         INT     10h
  359.         MOV     DX, ES
  360.         MOV     AX, BP
  361. end;  { GetFontPtr }
  362.  
  363. { Load (a part of) a font.  When loaded into the active blocks, changes will
  364.   affect display output }
  365.  
  366. Procedure LoadFont(block : FontBlock;
  367.             startchar : Char;
  368.  numofchars, charsize : Integer;
  369.               charptr : Pointer); Assembler;
  370. ASM
  371.         MOV     BL, block
  372.         XOR     DH, DH
  373.         MOV     DL, startchar
  374.         MOV     CX, numofchars
  375.         MOV     BH, Byte Ptr charsize
  376.         LES     BP, charptr
  377.         MOV     AX, 1100h
  378.         INT     10h
  379. end;  { LoadFont }
  380.  
  381. Begin  { VGABios }
  382. ASM
  383.  
  384. {  Determine whether active video system is VGA  }
  385.  
  386.         MOV     AX, 1A00h
  387.         INT     10h
  388.         MOV     AH, BL
  389.         CMP     AX, 081Ah
  390.         JE      @1
  391.         MOV     DL, NotVGA
  392.         JMP     @2
  393. @1:     MOV     DL, VGAColour
  394.  
  395. {  VGA found, determine if registers are mapped to mono  }
  396.  
  397.         MOV     AX, 1200h
  398.         MOV     BL, 10h
  399.         INT     10h
  400.         OR      BH, BH
  401.         JZ      @2
  402.         MOV     DL, VGAMono
  403. @2:     MOV     [VGAStatus], DL
  404. end;
  405. end.  { VGABios }