unit GrayMap;

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is Graphics32
 *
 * The Initial Developer of the Original Code is
 * Alex A. Denisov
 *
 * Portions created by the Initial Developer are Copyright (C) 2000-2004
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *   Michael Hansen <dyster_tid@hotmail.com>
 *   Andre Beckedorf <Andre@metaException.de>
 *   Mattias Andersson <mattias@centaurix.com>
 *   J. Tulach <tulach@position.cz>
 *   Timothy Weber <tw@6sys.com>
 *
 * ***** END LICENSE BLOCK ***** *)

{
	The TByteMap class in GR32 is hard to use for real graphics, as an 8-bit
	grayscale image or as an 8-bit alpha mask (e.g., used to apply a fixed color
	as in Springboard's spot-color layers).

	This class extends it with useful graphics primitives and manipulators.

	Some routines were based on routines copied from GR32; these are noted
	with a "Modified from" comment.

	One optimization added here is UsedBounds, which tracks the bounding rect
	of non-zero pixels.  This capitalizes on the tendency of many usage styles
	to focus on a particular small subset of the map.  It's tracked exactly for
	operations where that's quick, and the caller can call FindUsed to update it
	precisely at a convenient time (typically on application idle).  Thereafter,
	many drawing operations can be optimized by eliminating unused areas.
}

interface

uses Types, Graphics, GR32, GR32_OrdinalMaps, Classes;

type
	// Combiners for going from a Bitmap32 to a GrayMap.
	// These are globals rather than class methods, to accelerate calling.
	// The use of "Ex" parallels its use in GR32 - adds the M parameter.
	TBitmapByteMapCombiner = procedure (F: TColor32; var B: Byte);
	TBitmapByteMapCombinerEx = procedure (F: TColor32; var B: Byte; M: TColor32);

	TGrayMap = class(TByteMap)
	private
		// The bounds of all non-zero pixels in the map, if known.
		FUsedBounds: TRect;

		// Whether we know the bounds or not.
		// If we don't know the bounds, FUsedBounds is "loose" - that is, if it's
		// smaller than Bounds, we know it's within there, but it could maybe be tighter.
		FUsedBoundsValid: Boolean;

	public

		function BoundsRect: TRect;

		property UsedBounds: TRect read FUsedBounds;

		// Call this after changing the pixel data elsewhere, so we know to invalidate
		// UsedBounds.
		procedure InvalidateUsed; overload;

		// Same, but
		procedure InvalidateUsed(WithinRect: TRect); overload;

		// Call this at a convenient time to update the UsedBounds.
		procedure FindUsed;

		// Inverts all content bytes.
		procedure Invert;

		// Subtracts the given byte map from this one.
		// Puts the result back here.
		procedure Subtract(Sub: TByteMap);

		// Copies a rectangular region from this byte map to the indicated one.
		procedure CopyTo(Other: TByteMap; SrcRect: TRect; DestUpperLeft: TPoint);

		// Extracts the alpha channel from ChannelSrc, multiplies it
		// by the corresponding values here, and stores the results back here.
		// Requires that the two maps are the same size.
		procedure MultiplyByAlpha(ChannelSrc: TBitmap32);

		// Draws a TBitmap32 here, at the given point, with the given combiner.
		procedure Draw(Src: TBitmap32; P: TPoint; Combiner: TBitmapByteMapCombinerEx = nil); overload;

		// Draws a portion of a TBitmap32 here, at given point, with the given combiner.
		procedure Draw(Src: TBitmap32; SrcRect: TRect; P: TPoint; Combiner: TBitmapByteMapCombinerEx = nil); overload;

		// "Expands" this byte map into the given destination bitmap.
		// That is, uses the byte values as an alpha value, and sets all the pixels in the
		// destination to the specified color.
		// This gives an image that uses this ByteMap to fade from transparent to Color, and
		// which is editable by changing its alpha channel only.
		procedure ExpandSpotColor(Dest: TBitmap32; Color: TColor = clBlack); overload;
		procedure ExpandSpotColor(Dest: TBitmap32; SrcRect: TRect; DestOffset: TPoint;
			Color: TColor = clBlack); overload;  // same, but clips to SrcBounds and Dest.BoundsRect

		// Analogous to TBitmap32.SetPixelTS: Adds the given pixel with transparency,
		// and safely ignores out-of-bounds pixels.
		procedure AddPixelS(X, Y: Integer; NewValue: Byte);

		// Same, but uses intensity * alpha from Color.
		procedure SetPixelTS(X, Y: Integer; Color: TColor32);

		// Analogous to corresponding routines in TBitmap32.
		procedure LineAS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False);
		procedure LineTS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean = False);
		procedure VertLineTS(X, Y1, Y2: Integer; Value: TColor32);
		procedure HorzLineT(X1, Y, X2: Integer; Value: TColor32);
		procedure HorzLineTS(X1, Y, X2: Integer; Value: TColor32);
		procedure VertLineT(X, Y1, Y2: Integer; Value: TColor32);
    procedure FillRectS(ARect: TRect; Value: Byte);

		// Write to a 32-bit bitmap, in shades of gray.
		procedure WriteToFile(FileName: string);

		// Overrides, for UsedBounds.
		procedure Assign(Source: TPersistent); override;
		procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
	end;

