Archived

This topic is now archived and is closed to further replies.

sunbeam60

Is it me or did Delphi just bomb?! (John Hebert, please read)

Recommended Posts

Hi all Finishing John Hebert's excellent article on alpha-blending, I decided to convert the code to Object Pascal (well, at least some of it). Unfortunately I can't get nowhere near the same results that the C code delivers, so either my conversion sucks or Delphi's compiler can't deliver. Comments are appreciated. I've changed two things in John Hebert's code to accomodate both Delphi's lack of a "register" keyword (at least in the variable-declaration sense) and my preference about using IDirectDrawSurface4 and DDSURFACEDESC2 vs. IDirectDrawSurface and DDSURFACEDESC. Besides that, my conversion should be clean. Performance details: ** John Hebert's C code performs 69 FPS using the advanced Alpha Blender routine (in 640x480x16) blending a 320x240 bitmap. ** My Object Pascal code performs 34 FPS using the same routine (also in 640x480x16) blending a 300x100 bitmap (smaller than Hebert's). Using normal, colorkeyed blit, my code cranks out 75 FPS, so it shouldn't be the self-coded stuffing around the routine that interferes. Well, enough talk. Here's my conversion. I have included John Hebert's original code, so you can compare. Sorry for the length, but I'd like to get to the bottom of this
        
***** ORIGINAL C CODE BY JOHN HEBERT ******************

HRESULT TransAlphaImproved(LPDIRECTDRAWSURFACE src, LPDIRECTDRAWSURFACE dest, LONG lDestX, LONG lDestY, RECT srcRect, WORD ALPHA, DWORD ColorKey, WORD BPP)
{
	int register i,j;
	int height,width;
	BYTE* lpSprite;
	BYTE* lpDest;
	WORD dPitch, SpritePitch;
	DWORD sColorKey;
	DWORD sTemp,dTemp;
	DWORD sr,sg,sb,dr,dg,db;
	WORD sbuf,dbuf;
	DWORD Result;
	BOOL oddWidth = FALSE;
	DDSURFACEDESC srcDDSD, destDDSD;
	DWORD REDC,GREENC, BLUEC;
	DWORD PLUS64;
	DWORD ALPHABY4;
	DWORD doubleColorKey;


	// Check the ALPHA value

	if (ALPHA < 0)
		ALPHA = 0;
	else if (ALPHA > 256)
		ALPHA = 256;

	// Set height and width of SPRITE

    height = srcRect.bottom - srcRect.top;
    width = srcRect.right - srcRect.left; 

	// Lock down both surfaces for read and write

	ZeroMemory(&srcDDSD, sizeof(srcDDSD));
	srcDDSD.dwSize = sizeof(srcDDSD);
	src->Lock(NULL, &srcDDSD, DDLOCK_WAIT, NULL);
    
	ZeroMemory(&destDDSD, sizeof(destDDSD));
	destDDSD.dwSize = sizeof(destDDSD);
	dest->Lock(NULL, &destDDSD, DDLOCK_WAIT, NULL);

    // Get the color key for sprite surface

    sColorKey = ColorKey;

	// Set the pitch for both surfaces

    SpritePitch = (WORD)srcDDSD.lPitch;
    dPitch      = (WORD)destDDSD.lPitch;

    // Initialize the pointers to the upper left hand corner of surface

    lpSprite = (BYTE*)srcDDSD.lpSurface;
    lpDest   = (BYTE*)destDDSD.lpSurface;

	// Do some work outside of the loop

	PLUS64         = 64 / (64 << 16);
	ALPHABY4      = (ALPHA / 4) / ((ALPHA / 4) << 16);
	doubleColorKey = ColorKey / (ColorKey << 16);

	switch(BPP)
	{
             //case 8 and 15 here. Not included due to lack of space

             case 16:

		// Initialize the pointers to the first pixel in the rectangle

		lpSprite += (srcRect.top * SpritePitch) + (srcRect.left * 2);
		lpDest   += (lDestY * dPitch) + (lDestX * 2);

		// Set the horizontal padding

		sbuf = (WORD)(SpritePitch - (2 * width));
		dbuf = (WORD)(dPitch - (2 * width));

		// Is the Sprite width odd or even?

		if (width % 2 == 1)
		{
			oddWidth = TRUE;
			width = (width - 1) / 2; //div by 2, processing 2 pixels at a time.
		}
		else
			width = width / 2;  //div by 2, processing 2 pixels at a time.


		i = height;
		do
		{
			if (oddWidth)
			{
				sTemp = *((WORD*)lpSprite);

				if (sTemp != ColorKey)
				{
					dTemp = *((WORD*)lpDest);
					sb = sTemp & 0x1f;
					db = dTemp & 0x1f;
					sg = (sTemp >> 5) & 0x3f;
					dg = (dTemp >> 5) & 0x3f;
					sr = (sTemp >> 11) & 0x1f;
					dr = (dTemp >> 11) & 0x1f;

					*((WORD*)lpDest) = (WORD)((ALPHA * (sb - db) >> 8) + db /
						((ALPHA * (sg - dg) >> 8) + dg) << 5 /
						((ALPHA * (sr - dr) >> 8) + dr) << 11);
				}

				lpDest   += 2;
				lpSprite += 2;
			}
			j = width;
			do
			{
				sTemp = *((DWORD*)lpSprite);

				if ( sTemp != doubleColorKey )
				{
					dTemp = *((DWORD*)lpDest);

					sb = sTemp & 0x001F001F;
					db = dTemp & 0x001F001F;
					sg = (sTemp >> 5)  & 0x003F003F;
					dg = (dTemp >> 5)  & 0x003F003F;
					sr = (sTemp >> 11) & 0x001F001F;
					dr = (dTemp >> 11) & 0x001F001F;

					BLUEC  = ((((ALPHA * ((sb + PLUS64) - db)) >> 8) + db) - ALPHABY4) & 0x001F001F;
					GREENC = (((((ALPHA * ((sg + PLUS64) - dg)) >> 8) + dg) - ALPHABY4) & 0x003F003F) << 5;
					REDC   = (((((ALPHA * ((sr + PLUS64) - dr)) >> 8) + dr) - ALPHABY4) & 0x001F001F) << 11;

					Result = BLUEC / GREENC / REDC;

					if ( (sTemp >> 16) == ColorKey )
							Result = (Result & 0xFFFF) / (dTemp & 0xFFFF0000);
					else if ( (sTemp & 0xFFFF) == ColorKey )
							Result = (Result & 0xFFFF0000) / (dTemp & 0xFFFF);

					*((DWORD*)lpDest) = Result;
				}
				lpDest    += 4;
				lpSprite  += 4;

			}while (--j > 0);

			lpDest   += dbuf;
			lpSprite += sbuf;

		}while (--i > 0);

		break;
             //case 24 and 32 here

        } // End RGB Format switch statement



	src->Unlock(NULL);
	dest->Unlock(NULL);

	return DD_OK;
}

***** MY CONVERSION TO OBJECT PASCAL ******************

type
   PByte = ^Byte; //needed for lpSprite and lpDest

   PWord = ^Word; //needed to make these *((WORD*)lpDest) kinds of typecasts
   PCardinal = ^Cardinal; //needed to make these *((DWORD*)lpSprite) kinds of typecast

function TransAlphaImproved(src, dest: IDirectDrawSurface4; lDestX, lDestY: integer; srcRect: TRect; ALPHA: word; ColorKey: cardinal; BPP: byte): HRESULT;
var
   i, j: integer; //original is int register i,j. Not possible in Delphi, though it's optimizer might/might not detect these as loop variables only
   height, width: integer;
   lpSprite: PByte; //defined as ^Byte in original, but Delphi needs this construct to allow pointer incrementation
   lpDest: PByte; //defined as ^Byte in original, but Delphi needs this construct to allow pointer incrementation
   dPitch, SpritePitch: word;
   sColorKey: cardinal;
   sTemp, dTemp: cardinal;
   sr,sg,sb, dr, dg, db: cardinal;
   sbuf, dbuf: word;
   theResult: cardinal; //original is Result, but of course Delphi can't use that
   oddWidth: boolean;
   srcDDSD, destDDSD: TDDSurfaceDesc2;
   REDC, GREENC, BLUEC: cardinal;
   PLUS64: cardinal;
   ALPHABY4: cardinal;
   doubleColorKey: cardinal;
begin
   //init oddWidth

   oddWidth := false; //initialized in var declaration in original


   //check the ALPHA value

   if ALPHA < 0 then //strange to test for this as it will never happen, neither in Delphi nor C, since ALPHA in unsigned
      ALPHA := 0
   else
      if ALPHA > 256 then
         ALPHA := 256;

   //set height and width of sprite

   height := srcRect.bottom - srcRect.top;
   width := srcRect.right - srcRect.left;

   //Lock down both surfaces for read and write

   fillchar(srcDDSD, sizeOf(srcDDSD), 0);
   srcDDSD.dwSize := sizeOf(srcDDSD);
   src.Lock(nil, srcDDSD, DDLOCK_WAIT, 0);

   fillchar(destDDSD, sizeof(destDDSD), 0);
   destDDSD.dwSize := sizeOf(destDDSD);
   dest.Lock(nil, destDDSD, DDLOCK_WAIT, 0);

   //get the color key for sprite surface

   sColorKey := ColorKey;

   //set the pitch for both surfaces

   SpritePitch := word(srcDDSD.lPitch);
   dPitch := word(destDDSD.lPitch);

   //initialize the pointers to the upper left hand corner of surface

   lpSprite := PByte(srcDDSD.lpSurface);
   lpDest := PByte(destDDSD.lpSurface);

   //do some work outside of the loop

   PLUS64 := 64 or (64 shl 16);
   ALPHABY4 := (ALPHA div 4) or ((ALPHA div 4) shl 16);
   doubleColorKey := ColorKey or (ColorKey shl 16);

   case BPP of
      //case 8 and 15 here. Not included due to lack of space

      16:   begin
               //initialize the pointer to the first pixel in the rectangel

               inc(lpSprite, (srcRect.top * SpritePitch) + (srcRect.left * 2));
               inc(lpDest, (lDestY * dPitch) + (lDestX * 2));

               //set the horisontal padding

               sbuf := word(SpritePitch - (2 * width));
               dbuf := word(dPitch - (2 * width));

               //is the Sprite width odd or even?

               if (width mod 2) = 1 then
               begin
                  oddWidth := true;
                  width := (width - 1) div 2; //div by 2, processing 2 pixels at a time
               end else
                  width := width div 2; //div by 2, processing 2 pixels at a time

               i := height;
               repeat
                  if oddWidth then
                  begin
                     sTemp := (PWord(lpSprite))^;

                     if not (sTemp = ColorKey) then
                     begin
                        dTemp := (PWord(lpDest))^;
                        sb := sTemp and $1f;
                        db := dTemp and $1f;
                        sg := (sTemp shr 5) and $3f;
                        dg := (dTemp shr 5) and $3f;
                        sr := (sTemp shr 11) and $1f;
                        dr := (dTemp shr 11) and $1f;

                        (PWord(lpDest))^ := word((ALPHA * (sb - db) shr 8) + db or
                           ((ALPHA * (sg - dg) shr 8) + dg) shl 5 or
                           ((ALPHA * (sr - dr) shr 8) + dr) shl 11);
                     end;

                     inc(lpDest, 2);
                     inc(lpSprite, 2);
                  end; //if oddWidth


                  j := width;
                  repeat
                     sTemp := (PCardinal(lpSprite))^;

                     if not (sTemp = doubleColorKey) then
                     begin
                        dTemp := (PCardinal(lpDest))^;

                        sb := sTemp and $001F001F;
                        db := dTemp and $001F001F;
                        sg := (sTemp shr 5) and $003F003F;
                        dg := (dTemp shr 5) and $003F003F;
                        sr := (sTemp shr 11) and $001F001F;
                        dr := (dTemp shr 11) and $001F001F;

                        BLUEC  := ((((ALPHA * ((sb + PLUS64) - db)) shr 8) + db) - ALPHABY4) and $001F001F;
                        GREENC := (((((ALPHA * ((sg + PLUS64) - dg)) shr 8) + dg) - ALPHABY4) and $003F003F) shl 5;
                        REDC   := (((((ALPHA * ((sr + PLUS64) - dr)) shr 8) + dr) - ALPHABY4) and $001F001F) shl 11;

                        theResult := BLUEC or GREENC or REDC;

                        if  (sTemp shr 16) = ColorKey then
                           theResult := (theResult and $FFFF) or (dTemp and $FFFF0000)
                        else if (sTemp and $FFFF) = ColorKey then
							      theResult := (theResult and $FFFF0000) or (dTemp and $FFFF);;

                        (PCardinal(lpDest))^ := theResult;
                     end; //if not sTemp = doubleColorKey

                     inc(lpDest, 4);
                     inc(lpSprite, 4);

                     dec(j); //takes care of the do while (--j > 0) construct
                  until j <= 0; //original is a do .. while (--j > 0) loop

                  inc(lpDest, dbuf);
                  inc(lpSprite, sbuf);

                  dec(i); //takes care of the do while (--i > 0) construct
               until i <= 0; //original is a do .. while (--i > 0) loop
            end; //16: begin

            //case 24 and 32 here

   end; //case


   src.Unlock(nil);
   dest.Unlock(nil);

   Result := DD_OK;
end; //function


******* END *********************************

        
edited: 19th of June, 00:18 GMT + 1 - source code highlight Regards Toft Edited by - sunbeam60 on 6/18/00 5:15:54 PM Edited by - sunbeam60 on 6/18/00 5:17:02 PM

Share this post


Link to post
Share on other sites
I can''t comment since I''ve never used Object Pascal, but you might put the code into source brackets so that it''s easier to read.

This is what it looks like:
    
type [source], the code, then [/source]


--TheGoop

Share this post


Link to post
Share on other sites
Your conversion seems pretty solid, the only thing that I can think of is that the surfaces in your program might have been created in video memory. If if so, you will get slow performance as the data is going through the bus back and forth. Try declareing boath surfaces in system memory or create simple arrays of shorts in system memory and try it on those. Other than that I can''t think of anything as I''ve not touched pascal since I last used Turbo Pascal for windows back in high school.

OneEyeLessThanNone

My fish seem to be getting high of the oxygen in the water I poured in.

Share this post


Link to post
Share on other sites
Whoa!

OneEyeLessThanNone, it seems that you've got OneBrainMoreThanMe. But of course. My shaken faith in Delphi has been restored!

My surfaces should have been created in system memory, not video memory! Now why didn't I think of that before? :-)

Actually, I'm getting a couple of FPS more in the Delphi version, though it might be because of the smaller bitmap I display.

Amendment: Strange. I get 96 FPS with a regular blit using system memory instead of video memory as I did before (when I got around 75 FPS). That seems odd...

Thanks a lot
Regards
Toft

Edited by - sunbeam60 on June 18, 2000 6:34:15 PM

Share this post


Link to post
Share on other sites