Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Libraries/SAT 2.3.8/Libraries & Documentation/Add-ons/Sprite behavior/SATToolbox.p

Text File | 1996-05-28 | 19.8 KB | 650 lines | [TEXT/PJMM]

{ SAT Toolbox}
{This unit holds a set of utility routines that may simplify your sprite programming, but that are in no way mandatory.}


unit SATToolbox;

interface

    uses
{$ifc UNDEFINED THINK_PASCAL}
        Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit, TextEdit, Traps,{}
        Memory, SegLoad, Scrap, ToolUtils, OSUtils, Menus, Resources, StandardFile,{}
        GestaltEqu, Files, Errors, Devices, QuickDrawText,
{$endc}
        SAT;

{The following switch should be true if your SAT.p has a fixedPointPosition field.}
{$setc _hasfixedpoint = true}

{MoveSprite: Moves a sprite according to speed}
{KeepOnScreen: Performs border checks for a sprite}
{RectSeparate: Moves two sprites apart}
{RegionHit: Checks if the regions of two sprites overlap}
{SplitVector: A utility for splitting a vector in components parallel and perpendicular to another vector}
{}
{Sinus, Cosinus, SquareRoot: Useful look-up table based operations.}


    type
        FixSpritePtr = ^FixSprite;
        FixSprite = record
{ Variables that you should change as appropriate }
                kind: Integer; { Used for identification. >0: friend. <0 foe }
                position: Point;
                hotRect, hotRect2: Rect; { Tells how large the sprite is; hotRect is centered around origo }
                                    {hotRect is set by you. hotRect2 is offset to the current position.}
                face: FacePtr;            { Pointer to the Face (appearance) to be used. }
                task: ProcPtr;            { Callback-routine, called once per frame. If task=nil, the sprite is removed. }
                hitTask: ProcPtr;        { Callback in collisions. }
                destructTask: ProcPtr;    { Called when a sprite is disposed. (Usually nil.) }
                clip: RgnHandle;            {Clip region to be used when this sprite is drawn.}
{ SAT variables that you shouldn't change: }
                oldpos: Point;                {Used by RunSAT2}
                next, prev: SpritePtr;    {You may change them in your own sorting routine, but be careful if you do.}
                r, oldr: Rect;                {Rectangle telling where to draw. Avoid messing with it.}
                oldFace: FacePtr;            {Used by RunSAT2}
                dirty: Boolean;            {Used by RunSAT2}
{Variables for internal use by the sprites. Use as you please. Edit as necessary - this is merely a default}
{set, enough space for most cases - but if you change the size of the record, call SetSpriteSize immediately}
{after initializing (before any sprites are created)!}
                layer: integer; {For layer-sorting. When not used for that, use freely.}
                speed: Point; { Can be used for speed, but not necessarily. }
                mode: integer; { Usually used for different modes and/or to determine what image to show next. }
                fixedPointPosition: Point; {fixed point position}
                appLong: Longint; {Longint for free use by the application.}
            end;

{Constants for separation/bounceoff between sprites}
    const
        kPushBoth = 0;
        kPushMe = 1;
        kPushHim = 2;

(*Sprite utilities*)
    procedure MoveSprite (theSprite: SpritePtr);
    function KeepOnScreen (theSprite: SpritePtr): Boolean;
{$ifc _hasfixedpoint}
    procedure MoveSpriteFixedPoint (theSprite: FixSpritePtr);
    function KeepOnScreenFixed (theSprite: FixSpritePtr): Boolean;
{$endc}
    function RectSeparate (theSprite: SpritePtr; anotherSprite: SpritePtr; push: Integer): Integer;
    procedure RectBounce (me, him: SpritePtr; push: Integer);
    procedure RectBounceFixed (me, him: FixSpritePtr; push: Integer);
    function PtInSpriteRgn (p: Point; theSprite: SpritePtr): Boolean;
    function RegionHit (theSprite: SpritePtr; anotherSprite: SpritePtr): Boolean;
    procedure SplitVector (v: Point; d: Point; var p: Point; var n: Point);

    procedure RegionBounce (s1, s2: FixSpritePtr);

{Look-up table based fixed-point math operations. UNTESTED!}

    const
        kFixedPointShift = 4; {Number of fixed-point positions}
        kFixedOne = 16; {The "one" in the fixed-point system being used!}

    procedure InitTables; {Init not required}
    function SquareRoot (arg: Longint): Longint;
    function Sinus (arg: Longint): Longint;
    function Cosinus (arg: Longint): Longint;
    function VectorLength (vector: Point): Longint;
    function FPVectorLength (vector: Point): Longint;

implementation

{Call MoveSprite or MoveSpriteFixedPoint from the sprite handling routine, to move it according to the speed.}

    procedure MoveSprite (theSprite: SpritePtr);
    begin
        theSprite^.position.h := theSprite^.position.h + theSprite^.speed.h;
        theSprite^.position.v := theSprite^.position.v + theSprite^.speed.v;
        if KeepOnScreen(theSprite) then
            ;
    end; (*MoveSprite*)

{$ifc _hasfixedpoint}
    procedure MoveSpriteFixedPoint (theSprite: FixSpritePtr);
    begin
        theSprite^.fixedPointPosition.h := theSprite^.fixedPointPosition.h + theSprite^.speed.h;
        theSprite^.fixedPointPosition.v := theSprite^.fixedPointPosition.v + theSprite^.speed.v;
        theSprite^.position.h := BSR(theSprite^.fixedPointPosition.h, kFixedPointShift);
        theSprite^.position.v := BSR(theSprite^.fixedPointPosition.v, kFixedPointShift);
        if KeepOnScreenFixed(theSprite) then
            ;
    end; (*MoveSpriteFixedPoint*)
{$ENDC}


(* KeepOnScreen makes border checks to keep the sprite within the window.}
{on a border hit, the speed is negated in order to make the sprite bounce.}
{KeepOnScreen returns true if a border was hit. *)

    function KeepOnScreen (theSprite: SpritePtr): Boolean;
        var
            returnValue: Boolean;
    begin
        returnValue := false;
        if theSprite^.position.h < 0 then
            begin
                theSprite^.position.h := 0;
                theSprite^.speed.h := abs(theSprite^.speed.h);
                returnValue := true;
            end;
        if theSprite^.position.v < 0 then
            begin
                theSprite^.position.v := 0;
                theSprite^.speed.v := abs(theSprite^.speed.v);
                returnValue := true;
            end;
        if theSprite^.position.h > gSAT.offScreen.port^.portRect.right - theSprite^.hotRect.right then
            begin
                theSprite^.position.h := gSAT.offScreen.port^.portRect.right - theSprite^.hotRect.right;
                theSprite^.speed.h := -abs(theSprite^.speed.h);
                returnValue := true;
            end;
        if theSprite^.position.v > gSAT.offScreen.port^.portRect.bottom - theSprite^.hotRect.bottom then
            begin
                theSprite^.position.v := gSAT.offScreen.port^.portRect.bottom - theSprite^.hotRect.bottom;
                theSprite^.speed.v := -abs(theSprite^.speed.v);
                returnValue := true;
            end;

        KeepOnScreen := returnValue;
    end; (*KeepOnScreen*)


{$ifc _hasfixedpoint}
(*Same as above, but also modifies the fixedPointPosition field*)
    function KeepOnScreenFixed (theSprite: FixSpritePtr): Boolean;
        var
            returnValue: Boolean;
    begin
        returnValue := false;
        if theSprite^.fixedPointPosition.h < 0 then
            begin
                theSprite^.position.h := 0;
                theSprite^.fixedPointPosition.h := 0;
                theSprite^.speed.h := abs(theSprite^.speed.h);
                returnValue := true;
            end;
        if theSprite^.fixedPointPosition.v < 0 then
            begin
                theSprite^.position.v := 0;
                theSprite^.fixedPointPosition.v := 0;
                theSprite^.speed.v := abs(theSprite^.speed.v);
                returnValue := true;
            end;
        if theSprite^.position.h > gSAT.offScreen.port^.portRect.right - theSprite^.hotRect.right then
            begin
                theSprite^.position.h := gSAT.offScreen.port^.portRect.right - theSprite^.hotRect.right;
                theSprite^.fixedPointPosition.h := BSL(theSprite^.position.h, kFixedPointShift);
                theSprite^.speed.h := -abs(theSprite^.speed.h);
                returnValue := true;
            end;
        if theSprite^.position.v > gSAT.offScreen.port^.portRect.bottom - theSprite^.hotRect.bottom then
            begin
                theSprite^.position.v := gSAT.offScreen.port^.portRect.bottom - theSprite^.hotRect.bottom;
                theSprite^.fixedPointPosition.v := BSL(theSprite^.position.v, kFixedPointShift);
                theSprite^.speed.v := -abs(theSprite^.speed.v);
                returnValue := true;
            end;

        KeepOnScreenFixed := returnValue
    end; (*KeepOnScreenFixed*)
{$endif}


(* Moves two sprites apart, to separate them with respect to their bounding boxes. *)

    function RectSeparate (theSprite: SpritePtr; anotherSprite: SpritePtr; push: Integer): Integer;
        var
            distance: array[0..3] of Integer;
            shortest, shortestDistance, i: Integer;
            bounds1, bounds2: Rect;
            pushMe, pushHim: Integer;
    begin
        bounds1 := theSprite^.hotRect;    {Duger inte hotRect2???}
        OffsetRect(bounds1, theSprite^.position.h, theSprite^.position.v);

        bounds2 := anotherSprite^.hotRect;        {Duger inte hotRect2???}
        OffsetRect(bounds2, anotherSprite^.position.h, anotherSprite^.position.v);

(*Calculate the distance to separate the sprites in every direction*)
        distance[0] := bounds2.top - bounds1.bottom; {up}
        distance[1] := bounds2.bottom - bounds1.top; {down}
        distance[2] := bounds2.right - bounds1.left; {right}
        distance[3] := bounds2.left - bounds1.right; {left}

(*Find the shortest distance*)
        shortest := 0;
        shortestDistance := abs(distance[0]);
        for i := 1 to 3 do
            if abs(distance[i]) < shortestDistance then
                begin
                    shortest := i;
                    shortestDistance := abs(distance[i]);
                end;

(*Move the sprite in the appropriate direction*)
        case push of
            kPushBoth:
                begin
                    pushMe := BSR(distance[shortest], 1);
                    pushHim := distance[shortest] - pushMe;
                    case shortest of
                        0, 1:
                            begin
                                theSprite^.position.v := theSprite^.position.v + pushMe;
                                anotherSprite^.position.v := anotherSprite^.position.v - pushHim;
                            end;
                        2, 3:
                            begin
                                theSprite^.position.h := theSprite^.position.h + pushMe;
                                anotherSprite^.position.h := anotherSprite^.position.h - pushHim;
                            end;
                    end; {case}
                end;
            kPushMe:
                case shortest of
                    0, 1:
                        theSprite^.position.v := theSprite^.position.v + distance[shortest];
                    2, 3:
                        theSprite^.position.h := theSprite^.position.h + distance[shortest];
                end; {case}
            kPushHim:
                case shortest of
                    0, 1:
                        anotherSprite^.position.v := anotherSprite^.position.v - distance[shortest];
                    2, 3:
                        anotherSprite^.position.h := anotherSprite^.position.h - distance[shortest];
                end; {case}
        end; {case}
        RectSeparate := shortest;
    end; (*RectSeparate*)

    procedure InternalDoBounce (me, him: SpritePtr; separateResult, push: Integer);
        var
            tempSpeed: integer;
    begin
        case push of
            kPushBoth:
                if separateResult >= 2 then { 2 or 3: horizontal, otherwise vertical}
                    begin
                        tempSpeed := me^.speed.h;
                        me^.speed.h := him^.speed.h;
                        him^.speed.h := tempSpeed;
                    end
                else
                    begin
                        tempSpeed := me^.speed.v;
                        me^.speed.v := him^.speed.v;
                        him^.speed.v := tempSpeed;
                    end;
            kPushMe:
                if separateResult >= 2 then
                    begin
                        if me^.position.h > him^.position.h then
                            me^.speed.h := Abs(me^.speed.h)
                        else
                            me^.speed.h := -Abs(me^.speed.h);
                    end
                else
                    begin
                        if me^.position.v > him^.position.v then
                            me^.speed.v := Abs(me^.speed.v)
                        else
                            me^.speed.v := -Abs(me^.speed.v);
                    end;
            kPushHim:
                if separateResult >= 2 then { 2 or 3: horizontal, otherwise vertical}
                    begin
                        if him^.position.h > me^.position.h then
                            him^.speed.h := Abs(him^.speed.h)
                        else
                            him^.speed.h := -Abs(him^.speed.h);
                    end
                else
                    begin
                        if him^.position.v > me^.position.v then
                            him^.speed.v := Abs(him^.speed.v)
                        else
                            him^.speed.v := -Abs(him^.speed.v);
                    end;
        end; {case}
    end; {InternalDoBounce}

    procedure RectBounce (me, him: SpritePtr; push: Integer);
        var
            result: Integer;
    begin
        result := RectSeparate(me, him, push);
        InternalDoBounce(me, him, result, push);
    end; {RectBounce}

    procedure RectBounceFixed (me, him: FixSpritePtr; push: Integer);
        var
            result: integer;
    begin
        result := RectSeparate(SpritePtr(me), SpritePtr(him), push);
        InternalDoBounce(SpritePtr(me), SpritePtr(him), result, push);

        me^.fixedPointPosition.h := BSL(me^.position.h, kFixedPointShift);
        me^.fixedPointPosition.v := BSL(me^.position.v, kFixedPointShift);
        him^.fixedPointPosition.h := BSL(him^.position.h, kFixedPointShift);
        him^.fixedPointPosition.v := BSL(him^.position.v, kFixedPointShift);
    end; {RectBounceFixed}


{Check if a point is within a sprite – useful for mouse hits in sprites}

    function PtInSpriteRgn (p: Point; theSprite: SpritePtr): Boolean;
        var
            faceRgn: RgnHandle;
    begin
        PtInSpriteRgn := false;
        if theSprite = nil then
            Exit(PtInSpriteRgn);
        if theSprite^.face = nil then
            Exit(PtInSpriteRgn);

        faceRgn := NewRgn;

        CopyRgn(theSprite^.face^.maskRgn, faceRgn);
        OffsetRgn(faceRgn, theSprite^.position.h, theSprite^.position.v);

        PtInSpriteRgn := PtInRgn(p, faceRgn);
        DisposeRgn(faceRgn);
    end; {PtInSpriteRgn}


(* Collision test using regions! *)

    function RegionHit (theSprite: SpritePtr; anotherSprite: SpritePtr): Boolean;
        var
            faceRegion1, faceRegion2: RgnHandle;
            result: Boolean;
    begin
        faceRegion1 := NewRgn;
        faceRegion2 := NewRgn;

        CopyRgn(theSprite^.face^.maskRgn, faceRegion1);
        OffsetRgn(faceRegion1, theSprite^.position.h, theSprite^.position.v);

        CopyRgn(anotherSprite^.face^.maskRgn, faceRegion2);
        OffsetRgn(faceRegion2, anotherSprite^.position.h, anotherSprite^.position.v);

        SectRgn(faceRegion1, faceRegion2, faceRegion1);
        result := not EmptyRgn(faceRegion1);

        DisposeRgn(faceRegion1);
        DisposeRgn(faceRegion2);

        RegionHit := result;
    end; (*RegionHit*)


(* Split a vector v into a component p parallel to another vector d,}
{and a component n that is perpendicular to d. Useful for realistic}
{collision handling! *)

    procedure SplitVector (v: Point; d: Point; var p: Point; var n: Point);
        var
            length2, dotProduct: LongInt;
    begin
        length2 := d.h * d.h + d.v * d.v;    (*Squared length of "d"*)

        dotProduct := v.h * d.h + v.v * d.v;    (*Scalar product*)

        p.h := d.h * dotProduct div length2;
        p.v := d.v * dotProduct div length2;
        n.h := v.h - p.h;
        n.v := v.v - p.v;
    end; (* SplitVector *)













    procedure RegionSeparate (i, j: FixSpritePtr; r1, r2, diff: RgnHandle);
        var
            internalDiff: RgnHandle;
            initVector, nowVector: Point;
            absH, absV: integer;
            moveH, moveV: integer;
            frac: integer;
{Normal signum function (which I don't think is in the libs)}
        function Sgn (x: integer): integer;
        begin
            if x > 0 then
                Sgn := 1
            else if x < 0 then
                Sgn := -1
            else
                Sgn := 0;
        end;

    begin {RegionSeparate}
        internalDiff := NewRgn;
        frac := 0;
        initVector.h := i^.position.h - j^.position.h;
        initVector.v := i^.position.v - j^.position.v;

        initVector.h := -(diff^^.rgnBBox.right + diff^^.rgnBBox.left) div 2 + (r1^^.rgnBBox.right + r1^^.rgnBBox.left) div 2;
        initVector.v := -(diff^^.rgnBBox.bottom + diff^^.rgnBBox.top) div 2 + (r1^^.rgnBBox.bottom + r1^^.rgnBBox.top) div 2;

        absH := abs(initVector.h);
        absV := abs(initVector.v);
        moveH := Sgn(initVector.h);
        moveV := Sgn(initVector.v);
        if moveH = 0 then
            if moveV = 0 then
                moveV := 1;
        repeat
            if absH > absV then
                begin
                    i^.position.h := i^.position.h + moveH;
                    OffsetRgn(r1, moveH, 0);
{j^.position.h := j^.position.h - moveH;}
                    frac := frac + absV;
                    if frac > absH then
                        begin
                            i^.position.v := i^.position.v + moveV;
                            OffsetRgn(r1, 0, moveV);
{j^.position.v := j^.position.v - moveV;}
                            frac := frac - absH;
                        end
                end
            else
                begin
                    i^.position.v := i^.position.v + moveV;
                    OffsetRgn(r1, 0, moveV);
{j^.position.v := j^.position.v - moveV;}
                    frac := frac + absH;
                    if frac > absV then
                        begin
                            i^.position.h := i^.position.h + moveH;
                            OffsetRgn(r1, moveH, 0);
{j^.position.h := j^.position.h - moveH;}
                            frac := frac - absV;
                        end
                end;
            nowVector.h := i^.position.h - j^.position.h;
            nowVector.v := i^.position.v - j^.position.v;

            SectRgn(r1, r2, internalDiff);
        until EmptyRgn(internalDiff);

{until longint(nowVector.h) * nowVector.h + longint(nowVector.v) * nowVector.v > kBallDiameterSquared;}
        i^.fixedPointPosition.h := BSL(i^.position.h, 4); {Make fixedPos by shifting in the 4 binary "decimals"}
        i^.fixedPointPosition.v := BSL(i^.position.v, 4);

{j^.fixedPos.h := BSL(j^.position.h, 4); {Make fixedPos by shifting in the 4 binary "decimals"}
{j^.fixedPos.v := BSL(j^.position.v, 4);}

        DisposeRgn(internalDiff);
    end;{RegionSeparate}



{Variant av RegionHitTest som antar att s1 är en flyttbar sprite (boll) och den andra}
{ett icke cirkulärt objekt.}

    procedure RegionBounce (s1, s2: FixSpritePtr);
        var
            r1, r2, diff: RgnHandle;
            vector, parallel, normal: Point;
    begin

        if (s1^.face^.maskRgn = nil) or (s2^.face^.maskRgn = nil) then
            begin
                SATReportStr('Error: No mask region!');
                exit(RegionBounce);
            end;

{Make copies of the mask regions and offset them to the proper places.}
        r1 := NewRgn;
        r2 := NewRgn;
        diff := NewRgn;
        CopyRgn(s1^.face^.maskRgn, r1);
        CopyRgn(s2^.face^.maskRgn, r2);
        OffsetRgn(r1, s1^.position.h, s1^.position.v);
        OffsetRgn(r2, s2^.position.h, s2^.position.v);

        SectRgn(r1, r2, diff);                    {Is there any overlap?}

{If empty, no collision, otherwise, handle the collision!}
        if not EmptyRgn(diff) then
            begin
                vector.h := (diff^^.rgnBBox.right + diff^^.rgnBBox.left) div 2 - (r1^^.rgnBBox.right + r1^^.rgnBBox.left) div 2;
                vector.v := (diff^^.rgnBBox.bottom + diff^^.rgnBBox.top) div 2 - (r1^^.rgnBBox.bottom + r1^^.rgnBBox.top) div 2;

                RegionSeparate(s1, s2, r1, r2, diff);

{Avstuds som antar att vi skall ha elastisk studs utan störningar.}
{Flipprar, bumpers och sånt måste ha diverse påslag och variationer.}
{För att få plastisk studs - det vill man också ha ibland - så skall väl parallell-vektorn tas bort}
{eller dämpas kraftigt? Brus?}
                if Longint(vector) <> 0 then {Skydd mot div med 0.}
                    begin
                        SplitVector(s1^.speed, vector, parallel, normal);
                        s1^.speed.h := -parallel.h div 2 + normal.h;
                        s1^.speed.v := -parallel.v div 2 + normal.v;
                    end;

            end;

        DisposeRgn(r1);
        DisposeRgn(r2);
        DisposeRgn(diff);
    end; {RegionBounce}





{Look-up table handlers:}

    const
        kMaxAngle = 360;
        kMaxSqrt = 1000;
        kPi = 3.1416;
    var
        sinTable: array[0..kMaxAngle] of Longint;
        sqrtTable: array[0..kMaxSqrt] of Longint;

    procedure InitTables;
        var
            i: Longint;
    begin
        for i := 0 to kMaxSqrt do
            sqrtTable[i] := Trunc(sqrt(kFixedOne * i));
        for i := 0 to kMaxAngle do
            sinTable[i] := Trunc(kFixedOne * sin(i * kPi / kMaxAngle));
    end; {InitTables}

{Take the fixed-point square root of a fixed-point number}
    function SquareRoot (arg: Longint): Longint;
        var
            shift: Integer;
    begin
        if sqrtTable[kFixedOne] <> kFixedOne then
            InitTables;
        shift := 0;
        if arg < 0 then
            begin
                SquareRoot := 0;
                Exit(SquareRoot);
            end;
        while arg > kMaxSqrt do
            begin
                shift := shift + 1;
                arg := BSR(arg, 2);
            end;
        SquareRoot := BSL(sqrtTable[arg], shift);
    end; {SquareRoot}

{Get the fixed-point sinus of a fixed-point number}
    function Sinus (arg: Longint): Longint;
    begin
        if sqrtTable[kFixedOne] <> kFixedOne then
            InitTables;
        while arg < 0 do
            arg := arg + kMaxAngle;
        while arg > kMaxAngle do
            arg := arg - kMaxAngle;
        Sinus := sinTable[arg];
    end; {Sinus}

{Get the fixed-point cosinus of a fixed-point number}
    function Cosinus (arg: Longint): Longint;
    begin
        if sqrtTable[kFixedOne] <> kFixedOne then
            InitTables;
        arg := arg + BSR(kMaxAngle, 2); {Displace sinus to get cosinus!}
        while arg < 0 do
            arg := arg + kMaxAngle;
        while arg > kMaxAngle do
            arg := arg - kMaxAngle;
        Cosinus := sinTable[arg];
    end; {Cosinus}

{Get the length of a vector (integer vector, fixed-point result!)}
    function VectorLength (vector: Point): Longint;
    begin
        VectorLength := SquareRoot(BSL(vector.h * vector.h + vector.v * vector.v, kFixedPointShift));
    end; {VectorLength}

{Get the length of a vector (fixed-point vector, fixed-point result!)}
    function FPVectorLength (vector: Point): Longint;
    begin
        FPVectorLength := SquareRoot(vector.h * vector.h + vector.v * vector.v);
    end; {VectorLength}

{Lägg till ApproxVectorLength, den där approximationen som föreslogs, med 3/8.}
{Var det maj + min *3/8? KOLLA!}
    function ApproxVectorLength (vector: Point): Longint;
        var
            maj, min: Integer;
    begin
        if abs(vector.h) > abs(vector.v) then
            begin
                maj := abs(vector.h);
                min := abs(vector.v);
            end
        else
            begin
                maj := abs(vector.v);
                min := abs(vector.h);
            end;
        ApproxVectorLength := Longint(maj) + BSR(min + BSR(min, 1), 2); {STÄMMER DEN?}
    end; {ApproxVectorLength}

end.