// Combiners.
procedure BlendCombine(F: TColor32; var B: Byte);
procedure BlendCombineEx(F: TColor32; var B: Byte; M: TColor32);
procedure AddAlphaCombineEx(F: TColor32; var B: Byte; M: TColor32);
procedure SubAlphaCombineEx(F: TColor32; var B: Byte; M: TColor32);
procedure CopyAlphaCombineEx(F: TColor32; var B: Byte; M: TColor32);


implementation

uses Math, GR32_LowLevel, RectOps;


procedure BlendCombine(F: TColor32; var B: Byte);
var
	fA: TColor32;
begin
	fA := TColor32(AlphaComponent(F));

	B := Clamp((fA * TColor32(Intensity(F)) + (255 - fA) * B) shr 8);
end;

procedure BlendCombineEx(F: TColor32; var B: Byte; M: TColor32);
var
	fA: TColor32;
begin
	// Assume M ranges from 0..255.

	// Skew correction.
	if M >= $80 then
		Inc(M);  // M now ranges from 0..256.

	fA := M * TColor32(AlphaComponent(F)) shr 8;  // fA ranges from 0..255.

	if fA = 0 then
		// Foreground has no effect; leave background as is.
		Exit
	else if fA = 255 then
		// Foreground has full effect; take background from it directly.
		B := Intensity(F)
	else begin
		// General case.

		// Skew correction.
		if fA >= $80 then
			Inc(fA);  // fA now ranges from 0..256.

		B := (fA * TColor32(Intensity(F)) + (256 - fA) * B) shr 8;  // B ranges Form 0..255.

		B := Clamp(B);
	end;
end;

procedure BlendBytesMemEx(F: Byte; var B: Byte; M: Byte);
begin
	B := Clamp((F * M + (M xor 255) * B) shr 8);
end;

procedure AddAlphaCombineEx(F: TColor32; var B: Byte; M: TColor32);
begin
	B := Clamp(B + M * TColor32(AlphaComponent(F)) shr 8);
end;

procedure SubAlphaCombineEx(F: TColor32; var B: Byte; M: TColor32);
begin
	B := Clamp(B - M * TColor32(AlphaComponent(F)) shr 8);
end;

procedure CopyAlphaCombineEx(F: TColor32; var B: Byte; M: TColor32);
begin
	B := AlphaComponent(F);
end;

{ TGrayMap }

function TGrayMap.BoundsRect: TRect;
begin
	Result := Rect(0, 0, Width, Height);
end;

procedure TGrayMap.Assign(Source: TPersistent);
begin
	inherited;

	if Source is TGrayMap then begin
		FUsedBounds := TGrayMap(Source).FUsedBounds;
		FUsedBoundsValid := TGrayMap(Source).FUsedBoundsValid;
	end else
		InvalidateUsed;
end;

