Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/Blasto-P/DirectScreen.p

Text File | 1995-02-16 | 5.1 KB | 135 lines | [TEXT/PJMM]

(* 11-11-92 • BRS changed things from short to long, to fix bug with THINK C compiler. *)


{Decomment under UPI:}
{$SETC GENERATINGPOWERPC=false}

unit DirectScreen;

interface

{$IFC UNDEFINED THINK_PASCAL}
    uses
        OSUtils, Windows, QDOffscreen, Retrace, Memory, Resources, Events,{}
        Menus, ToolUtils;
{$ENDC}

    type
        LongPtr = ^Longint;
    procedure DirectPlotColorIcon (colorIconPtr: LongPtr; screenPixMap: PixMapHandle; row: Integer; col: Integer);

implementation

    procedure DirectPlotColorIcon (colorIconPtr: LongPtr; screenPixMap: PixMapHandle; row: Integer; col: Integer);
{     Draws a color icon image directly to the pixMap passed.}
{    colorIconPtr = pointer to the image data for a color icon}
{    screenPixMap = handle to the pixMap for the screen we're writing on}
{    row, col      = location of the top left corner of the icon in the }
{                    pixMap's coordinate system; }
{                    since we know the icon is 32 by 32, }
{                    the other coordinates are unnecessary. }
        var
            screenMemPtr: LongPtr;        { Pointer to video memory}
            numRowsToCopy: LongInt;        { Rows we are going to copy}
            stripRowBytes: LongInt;        { To clear high bit of rowbytes}
            rowLongsOffset: LongInt;        { rowBytes converted to long}
            mmuMode: SignedByte;                { 32-bit mode required}
            cursRect: Rect;            { rectangle for shield cursor call}
            cursOffset: Point;            { 0,0 to indicate rect is in global coordinates}
    begin
    (* High bit of pixMap rowBytes must be cleared. *)
        stripRowBytes := BitAnd($7FFF, screenPixMap^^.rowBytes);

    (* We must strip the high byte of the address of the color icon, which, if we're in}
    {24-bit mode, may be garbage when we go to 32-bit mode to access video memory. *)
{$IFC GENERATINGPOWERPC }
        colorIconPtr := LongPtr(colorIconPtr);
{$ELSEC}
        colorIconPtr := LongPtr(StripAddress(Ptr(colorIconPtr)));
{$ENDC}

    (* Calculate the address of the first byte of the destination. *)
        screenMemPtr := LongPtr(Longint(screenPixMap^^.baseAddr) + (stripRowBytes * row) + col); {GetPixBaseAddr???}

    (* call shield cursor to maintain compatibility with all displays *)
    (* This rectangle should be a parameter, but this was added to late *)
        cursOffset.h := 0;
        cursOffset.v := 0;
        cursRect.top := row;
        cursRect.left := col;
        cursRect.bottom := row + 32;
        cursRect.right := col + 32;
        ShieldCursor(cursRect, cursOffset);

    (* Change to 32-bit addressing mode to access video memory. The previous addressing mode }
    { is returned in mmuMode for restoring later. *)
        mmuMode := true32b;
{$IFC NOT GENERATINGPOWERPC }
        SwapMMUMode(mmuMode);
{$ENDC}
        numRowsToCopy := 32;                        (* Color icons have 32 rows. *)

(* Calculate the long word offset from the end of one row of the color icon on the screen's }
{pixMap to the first byte of the icon in the next row. *)
        rowLongsOffset := stripRowBytes - 32;
{BSR(stripRowBytes, 2) - 8;}

    (* Draw the color icon directly to the screen. *)
        repeat
{^screenMemPtr++ := ^colorIconPtr++;}
{^screenMemPtr++ := ^colorIconPtr++;}
{^screenMemPtr++ := ^colorIconPtr++;}
{^screenMemPtr++ := ^colorIconPtr++;}
{^screenMemPtr++ := ^colorIconPtr++;}
{^screenMemPtr++ := ^colorIconPtr++;}
{^screenMemPtr++ := ^colorIconPtr++;}
{^screenMemPtr++ := ^colorIconPtr++;}

{The Pascal version is quite a bit longer. It is, however, exactly as fast, according}
{to my measurements. All that has happened is that we have to do some typecasts}
{since Pascal doesn't enjoy pointer arithmetics, and we must add each separately.}
{Big deal.}

{How bad would BlockMove be? If called by trap address? And how bad would it be with QuickDraw?}
{And how much better with a row-list?}
            {LongPtr(screenMemPtr)^ := LongPtr(colorIconPtr)^;}
            {screenMemPtr := screenMemPtr + 4;}
            {colorIconPtr := colorIconPtr + 4;}

            screenMemPtr^ := colorIconPtr^;
            screenMemPtr := LongPtr(Longint(screenMemPtr) + 4);
            colorIconPtr := LongPtr(Longint(colorIconPtr) + 4);
            screenMemPtr^ := colorIconPtr^;
            screenMemPtr := LongPtr(Longint(screenMemPtr) + 4);
            colorIconPtr := LongPtr(Longint(colorIconPtr) + 4);
            screenMemPtr^ := colorIconPtr^;
            screenMemPtr := LongPtr(Longint(screenMemPtr) + 4);
            colorIconPtr := LongPtr(Longint(colorIconPtr) + 4);
            screenMemPtr^ := colorIconPtr^;
            screenMemPtr := LongPtr(Longint(screenMemPtr) + 4);
            colorIconPtr := LongPtr(Longint(colorIconPtr) + 4);
            screenMemPtr^ := colorIconPtr^;
            screenMemPtr := LongPtr(Longint(screenMemPtr) + 4);
            colorIconPtr := LongPtr(Longint(colorIconPtr) + 4);
            screenMemPtr^ := colorIconPtr^;
            screenMemPtr := LongPtr(Longint(screenMemPtr) + 4);
            colorIconPtr := LongPtr(Longint(colorIconPtr) + 4);
            screenMemPtr^ := colorIconPtr^;
            screenMemPtr := LongPtr(Longint(screenMemPtr) + 4);
            colorIconPtr := LongPtr(Longint(colorIconPtr) + 4);
            screenMemPtr^ := colorIconPtr^;
            screenMemPtr := LongPtr(Longint(screenMemPtr) + 4);
            colorIconPtr := LongPtr(Longint(colorIconPtr) + 4);

        (* Bump to start of next row. *)
            screenMemPtr := LongPtr(Longint(screenMemPtr) + rowLongsOffset);

            numRowsToCopy := numRowsToCopy - 1;
        until numRowsToCopy <= 0;

{$IFC NOT GENERATINGPOWERPC }
        SwapMMUMode(mmuMode);        (* Restore addressing mode back to what it was. *)
{$ENDC}
        ShowCursor;
    end;
end.