home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 573 / 3dlab101 / vgapal.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  7KB  |  211 lines
  1. {────────────────────────────────────────────────────────────────────────────}
  2. {───( C ) Copyright 1994 By Kimmo Fredriksson.───────────────────────────────}
  3. {────────────────────────────────────────────────────────────────────────────}
  4. {───You may use this unit freely in your programs, and distribute them,──────}
  5. {───but you are *NOT* allowed to distribute any modified form of this────────}
  6. {───unit, not source, nor the compiled TPU, TPP or whatsoever, *without*─────}
  7. {───my permission! In it's original form, this source is freeware.───────────}
  8. {────────────────────────────────────────────────────────────────────────────}
  9. {───Internet email: Kimmo.Fredriksson@Helsinki.FI────────────────────────────}
  10. {────────────────────────────────────────────────────────────────────────────}
  11.  
  12.  
  13. (*
  14.   ╔═════════════════════════════════════════════════════════════════════════╗
  15.   ║                                                                         ║
  16.   ║    (C) Copyright 1992, 94 by Kimmo Fredriksson.                         ║
  17.   ║                                                                         ║
  18.   ╚═════════════════════════════════════════════════════════════════════════╝
  19. *)
  20.  
  21. {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  22.  
  23. UNIT    VGAPal;
  24.  
  25. (****************************************************************************)
  26.                    INTERFACE
  27. (****************************************************************************)
  28.  
  29. TYPE    RGB = RECORD                       { Red, Green and Blue         }
  30.         R : Byte;                  { intensity of the color.     }
  31.         G : Byte;                  { Only bits 0-5 have meaning. }
  32.         B : Byte
  33.           END;
  34.  
  35.     VGAPalType = ARRAY[ 0..256 ] OF RGB;
  36.  
  37.     PtrType = RECORD
  38.             Ofs : Word;
  39.             Seg : Word
  40.           END;
  41.  
  42. CONST    Copyright = ' (C) Copyright 1994 By Kimmo Fredriksson. ';
  43.  
  44.  
  45. PROCEDURE SBorderC( Color : Byte );
  46.  
  47. PROCEDURE SetDACs( Fst, NumOfDACs : Word; Pal : Pointer );
  48.  
  49. PROCEDURE Show;
  50. PROCEDURE Hide;
  51.  
  52. PROCEDURE WaitDisplay;
  53. PROCEDURE WaitRetrace;
  54.  
  55. PROCEDURE BlackToColor( Pal : VGAPalType; MaxColor : Word );
  56. PROCEDURE ColorToBlack( Pal : VGAPalType; MaxColor : Word );
  57. PROCEDURE ZeroDACs;
  58.  
  59. (****************************************************************************)
  60.                 IMPLEMENTATION
  61. (****************************************************************************)
  62.  
  63. CONST    ATTR        = $03C0;
  64.     MISC        = $03C2;
  65.     SEQU        = $03C4;
  66.     GOUT        = $03CE;
  67.     CRTC        = $03D4;
  68.     STA1        = $03DA;
  69. {
  70.  ╔═════════════════════════════════════════════════════════════════════════╗
  71.  ║ SBorderC : Set border color                                             ║
  72.  ╚═════════════════════════════════════════════════════════════════════════╝
  73. }
  74. PROCEDURE SBorderC( Color : Byte ); ASSEMBLER;
  75. ASM
  76.   MOV    AX,1001h
  77.   MOV    BH,[Color]
  78.   INT    10h
  79. END;
  80. {
  81.  ╔═════════════════════════════════════════════════════════════════════════╗
  82.  ║ Show : Screen on                                                        ║
  83.  ╚═════════════════════════════════════════════════════════════════════════╝
  84. }
  85. PROCEDURE Show; ASSEMBLER;
  86. ASM
  87.   MOV    AX,1200h
  88.   MOV    BL,36h
  89.   INT    10h
  90. END;
  91. {
  92.  ╔═════════════════════════════════════════════════════════════════════════╗
  93.  ║ Hide : Screen off                                                       ║
  94.  ╚═════════════════════════════════════════════════════════════════════════╝
  95. }
  96. PROCEDURE Hide; ASSEMBLER;
  97. ASM
  98.   MOV    AX,1201h
  99.   MOV    BL,36h
  100.   INT    10h
  101. END;
  102. {
  103.  ╔═════════════════════════════════════════════════════════════════════════╗
  104.  ║ WaitDisplay                                                             ║
  105.  ╚═════════════════════════════════════════════════════════════════════════╝
  106. }
  107. PROCEDURE WaitDisplay;
  108. BEGIN
  109.   WHILE PORT[ STA1 ] AND $8  = 0 DO;
  110.   WHILE PORT[ STA1 ] AND $8 <> 0 DO;
  111. END;
  112. {
  113.  ╔═════════════════════════════════════════════════════════════════════════╗
  114.  ║ WaitRetrace                                                             ║
  115.  ╚═════════════════════════════════════════════════════════════════════════╝
  116. }
  117. PROCEDURE WaitRetrace;
  118. BEGIN
  119.   WHILE PORT[ STA1 ] AND $8 <> 0 DO;
  120.   WHILE PORT[ STA1 ] AND $8  = 0 DO;
  121. END;
  122. {
  123.  ╔═════════════════════════════════════════════════════════════════════════╗
  124.  ║ SetDACs : Set the VGA DAC-registers                                     ║
  125.  ╚═════════════════════════════════════════════════════════════════════════╝
  126. }
  127. PROCEDURE SetDACs( Fst, NumOfDACs : Word; Pal : Pointer ); ASSEMBLER;
  128. ASM
  129.     PUSH    DS
  130.  
  131.     MOV    DX,03C8h    { PEL address / write }
  132.     MOV    AL,BYTE PTR [Fst]
  133.     OUT    DX,AL
  134.     INC    DX              { DX --> PEL data     }
  135.     LDS    SI,[Pal]
  136.     XOR    AH,AH
  137.     ADD    SI,AX        { Adjust address      }
  138.     ADD    SI,AX
  139.     ADD    SI,AX
  140.     MOV    CX,[NumOfDACs]
  141.     MOV    BX,CX
  142.     ADD    CX,BX           { 3 bytes per color   }
  143.     ADD    CX,BX
  144.  
  145. @NextC: LODSB
  146.     OUT    DX,AL           { Set DACs }
  147.     LOOP    @NextC
  148.  
  149.     POP    DS
  150. END;
  151. {
  152.  ╔═════════════════════════════════════════════════════════════════════════╗
  153.  ║ BlackToColor - fade black screen to desired palette colors              ║
  154.  ╚═════════════════════════════════════════════════════════════════════════╝
  155. }
  156. PROCEDURE BlackToColor( Pal : VGAPalType; MaxColor : Word );
  157. VAR i, j : Word; ZPal : VGAPalType;
  158. BEGIN
  159.   FillChar( ZPal, SizeOf( VGAPalTYPE ), 0 );
  160.   j := 0;
  161.   REPEAT
  162.     Inc( j );
  163.     FOR i := 0 TO MaxColor DO WITH ZPal[ i ] DO
  164.       BEGIN
  165.     IF R < Pal[ i ].R THEN Inc( R );
  166.     IF G < Pal[ i ].G THEN Inc( G );
  167.     IF B < Pal[ i ].B THEN Inc( B )
  168.       END;
  169.     WaitDisplay;
  170.     SetDACs( 0, MaxColor, @ZPal )
  171.   UNTIL j = 64
  172. END;
  173. {
  174.   ╔═════════════════════════════════════════════════════════════════════════╗
  175.   ║ ColorToBlack - fade tha input palette to black                          ║
  176.   ╚═════════════════════════════════════════════════════════════════════════╝
  177. }
  178. PROCEDURE ColorToBlack( Pal : VGAPalType; MaxColor : Word );
  179. VAR i, j : Word;
  180. BEGIN
  181.   j := 0;
  182.   REPEAT
  183.     Inc( j );
  184.     FOR i := 0 TO MaxColor DO WITH Pal[ i ] DO
  185.       BEGIN
  186.     IF R > 0 THEN Dec( R );
  187.     IF G > 0 THEN Dec( G );
  188.     IF B > 0 THEN Dec( B )
  189.       END;
  190.     WaitDisplay;
  191.     SetDACs( 0, MaxColor + 1, @Pal )
  192.   UNTIL j = 64
  193. END;
  194. {
  195.   ╔═════════════════════════════════════════════════════════════════════════╗
  196.   ║ ZeroDACs                                                                ║
  197.   ╚═════════════════════════════════════════════════════════════════════════╝
  198. }
  199. PROCEDURE ZeroDACs;
  200. VAR z : VGAPalTYPE;
  201. BEGIN
  202.   FillChar( z, SizeOf( VGAPalTYPE ), 0 );
  203.   SetDACs( 0, 256, @z )
  204. END;
  205.  
  206. (*****************************************************************************
  207.                 INITIALIZATION
  208. *****************************************************************************)
  209.  
  210. END.
  211.