procedure TGrayMap.ChangeSize(var Width, Height: Integer; NewWidth,
	NewHeight: Integer);
begin
	inherited;

	InvalidateUsed;
end;

procedure TGrayMap.InvalidateUsed;
begin
	FUsedBoundsValid := False;
	FUsedBounds := BoundsRect;
end;

procedure TGrayMap.InvalidateUsed(WithinRect: TRect);
begin
	FUsedBoundsValid := False;
	FUsedBounds := RectIntersection(BoundsRect, WithinRect);
end;

procedure TGrayMap.FillRectS(ARect: TRect; Value: Byte);
var
  y, w: Integer;
begin
  ARect := RectIntersection(ARect, BoundsRect);  // the "safe" part

  if not IsRectEmpty(ARect) then begin
    w := RectWidth(ARect);

    for y := ARect.Top to ARect.Bottom - 1 do
      FillChar(ValPtr[ARect.Left, y]^, w, Value);
  end;
end;

procedure TGrayMap.FindUsed;
var
	oldUsed: TRect;
	x, y: Integer;
	b: PByte;
begin
	oldUsed := FUsedBounds;

	// Start with a rect turned inside out.
	FUsedBounds.Left := Width;
	FUsedBounds.Right := 0;
	FUsedBounds.Top := Height;
	FUsedBounds.Bottom := 0;

	// Look through the data and expand as necessary.
	// But just look within the old UsedBounds - we're only tightening the net.
	Dec(oldUsed.Right);
	Dec(oldUsed.Bottom);

	for y := oldUsed.Top to oldUsed.Bottom do begin
		b := ValPtr[oldUsed.Left, y];

		for x := oldUsed.Left to oldUsed.Right do begin
			if b^ > 0 then
				FUsedBounds := ExpandRectToInclude(FUsedBounds, Point(x, y));

			Inc(b);
		end;
	end;

	// Standardize on an empty rect at the upper left if it's all empty.
	if RectIsEmpty(FUsedBounds) then
		FUsedBounds := ZeroRect;
end;

procedure TGrayMap.Invert;
var
	x, y: Integer;
	b: PByte;
begin
	b := ValPtr[0, 0];

	for x := 0 to Width - 1 do
		for y := 0 to Height - 1 do begin
			b^ := not b^;
			Inc(b);
		end;

	// Could recompute as we go, but that's messy.  Only do it if it's important.
	InvalidateUsed;
end;

procedure TGrayMap.Subtract(Sub: TByteMap);
var
	x, y: Integer;
	a, b: PByte;
begin
	Assert((Width = Sub.Width) and (Height = Sub.Height),
		'TGrayMap.Subtract: Sizes must be the same');

	a := ValPtr[0, 0];
	b := Sub.ValPtr[0, 0];

	for x := 0 to Width - 1 do
		for y := 0 to Height - 1 do begin
			a^ := a^ - b^;
			Inc(a);
			Inc(b);
		end;

	InvalidateUsed;
end;

procedure TGrayMap.MultiplyByAlpha(ChannelSrc: TBitmap32);
var
	bytes: PByte;
	channelBits: PColor32;
	alpha: TColor32;
	i, n: Integer;
begin
	Assert(Width = ChannelSrc.Width);
	Assert(Height = ChannelSrc.Height);

	bytes := ValPtr[0, 0];
	channelBits := @ChannelSrc.Bits[0];

	n := Width * Height - 1;
	for i := 0 to n do begin
		alpha := (channelBits^ and $FF000000) shr 24;
		Inc(alpha);  // 255:256 range bias
		bytes^ := (bytes^ * alpha) shr 8;

		Inc(bytes);
		Inc(channelBits);
	end;

	InvalidateUsed;
end;

procedure TGrayMap.Draw(Src: TBitmap32; P: TPoint; Combiner: TBitmapByteMapCombinerEx);
begin
	Draw(Src, Src.BoundsRect, P, Combiner);

	InvalidateUsed(RectUnion(FUsedBounds, RectOffsetBy(Src.BoundsRect, P)));
end;

