Gamma Fading in PascalSource code by Matt Mora, Port and comments by Bill Catambay
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.