Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Pascal/Games/Showwit! 1.0/source code/Source/CShLevel.p

Text File | 1996-02-04 | 13.2 KB | 476 lines | [TEXT/PJMM]

{****************************************************}
{}
{        CShLevel    .p                                                                                                                                                                                                            }
{}
{        Object class for a level in the Showwit game.                                                                                                    }
{}
{****************************************************}


unit CShLevel;

interface

    uses
        TCL, ShIntf;

implementation

    type
        GridType = array[RowRange] of Integer;

    type
        LEVLtemplate = record
                theStartConfig: GridType;
                theFlipGrids: array[TileRange] of GridType;
            end;
        LEVLtemplateP = ^LEVLtemplate;
        LEVLtemplateH = ^LEVLtemplateP;


{****************************************************}
{}
{        SetLEVL                                                                                                                                                                                                                    }
{}
{        Set the level details from a LEVL resource.                                                                                                            }
{}
{****************************************************}

    procedure CShLevel.SetLEVL (LEVLid: Integer);

        var
            theLEVL: LEVLtemplateH;    { Handle to level resource. }
            theRuleCount: TileRange;

        { Returns the default name, indicating an error. }
        function DefaultName (LEVLid: Integer): Str15;

            var
                theNumStr: Str255;

        begin { DefaultName }
            NumToString(LEVLid, theNumStr);
            DefaultName := Concat('*** ', theNumStr, ' ***');
        end; { DefaultName }

        { Returns the default start, which is quite dull. }
        function DefaultStart: ConfigType;

            var
                theConfig: ConfigType;
                theTile: TileRange;

        begin { DefaultStart }
            for theTile := 1 to kMaxTiles do begin
                theConfig[theTile] := TRUE;
            end; { for }

            DefaultStart := theConfig;
        end; { DefaultStart }

        { Returns the default rule for the given tile, which is well behaved but boring. }
        function DefaultRule (aTileNum: TileRange): TileRuleType;

            var
                theTileRule: TileRuleType;

        begin { DefaultRule }
            theTileRule.theNumDep := 1;
            theTileRule.theDep[1] := aTileNum;

            DefaultRule := theTileRule;
        end; { DefaultRule }

        { Returns the name of the level, from the resource information. }
        function LEVLName (aLEVL: LEVLTemplateH): Str15;

            var
                rID: Integer;
                rType: ResType;
                rName: Str255;

        begin { LEVLName }
            GetResInfo(Handle(aLEVL), rID, rType, rName);

            if rName = '' then begin
                { We don't want an empty string for the level name, }
                { otherwise CAbstract text complains when setting }
                { up the game window. }

                LEVLName := DefaultName(rID);
            end { if }
            else if Length(rName) < 15 then begin
                { This section is not really required for THINK Pascal, }
                { where it is not an error to copy over the end of a string. }
                { However, in case we recompile under a different compiler }
                { may as well prevent problems now. }

                LEVLName := Copy(rName, 1, Length(rName));
            end { else if }
            else begin
                LEVLName := Copy(rName, 1, 15);
            end; { else }
        end; { LEVLName }

        { Returns a configuration from the given grid as it appears in the resource. }
        {   Need to be defensive, but fortunately this is fairly easy here. }
        function ConfigFromGrid (aConfigGrid: GridType): ConfigType;

            var
                theConfig: ConfigType;

                theRowCount: RowRange;
                theColCount: ColRange;

                theGroup: array[ColRange] of Boolean;

        begin { ConfigFromGrid }
            for theRowCount := 1 to kMaxGridDown do begin

                { Unfortunately there is no type defined for 4 bytes (who needs it :) }
                { so we have to deal with the columns as byte groups. }

                if aConfigGrid[theRowCount] >= 0 then begin
                    theGroup[4] := aConfigGrid[theRowCount] mod $0010 <> 0;
                    theGroup[3] := aConfigGrid[theRowCount] mod $0100 div $0010 <> 0;
                    theGroup[2] := aConfigGrid[theRowCount] mod $1000 div $0100 <> 0;
                    theGroup[1] := aConfigGrid[theRowCount] div $1000 <> 0;
                end { if }
                else begin
                    { Effect of adding 65536 is to bring it back into range 0..65535 }
                    { The result is of LongInt, because 65535 is of type LongInt. }

                    theGroup[4] := (aConfigGrid[theRowCount] + 65536) mod $0010 <> 0;
                    theGroup[3] := (aConfigGrid[theRowCount] + 65536) mod $0100 div $0010 <> 0;
                    theGroup[2] := (aConfigGrid[theRowCount] + 65536) mod $1000 div $0100 <> 0;
                    theGroup[1] := (aConfigGrid[theRowCount] + 65536) div $1000 <> 0;
                end; { else }

                for theColCount := 1 to kMaxGridAcross do begin
                    theConfig[TileRange((theRowCount - 1) * kMaxGridAcross + theColCount)] := theGroup[theColCount];
                end; { for }
            end; { for }

            ConfigFromGrid := theConfig;
        end; { ConfigFromGrid }

        { Returns the tile rule for aTileNum is specified from aRuleGrid. Remember }
        { that levels can be edited by other people, so we need to be extremely }
        { defensive (as always). Hence the algorithm used here is much slower than }
        { would be possible if everything was assumed to be fine. }
        function RuleFromGrid (aTileNum: TileRange;
                                        aRuleGrid: GridType): TileRuleType;

            var
                theRule: TileRuleType;

                theDepCount: Integer;
                theRowCount: RowRange;
                theColCount: ColRange;

                theGroup: array[ColRange] of 0..kMaxTiles;

                newDepFound: Boolean;

        begin { RuleFromGrid }
            with theRule do begin

                { Iterating over theDepCount, we try and find a dependant numbered theDepCount. }
                { We terminate if we cannot find it . This guarantees that we have a valid list }
                { of dependants from 1..theDepCount . }

                { We handle the case for the first dependant separately, enforcing the requirement }
                { that the first dependant of a tile be itself. }

                theNumDep := 1;
                theDep[1] := aTileNum;

                { Now look for other dependants. }
                { Note that the n-th dependant is actually numbered n-1 in the resource. }
                { This way we can have up to and including 15 dependants other than }
                { itself, and hence every tile can be a dependant of a given tile. }

                theDepCount := 0;

                repeat

                    newDepFound := FALSE;
                    theDepCount := theDepCount + 1;
                    { so from now on, theDepCount can be safely cast into TileRange. }

                    for theRowCount := 1 to kMaxGridDown do begin

                        { Unfortunately there is no type defined for 4 bytes (who needs it :) }
                        { so we have to deal with the columns as byte groups. }

                        if aRuleGrid[theRowCount] >= 0 then begin
                            theGroup[4] := aRuleGrid[theRowCount] mod $0010;
                            theGroup[3] := aRuleGrid[theRowCount] mod $0100 div $0010;
                            theGroup[2] := aRuleGrid[theRowCount] mod $1000 div $0100;
                            theGroup[1] := aRuleGrid[theRowCount] div $1000;
                        end { if }
                        else begin
                            { Effect of adding 65536 is to bring it back into range 0..65535 }
                            { The result is of LongInt, because 65535 is of type LongInt. }

                            theGroup[4] := (aRuleGrid[theRowCount] + 65536) mod $0010;
                            theGroup[3] := (aRuleGrid[theRowCount] + 65536) mod $0100 div $0010;
                            theGroup[2] := (aRuleGrid[theRowCount] + 65536) mod $1000 div $0100;
                            theGroup[1] := (aRuleGrid[theRowCount] + 65536) div $1000;
                        end; { else }

                        for theColCount := 1 to kMaxGridAcross do begin
                            if theGroup[theColCount] = TileRange(theDepCount) then begin

                                { Set the number of dependants and the position. }

                                theNumDep := TileRange(theDepCount + 1);    { n-th dependant is numbered n-1 in resource. }
                                theDep[theNumDep] := TileRange((theRowCount - 1) * kMaxGridAcross + theColCount);
                                newDepFound := TRUE;
                                LEAVE;
                            end { if }
                        end; { for }

                        if newDepFound then begin
                            LEAVE;
                        end; { if }

                    end; { for }

                until not newDepFound or (theDepCount = kMaxTiles - 1);

            end; { with }

            RuleFromGrid := theRule;
        end; { RuleFromGrid }

    begin { SetLEVL }
        { The following check could also probably be done }
        { by the exception handler, except that they are }
        { straightforward, and recoverable at this level. }

        { If anything really goes wrong, it will be caught first }
        { by the exception handler at the document or application }
        { reader level, then either in the main event handler }
        { or the pre-loading handler. }

        theLEVL := LEVLtemplateH(Get1Resource(kLEVLResType, LEVLid));

        if theLEVL = nil then begin
            itsName := DefaultName(LEVLid);

            itsStart := DefaultStart;

            for theRuleCount := 1 to kMaxTiles do begin
                itsRules[theRuleCount] := DefaultRule(theRuleCount);
            end; { for }
        end { if }
        else begin

            itsName := LEVLName(theLEVL);

            itsStart := ConfigFromGrid(theLEVL^^.theStartConfig);

            for theRuleCount := 1 to kMaxTiles do begin
                itsRules[theRuleCount] := RuleFromGrid(theRuleCount, theLEVL^^.theFlipGrids[theRuleCount]);
            end; { for }

            ForgetResource(theLEVL);

        end; { else }
    end; { SetLEVL }


{****************************************************}
{}
{        SetBEST                                                                                                                                                                                                                    }
{}
{        Set the best player details from a BEST resource.                                                                                        }
{}
{****************************************************}

    procedure CShLevel.SetBEST (BESTid: Integer);

        var
            theBEST: BESTtemplateH; { Handle to best player resource. }

    begin { SetBEST }
        theBEST := BESTtemplateH(Get1Resource(kBESTResType, BESTid));

        { The following check could also probably be done }
        { by the exception handler, except that they are }
        { straightforward, and recoverable at this level. }

        { If anything really goes wrong, it will be caught first }
        { by the exception handler at the document or application }
        { reader level, then either in the main event handler }
        { or the pre-loading handler. }

        if theBEST = nil then begin
            SetDefaultBestPlayer;
        end { if }
        else begin
            SetPlayer(theBest^^.thePlayer);
            SetMoves(theBest^^.theMoves);
            SetTime(theBest^^.theTime);

            ForgetResource(theBEST);
        end; { else }
    end; { SetBEST }


{****************************************************}
{}
{        SetDefaultBestPlayer                                                                                                                                                                            }
{}
{        Set the best player details to some safe, default values.                                                                    }
{}
{****************************************************}

    procedure CShLevel.SetDefaultBestPlayer;

    begin { SetDefaultBestPlayer }
        { Don't want these to be editable, so put them here, not in a resource. }

        SetPlayer('Showwit!');
        SetMoves(10000);
        SetTime(36000);
    end; { SetDefaultBestPlayer }


{****************************************************}
{}
{        GetName                                                                                                                                                                                                                    }
{}
{        Returns the name of the level.                                                                                                                                                    }
{}
{****************************************************}

    function CShLevel.GetName: Str15;

    begin { GetName }
        GetName := itsName;
    end; { GetName }


{****************************************************}
{}
{        GetStart                                                                                                                                                                                                                    }
{}
{        Returns the starting configuration of the level.                                                                                                }
{}
{****************************************************}

    function CShLevel.GetStart: ConfigType;

    begin { GetStart }
        GetStart := itsStart;
    end; { GetStart }


{****************************************************}
{}
{        GetRules                                                                                                                                                                                                                    }
{}
{        Returns the rules for the level.                                                                                                                                                }
{}
{****************************************************}

    function CShLevel.GetRules: RulesType;

    begin { GetRules }
        GetRules := itsRules;
    end; { GetRules }


{****************************************************}
{}
{        GetPlayer                                                                                                                                                                                                                }
{}
{        Returns the name of the current best player of the level.                                                                    }
{}
{****************************************************}

    function CShLevel.GetPlayer: Str15;

    begin { GetPlayer }
        GetPlayer := itsPlayer;
    end; { GetPlayer }


{****************************************************}
{}
{        SetPlayer                                                                                                                                                                                                                }
{}
{        Sets the name of the current best player of the level.                                                                            }
{}
{****************************************************}

    procedure CShLevel.SetPlayer (aPlayer: Str15);

    begin { SetPlayer }
        itsPlayer := aPlayer;
    end; { SetPlayer }


{****************************************************}
{}
{        GetMoves                                                                                                                                                                                                                }
{}
{        Returns the moves taken by the current best player of the level.                                            }
{}
{****************************************************}

    function CShLevel.GetMoves: Integer;

    begin { GetMoves }
        GetMoves := itsMoves;
    end; { GetMoves }


{****************************************************}
{}
{        SetMoves                                                                                                                                                                                                                }
{}
{        Sets the moves taken by the current best player of the level.                                                        }
{}
{****************************************************}

    procedure CShLevel.SetMoves (aMoves: Integer);

    begin { SetMoves }
        itsMoves := aMoves;
    end; { SetMoves }


{****************************************************}
{}
{        GetTime                                                                                                                                                                                                                    }
{}
{        Returns the time taken by the current best player of the level.                                                    }
{}
{****************************************************}

    function CShLevel.GetTime: LongInt;

    begin { GetTime }
        GetTime := itsTime;
    end; { GetTime }


{****************************************************}
{}
{        SetTime                                                                                                                                                                                                                    }
{}
{        Sets the time taken by the current best player of the level.                                                            }
{}
{****************************************************}

    procedure CShLevel.SetTime (aTime: LongInt);

    begin { SetTime }
        itsTime := aTime;
    end; { SetTime }


end. { CShLevel }