procedure TGrayMap.Draw(Src: TBitmap32; SrcRect: TRect; P: TPoint; Combiner: TBitmapByteMapCombinerEx);
var
	w, h, xStart, x, xEnd, yStart, y, yEnd: Integer;  // coordinates are from Src's point of view
	nextSrc: PColor32;
	nextDest: PByte;
begin
	if not Assigned(Combiner) then
		Combiner := @BlendCombineEx;

	SrcRect := RectIntersection(SrcRect, Src.BoundsRect);

	w := Max(0, Min(RectWidth(SrcRect), Width - P.X));
	h := Max(0, Min(RectHeight(SrcRect), Height - P.Y));

	xStart := SrcRect.Left;
	if P.X < 0 then begin
		xStart := xStart - P.X;
		w := Max(0, w + P.X);
	end;

	yStart := 0;
	if P.Y < 0 then begin
		yStart := yStart - P.Y;
		h := Max(0, h + P.Y);
	end;

	if (h = 0) or (w = 0) then
		Exit;

	yEnd := yStart + h - 1;
	xEnd := xStart + w - 1;
	for y := yStart to yEnd do begin
		nextSrc := Src.PixelPtr[xStart, y];
		nextDest := ValPtr[xStart + P.X, y + P.Y];

		for x := xStart to xEnd do begin
			Combiner(nextSrc^, nextDest^, Src.MasterAlpha);

			Inc(nextSrc);
			Inc(nextDest);
		end;
	end;

	InvalidateUsed(RectUnion(FUsedBounds, MakeRect(xStart + P.X, yStart + P.Y,
		xStart + P.X + w, yStart + P.Y + h)));
end;

procedure TGrayMap.ExpandSpotColor(Dest: TBitmap32; Color: TColor);
var
	SourceBits: PByte;
	DestBits: PColor32;
	ColorMask: TColor32;
	I: Integer;
begin
	Dest.SetSizeFrom(Self);

	SourceBits := ValPtr[0, 0];
	DestBits := @Dest.Bits[0];

	ColorMask := SetAlpha(Color32(Color), 0);

	// Could perhaps optimize this by only working within UsedBounds.
	// But, we still have to visit all the destination pixels, and this is a pretty tight loop.
	// So it might not be worth much.

	for I := 0 to Width * Height - 1 do
	begin
		DestBits^ := (TColor32(SourceBits^) shl 24) or ColorMask;

		Inc(SourceBits);
		Inc(DestBits);
	end;

	Dest.DrawMode := dmBlend;
end;
                            
procedure TGrayMap.ExpandSpotColor(Dest: TBitmap32; SrcRect: TRect;
	DestOffset: TPoint; Color: TColor);
var
	w, h, xStart, x, xEnd, yStart, y, yEnd: Integer;  // coordinates are from Src's point of view
	xOffset, yOffset: Integer;  // offset from Src to Dest.
	destRect, trimSrc, trimDest: TRect;
	colorMask: TColor32;
	nextSrc: PByte;
	nextDest: PColor32;
begin
	colorMask := SetAlpha(Color32(Color), 0);

	// Find the maximum rect that actually contains valid pixels in both source and dest.
	SrcRect := RectIntersection(SrcRect, BoundsRect);
	SrcRect := RectIntersection(SrcRect, FUsedBounds);

	destRect := MakeRect(DestOffset, RectSize(SrcRect));

	trimDest := RectIntersection(destRect, Dest.BoundsRect);

	trimSrc := RectAnalogy(destRect, srcRect, trimDest);

	if not(IsRectEmpty(trimDest) or IsRectEmpty(trimSrc)) then begin
		Assert(SizesEqual(RectSize(trimDest), RectSize(trimSrc)));

		// Precompute the bound values.

		w := Max(0, RectWidth(SrcRect));
		h := Max(0, RectHeight(SrcRect));

		if (h = 0) or (w = 0) then
			Exit;

		xStart := trimSrc.Left;
		yStart := trimSrc.Top;

		yEnd := yStart + h - 1;
		xEnd := xStart + w - 1;

		xOffset := trimDest.Left - trimSrc.Left;
		yOffset := trimDest.Top - trimSrc.Top;

		for y := yStart to yEnd do begin
			nextSrc := ValPtr[xStart, y];
			nextDest := Dest.PixelPtr[xStart + xOffset, y + yOffset];

			for x := xStart to xEnd do begin
				nextDest^ := (TColor32(nextSrc^) shl 24) or colorMask;

				Inc(nextSrc);
				Inc(nextDest);
			end;
		end;
	end;

	Dest.DrawMode := dmBlend;
