MacFormat 1996 November/macformat-043.iso/mac/Shareware Plus/Developers/Sprite Animation Toolkit 2.3.8/Add-ons/Graphic effects/Pixels.p

Text File | 1995-11-10 | 13.4 KB | 506 lines | [TEXT/MWPS]

{ Plotting sets of pixels fast. }
{ All reasonable screen depths supported: 1, 4, 8, 16 and 32 bits. }

unit Pixels;
interface
    uses
{$ifc UNDEFINED THINK_PASCAL}
        Types, QuickDraw, Windows, Dialogs, Fonts, Memory, {}
        SegLoad, Scrap, ToolUtils, {}
{$ELSEC}
{$SETC GENERATINGPOWERPC = false}
{$endc}
        SAT;

    type
        Pixel = record
                position: Point;
                data1, data2, data3, data4: SignedByte;
            end;
        Pixels = array[0..32000] of Pixel;
        PixelPtr = ^Pixels;

    procedure SATDrawPixels (pix: PixelPtr; var port: SATPort; value: Longint);
    procedure SATCopyPixels (pix: PixelPtr; var src, dest: SATPort);
    procedure SATDrawPixelsSafe (pix: PixelPtr; var port: SATPort; value: Longint);
    procedure SATCopyPixelsSafe (pix: PixelPtr; var src, dest: SATPort);

implementation

    type
        LongPtr = ^Longint;
        IntPtr = ^Integer;
    var
        gBitTablesInitialized: Boolean;
        bits, bitValues, masks: array[0..7] of Byte;

    type
        SATRowListType = array[0..480] of Ptr; {skall vara 0..0}
        SATRowListPtr = ^SATRowListType;

    procedure InitializeBitTables;
        var
            bit, i: integer;
    begin
        bit := 128;
        for i := 0 to 7 do
            begin
                bits[i] := bit;
{bitValues[i] := BitAnd(bit, value);}
{$PUSH}
{$R-}
                masks[i] := BitNot(bit);
                bit := BSR(bit, 1);
{$POP}
            end;
        gBitTablesInitialized := true;
    end; {InitializeBitTables}

    procedure SATDrawPixels (pix: PixelPtr; var port: SATPort; value: Longint);
        var
            mmuMode: SignedByte;
            depth, i, count: Integer;
            byteVal: SignedByte;
            intVal: Integer;
            lp: LongPtr;
            ip: IntPtr;
            bp: Ptr;
            byteValEven, byteValOdd: SignedByte;
            phase: Integer;
    begin
        if pix = nil then
            Exit(SATDrawPixels);
        count := GetPtrSize(Ptr(pix)) div SizeOf(Pixel);

        if gSAT.colorFlag then
            depth := port.device^^.gdPMap^^.pixelSize
        else
            depth := 0;

