Gamma Fading in Pascal
Source code by Matt Mora, Port and comments by Bill Catambay



A frequently requested code example is code to perform a Gamma Fade on the Macintosh. In early 1995, Matt Slot wrote a library in C which accomplished this, but Pascal programmers had no sample code to work from. Then, in July of 1995, Matt Mora posted a set of Gamma Fade routines in Pascal. The code which follows are those Gamma Fade library routines, composed in a UNIT named GammaPasLib. Following the library is a short sample program which demonstrates the use of the Gamma Fade routines. The complete project can be found in the alt.sources.mac archive, in the AOL Pascal archive, and at various FTP sites.


Download a working version of this project. (6/8/98)




Unit GammaPaslib;

{---------------------------------------------------------------------------------------------}
{ File "gamma.p" - Source for Altering the Gamma Tables of GDevices from Gamma.c              }
{  (C code by Matt Slot)                                                                      }
{---------------------------------------------------------------------------------------------}
{ 7-13-95    ported to pascal  by Matthew Xavier Mora mxmora@mxmdesigns.com                   }
{ 7-18-95    fixed all the porting bugs and got it to work in think pascal                    }
{---------------------------------------------------------------------------------------------}
{ 7-18-95 ported to CW (68k and PPC) by Bill Catambay, cleaned the code a bit (no more labels)}
{         and added delay functions.                                                          }
{---------------------------------------------------------------------------------------------}



{---------------------------------------------------------------------------------------------}
{    This is the Source Code for the Gamma Utils Library file.                                }                           
{---------------------------------------------------------------------------------------------}
Interface

Uses
    Traps, Video, ToolUtils, Devices;

Const
    kGammaUtilsSig = 'GAMA';
    kGetDeviceListTrapNum = $AA29;

Type
    globalGammasPtr = ^globalGammas;
    globalGammasHdl = ^globalGammasPtr;
    globalGammas = record
        size, dataOffset: Integer;
        saved, hacked: GammaTblHandle;
        theGDevice: GDHandle;
        next: globalGammasHdl;
        end;
    gammaData = packed array[0..100000] of Byte;  {used to set the gamma}
    gammaDataPtr = ^gammaData;

Var
    gammaUtilsInstalled: OSType;
    gammaTables: globalGammasHdl;
    gammaFaded: boolean;