end;

procedure TGrayMap.AddPixelS(X, Y: Integer; NewValue: Byte);
var
	b: PByte;
begin
	if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then begin
		b := ValPtr[X, Y];
		b^ := Clamp(b^ + NewValue);

		InvalidateUsed;
	end;
end;

procedure TGrayMap.SetPixelTS(X, Y: Integer; Color: TColor32);
begin
	if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then begin
		BlendCombine(Color, ValPtr[X, Y]^);
		InvalidateUsed;
	end;
end;

procedure TGrayMap.CopyTo(Other: TByteMap; SrcRect: TRect; DestUpperLeft: TPoint);
var
	x, y: Integer;
	srcBits, destBits: PByte;
begin
	for y := SrcRect.Top to SrcRect.Bottom - 1 do begin
		srcBits := ValPtr[SrcRect.Left, y];
		destBits := ValPtr[DestUpperLeft.X, DestUpperLeft.Y];

		for x := SrcRect.Left to SrcRect.Right - 1 do begin
			destBits^ := srcBits^;

			Inc(srcBits);
			Inc(destBits);
		end;
	end;
end;

// Modified from TBitmap32.
{$RANGECHECKS OFF}
{$OVERFLOWCHECKS OFF}
procedure TGrayMap.LineAS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean);
var
	Cx1, Cx2, Cy1, Cy2, PI, Sx, Sy, Dx, Dy, xd, yd, rem, term, tmp: Integer;
	CheckVert, CornerAA, TempClipped: Boolean;
	D1, D2: PInteger;
	EC, EA, ED, D: Word;
	CI: Byte;
	P: PByte;
