Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Pascal/Snippets/OffscreenToys 1.4/OffscreenToysUtils.p

Text File | 1995-11-22 | 10.6 KB | 358 lines | [TEXT/PJMM]

{Minimalist's offscreen package - reuseable code from OffscreenToys.}

{This unit implements glue for using "cicn" resources and GWorlds. It works on all Macs I can}
{imagine, including Macs without 32-bit QD or Color QD.}
{Note: Assumes that ALRT #129 is present, for error messages.}

unit OffscreenToysUtils;

interface
    uses
{$IFC UNDEFINED THINK_PASCAL}
        Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit,{}
        TextEdit, Traps, Memory, Icons, {}
        SegLoad, Scrap, ToolUtils, OSUtils, Menus, Resources, Packages, {}
{$ENDC}
        QDOffScreen;

{$IFC UNDEFINED GENERATINGPOWERPC}
{$SETC GENERATINGPOWERPC = false}
{$ENDC}

{Glue for GWorlds}
    procedure OTGetGWorld (var thePort: GrafPtr; var theDevice: GDHandle);
    procedure OTSetGWorld (thePort: GrafPtr; theDevice: GDHandle);

{Glue for cicns}
    function OTGetCicn (cicnId: integer): CIconHandle;
    procedure OTPlotCicn (theCicn: CIconHandle; destWorld: GrafPtr; r: Rect);
    procedure OTDisposeCicn (theCicn: CIconHandle);
    function OTGetBoostCicn (cicnId: integer): GrafPtr;
    procedure OTPlotBoostCicn (theCicn, destPort: GrafPtr; where: Point);

{NewPtr with built-in error check}
    function OTNewPtr (size: Longint): Ptr;

{Glue for making GWorlds}
    procedure OTNewGWorld (var offscreenGWorld: GrafPtr; boundsRect: Rect);
    procedure OTDisposeGWorld (var offscreenGWorld: GrafPtr);

{Apples code for TrapAvailable}
    function TrapAvailable (theTrap: Integer): Boolean;

{Initialize the globals - must be done first!}
    procedure OTInitGlobals;

    var
        gColorQDFlag: Boolean;    {True if 32-bit QD exists. If not, we run everything in b/w.}
        gHasWNE: Boolean;        {True if we can use WaitNextEvent}
        gSoundFlag: Boolean;        {True if Sound Manager is around.}

implementation

{Taken out from:}
{ --- PART 2: Various general, reuseable routines, mostly glue: ---------------------}

{Rand: simply make a random number between 0 and range-1.}

    function Rand (range: integer): integer;
    begin
        Rand := abs(Random mod range)
    end;

{BailOut: Emergency exit. We go here on errors (i.e. out of memory). Here, I assume that}
{the problem is out of memory. Note: Assumes that ALRT #129 is present!}

    procedure BailOut;
    begin
        ParamText('Out of memory!', ' ', '', '');
        if Alert(129, nil) = 1 then
            ;
        Halt;
    end; {BailOut}

{OTGetGWorld and OTSetGWorld: Glue to GetGWorld and SetGWorld, so this will work}
{without 32-bit QD, if necessary.}

    procedure OTGetGWorld (var thePort: GrafPtr; var theDevice: GDHandle);
    begin
        theDevice := nil;
        if gColorQDFlag then
            GetGWorld(CGrafPtr(thePort), theDevice)
        else
            GetPort(thePort);
    end;

    procedure OTSetGWorld (thePort: GrafPtr; theDevice: GDHandle);
    begin
        if gColorQDFlag then
            SetGWorld(CGrafPtr(thePort), theDevice)
        else
            SetPort(thePort);
    end;

{OTGetCicn: Glue to GetCIcon, loads a cicn resource}

    function OTGetCicn (cicnId: integer): CIconHandle;
        var
            h: Handle;
    begin
        if gColorQDFlag then
            begin
                OTGetCicn := GetCIcon(cicnId);
                h := GetResource('cicn', cicnID);
                ReleaseResource(h);
            end
        else
            OTGetCicn := CIconHandle(GetResource('cicn', cicnId));
    end;

{OTPlotCicn: Glue to PlotCIcon, plots a cicn.}

    procedure OTPlotCicn (theCicn: CIconHandle; destWorld: GrafPtr; r: Rect);
        var
            tempIconBMap, tempIconMask: BitMap;
            savePort: GrafPtr;
            saveDevice: GDHandle;
            datasize: integer;
    begin
        OTGetGWorld(savePort, saveDevice);
        if destWorld <> nil then
            OTSetGWorld(destWorld, nil)
        else
            destWorld := savePort; {So that CopyMask has a GrafPtr!}
        if theCicn <> nil then {If we have a cicn}
            if gColorQDFlag then {We have color - then it's easy.}
                PlotCicon(r, theCicn)
            else
{No color: Use CopyMask.}
{NOTE: This only works for 9 pixels or wider cicn's! (Old QuickDraw can't handle 1 byte wide bitmaps.)}
{There is a workaround for this, but that is *really* tedious.}
                begin
                    HLock(Handle(theCicn));
{Make the base address pointers valid}
                    with theCicn^^.iconBMap do
                        datasize := rowBytes * (bounds.bottom - bounds.top);
                    theCicn^^.iconBMap.baseAddr := Ptr(longint(@theCicn^^.iconMaskData[0]) + datasize); {Bitmappen måste vara giltig fört!}
                    theCicn^^.iconMask.baseAddr := @theCicn^^.iconMaskData[0]; {Maskbitmappen måste också vara giltig först!}
{Draw with CopyMask}
                    CopyMask(theCicn^^.iconBMap, theCicn^^.iconMask, destWorld^.portBits, theCicn^^.iconBMap.bounds, theCicn^^.iconBMap.bounds, r);
                    HUnLock(Handle(theCicn));
                end;
        OTSetGWorld(savePort, saveDevice);
    end;

    procedure OTDisposeCicn (theCicn: CIconHandle);
    begin
        if gColorQDFlag then
            DisposeCIcon(theCicn)
        else
            ReleaseResource(Handle(theCicn));
    end;

{To avoid a lot of boring checks later, we have a glue for NewPtr, making it emergency}
{exit on out of memory. (This is of course often not what you want, but this is a demo!)}

    function OTNewPtr (size: Longint): Ptr;
    begin
        OTNewPtr := NewPtrClear(size);
        if MemError <> noErr then
            BailOut;
    end;

{OTNewGWorld: Glue to NewGWorld}
{I declare offscreenGWorld as GrafPtr to save us a bunch of typecasts later (in CopyBits).}
{Most parameters to NewGWorld omitted - NewGWorld is smart enough to make the defaults useable.}

    procedure OTNewGWorld (var offscreenGWorld: GrafPtr; boundsRect: Rect);
        var
            theDevice, oldDevice: GDHandle;
            ourCMHandle: CTabHandle;
            err: OsErr;

            saveGD: GDHandle;
            savePort: GrafPtr;
    begin
        OTGetGWorld(savePort, saveGD);

        if gColorQDFlag then
            begin
{$IFC UNDEFINED THINK_PASCAL}
                if noErr <> NewGWorld(GWorldPtr(offscreenGWorld), 0, boundsRect, nil, nil, pixelsLocked) then
{$ELSEC}
                    if noErr <> NewGWorld(GWorldPtr(offscreenGWorld), 0, boundsRect, nil, nil, [pixelsLocked]) then
{$ENDC}
                        BailOut;
{We lock the offscreen pixmap so we can CopyBits and PlotCIcon to it.}
                if LockPixels(CGrafPtr(offscreenGWorld)^.portPixMap) then
                    ;
{Note: We should unlock it (UnlockPixels) when not animating, to avoid memory fragmentation,}
{but you can bother with that later if it's a problem.}
            end
        else
            begin
{Not color - setup in b/w}
                offscreenGWorld := GrafPtr(OTnewPtr(sizeof(GrafPort)));
                OpenPort(offscreenGWorld);
                offscreenGWorld^.portRect := boundsRect;
                offscreenGWorld^.portBits.bounds := offscreenGWorld^.portRect;

                RectRgn(offscreenGWorld^.visRgn, boundsRect);
                ClipRect(boundsRect);

                offscreenGWorld^.portBits.rowBytes := longint(((offscreenGWorld^.portRect.right - offscreenGWorld^.portRect.left + 15) div 16) * 2);
                offscreenGWorld^.portBits.baseAddr := OTnewPtr(offscreenGWorld^.portBits.rowBytes * longint(offscreenGWorld^.portRect.bottom - offscreenGWorld^.portRect.top));
            end;

        OTSetGWorld(savePort, saveGD);
    end;

{OTDisposeGWorld: Glue to DisposeGWorld}

    procedure OTDisposeGWorld (var offscreenGWorld: GrafPtr);
    begin
        if gColorQDFlag then
            begin
                DisposeGWorld(GWorldPtr(offscreenGWorld));
            end
        else
            begin
                DisposePtr(offscreenGWorld^.portBits.baseAddr);
                DisposePtr(Ptr(offscreenGWorld));
            end;
        offscreenGWorld := nil;
    end;


{TrapAvailable from IM6-3-8}
    function NumToolboxTraps: Integer;
    begin
        if NGetTrapAddress($A86E, ToolTrap) = NGetTrapAddress($aa6e, ToolTrap) then {_InitGraf}
            NumToolboxTraps := $200
        else
            NumToolboxTraps := $400;
    end;
    function GetTrapType (theTrap: Integer): TrapType;
        const
            TrapMask = $800;
    begin
        if band(theTrap, TrapMask) > 0 then
            GetTrapType := ToolTrap
        else
            GetTrapType := OSTrap;
    end;
    function TrapAvailable (theTrap: Integer): Boolean;
        var
            tType: TrapType;
    begin
        tType := GetTrapType(theTrap);
        if tType = ToolTrap then
            begin
                theTrap := band(theTrap, $7ff);
                if theTrap >= NumToolboxTraps then
                    theTrap := $A89F;{_Unimplemented}
            end;
        TrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress($A89F, ToolTrap);{_Unimplemented}
    end;
{End of code from IM6}

    procedure OTInitGlobals;
        const
{Trap numbers}
            _WaitNextEvent = $A860;
            _GetCIcon = $AA1E; {E.g. any Color QuickDraw routine}
            k32bQD = $AB1D;
            _SndPlay = $A805;
    begin
        gHasWNE := TrapAvailable(_WaitNextEvent);
        gColorQDFlag := TrapAvailable(k32bQD) and TrapAvailable(_GetCIcon); {???}
        gSoundFlag := TrapAvailable(_SndPlay);
{$IFC UNDEFINED THINK_PASCAL}
        qd.randSeed := TickCount;            {Seed the random number generator - TickCount is good enough.}
{$ELSEC}
        randSeed := TickCount;                {Seed the random number generator - TickCount is good enough.}
{$ENDC}
    end;




{Load a cicn to a GWorld. Wastes some memory, but if it isn't too many, the speed increase pays}
{for it.}

    function OTGetBoostCicn (cicnId: integer): GrafPtr;
        var
            offscreenGWorld: GrafPtr;
            theCicn: CIconHandle;
            saveGD: GDHandle;
            savePort: GrafPtr;
    begin
        OTGetGWorld(savePort, saveGD);
        theCicn := OTGetCicn(cicnId);
        OTNewGWorld(offscreenGWorld, theCicn^^.iconMask.bounds);
        if offscreenGWorld <> nil then
            begin {OTSetGWorld(offscreenGWorld, nil); Onödigt!}
                OTPlotCicn(theCicn, offscreenGWorld, theCicn^^.iconMask.bounds);

{I use the clipRgn for storing the mask region. This may seem weird, but when we aren't drawing}
{in the GWorld anyway, it won't matter.}
                if offscreenGWorld = nil then
                    offscreenGWorld^.clipRgn := NewRgn;
                if gColorQDFlag and TrapAvailable($A8D7) then {a8d7 = BitMapToRegion}
                    begin
                        if noErr <> BitMapToRegion(offscreenGWorld^.clipRgn, theCicn^^.iconMask) then{}
                            offscreenGWorld^.clipRgn := nil;{or DisposeRgn?}
                    end
                else {Trap not available - use the glue routine instead.}
                    begin
{$IFC GENERATINGPOWERPC}
{$ELSEC}
                        if noErr <> BitMapToRegionGlue(offscreenGWorld^.clipRgn, theCicn^^.iconMask) then{}
                            offscreenGWorld^.clipRgn := nil;{or DisposeRgn?}
{$ENDC}
                    end;
                OTDisposeCicn(theCicn);
            end;
        OTSetGWorld(savePort, saveGD);
        OTGetBoostCicn := offscreenGWorld;
    end;

    var
        gTmpRgn: RgnHandle;

    procedure OTPlotBoostCicn (theCicn, destPort: GrafPtr; where: Point);
        var
            saveGD: GDHandle;
            savePort: GrafPtr;
            bounds: Rect;
            tmpRgn: RgnHandle;
            saveForeColor, saveBackColor: RGBColor;
    begin
        OTGetGWorld(savePort, saveGD);
{OTSetGWorld(theCicn, nil);}
        bounds := theCicn^.portRect;
        OffsetRect(bounds, where.h - bounds.left, where.v - bounds.top);

        if gTmpRgn = nil then
            gTmpRgn := NewRgn; {For top speed, we make this global, and create it only once!}
        CopyRgn(theCicn^.clipRgn, gTmpRgn);
        OffsetRgn(gTmpRgn, where.h, where.v);
        SetPort(destPort); {Device?}
        if gColorQDFlag then
            begin
                GetForeColor(saveForeColor);
                GetBackColor(saveBackColor);
            end;
        ForeColor(blackColor);
        BackColor(whiteColor);
        CopyBits(theCicn^.portBits, destPort^.portBits, theCicn^.portRect, bounds, srcCopy, gTmpRgn);
{DisposeRgn(tmpRgn);}
        if gColorQDFlag then
            begin
                RGBForeColor(saveForeColor);
                RGBBackColor(saveBackColor);
            end;
        OTSetGWorld(savePort, saveGD);
    end;

end.