[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]