begin
	if (Width = 0) or (Height = 0) then
		Exit;

	InvalidateUsed(RectUnion(FUsedBounds, Rect(X1, Y1, X2, Y2)));

	Dx := X2 - X1; Dy := Y2 - Y1;

	// check for trivial cases...
	if Abs(Dx) = Abs(Dy) then // diagonal line?
	begin
		LineTS(X1, Y1, X2, Y2, Value, L);
		Exit;
	end
	else if Dx = 0 then // vertical line?
	begin
		if Dy > 0 then VertLineTS(X1, Y1, Y2 - 1, Value)
		else if Dy < 0 then VertLineTS(X1, Y2 + 1, Y1, Value);
		if L then SetPixelTS(X2, Y2, Value);
		Exit;
	end
	else if Dy = 0 then // horizontal line?
	begin
		if Dx > 0 then HorzLineTS(X1, Y1, X2 - 1, Value)
		else if Dx < 0 then HorzLineTS(X2 + 1, Y1, X1, Value);
		if L then SetPixelTS(X2, Y2, Value);
		Exit;
	end;

	Cx1 := 0; Cx2 := Width - 1;
	Cy1 := 0; Cy2 := Height - 1;

	if Dx > 0 then
	begin
		if (X1 > Cx2) or (X2 < Cx1) then Exit; // segment not visible
		Sx := 1;
	end
	else
	begin
		if (X2 > Cx2) or (X1 < Cx1) then Exit; // segment not visible
		Sx := -1;
		X1 := -X1;   X2 := -X2;   Dx := -Dx;
		Cx1 := -Cx1; Cx2 := -Cx2;
		Swap(Cx1, Cx2);
	end;

	if Dy > 0 then
	begin
		if (Y1 > Cy2) or (Y2 < Cy1) then Exit; // segment not visible
		Sy := 1;
	end
	else
	begin
		if (Y2 > Cy2) or (Y1 < Cy1) then Exit; // segment not visible
		Sy := -1;
		Y1 := -Y1;   Y2 := -Y2;   Dy := -Dy;
		Cy1 := -Cy1; Cy2 := -Cy2;
		Swap(Cy1, Cy2);
	end;

	if Dx < Dy then
	begin
		Swap(X1, Y1); Swap(X2, Y2); Swap(Dx, Dy);
		Swap(Cx1, Cy1); Swap(Cx2, Cy2); Swap(Sx, Sy);
		D1 := @yd; D2 := @xd;
		PI := Sy;
	end
	else
	begin
		D1 := @xd; D2 := @yd;
		PI := Sy * Width;
	end;

	rem := 0;
	EA := Dy shl 16 div Dx;
	EC := 0;
	xd := X1; yd := Y1;
	CheckVert := True;
	CornerAA := False;

	// clipping rect horizontal entry
	if Y1 < Cy1 then
	begin
		tmp := (Cy1 - Y1) * 65536;
		rem := tmp - 65536; // rem := (Cy1 - Y1 - 1) * 65536;
		if tmp mod EA > 0 then
			tmp := tmp div EA + 1
		else
			tmp := tmp div EA;

		xd := Min(xd + tmp, X2 + 1);
		EC := tmp * EA;

		if rem mod EA > 0 then
			rem := rem div EA + 1
		else
			rem := rem div EA;

		tmp := tmp - rem;

		// check whether the line is partly visible
		if xd > Cx2 then
			// do we need to draw an antialiased part on the corner of the clip rect?
			If xd <= Cx2 + tmp then
				CornerAA := True
			else
				Exit;

		if (xd {+ 1} >= Cx1) or CornerAA then
		begin
			yd := Cy1;
			rem := xd; // save old xd

			ED := EC - EA;
			term := SwapConstrain(xd - tmp, Cx1, Cx2);

			If CornerAA then
			begin
				Dec(ED, (xd - Cx2 - 1) * EA);
				xd := Cx2 + 1;
			end;

			// do we need to negate the vars?
			if Sy = -1 then yd := -yd;
			if Sx = -1 then
			begin
				xd := -xd;
				term := -term;
			end;

			// draw special case horizontal line entry (draw only last half of entering segment)
			while xd <> term do
			begin
				Inc(xd, -Sx);
				BlendCombineEx(Value, Bits[D1^ + D2^ * Width], GAMMA_TABLE[ED shr 8]);
				Dec(ED, EA);
			end;

			If CornerAA then
				// we only needed to draw the visible antialiased part of the line,
				// everything else is outside of our cliprect, so exit now since
				// there is nothing more to paint...
				Exit;

			if Sy = -1 then yd := -yd;  // negate back
			xd := rem;  // restore old xd
			CheckVert := False; // to avoid ugly labels we set this to omit the next check
		end;
	end;

	// clipping rect vertical entry
	if CheckVert and (X1 < Cx1) then
	begin
		tmp := (Cx1 - X1) * EA;
		Inc(yd, tmp div 65536);
		EC := tmp;
		xd := Cx1;
		if (yd > Cy2) then
			Exit
		else if (yd = Cy2) then
			CornerAA := True;
	end;

	term := X2;
	TempClipped := False;
	CheckVert := False;

	// horizontal exit?
	if Y2 > Cy2 then
	begin
		tmp := (Cy2 - Y1) * 65536;
		term := X1 + tmp div EA;
		if not(tmp mod EA > 0) then
			Dec(Term);

		if term < Cx2 then
		begin
			rem := tmp + 65536; // was: rem := (Cy2 - Y1 + 1) * 65536;
			if rem mod EA > 0 then
				rem := X1 + rem div EA + 1
			else
				rem := X1 + rem div EA;

			if rem > Cx2 then rem := Cx2;
			CheckVert := True;
		end;

		TempClipped := True;
	end;

	if term > Cx2 then
	begin
		term := Cx2;
		TempClipped := True;
	end;

	Inc(term);

	if Sy = -1 then yd := -yd;
	if Sx = -1 then
	begin
		xd := -xd;
		term := -term;
		rem := -rem;
	end;

	// draw line
	if not CornerAA then begin
		// do we need to skip the last pixel of the line and is temp not clipped?
		if not(L or TempClipped) and not CheckVert then
		begin
			if xd < term then
				Dec(term)
			else if xd > term then
				Inc(term);
		end;

		while xd <> term do
		begin
			CI := EC shr 8;
			P := @Bits[D1^ + D2^ * Width];
			BlendCombineEx(Value, P^, GAMMA_TABLE[CI xor 255]);
			Inc(P, PI);
			BlendCombineEx(Value, P^, GAMMA_TABLE[CI]);
			// check for overflow and jump to next line...
			D := EC;
			Inc(EC, EA);
			if EC <= D then
				Inc(yd, Sy);

			Inc(xd, Sx);
		end;
	end;

	// draw special case horizontal line exit (draw only first half of exiting segment)
	If CheckVert then
		while xd <> rem do
		begin
			BlendCombineEx(Value, Bits[D1^ + D2^ * Width], GAMMA_TABLE[EC shr 8 xor 255]);
			Inc(EC, EA);
			Inc(xd, Sx);
		end;
