[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{
>> Could someone please explain to me about VGA palette fading and
>> rotating? I am writing a small screensaver program, and want to rotate
>> the palette and fade a little. Any help would be greatly appreciated.
>First, a few questions for you. Do you know how to access the Palette? Do
>you know how the VGA Palette is set up? If not, I can help you understand i
>& manipulate it.
JR>Once you know the above, fading & rotating is pretty easy. Fading is just
JR>decrementing the values in the palette slowly while rotating is just moving
JR>all the values in the palette forward or backward.
Here is some source for Fadeing, Cycling, and Rotating the palette. It
probably doesn't have the procedures you need for a Screensaver, but I
figure you will be able to understand it and write you own procedures
using the code provided. (I have tested the code and find that it works
almost perfectly on my machine (there's a little "snow" at the top) but
I make no guarantees that it will work for anyone elses).
If you need a Demo program that uses this unit, just ask, I have one.
{ ********************************************************** }
{ ********************** Palette Unit ********************** }
{ ********************************************************** }
{ **************** Written by: Rick Haines ***************** }
{ ********************************************************** }
{ ***************** Last Revised 11/28/94 ****************** }
{ ********************************************************** }
Unit Palette;
{ ********************************************************** }
{ *********************** REMINDER!: *********************** }
{ ************* The first color in the palette ************* }
{ **************** is the background color! **************** }
{ ********************************************************** }
Interface
Type
RGBColor = Record
R, G, B : Byte;
End;
RGBPalette = Array[0..255] Of RGBColor;
Procedure WaitForVRT; { Wait For Verticl}
Procedure FadeInColor(ColorNum : Byte); { Fade In a specif}
Procedure FadeOutColor(ColorNum : Byte); { Fade Out a speci}
Procedure RestoreColor(ColorNum : Byte); { Fade In Color im}
Procedure BlackOutColor(ColorNum : Byte); { Fade Out Color i}
Procedure CycleColor(ColorNum, Red, Green, Blue : Byte); { Cycle color into}
Procedure ChangeColor(ColorNum, Red, Green, Blue : Byte); { Change color int}
Procedure CopyColor(Num : Byte; Var Color : RGBColor); { Load a copy of C}
Procedure GetCopyOfColor(Num : Byte; Var Color : RGBColor); { Get a Copy of Co}
Procedure GetPalette; { Load the default Palett}
Procedure CyclePalette; { Cycle from one Palette }
Procedure FadeInPalette; { Fade Palette in slowly }
Procedure FadeOutPalette; { Fade Palette out slowly}
Procedure RestorePalette; { Fade Palette in immedia}
Procedure BlackOutPalette; { Fade Palette out immedi}
Procedure LoadPalette(PalName : String); { Load a palette }
Procedure SavePalette(PalName : String); { Save the palette that i}
Procedure CyclePaletteToColor(ColorNum : Byte); { Cycle entire Palette Co}
Procedure ChangePaletteToColor(ColorNum : Byte); { Change entire Palette C}
Procedure CopyPalette(Var NewPal : RGBPalette); { Load palette already in}
Procedure GetCopyOfPalette(Var Copy : RGBPalette); { Incase you don't want t}
Procedure CyclePart(FirstC, LastC : Byte); { Cycle from one }
Procedure FadeInPart(FirstC, LastC : Byte); { Fade Part in sl}
Procedure FadeOutPart(FirstC, LastC : Byte); { Fade Part out s}
Procedure RestorePart(FirstC, LastC : Byte); { Fade Part in im}
Procedure BlackOutPart(FirstC, LastC : Byte); { Fade Part out i}
Procedure RotatePartForward(FirstC, LastC : Byte); { Rotate Part For}
Procedure RotatePartBackward(FirstC, LastC : Byte); { Rotate Part Bac}
Procedure CyclePartToColor(FirstC, LastC, ColorNum : Byte); { Cycle Part Colo}
Procedure ChangePartToColor(FirstC, LastC, ColorNum : Byte); { Change Part Col}
Implementation
Uses MostUsed;
Const
PalRange = $03C6;
ReadPal = $03C7;
WritePal = $03C8;
PalData = $03C9;
VRTPort = $03DA;
Var
APalette,
BackUpP : RGBPalette;
ExColor : RGBColor;
First,
Last,
I, II, Z : Byte;
Procedure WaitForVRT; Assembler;
Asm { Wait for Verticle Retrace so that }
Mov DX, VRTPort { "snow" is avoided }
@VRT:
In AL, DX
Test AL, 8
JNZ @VRT { Wait until Verticle Retrace starts }
@NoVRT:
In AL, DX
Test AL, 8
JZ @NoVRT { Wait until Verticle Retrace Ends }
End;
Procedure WriteColor(ColorNum : Byte); Assembler;
Asm
{ Initialization Stuff }
Mov SI, Offset APalette { DS:SI := @APalette }
Xor CH, CH
Mov CL, ColorNum { CX := ColorNum }
Mov AX, CX
ShL AX, 1 { Use a Shift by Two and an }
Add CX, AX { Add to Multiply by 3 }
Add SI, CX { Adjust Offset of APalette }
Mov DX, PalRange { DX := Palette Range Port }
Mov AX, 0FFh { AX := Range is All Colors }
Out DX, AX { Write AX To Port DX }
Call WaitForVRT; { Wait for Verticle ReTrace }
{ Write the color to Ports }
Mov DX, WritePal { DX := Color To Write Port }
Mov AL, ColorNum { AL := Color To Write }
Out DX, AL { Tell It We Want to Write Color }
Mov DX, PalData { DX := Palette Data Port }
Mov AL, [SI] { AL := APalette[ColorNum].R }
Out DX, AL { Write it }
Inc SI { Inc Offset }
Mov AL, [SI] { AL := APalette[ColorNum].G }
Out DX, AL { Write it }
Inc SI { Inc Offset }
Mov AL, [SI] { AL := APalette[ColorNum].G }
Out DX, AL { Write it }
End;
Procedure FadeInColor(ColorNum : Byte);
Begin
For I := 0 To 63 Do
With APalette[ColorNum] Do
Begin
If R < BackUpP[ColorNum].R Then Inc(R);
If G < BackUpP[ColorNum].G Then Inc(G);
If B < BackUpP[ColorNum].B Then Inc(B);
WriteColor(ColorNum);
End;
End;
Procedure FadeOutColor(ColorNum : Byte);
Begin
For I := 0 To 63 Do
With APalette[ColorNum] Do
Begin
If R > 0 Then Dec(R);
If G > 0 Then Dec(G);
If B > 0 Then Dec(B);
WriteColor(ColorNum);
End;
End;
Procedure RestoreColor(ColorNum : Byte);
Begin
APalette[ColorNum] := BackUpP[ColorNum];
WriteColor(ColorNum);
End;
Procedure BlackOutColor(ColorNum : Byte);
Begin
With APalette[ColorNum] Do
Begin
R := 0;
G := 0;
B := 0;
End;
WriteColor(ColorNum);
End;
Procedure CopyColor(Num : Byte; Var Color : RGBColor);
Begin
With BackUpP[Num] Do
Begin
R := Color.R;
G := Color.G;
B := Color.B;
End;
End;
Procedure CycleColor(ColorNum, Red, Green, Blue : Byte);
Begin
For I := 0 To 63 Do
With APalette[ColorNum] Do
Begin
If R < Red Then Inc(R);
If G < Green Then Inc(G);
If B < Blue Then Inc(B);
If R > Red Then Dec(R);
If G > Green Then Dec(G);
If B > Blue Then Dec(B);
WriteColor(ColorNum);
End;
End;
Procedure ChangeColor(ColorNum, Red, Green, Blue : Byte);
Begin
With BackUpP[ColorNum] Do
Begin
R := Red;
G := Green;
B := Blue;
End;
End;
Procedure GetCopyOfColor(Num : Byte; Var Color : RGBColor);
Begin
With BackUpP[Num] Do
Begin
Color.R := R;
Color.G := G;
Color.B := B;
End;
End;
Procedure GetPalette; Assembler;
Asm
{ Initialization Stuff }
Mov DI, Offset BackUpP { DS:DI := @BackUpP }
Xor CX, CX { CL := 0 (Counter) }
Mov DX, PalRange { DX := Palette Range Port }
Mov AX, 0FFh { AX := Range is All Colors }
Out DX, AX { Write AX To Port DX }
Call WaitForVRT; { Wait for Verticle ReTrace }
{ Now Get the Entire Palette From Ports }
@MainLoop:
Mov DX, ReadPal { DX := Color To Read Port }
Mov AL, CL { AL := CL (Current Color) }
Out DX, AL { Tell It We Want to Read Color # CL }
Mov DX, PalData { DX := Palette Data Port }
In AL, DX { Read Red }
Mov [DI], AL { BackUpP[CL].R := AL }
Inc DI { Inc Offset }
In AL, DX { Read Green }
Mov [DI], AL { BackUpP[CL].G := AL }
Inc DI { Inc Offset }
In AL, DX { Read Blue }
Mov [DI], AL { BackUpP[CL].B := AL }
Inc DI { Inc Offset }
Inc CX { Inc Counter }
Cmp CX, 256 { Are We Done? }
JNE @MainLoop { No? Then Loop }
{ Now Do APalette := BackUpP }
Mov SI, Offset BackUpP { DS:SI := @BackUpP }
Mov DI, DS
Mov ES, DI
Mov DI, Offset APalette { ES:DI := @APalette }
Mov CX, 256*3 { How many bytes to copy }
Shr CX, 1 { Div by 2 for Words }
ClD { Go downward in memory }
Rep MovSW { Move It }
End;
Procedure WritePalette; Assembler;
Asm
{ Initialization Stuff }
Mov SI, Offset APalette { DS:SI := @APalette }
Xor CX, CX { CX := 0 (Counter) }
Mov DX, PalRange { DX := Palette Range Port }
Mov AX, 0FFh { AX := Range is All Colors }
Out DX, AX { Write AX To Port DX }
Call WaitForVRT; { Wait for Verticle ReTrace }
{ Now write Entire Palette to Ports }
@MainLoop:
Mov DX, WritePal { DX := Color To Write Port }
Mov AL, CL { AL := CL (Current Color) }
Out DX, AL { Tell It We Want to Write Color # CL }
Mov DX, PalData { DX := Palette Data Port }
Mov AL, [SI] { AL := APalette[CL].R }
Out DX, AL { Write it }
Inc SI { Inc Offset }
Mov AL, [SI] { AL := APalette[CL].R }
Out DX, AL { Write it }
Inc SI { Inc Offset }
Mov AL, [SI] { AL := APalette[CL].G }
Out DX, AL { Write it }
Inc SI { Inc Offset }
Inc CX { Inc Counter }
Cmp CX, 256 { Are We Done? }
JNE @MainLoop { No? Then Loop }
End;
Procedure CyclePalette;
Begin
For I := 0 To 63 Do
Begin
For II := 0 To 255 Do With APalette[II] Do
Begin
If R < BackUpP[II].R Then Inc(R)
Else If R > BackUpP[II].R Then Dec(R);
If G < BackUpP[II].G Then Inc(G)
Else If G > BackUpP[II].G Then Dec(G);
If B < BackUpP[II].B Then Inc(B)
Else If B > BackUpP[II].B Then Dec(B);
End;
WritePalette;
End;
End;
Procedure FadeInPalette;
Begin
For I := 0 To 63 Do
Begin
For II := 0 To 255 Do With APalette[II] Do
Begin
If R < BackUpP[II].R Then Inc(R);
If G < BackUpP[II].G Then Inc(G);
If B < BackUpP[II].B Then Inc(B);
End;
WritePalette;
End;
End;
Procedure FadeOutPalette;
Begin
For I := 0 To 63 Do
Begin
For II := 0 To 255 Do With APalette[II] Do
Begin
If R > 0 Then Dec(R);
If G > 0 Then Dec(G);
If B > 0 Then Dec(B);
End;
WritePalette;
End;
End;
Procedure RestorePalette;
Begin
APalette := BackUpP;
WritePalette;
End;
Procedure BlackOutPalette; Assembler;
Asm
Mov DI, DS
Mov ES, DI { ES contains segment of Palette }
Mov DI, Offset APalette; { DI contains offset of Palette }
Mov CX, 256*3 { CX = how many bytes to write }
ShR CX, 1 { Divide by 2 for how many words }
Mov AX, 0 { Word to write to memory }
ClD { Go downward in memory }
Rep StoSW { Write it all to memory }
Call WritePalette; { Write the Palette }
End;
Procedure LoadPalette(PalName : String);
Var
PalFile : File;
Begin
PalName := PalName + '.PAL';
If Not FileExists(PalName) Then Exit;
Assign(PalFile, PalName);
Reset(PalFile, 3);
For I := 0 To 255 Do
Begin
If EoF(PalFile) Then Break;
BlockRead(PalFile, BackUpP[I], 1);
End;
Close(PalFile);
End;
Procedure SavePalette(PalName : String);
Var
PalFile : File;
Begin
If Length(PalName) > 8 Then Exit;
PalName := PalName + '.PAL';
Assign(PalFile, PalName);
ReWrite(PalFile, 3);
For I := 0 To 255 Do BlockWrite(PalFile, BackUpP[I], 1);
Close(PalFile);
End;
Procedure CyclePaletteToColor(ColorNum : Byte);
Begin
For I := 0 To 63 Do
Begin
For II := 0 To 255 Do With APalette[II] Do
Begin
If R < BackUpP[ColorNum].R Then Inc(R)
Else If R > BackUpP[ColorNum].R Then Dec(R);
If G < BackUpP[ColorNum].G Then Inc(G)
Else If G > BackUpP[ColorNum].G Then Dec(G);
If B < BackUpP[ColorNum].B Then Inc(B)
Else If B > BackUpP[ColorNum].B Then Dec(B);
End;
WritePalette;
End;
End;
Procedure ChangePaletteToColor(ColorNum : Byte);
Begin
For I := 0 To 255 Do With APalette[I] Do
Begin
R := BackUpP[ColorNum].R;
G := BackUpP[ColorNum].G;
B := BackUpP[ColorNum].B;
End;
WritePalette;
End;
Procedure CopyPalette(Var NewPal : RGBPalette);
Begin
BackUpP := NewPal;
End;
Procedure GetCopyOfPalette(Var Copy : RGBPalette);
Begin
Copy := BackUpP;
End;
Procedure WritePart; Assembler;
Asm
{ Initialization Stuff }
Mov SI, Offset APalette { DS:SI := @APalette }
Xor BH, BH
Mov BL, [First]
Mov DI, BX
ShL BX, 1
Add DI, BX { Mult By 3 Quick }
Add SI, DI { Adjust Offset }
Xor CH, CH
Mov CL, [First] { CX := First (Counter) }
Xor BH, BH
Mov BL, [Last] { BX := Last Color }
Inc BX
Mov DX, PalRange { DX := Palette Range Port }
Mov AX, 0FFh { AX := Range is All Colors }
Out DX, AX { Write AX To Port DX }
Call WaitForVRT; { Wait for Verticle ReTrace }
{ Now write Palette to Ports }
@MainLoop:
Mov DX, WritePal { DX := Color To Write Port }
Mov AL, CL { AL := CL (Current Color) }
Out DX, AL { Tell It We Want to Write Color # CL }
Mov DX, PalData { DX := Palette Data Port }
Mov AL, [SI] { AL := APalette[CL].R }
Out DX, AL { Write it }
Inc SI { Inc Offset }
Mov AL, [SI] { AL := APalette[CL].R }
Out DX, AL { Write it }
Inc SI { Inc Offset }
Mov AL, [SI] { AL := APalette[CL].G }
Out DX, AL { Write it }
Inc SI { Inc Offset }
Inc CX { Inc Counter }
Cmp CX, BX { Are We Done? }
JNE @MainLoop { No? Then Loop }
End;
Procedure CyclePart(FirstC, LastC : Byte);
Begin
First := FirstC; Last := LastC;
For I := 0 To 63 Do
Begin
For II := First To Last Do With APalette[II] Do
Begin
If R < BackUpP[II].R Then Inc(R)
Else If R > BackUpP[II].R Then Dec(R);
If G < BackUpP[II].G Then Inc(G)
Else If G > BackUpP[II].G Then Dec(G);
If B < BackUpP[II].B Then Inc(B)
Else If B > BackUpP[II].B Then Dec(B);
End;
WritePart;
End;
End;
Procedure FadeInPart(FirstC, LastC : Byte);
Begin
First := FirstC; Last := LastC;
For I := 0 To 63 Do
Begin
For II := First To Last Do With APalette[II] Do
Begin
If R < BackUpP[II].R Then Inc(R);
If G < BackUpP[II].G Then Inc(G);
If B < BackUpP[II].B Then Inc(B);
End;
WritePart;
End;
End;
Procedure FadeOutPart(FirstC, LastC : Byte);
Begin
First := FirstC; Last := LastC;
For I := 0 To 63 Do
Begin
For II := First To Last Do With APalette[II] Do
Begin
If R > 0 Then Dec(R);
If G > 0 Then Dec(G);
If B > 0 Then Dec(B);
End;
WritePart;
End;
End;
Procedure RestorePart(FirstC, LastC : Byte);
Begin
First := FirstC; Last := LastC;
For I := First To Last Do APalette[I] := BackUpP[I];
WritePart;
End;
Procedure BlackOutPart(FirstC, LastC : Byte); Assembler;
Asm
Mov BL, [FirstC]
Mov [First], BL
Mov BL, [LastC]
Mov [Last], BL
Mov DI, DS
Mov ES, DI { ES contains segment of Palette }
Mov DI, Offset APalette; { DI contains offset of Palette }
Xor BH, BH
Mov BL, [First]
Mov CX, BX
ShL CX, 1
Add BX, CX { Mult By 3 Quick }
Add DI, BX { Adjust Offset Of Palette }
Xor BH, BH
Mov BL, [Last]
Xor CH, CH
Mov CL, [First]
Sub BX, CX { Get Num Of Bytes to Write in CX}
Mov CX, BX
ShL CX, 1
Mov AX, 0 { Word to write to memory }
ClD { Go downward in memory }
Rep StoSB { Write it all to memory }
Call WritePart; { Write the Palette }
End;
Procedure CyclePartToColor(FirstC, LastC, ColorNum : Byte);
Begin
First := FirstC; Last := LastC;
For I := 0 To 63 Do
Begin
For II := FirstC To LastC Do With APalette[II] Do
Begin
If R < BackUpP[ColorNum].R Then Inc(R)
Else If R > BackUpP[ColorNum].R Then Dec(R);
If G < BackUpP[ColorNum].G Then Inc(G)
Else If G > BackUpP[ColorNum].G Then Dec(G);
If B < BackUpP[ColorNum].B Then Inc(B)
Else If B > BackUpP[ColorNum].B Then Dec(B);
End;
WritePart;
End;
End;
Procedure ChangePartToColor(FirstC, LastC, ColorNum : Byte);
Begin
First := FirstC; Last := LastC;
For I := First To Last Do With APalette[I] Do
Begin
R := BackUpP[ColorNum].R;
G := BackUpP[ColorNum].G;
B := BackUpP[ColorNum].B;
End;
WritePart;
End;
Procedure RotatePartForward(FirstC, LastC : Byte);
Begin
First := FirstC; Last := LastC;
ExColor := APalette[Last];
For I := Last DownTo First+1 Do APalette[I] := APalette[I-1];
APalette[First] := ExColor;
WritePart;
End;
Procedure RotatePartBackward(FirstC, LastC : Byte);
Begin
First := FirstC; Last := LastC;
ExColor := APalette[First];
For I := First To Last-1 Do APalette[I] := APalette[I+1];
APalette[Last] := ExColor;
WritePart;
End;
End.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]