{-----------------------------------------------------------------------------------}
{    These routines help you determine whether you can use the Gamma Table Utils    }
{        on the current machine. The first checks all attached monitors, and the    }
{        second just checks the indicated monitor. Each returns TRUE if you can     }
{        use the functions, or FALSE if you can't. o Note: Before calling any other }
{        Gamma Table function below, use this function to see if you are allowed.   }
{-----------------------------------------------------------------------------------}
Function IsGammaAvailable: Boolean;
Function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;


{-----------------------------------------------------------------------------------}
{    These routines must bracket any calls to the Gamma Table functions, perhaps    }
{        at the head and tail of your main(). The first sets up the data structures }
{        necessary to save and restore the state of your monitors. The second       }
{        disposes of all the internal data structures, but does not reset the       }
{        monitors to their original states. Both return the error code if some      }
{        part failed.                                                               }
{-----------------------------------------------------------------------------------}
Function SetupGammaTools: OSErr;
Function DisposeGammaTools: OSErr;

{--------------------------------------------------------------------------------------}
{    Use the first function to Fade each of your monitors to some percentage of their  }
{        initial brightness (100 = bright, 0 = dim). Repeatedly call this to ramp your }
{        monitors up or down. The second function performs the same function, but only }
{        for the specified monitor. Both return any applicable error codes.  Be sure   }
{        to set up the necessary save-state data structures before you start by        }
{        calling the compatibility and initialization functions.                       }
{--------------------------------------------------------------------------------------}
Function DoGammaFade (percent: Integer): OSErr;
Function DoOneGammaFade (theGDevice: GDHandle;
                               percent: Integer): OSErr;


{--------------------------------------------------------------------------------------}
{    These routines are low-level interfaces to the device drivers for the monitors.   }
{--------------------------------------------------------------------------------------}
Function GetDevGammaTable (theGDevice: GDHandle;
                              Var theTable: GammaTblPtr): OSErr;
Function SetDevGammaTable (theGDevice: GDHandle;
                               Var theTable: GammaTblPtr): OSErr;


{-------------------------------------------------------------- }
{    These routines are for performing Delays on the Fade.      }
{-------------------------------------------------------------- }
Procedure DelayFadeToBlack (delayTicks: longint);
Procedure FadeToBlack (speed: integer);
Procedure FadeFromBlack (speed: integer);
Procedure DelayFadeFromBlack (delayTicks: longint);


Implementation

Function IsGammaAvailable: Boolean;

Var
   theGDevice: GDHandle;

    Begin
    IsGammaAvailable := false;
    If (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = 
        NGetTrapAddress(_Unimplemented, ToolTrap)) Then
          exit(IsGammaAvailable);
    theGDevice := GetDeviceList;
    While (theGDevice  Nil) Do
        Begin
        If (TestDeviceAttribute(theGDevice, screenDevice) And 
            TestDeviceAttribute(theGDevice, noDriver)) Then
            exit(IsGammaAvailable);
        If (theGDevice^^.gdType = fixedType) Then
            exit(IsGammaAvailable);
        theGDevice := GetNextDevice(theGDevice);
        End;
    IsGammaAvailable := true; {If we made it this far then its true}
    End;


Function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;

    Begin
    IsOneGammaAvailable := false;
    If (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = 
        NGetTrapAddress(_Unimplemented, ToolTrap)) Then
          exit(IsOneGammaAvailable);
    If (TestDeviceAttribute(theGDevice, screenDevice) And 
        TestDeviceAttribute(theGDevice, noDriver)) Then
          exit(IsOneGammaAvailable);
    If (theGDevice^^.gdType = fixedType) Then
          exit(IsOneGammaAvailable);
    IsOneGammaAvailable := true;
    End;


Function SetupGammaTools: OSErr;

Var
   errorCold: Integer;
   tempHdl: globalGammasHdl;
   masterGTable: GammaTblPtr;
   theGDevice: GDHandle;

    Begin
    If (gammaUtilsInstalled = kGammaUtilsSig) Then
        Begin
        SetupGammaTools := -1;
        exit(SetupGammaTools);
        End;
    gammaTables := Nil;
    gammaUtilsInstalled := kGammaUtilsSig;
    gammaFaded := FALSE;
    theGDevice := GetDeviceList;
    While (theGDevice  Nil) Do
        Begin
        errorCold := GetDevGammaTable(theGDevice, masterGTable);
        If (errorCold  0) Then
            Begin
            SetupGammaTools := errorCold;
            exit(SetupGammaTools);
            End;
        tempHdl := globalGammasHdl(NewHandle(sizeof(globalGammas)));
        If (tempHdl = Nil) Then
            Begin
            SetupGammaTools := MemError;
            exit(SetupGammaTools);
            End;
        With masterGTable^ Do
            Begin
            tempHdl^^.size := sizeof(GammaTbl) + gFormulaSize + 
                              (gChanCnt * gDataCnt * gDataWidth Div 8);
            tempHdl^^.dataOffset := gFormulaSize;
            tempHdl^^.theGDevice := theGDevice;
            End;
        tempHdl^^.saved := GammaTblHandle(NewHandle(tempHdl^^.size));
        If (tempHdl^^.saved = Nil) Then
            Begin
            SetupGammaTools := MemError;
            exit(SetupGammaTools);
            End;
        tempHdl^^.hacked := GammaTblHandle(NewHandle(tempHdl^^.size));
        If (tempHdl^^.hacked = Nil) Then
            Begin
            SetupGammaTools := MemError;
            exit(SetupGammaTools);
            End;
        BlockMove(Ptr(masterGTable), Ptr(tempHdl^^.saved^), tempHdl^^.size);
        tempHdl^^.next := gammaTables;
        gammaTables := tempHdl;
        theGDevice := GetNextDevice(theGDevice)
        End;
    SetupGammaTools := 0;
    End;

Function DoGammaFade (percent: Integer): OSErr;

Var
   errorCold: Integer;
   thesize, i, theNum: LongInt;
   tempHdl: globalGammasHdl;
   gdp: gammaDataPtr;
   tempLong: Longint;

    Begin
    If (gammaUtilsInstalled  kGammaUtilsSig) Then
        Begin
        DoGammaFade := -1;
        exit(DoGammaFade);
        End;
    tempHdl := gammaTables;
    While (tempHdl  Nil) Do
        Begin
        With tempHdl^^ Do
            Begin
            BlockMove(Ptr(saved^), Ptr(hacked^), size);
            tempLong := ord(@hacked^^.gFormulaData) + dataOffset;
            gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
            thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
            End;
        For i := 0 To thesize - 1 Do
            Begin
            theNum := gdp^[i];
            theNum := (theNum * percent) Div 100;
            gdp^[i] := theNum;
            End;
        errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
        If (errorCold  0) Then
            Begin
            DoGammaFade := errorCold;
            exit(DoGammaFade);
            End;
        tempHdl := tempHdl^^.next;
        End;
    DoGammaFade := 0;
    End;

Function DoOneGammaFade (theGDevice: GDHandle;
                           percent: Integer): OSErr;

Var
   errorCold: Integer;
   thesize, i, theNum: LongInt;
   tempHdl: globalGammasHdl;
   gdp: gammaDataPtr;

    Begin
    If (gammaUtilsInstalled  kGammaUtilsSig) Then
        DoOneGammaFade := -1;
    tempHdl := gammaTables;
    While ((tempHdl  Nil) And (theGDevice  tempHdl^^.theGDevice)) Do
        tempHdl := tempHdl^^.next;
    With tempHdl^^ Do
        Begin
        BlockMove(Ptr(saved^), Ptr(hacked^), size);
        gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
        thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
        End;
    For i := 0 To thesize - 1 Do
        Begin
        theNum := gdp^[i];
        theNum := (theNum * percent) Div 100;
        gdp^[i] := theNum;
        End;
    errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
    DoOneGammaFade := errorCold;
    End;

Function DisposeGammaTools: OSErr;

Var
   tempHdl, nextHdl: globalGammasHdl;

    Begin
    If (gammaUtilsInstalled  kGammaUtilsSig) Then
        Begin
        DisposeGammaTools := -1;
        exit(DisposeGammaTools);
        End;
    tempHdl := gammaTables;
    While (tempHdl  Nil) Do
        Begin
        HLock(Handle(tempHdl));
        With tempHdl^^ Do
            Begin
            nextHdl := next;
            DisposeHandle(Handle(saved));
            DisposeHandle(Handle(hacked));
            HUnLock(Handle(tempHdl));
            DisposeHandle(Handle(tempHdl));
            tempHdl := nextHdl;
            End;
        End;
    gammaUtilsInstalled := '    ';
    DisposeGammaTools := 0;
    End;

Function GetDevGammaTable (theGDevice: GDHandle;
                       Var theTable: GammaTblPtr): OSErr;

Var
   errorCold: Integer;
   myCPB: ParmBlkPtr;

    Begin
    theTable := Nil;
    If Not IsOneGammaAvailable(theGDevice) Then
        Begin
        GetDevGammaTable := -1;
        exit(GetDevGammaTable);
        End;
    myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
    If (myCPB = Nil) Then
        Begin
        GetDevGammaTable := MemError;
        exit(GetDevGammaTable);
        End;
    myCPB^.csCode := cscGetGamma;
    myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
    myCPB^.csParam[0] := HiWord(longint(@theTable));
    myCPB^.csParam[1] := LoWord(longint(@theTable));
    errorCold := PBStatusSync(myCPB);
    DisposePtr(Ptr(myCPB));
    GetDevGammaTable := errorCold;
    End;

Function SetDevGammaTable (theGDevice: GDHandle;
                       Var theTable: GammaTblPtr): OSErr;

Var
   myCPB: ParmBlkPtr;
   errorCold: Integer;
   cTab: CTabHandle;
   saveGDevice: GDHandle;

    Begin
    If Not IsOneGammaAvailable(theGDevice) Then
        Begin
        SetDevGammaTable := -1;
        exit(SetDevGammaTable);
        End;
    myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
    If (myCPB = Nil) Then
        Begin
        SetDevGammaTable := MemError;
        exit(SetDevGammaTable);
        End;
    myCPB^.csCode := cscSetGamma;
    myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
    myCPB^.csParam[0] := HiWord(longint(@theTable));
    myCPB^.csParam[1] := LoWord(longint(@theTable));
    errorCold := PBStatusSync(myCPB);
    If (errorCold = 0) Then
        Begin
        saveGDevice := GetGDevice;
        SetGDevice(theGDevice);
        cTab := theGDevice^^.gdPMap^^.pmTable;
        SetEntries(0, cTab^^.ctSize, cTab^^.ctTable);
        SetGDevice(saveGDevice);
        End;
    DisposePtr(Ptr(myCPB));
    SetDevGammaTable := errorCold;
    End;

Procedure DelayFadeToBlack (delayTicks: longint);

Var
    i: integer;
    oe: integer;
    finalTicks: longint;

    begin
    i := 100;
    while i > 0 do
        begin
        oe := DoGammaFade(i);
        i := i - 1;
        Delay(delayTicks, finalTicks);
           end;
    gammaFaded := TRUE;
    end;

Procedure FadeToBlack (speed: integer);

Var
    i: integer;
    oe: integer;

    begin
    i := 100;
    while (i >= 0) do
        begin
        oe := DoGammaFade(i);
        i := i - speed;
        end;
    gammaFaded := TRUE;
    end;

Procedure FadeFromBlack (speed: integer);

Var
    i: integer;
    oe: integer;

    begin
    i := 0;
    while (i <= 100) do
        begin
        oe := DoGammaFade(i);
        i := i + speed;
        end;
    gammaFaded := FALSE;
    end;

Procedure DelayFadeFromBlack (delayTicks: longint);

Var
    i: integer;
    oe: integer;
    finalTicks: longint;
    
    begin
    i := 0;
    while (i <= 100) do
        begin
        oe := DoGammaFade(i);
        i := i + 1;
        Delay(delayTicks, finalTicks);
        end;
    gammaFaded := FALSE;
    end;

End.

{ ----------------------------------------------------------------------}
{ Sample program for demonstrating use of Gamma Fade library routines.  }
{ By Bill Catambay - catambay@aol.com, 2/11/96                          }
{                                                                       }
{ NOTE: CW "Uses Propagation" flag is set for this project.             }
{ ----------------------------------------------------------------------}
Program SampleFade;

Uses
    Windows, Fonts, Dialogs, Processes, ToolUtils, Devices, Resources, GammaPasLib;

Const
    buttonClick	= 128;
	
Var
    oe: 		integer;
    myrect: 	rect;
    mywindow: 	windowPtr;
    mypicture: 	pichandle;

Procedure InitToolbox;

    begin
    InitGraf(@qd.thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEinit;
    InitDialogs(nil);
    MaxApplZone;
    InitCursor;
    end;

begin
InitToolbox;
if not IsGammaAvailable then
    ExitToShell;
oe := SetupGammaTools;
mypicture := GetPicture(128);   {  Project must have a PICT resource 128  }
Hlock(Handle(mypicture));
myrect := myPicture^^.picFrame;  { Center the window }
OffsetRect(myRect, (qd.screenBits.bounds.right - myrect.right) div 2, 
	                  (qd.screenBits.bounds.bottom - myrect.bottom) div 2);
DelayFadeToBlack(1);   { Slow Fade the screen to black and display the window }
mywindow := NewCWindow(NIL, myrect, '', TRUE, plainDBox ,pointer(-1), FALSE, 0);
SetPort(mywindow);
DrawPicture(mypicture, mypicture^^.picFrame);
HUnlock(Handle(mypicture));
ReleaseResource(Handle(mypicture));
{ Fade the screen back in and wait for mouse button }
FadeFromBlack(2);
repeat
until Button;
{ Fade the screen to black again, remove the window, then slow fade back in }
FadeToBlack(2);
HideWindow(mywindow);
DelayFadeFromBlack(1);
oe := DisposeGammaTools;
end.


Copyright © 1995 Matt Mora. All Rights Reserved.