end;

procedure TGrayMap.VertLineTS(X, Y1, Y2: Integer; Value: TColor32);
begin
	if (X >= 0) and (X < Width) and TestClip(Y1, Y2, 0, Height) then
		VertLineT(X, Y1, Y2, Value);
end;

procedure TGrayMap.VertLineT(X, Y1, Y2: Integer; Value: TColor32);
var
  i: Integer;
	P: PByte;
begin
	P := ValPtr[X, Y1];
	for i := Y1 to Y2 do begin
		BlendCombine(Value, P^);
		Inc(P, Width);
	end;
end;
          
procedure TGrayMap.HorzLineTS(X1, Y, X2: Integer; Value: TColor32);
begin
	if (Y >= 0) and (Y < Height) and TestClip(X1, X2, 0, Width) then
		HorzLineT(X1, Y, X2, Value);
end;

procedure TGrayMap.HorzLineT(X1, Y, X2: Integer; Value: TColor32);
var
  i: Integer;
	P: PByte;
begin
	if X2 < X1 then Exit;
	P := ValPtr[X1, Y];
	for i := X1 to X2 do begin
		BlendCombine(Value, P^);
		Inc(P);
  end;
end;

procedure TGrayMap.LineTS(X1, Y1, X2, Y2: Integer; Value: TColor32; L: Boolean);
var
  Cx1, Cx2, Cy1, Cy2, PI, Sx, Sy, Dx, Dy, xd, yd, Dx2, Dy2, rem, term, tmp, e: Integer;
  Swapped, CheckAux: Boolean;
	P: PByte;
