Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Libraries/SAT 2.4.0/SAT/Add-ons/Storage/Scores.p

Text File | 1997-03-05 | 13.9 KB | 548 lines | [TEXT/PJMM]

{================================================}
{============= Score handling and display ==============}
{================================================}

{Reusable score and highscore unit! All code that needs changing is in ScoresStubs.}

{You should call InitScores before using any other routines, and pass the refnum of your}
{preference file. If you don't, it will still work, but the application file (or whatever the}
{current resource file is when you call) will be used - a "best effort" soluition that may}
{not be what you want.}

unit Scores;

interface
    uses
{$IFC UNDEFINED THINK_PASCAL}
        Types, QuickDraw, Fonts, Events, Packages, Menus, Dialogs, Windows,{}
        OSUtils, ToolUtils, Resources, Controls, QuickDrawText, TextUtils, {}
        Memory,
{$ELSEC}
        InterfacesUI,
{$ENDC}
        SAT, ScoresStubs;

    procedure InitScores (prefFile: Integer);                    { Loads the high score list and the high score window. }
    procedure ZeroScore;                     { Call this on New Game! }
    procedure AddScore (amount: Longint);
    procedure AddScoreImmediate (amount: Longint);

    procedure DrawHighScores (bounds: Rect; rankPos, namePos, datePos, levelPos: Integer; markLatest: Boolean);
    procedure EraseHighScores (ask: Boolean);

{Check if the current score makes the list, and if it does, fire up a modal dialog and write the result into}
{the high score list.}
    function TestNewHigh (level: Integer): Boolean;