{if 24-bit, swap to 32-bit}
{$IFC NOT GENERATINGPOWERPC }
        if gSAT.mmuMode <> true32b then
            begin
                mmuMode := true32b;
                pix := PixelPtr(StripAddress(Ptr(pix)));
                SwapMMUMode(mmuMode);
            end;
{$ENDC}

        case depth of
            0, 1:
                begin
                    if not gBitTablesInitialized then
                        InitializeBitTables;
                    for i := 0 to 7 do
                        begin
                            bitValues[i] := BitAnd(bits[i], value);
                        end;

                    for i := 0 to count - 1 do
                        begin
                            bp := Ptr(BSR(pix^[i].position.h, 3) + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                            phase := BitAnd(pix^[i].position.h, 3);
{$PUSH}
{$R-}
                            bp^ := BitOr(BitAnd(bp^, masks[phase]), bitValues[phase])
{$POP}
                        end;

                end;
            2:
                begin
{Pointless screen depth - ignored!}
                end;
            4:
                begin
{$PUSH}
{$R-}
                    byteVal := value;
                    byteValEven := BitAnd(byteVal, $f0);
                    byteValOdd := BitAnd(byteVal, $0f);
{$POP}
                    for i := 0 to count - 1 do
                        begin
                            bp := Ptr(BSR(pix^[i].position.h, 1) + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                            if BitAnd(pix^[i].position.h, 1) = 0 then
{$PUSH}
{$R-}
                                bp^ := BitOr(BitAnd(bp^, $0f), byteValEven)
                            else
                                bp^ := BitOr(BitAnd(bp^, $f0), byteValOdd);
{$POP}
                        end;
                end;
            8:
                begin
                    byteVal := value;
                    for i := 0 to count - 1 do
                        begin
                            bp := Ptr(pix^[i].position.h + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                            bp^ := byteVal;
                        end;
                end;
            16:
                begin
                    intVal := value;
                    for i := 0 to count - 1 do
                        begin
                            ip := IntPtr(BSL(pix^[i].position.h, 1) + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                            ip^ := intVal;
                        end;
                end;
            32:
                begin
                    for i := 0 to count - 1 do
                        begin
                            lp := LongPtr(BSL(pix^[i].position.h, 2) + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                            lp^ := value;
                        end;
                end;
            otherwise
        end;

{swap back}
{$IFC NOT GENERATINGPOWERPC }
        if gSAT.mmuMode <> true32b then
            begin
                SwapMMUMode(mmuMode);
            end;
{$ENDC}
    end; {SATDrawPixels}

    procedure SATCopyPixels (pix: PixelPtr; var src, dest: SATPort);
        var
            mmuMode: SignedByte;
            depth, i, count: Integer;
            lp, ldp: LongPtr;
            ip, idp: IntPtr;
            bp, bdp: Ptr;
    begin
        if pix = nil then
            Exit(SATCopyPixels);
        count := GetPtrSize(Ptr(pix)) div SizeOf(Pixel);

        if gSAT.colorFlag then
            depth := dest.device^^.gdPMap^^.pixelSize
        else
            depth := 0;

{if 24-bit, swap to 32-bit}
{$IFC NOT GENERATINGPOWERPC }
        if gSAT.mmuMode <> true32b then
            begin
                mmuMode := true32b;
                pix := PixelPtr(StripAddress(Ptr(pix)));
                SwapMMUMode(mmuMode);
            end;
{$ENDC}

        case depth of
            0, 1:
                begin
                    if not gBitTablesInitialized then
                        InitializeBitTables;
                    for i := 0 to count - 1 do
                        begin
                            bp := Ptr(BSR(pix^[i].position.h, 3) + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                            bdp := Ptr(BSR(pix^[i].position.h, 3) + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                            bdp^ := bp^;
                        end;

                end;
            2:
                begin
{Pointless screen depth - ignored!}
                end;
            4:
                begin
                    for i := 0 to count - 1 do
                        begin
                            bp := Ptr(BSR(pix^[i].position.h, 1) + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                            bdp := Ptr(BSR(pix^[i].position.h, 1) + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                            bdp^ := bp^;
                        end;
                end;
            8:
                begin
                    for i := 0 to count - 1 do
                        begin
                            bp := Ptr(pix^[i].position.h + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                            bdp := Ptr(pix^[i].position.h + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                            bdp^ := bp^;
                        end;
                end;
            16:
                begin
                    for i := 0 to count - 1 do
                        begin
                            ip := IntPtr(BSL(pix^[i].position.h, 1) + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                            idp := IntPtr(BSL(pix^[i].position.h, 1) + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                            idp^ := ip^;
                        end;
                end;
            32:
                begin
                    for i := 0 to count - 1 do
                        begin
                            lp := LongPtr(BSL(pix^[i].position.h, 2) + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                            ldp := LongPtr(BSL(pix^[i].position.h, 2) + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                            ldp^ := lp^;
                        end;
                end;
            otherwise
        end;

{swap back}
{$IFC NOT GENERATINGPOWERPC }
        if gSAT.mmuMode <> true32b then
            begin
                SwapMMUMode(mmuMode);
            end;
{$ENDC}
    end; {SATCopyPixels}



    procedure SATDrawPixelsSafe (pix: PixelPtr; var port: SATPort; value: Longint);
        var
            mmuMode: SignedByte;
            depth, i, count: Integer;
            byteVal: SignedByte;
            intVal: Integer;
            lp: LongPtr;
            ip: IntPtr;
            bp: Ptr;
            byteValEven, byteValOdd: SignedByte;
            phase: Integer;
    begin
        if pix = nil then
            Exit(SATDrawPixelsSafe);
        count := GetPtrSize(Ptr(pix)) div SizeOf(Pixel);

        if gSAT.colorFlag then
            depth := port.device^^.gdPMap^^.pixelSize
        else
            depth := 0;

{if 24-bit, swap to 32-bit}
{$IFC NOT GENERATINGPOWERPC }
        if gSAT.mmuMode <> true32b then
            begin
                mmuMode := true32b;
                pix := PixelPtr(StripAddress(Ptr(pix)));
                SwapMMUMode(mmuMode);
            end;
{$ENDC}

        case depth of
            0, 1:
                begin
                    if not gBitTablesInitialized then
                        InitializeBitTables;
                    for i := 0 to 7 do
                        begin
                            bitValues[i] := BitAnd(bits[i], value);
                        end;

                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= port.bounds.left then
                            if pix^[i].position.v >= port.bounds.top then
                                if pix^[i].position.h < port.bounds.right then
                                    if pix^[i].position.h < port.bounds.bottom then
                                        begin
                                            bp := Ptr(BSR(pix^[i].position.h, 3) + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                                            phase := BitAnd(pix^[i].position.h, 3);
                                            bp^ := BitOr(BitAnd(bp^, masks[phase]), bitValues[phase])
                                        end;

                end;
            2:
                begin
{Pointless screen depth - ignored!}
                end;
            4:
                begin
                    byteVal := value;
                    byteValEven := BitAnd(byteVal, $f0);
                    byteValOdd := BitAnd(byteVal, $0f);
                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= port.bounds.left then
                            if pix^[i].position.v >= port.bounds.top then
                                if pix^[i].position.h < port.bounds.right then
                                    if pix^[i].position.h < port.bounds.bottom then
                                        begin
                                            bp := Ptr(BSR(pix^[i].position.h, 1) + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                                            if BitAnd(pix^[i].position.h, 1) = 0 then
                                                bp^ := BitOr(BitAnd(bp^, $0f), byteValEven)
                                            else
                                                bp^ := BitOr(BitAnd(bp^, $f0), byteValOdd);
                                        end;
                end;
            8:
                begin
                    byteVal := value;
                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= port.bounds.left then
                            if pix^[i].position.v >= port.bounds.top then
                                if pix^[i].position.h < port.bounds.right then
                                    if pix^[i].position.h < port.bounds.bottom then
                                        begin
                                            bp := Ptr(pix^[i].position.h + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                                            bp^ := byteVal;
                                        end;
                end;
            16:
                begin
                    intVal := value;
                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= port.bounds.left then
                            if pix^[i].position.v >= port.bounds.top then
                                if pix^[i].position.h < port.bounds.right then
                                    if pix^[i].position.h < port.bounds.bottom then
                                        begin
                                            ip := IntPtr(BSL(pix^[i].position.h, 1) + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                                            ip^ := intVal;
                                        end;
                end;
            32:
                begin
                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= port.bounds.left then
                            if pix^[i].position.v >= port.bounds.top then
                                if pix^[i].position.h < port.bounds.right then
                                    if pix^[i].position.h < port.bounds.bottom then
                                        begin
                                            lp := LongPtr(BSL(pix^[i].position.h, 2) + Longint(SATRowListPtr(port.rows)^[pix^[i].position.v]));
                                            lp^ := value;
                                        end;
                end;
            otherwise
        end;


{swap back}
{$IFC NOT GENERATINGPOWERPC }
        if gSAT.mmuMode <> true32b then
            begin
                SwapMMUMode(mmuMode);
            end;
{$ENDC}
    end; {SATDrawPixelsSafe}

    procedure SATCopyPixelsSafe (pix: PixelPtr; var src, dest: SATPort);
        var
            mmuMode: SignedByte;
            depth, i, count: Integer;
            lp, ldp: LongPtr;
            ip, idp: IntPtr;
            bp, bdp: Ptr;
    begin
        if pix = nil then
            Exit(SATCopyPixelsSafe);
        count := GetPtrSize(Ptr(pix)) div SizeOf(Pixel);

        if gSAT.colorFlag then
            depth := dest.device^^.gdPMap^^.pixelSize
        else
            depth := 0;

{if 24-bit, swap to 32-bit}
{$IFC NOT GENERATINGPOWERPC }
        if gSAT.mmuMode <> true32b then
            begin
                mmuMode := true32b;
                pix := PixelPtr(StripAddress(Ptr(pix)));
                SwapMMUMode(mmuMode);
            end;
{$ENDC}

        case depth of
            0, 1:
                begin
                    if not gBitTablesInitialized then
                        InitializeBitTables;

                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= dest.bounds.left then
                            if pix^[i].position.v >= dest.bounds.top then
                                if pix^[i].position.h < dest.bounds.right then
                                    if pix^[i].position.h < dest.bounds.bottom then
                                        begin
                                            bp := Ptr(BSR(pix^[i].position.h, 3) + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                                            bdp := Ptr(BSR(pix^[i].position.h, 3) + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                                            bdp^ := bp^;
                                        end;

                end;
            2:
                begin
{Pointless screen depth - ignored!}
                end;
            4:
                begin
                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= dest.bounds.left then
                            if pix^[i].position.v >= dest.bounds.top then
                                if pix^[i].position.h < dest.bounds.right then
                                    if pix^[i].position.h < dest.bounds.bottom then
                                        begin
                                            bp := Ptr(BSR(pix^[i].position.h, 1) + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                                            bdp := Ptr(BSR(pix^[i].position.h, 1) + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                                            bdp^ := bp^;
                                        end;
                end;
            8:
                begin
                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= dest.bounds.left then
                            if pix^[i].position.v >= dest.bounds.top then
                                if pix^[i].position.h < dest.bounds.right then
                                    if pix^[i].position.h < dest.bounds.bottom then
                                        begin
                                            bp := Ptr(pix^[i].position.h + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                                            bdp := Ptr(pix^[i].position.h + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                                            bdp^ := bp^;
                                        end;
                end;
            16:
                begin
                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= dest.bounds.left then
                            if pix^[i].position.v >= dest.bounds.top then
                                if pix^[i].position.h < dest.bounds.right then
                                    if pix^[i].position.h < dest.bounds.bottom then
                                        begin
                                            ip := IntPtr(BSL(pix^[i].position.h, 1) + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                                            idp := IntPtr(BSL(pix^[i].position.h, 1) + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                                            idp^ := ip^;
                                        end;
                end;
            32:
                begin
                    for i := 0 to count - 1 do
                        if pix^[i].position.h >= dest.bounds.left then
                            if pix^[i].position.v >= dest.bounds.top then
                                if pix^[i].position.h < dest.bounds.right then
                                    if pix^[i].position.h < dest.bounds.bottom then
                                        begin
                                            lp := LongPtr(BSL(pix^[i].position.h, 2) + Longint(SATRowListPtr(src.rows)^[pix^[i].position.v]));
                                            ldp := LongPtr(BSL(pix^[i].position.h, 2) + Longint(SATRowListPtr(dest.rows)^[pix^[i].position.v]));
                                            ldp^ := lp^;
                                        end;
                end;
            otherwise
        end;

{swap back}
{$IFC NOT GENERATINGPOWERPC }
        if gSAT.mmuMode <> true32b then
            begin
                SwapMMUMode(mmuMode);
            end;
{$ENDC}
    end; {SATCopyPixelsSafe}

end.