Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : VGAPAL.PAS

 
Output of file : VGAPAL.PAS contained in archive : 3DLAB110.ZIP
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄ( C ) Copyright 1994 By Kimmo Fredriksson.ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄYou may use this unit freely in your programs, and distribute them,ÄÄÄÄÄÄ}
{ÄÄÄbut you are *NOT* allowed to distribute any modified form of thisÄÄÄÄÄÄÄÄ}
{ÄÄÄunit, not source, nor the compiled TPU, TPP or whatsoever, *without*ÄÄÄÄÄ}
{ÄÄÄmy permission! In it's original form, this source is freeware.ÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄInternet email: [email protected]ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}


(*
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º º
º (C) Copyright 1992, 94 by Kimmo Fredriksson. º
º º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
*)

{$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+}

UNIT VGAPal;

(****************************************************************************)
INTERFACE
(****************************************************************************)

TYPE RGB = RECORD { Red, Green and Blue }
R : Byte; { intensity of the color. }
G : Byte; { Only bits 0-5 have meaning. }
B : Byte
END;

VGAPalType = ARRAY[ 0..256 ] OF RGB;

PtrType = RECORD
Ofs : Word;
Seg : Word
END;

CONST Copyright = ' (C) Copyright 1994 By Kimmo Fredriksson. ';


PROCEDURE SBorderC( Color : Byte );

PROCEDURE SetDACs( Fst, NumOfDACs : Word; Pal : Pointer );

PROCEDURE Show;
PROCEDURE Hide;

PROCEDURE WaitDisplay;
PROCEDURE WaitRetrace;

PROCEDURE BlackToColor( Pal : VGAPalType; MaxColor : Word );
PROCEDURE ColorToBlack( Pal : VGAPalType; MaxColor : Word );
PROCEDURE ZeroDACs;

(****************************************************************************)
IMPLEMENTATION
(****************************************************************************)

CONST ATTR = $03C0;
MISC = $03C2;
SEQU = $03C4;
GOUT = $03CE;
CRTC = $03D4;
STA1 = $03DA;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º SBorderC : Set border color º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE SBorderC( Color : Byte ); ASSEMBLER;
ASM
MOV AX,1001h
MOV BH,[Color]
INT 10h
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Show : Screen on º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Show; ASSEMBLER;
ASM
MOV AX,1200h
MOV BL,36h
INT 10h
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Hide : Screen off º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE Hide; ASSEMBLER;
ASM
MOV AX,1201h
MOV BL,36h
INT 10h
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º WaitDisplay º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE WaitDisplay;
BEGIN
WHILE PORT[ STA1 ] AND $8 = 0 DO;
WHILE PORT[ STA1 ] AND $8 <> 0 DO;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º WaitRetrace º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE WaitRetrace;
BEGIN
WHILE PORT[ STA1 ] AND $8 <> 0 DO;
WHILE PORT[ STA1 ] AND $8 = 0 DO;
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º SetDACs : Set the VGA DAC-registers º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE SetDACs( Fst, NumOfDACs : Word; Pal : Pointer ); ASSEMBLER;
ASM
PUSH DS

MOV DX,03C8h { PEL address / write }
MOV AL,BYTE PTR [Fst]
OUT DX,AL
INC DX { DX --> PEL data }
LDS SI,[Pal]
XOR AH,AH
ADD SI,AX { Adjust address }
ADD SI,AX
ADD SI,AX
MOV CX,[NumOfDACs]
MOV BX,CX
ADD CX,BX { 3 bytes per color }
ADD CX,BX

@NextC: LODSB
OUT DX,AL { Set DACs }
LOOP @NextC

POP DS
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º BlackToColor - fade black screen to desired palette colors º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE BlackToColor( Pal : VGAPalType; MaxColor : Word );
VAR i, j : Word; ZPal : VGAPalType;
BEGIN
FillChar( ZPal, SizeOf( VGAPalTYPE ), 0 );
j := 0;
REPEAT
Inc( j );
FOR i := 0 TO MaxColor DO WITH ZPal[ i ] DO
BEGIN
IF R < Pal[ i ].R THEN Inc( R );
IF G < Pal[ i ].G THEN Inc( G );
IF B < Pal[ i ].B THEN Inc( B )
END;
WaitDisplay;
SetDACs( 0, MaxColor, @ZPal )
UNTIL j = 64
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º ColorToBlack - fade tha input palette to black º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE ColorToBlack( Pal : VGAPalType; MaxColor : Word );
VAR i, j : Word;
BEGIN
j := 0;
REPEAT
Inc( j );
FOR i := 0 TO MaxColor DO WITH Pal[ i ] DO
BEGIN
IF R > 0 THEN Dec( R );
IF G > 0 THEN Dec( G );
IF B > 0 THEN Dec( B )
END;
WaitDisplay;
SetDACs( 0, MaxColor + 1, @Pal )
UNTIL j = 64
END;
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º ZeroDACs º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
PROCEDURE ZeroDACs;
VAR z : VGAPalTYPE;
BEGIN
FillChar( z, SizeOf( VGAPalTYPE ), 0 );
SetDACs( 0, 256, @z )
END;

(*****************************************************************************
INITIALIZATION
*****************************************************************************)

END.


  3 Responses to “Category : Pascal Source Code
Archive   : 3DLAB110.ZIP
Filename : VGAPAL.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/