{IsNewHigh and SetNewHigh should be used if you don't want the default modal dialog, but rather}
{get the player name some other way.}

{Checks if the current score is high enough for the high score list.}
    function IsNewHigh: Boolean;
{After IsNewHigh has returned true, and you have got a name, call SetNewHigh to write the}
{score into the high score list.}
    procedure SetNewHigh (name: Str255; level: Integer);


implementation

{ Highscore record }
    type
        str20 = string[kStringSize];

        HsRec = record
                highScore: array[1..kListLength] of longint;
                highPlayer: array[1..kListLength] of Str20;
                lastPlayer: Str20;
                when: array[1..kListLength] of Longint;
                level: array[1..kListLength] of Integer;
            end;
        HsPtr = ^HsRec;
        HsHnd = ^HsPtr;

    var
        hs: hsHnd;                {Handle to high scores resource, initialized by }
        gLastHigh: Integer;    {Index of last high score}
        scoresInitialized: Boolean;
        gScore: Longint;
        gPrefFile: Integer;    {Pref file}

{Standard filter function, here used for AskHigh}

    function StdFilter (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: integer): boolean;
        var
            theChar: Char;
            kind: integer;
            item: Handle;
            box: Rect;
    begin

        if theEvent.what = updateEvt then
            begin
                BeginUpdate(theDialog);
                SetPort(theDialog);

                DrawDialog(theDialog);

{Frame button}
                GetDialogItem(theDialog, ok, kind, item, box);
                InsetRect(box, -4, -4);
                PenSize(3, 3);
                FrameRoundRect(box, 15, 15);

                StdFilter := false;

                EndUpdate(theDialog);
            end;

        if theEvent.what = keyDown then
            begin
                theChar := Char(BitAnd(theEvent.message, charCodeMask));
                if ((BitAnd(theEvent.modifiers, cmdkey) <> 0) and (theChar = '.')) or (theChar = char(27)) then {cmd-. eller ESC}
{if TestDItemEnable(theDialog, cancel) then}
                    begin
                        itemHit := cancel;
{Måste jag highlighta till keyup?}

                        GetDialogItem(theDialog, cancel, kind, item, box);
                        HiliteControl(ControlHandle(item), 1);

                        StdFilter := true;
                        exit(StdFilter);
                    end;
                if (theChar = char(13)) or (theChar = char(3)) then
{if TestDItemEnable(theDialog, ok) then}
                    begin
                        itemHit := ok;
                        GetDialogItem(theDialog, ok, kind, item, box);
                        HiliteControl(ControlHandle(item), 1);
                        StdFilter := true;
                        exit(StdFilter);
                    end;
            end;
        StdFilter := false;
    end; {StdFilter}

{ Ask for players name (at highscore) }
    function AskHigh: str255;
        var
            dialog: DialogPtr;
            oldPort: SATPort;
            itemHit: integer;
            itemHandle: Handle;
            itemType, item: integer;
            itemRect: Rect;
            str: str255;
    begin
        SATGetPort(oldPort);
        SATSetPortScreen;
        dialog := GetNewDialog(kAskHighDlog, nil, WindowPtr(-1));
        ShowWindow(dialog);
        SelectWindow(dialog);
        if gSAT.colorFlag then
            SetGDevice(GetMainDevice);
        SetPort(dialog);

        GetDialogItem(dialog, 3, itemType, itemHandle, itemRect);
        SetDialogItemText(itemHandle, hs^^.lastPlayer);
        SelectDialogItemText(dialog, 3, 0, 32767);
        itemHit := -1;
        while (itemHit <> 1) and (itemHit <> 2) do { 1=ok, 2=cancel }
            ModalDialog(@StdFilter, itemHit);
        if itemHit = 2 then
            begin
                AskHigh := '';
            end;
        if itemHit = 1 then
            begin
                GetDialogItem(dialog, 3, itemType, itemHandle, itemRect);
                GetDialogItemText(itemHandle, str);
                if Length(str) > kStringSize then
                    str[0] := Char(kStringSize);
                hs^^.lastPlayer := str;
                AskHigh := str;
            end;
        DisposeDialog(dialog);
        SATSetPort(oldPort);
    end; {AskHigh}


    procedure DrawHighScores (bounds: Rect; rankPos, namePos, datePos, levelPos: Integer; markLatest: Boolean);
{bounds: Area in which to draw. (Current port!)}
{rankPos, namePos, datePos, levelPos: Right edge of each subfield.}
{markLatest: Draw latest in red?}
{Note: The score is always drawn to the right!}
        var
            rankBox, nameBox, dateBox, levelBox, scoreBox: Rect;
            info: FontInfo;
            spacing, spillSpacing: Integer;
            saveColor: RGBColor;
            saveBWcolor: Longint;
            i: Integer;
            dateString: Str255;

        procedure RestoreColor;
        begin
            if gSAT.colorFlag then
                RGBForeColor(saveColor)
            else
                ForeColor(saveBWcolor);
        end; {RestoreColor}

        procedure ProperColor (index: Integer);
        begin
            if (index = gLastHigh) and markLatest then
                ForeColor(redColor)
            else
                RestoreColor;
        end; {ProperColor}

        function Max (a, b: integer): Integer;
        begin
            if a > b then
                Max := a
            else
                Max := b;
        end; {Max}

        function Min (a, b: integer): Integer;
        begin
            if a < b then
                Min := a
            else
                Min := b;
        end; {Min}

        procedure DrawStringRight (str: Str255; width: Integer);
        begin
            Move(width - StringWidth(str), 0);
            DrawString(str);
        end; {DrawStringRight}

        function MyNumToString (num: Longint): Str255;
            var
                str: Str255;
        begin
            NumToString(num, str);
            MyNumToString := str;
        end; {MyNumToString}

        function RectWidth (r: Rect): integer;
        begin
            RectWidth := r.right - r.left;
        end; {RectWidth}

        function RectHeight (r: Rect): integer;
        begin
            RectHeight := r.bottom - r.top;
        end; {RectHeight}

    begin {DrawHighScores}
        if not scoresInitialized then
            InitScores(CurResFile);

        rankBox := bounds;
        nameBox := bounds;
        dateBox := bounds;
        levelBox := bounds;
        scoreBox := bounds;

        rankBox.right := rankPos;
        nameBox.left := rankPos;
        nameBox.right := Min(datePos, levelPos);

        dateBox.right := datePos;
{dateBox.left := Min(namePos, levelPos);}
        levelBox.right := levelPos;
{levelBox.left := Min(namePos, datePos);}

        if datePos <= levelPos then
            begin
                dateBox.left := namePos;
                levelBox.left := datePos;
            end
        else
            begin
                dateBox.left := levelPos;
                levelBox.left := namePos;
            end;

        scoreBox.left := Max(datePos, levelPos);

        nameBox.left := nameBox.left + kMargin;
        dateBox.left := dateBox.left + kMargin;
        levelBox.left := levelBox.left + kMargin;
        scoreBox.left := scoreBox.left + kMargin;

        GetFontInfo(info);
        spillSpacing := (RectHeight(bounds) - (info.ascent + info.descent) * kListLength) div (kListLength);
        spacing := spillSpacing + info.ascent + info.descent;
        spillSpacing := spillSpacing div 2;

        if gSAT.colorFlag then
            GetForeColor(saveColor)
        else
{$IFC UNDEFINED THINK_PASCAL}
            saveBWcolor := qd.thePort^.fgColor;
{$ELSEC}
        saveBWcolor := thePort^.fgColor;
{$ENDC}

{Draw rank}
        if RectWidth(rankBox) > 0 then
            for i := 1 to kListLength do
                begin
                    ProperColor(i);
                    ClipRect(rankBox);
                    MoveTo(rankBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
                    DrawStringRight(MyNumToString(i), RectWidth(rankBox));
                end;

{Draw name}
        if RectWidth(nameBox) > 0 then
            for i := 1 to kListLength do
                begin
                    ProperColor(i);
                    ClipRect(nameBox);
                    MoveTo(nameBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
                    DrawString(hs^^.highPlayer[i]);
                end;

{Draw date}
        if RectWidth(dateBox) > 0 then
            for i := 1 to kListLength do
                begin
                    ProperColor(i);
                    ClipRect(dateBox);
                    MoveTo(dateBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
                    if hs^^.when[i] <> 0 then
                        IUDateString(hs^^.when[i], shortDate, dateString)
                    else
                        dateString := '-';
                    DrawStringRight(dateString, RectWidth(dateBox));
                end;

{Draw level}
        if RectWidth(levelBox) > 0 then
            for i := 1 to kListLength do
                begin
                    ProperColor(i);
                    ClipRect(levelBox);
                    MoveTo(levelBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
                    DrawStringRight(MyNumToString(hs^^.level[i]), RectWidth(levelBox));
                end;

{Draw score}
        if RectWidth(scoreBox) > 0 then
            for i := 1 to kListLength do
                begin
                    ProperColor(i);
                    ClipRect(scoreBox);
                    MoveTo(scoreBox.left, bounds.top + spillSpacing + info.ascent + spacing * (i - 1));
                    DrawStringRight(MyNumToString(hs^^.highScore[i]), RectWidth(scoreBox));
                end;
        RestoreColor;
{$IFC UNDEFINED THINK_PASCAL}
        ClipRect(qd.thePort^.portRect); {Set to a reasonable cliprect!}
{$ELSEC}
        ClipRect(thePort^.portRect); {Set to a reasonable cliprect!}
{$ENDC}
    end; {DrawHighScores}

{*** TestNewHigh ***}
{Call this on game over!}
{It checks if the current score is a new high score, and if so,}
{fires up a modal dialog and ask for the player's name.}
{It returns true if the high score list was altered, to signal that you}
{should display the high score list.}
    function TestNewHigh (level: Integer): Boolean;
        var
            num, len: integer;
            name, s: str255;
    begin
        if not scoresInitialized then
            InitScores(CurResFile);

        TestNewHigh := false;
        gLastHigh := 0;
        if gScore > hs^^.highScore[kListLength] then
            begin
                num := kListLength;
                name := AskHigh;
                if name = '' then { alt length(name) = 0 }
                    Exit(TestNewHigh);

                TestNewHigh := true;

                if length(name) > kStringSize then
                    name := copy(name, 1, kStringSize);

                while (hs^^.highScore[num - 1] < gScore) and (num > 1) do
                    begin
                        hs^^.highScore[num] := hs^^.highScore[num - 1];
                        hs^^.highPlayer[num] := hs^^.highPlayer[num - 1];
                        hs^^.level[num] := hs^^.level[num - 1];
                        hs^^.when[num] := hs^^.when[num - 1];
                        num := num - 1;
                    end;
                gLastHigh := num; {Remember last high for the highscore display}
                hs^^.highScore[num] := gScore;
                hs^^.highPlayer[num] := name;
                hs^^.level[num] := level;
                GetDateTime(hs^^.when[num]);
                ChangedResource(Handle(hs));
            end;
    end; {TestNewHigh}


{IsNewHigh and SetNewHigh should be used if you don't want the default modal dialog, but rather}
{get the player name some other way.}

{Checks if the current score is high enough for the high score list.}
    function IsNewHigh: Boolean;
        var
            num, len: integer;
            name, s: str255;
    begin
        if not scoresInitialized then
            InitScores(CurResFile);

        IsNewHigh := gScore > hs^^.highScore[kListLength];
    end; {IsNewHigh}


{ Call this on game over! }
    procedure SetNewHigh (name: Str255; level: Integer);
        var
            num, len: integer;
            s: str255;
    begin
        if not scoresInitialized then
            InitScores(CurResFile);

        gLastHigh := 0;
        if gScore > hs^^.highScore[kListLength] then
            begin
                num := kListLength;
                if name = '' then { alt length(name) = 0 }
                    Exit(SetNewHigh);

                if length(name) > kStringSize then
                    name := copy(name, 1, kStringSize);

                while (hs^^.highScore[num - 1] < gScore) and (num > 1) do
                    begin
                        hs^^.highScore[num] := hs^^.highScore[num - 1];
                        hs^^.highPlayer[num] := hs^^.highPlayer[num - 1];
                        hs^^.level[num] := hs^^.level[num - 1];
                        hs^^.when[num] := hs^^.when[num - 1];
                        num := num - 1;
                    end;
                gLastHigh := num; {Remember last high for the highscore display}
                hs^^.highScore[num] := gScore;
                hs^^.highPlayer[num] := name;
                hs^^.level[num] := level;
                GetDateTime(hs^^.when[num]);
                ChangedResource(Handle(hs));
            end;
    end; {TestNewHigh}






    procedure ZeroScore;
    begin
        if not scoresInitialized then
            InitScores(CurResFile);

        gScore := 0;
        gLastHigh := -1;
        gNextLimit := kFirstLimit; {Nästa gräns för nytt liv!}
    end;

    procedure EraseHighScores (ask: Boolean);
        var
            doIt: Boolean;
            i: Integer;
    begin
        if not scoresInitialized then
            InitScores(CurResFile);

        if ask then
            doIt := SATQuestionStr('Are you sure you want to erase the high scores?')
        else
            doIt := true;
        if doIt then
            begin
                for i := 1 to kListLength do
                    begin
                        hs^^.highScore[i] := 0;
                        hs^^.highPlayer[i] := 'Noone';
                        hs^^.level[i] := 0;
                        hs^^.when[i] := 0;
                    end;
                ChangedResource(handle(hs));
                gLastHigh := -1;
            end;
    end; {EraseHighScores}

    procedure InitScores (prefFile: Integer);
        var
            saveResFile: Integer;
    begin
        gPrefFile := prefFile;
        saveResFile := CurResFile;
        UseResFile(prefFile);

        scoresInitialized := true;

        gLastHigh := -1; {no "last"}

        hs := hsHnd(GetResource('Bäst', 0));        {"Bäst" is "best" in swedish, in case you wonder…}
        if hs = nil then
            begin
                hs := hsHnd(NewHandle(Sizeof(hsRec)));
                CheckNoMem(Ptr(hs));
                EraseHighScores(false);
                AddResource(handle(hs), 'Bäst', 0, 'High scores');
            end
        else if GetHandleSize(Handle(hs)) < sizeof(hsRec) then
            SetHandleSize(Handle(hs), sizeof(hsRec));

        ZeroScore;

        UseResFile(saveResFile);
    end; {InitScores}


    procedure AddScore (amount: Longint);
    begin
        if not scoresInitialized then
            InitScores(CurResFile);

        gScore := gScore + amount;

        if gNextLimit > 0 then
            if gScore >= gNextLimit then
                DoLimit;

        DrawScore(gScore);
    end; {AddScore}

    procedure AddScoreImmediate (amount: Longint);
    begin
        if not scoresInitialized then
            InitScores(CurResFile);

        gScore := gScore + amount;

        if gNextLimit > 0 then
            if gScore >= gNextLimit then
                DoLimit;

        DrawScoreImmediate(gScore);
    end; {AddScoreImmediate}

end.