Unit GammaPaslib;

{--------------------------------------------------------------------------------------------------------------- }
{ File "gamma.p" - Source for Altering the Gamma Tables of GDevices from Gamma.c								 }
{   Last updated 6/29/95, MJS																					 }
{--------------------------------------------------------------------------------------------------------------- }
{	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 (pretty easy), cleaned the code a bit (no more labels),	 }
{           brought back Matthew's delay fade routines (in main program). 		   								 }
{----------------------------------------------------------------------------------------------------------------}



{---------------------------------------------------------------------------------------------------------------}
{	This is the Source Code for the Gamma Utils Library file. Use this to build									}
{		new functionality into the library or make an A4-based library. 										}
{	See the header file "gamma.h" for much more information. -- MJS												}
{---------------------------------------------------------------------------------------------------------------}
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;

{ Function Prototypes}

{	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. € 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.}
{		Use them at your own risk.}
Function GetDevGammaTable (theGDevice: GDHandle;
      						Var theTable: GammaTblPtr): OSErr;
Function SetDevGammaTable (theGDevice: GDHandle;
       						Var theTable: GammaTblPtr): OSErr;


Procedure DelayFadeToBlack (delayTicks: UInt32);
Procedure FadeToBlack (speed: integer);
Procedure FadeFromBlack (speed: integer);
Procedure DelayFadeFromBlack (delayTicks: UInt32);


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 := PBStatus(myCPB, false);
	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 := PBControl(myCPB, false);
	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: UInt32);

Var
	i: integer;
	oe: integer;
	finalTicks: UInt32;

	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: UInt32);

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

End.