begin
	Dx := X2 - X1; Dy := Y2 - Y1;

	// check for trivial cases...
	if Dx = 0 then // vertical line?
	begin
		if Dy > 0 then VertLineTS(X1, Y1, Y2 - 1, Value)
		else if Dy < 0 then VertLineTS(X1, Y2 + 1, Y1, Value);
		if L then SetPixelTS(X2, Y2, Value);
		Exit;
	end
	else if Dy = 0 then // horizontal line?
	begin
		if Dx > 0 then HorzLineTS(X1, Y1, X2 - 1, Value)
		else if Dx < 0 then HorzLineTS(X2 + 1, Y1, X1, Value);
		if L then SetPixelTS(X2, Y2, Value);
		Exit;
	end;

	Cx1 := 0; Cx2 := Width - 1;
	Cy1 := 0; Cy2 := Height - 1;

	if Dx > 0 then
	begin
		If (X1 > Cx2) or (X2 < Cx1) then Exit; // segment not visible
		Sx := 1;
	end
	else
	begin
		If (X2 > Cx2) or (X1 < Cx1) then Exit; // segment not visible
		Sx := -1;
		X1 := -X1;   X2 := -X2;   Dx := -Dx;
		Cx1 := -Cx1; Cx2 := -Cx2;
		Swap(Cx1, Cx2);
	end;

	if Dy > 0 then
	begin
		If (Y1 > Cy2) or (Y2 < Cy1) then Exit; // segment not visible
		Sy := 1;
	end
	else
	begin
		If (Y2 > Cy2) or (Y1 < Cy1) then Exit; // segment not visible
		Sy := -1;
		Y1 := -Y1;   Y2 := -Y2;   Dy := -Dy;
		Cy1 := -Cy1; Cy2 := -Cy2;
		Swap(Cy1, Cy2);
	end;

	if Dx < Dy then
	begin
		Swapped := True;
		Swap(X1, Y1); Swap(X2, Y2); Swap(Dx, Dy);
		Swap(Cx1, Cy1); Swap(Cx2, Cy2); Swap(Sx, Sy);
	end
	else
		Swapped := False;

	// Bresenham's set up:
	Dx2 := Dx shl 1; Dy2 := Dy shl 1;
	xd := X1; yd := Y1; e := Dy2 - Dx; term := X2;
	CheckAux := True;

	// clipping rect horizontal entry
	if Y1 < Cy1 then
	begin
		tmp := Dx2 * (Cy1 - Y1) - Dx;
		Inc(xd, tmp div Dy2);
		rem := tmp mod Dy2;
		if xd > Cx2 then Exit;
		if xd >= Cx1 then
		begin
			yd := Cy1;
			Dec(e, rem + Dx);
			if rem > 0 then
			begin
				Inc(xd);
				Inc(e, Dy2);
			end;
			CheckAux := False; // to avoid ugly labels we set this to omit the next check
		end;
	end;

	// clipping rect vertical entry
	if CheckAux and (X1 < Cx1) then
	begin
		tmp := Dy2 * (Cx1 - X1);
		Inc(yd, tmp div Dx2);
		rem := tmp mod Dx2;
		if (yd > Cy2) or (yd = Cy2) and (rem >= Dx) then Exit;
		xd := Cx1;
		Inc(e, rem);
		if (rem >= Dx) then
		begin
			Inc(yd);
			Dec(e, Dx2);
		end;
	end;

	// set auxiliary var to indicate that temp is not clipped, since
	// temp still has the unclipped value assigned at setup.
	CheckAux := False;

	// is the segment exiting the clipping rect?
	if Y2 > Cy2 then
	begin
		tmp := Dx2 * (Cy2 - Y1) + Dx;
		term := X1 + tmp div Dy2;
		rem := tmp mod Dy2;
		if rem = 0 then Dec(term);
		CheckAux := True; // set auxiliary var to indicate that temp is clipped
	end;

	if term > Cx2 then
	begin
		term := Cx2;
		CheckAux := True; // set auxiliary var to indicate that temp is clipped
	end;

	Inc(term);

	if Sy = -1 then
		yd := -yd;

	if Sx = -1 then
	begin
		xd := -xd;
		term := -term;
	end;

	Dec(Dx2, Dy2);

	if Swapped then
	begin
		PI := Sx * Width;
		P := @Bits[yd + xd * Width];
	end
	else
	begin
		PI := Sx;
		Sy := Sy * Width;
		P := @Bits[xd + yd * Width];
	end;

	// do we need to skip the last pixel of the line and is temp not clipped?
	if not(L or CheckAux) then
	begin
		if xd < term then
			Dec(term)
		else
			Inc(term);
	end;

	while xd <> term do
	begin
		Inc(xd, Sx);

		BlendCombine(Value, P^);
		Inc(P, PI);
		if e >= 0 then
		begin
			Inc(P, Sy);
			Dec(e, Dx2);
		end
		else
			Inc(e, Dy2);
	end;
end;

procedure TGrayMap.WriteToFile(FileName: string);
var
	temp: TBitmap32;
begin
	temp := TBitmap32.Create;
	try
		WriteTo(temp, ctUniformRGB);
		temp.SaveToFile(FileName);
	finally
		temp.Free;
	end;
end;

end.