Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Utilities/Siege Watch 2.0/siege.p

Text File | 1994-04-23 | 6.8 KB | 301 lines | [TEXT/PJMM]

program Clinton;
    uses
        Init, Sane, Sound, AppleEvents, QDOffscreen, Globals, Strings, MySpeech, Preferences, Watch, MenuStuff;

    const


        RECT_TOP = 20;
        RECT_LEFT = 20;

        SLEEP = 60;
        WNE_TRAP_NUM = $60;
        UNIMPL_TRAP_NUM = $9F;

        BYE_BYE_SPEECH = 3;
        OCLOCK_SPEECH = 2;
    var

        gTheEvent: EventRecord;

    procedure PlayMySound (resID: integer);
        var
            lFreeBytes: LONGINT;
            iErr: OSErr;
            mySndChan: SndChannelPtr;
    begin
        mySndChan := nil;
        iErr := SndNewChannel(mySndChan, sampledSynth, initMono, nil);
        if iErr = 0 then
            begin

                lFreeBytes := MaxBlock;
                if lFreeBytes > 20000 then
                    begin
                        lFreeBytes := 20000;
                        iErr := SndStartFilePlay(mySndChan, 0, resID, lFreeBytes, nil, nil, nil, FALSE);
                    end;
                if mySndChan <> nil then
                    begin
                        iErr := SndDisposeChannel(mySndChan, TRUE);
                    end;
            end;
    end;



    procedure HandleActivate;
        var
            theWindow: WindowPtr;
    begin
        theWindow := WindowPtr(gTheEvent.message);
        if (BitAnd(gTheEvent.modifiers, activeFlag) <> 0) then
            begin
                SetPort(theWindow);
            end;
    end;


    procedure HandleUpdate;
        var
            scratch: PixMapHandle;
            worldRect: Rect;
            theWindow: WindowPtr;
    begin
        theWindow := WindowPtr(gTheEvent.message);

        BeginUpdate(theWindow);
        if theWindow = gWindow then
            begin
                SetPort(theWindow);
                HLock(Handle(gFramePict));
                DrawPicture(gFramePict, gFramePict^^.picFrame);
                HUnlock(Handle(gFramePict));

                if (CheckGWorlds) or (gScratchWorld = nil) then
                    begin
                        DrawTheWatch;
                    end
                else (* the scratch world should hold a valid picture *)
                    begin
                        scratch := GetGWorldPixMap(gScratchWorld);
                        if (LockPixels(scratch)) then
                            begin
                                worldRect := gWatchPict^^.picFrame;
                                OffsetRect(worldRect, -worldRect.left, -worldRect.top);
                                CopyBits(BitMapHandle(scratch)^^, thePort^.portBits, worldRect, gWatchPict^^.picFrame, srcCopy, nil);
                                UnLockPixels(scratch);
                            end
                        else
                            begin
                                DrawTheWatch;
                            end;
                    end;
                DrawMyStrings;
                if (gZoomCtl <> nil) then
                    DrawControls(theWindow);
            end;
        EndUpdate(theWindow);
    end;


    procedure HandleNull;
        var
            currentTime, deltaTime: LONGINT;
            hour: integer;
            dateRec: DateTimeRec;
            needed: Boolean;
            oldPort: GrafPtr;
            iErr: OSErr;
    begin
        GetDateTime(currentTime);
        if gLastTime <> currentTime then
            begin
                GetPort(oldPort);
                SetPort(gWindow);
                gLastTime := currentTime;
                deltaTime := gEndTime - currentTime;
                if (gEndTime < currentTime) and (gChimed = FALSE) then
                    begin
                        gChimed := TRUE;
                        PlayMySound(BASE_RES_ID);
                        if gSpeechAvailable then
                            PlayMySpeech(BYE_BYE_SPEECH);
                        InitTime;
                        deltaTime := gEndTime - currentTime;
                    end;
                Secs2Date(deltaTime, dateRec);

                needed := DrawIfNeeded(dateRec.second, gRectArray[SECOND_NUM]);

                if DrawIfNeeded(dateRec.minute, gRectArray[MINUTE_NUM]) = TRUE then
                    begin

                        needed := DrawIfNeeded(dateRec.year - 1904, gRectArray[YEAR_NUM]);
                        needed := DrawIfNeeded(dateRec.month - 1, gRectArray[MONTH_NUM]);
                        needed := DrawIfNeeded(dateRec.day - 1, gRectArray[DAY_NUM]);
                        if DrawIfNeeded(dateRec.hour, gRectArray[HOUR_NUM]) then
                            begin
                                RefreshWatch; (* just redraw the watch with the proper day *)
                                if (gPreferences.sayHours) and (dateRec.minute = 59) then
                                    begin
                                        Secs2Date(currentTime, dateRec);
                                        hour := dateRec.hour mod 12;
                                        if hour = 0 then
                                            hour := 12;
                                        if gSpeechAvailable then
                                            SayNumbers(hour, OCLOCK_SPEECH);
                                    end;
                            end
                        else
                            begin
                                PlayBites;
                            end;

                        CalcHands(currentTime);
                        DrawTheWatch;
                        DrawControls(gWindow);
                    end;
                SetPort(oldPort);
            end;
    end;

    procedure HandleZoom;
        var
            updateFlag: Boolean;
            wide, high: integer;
    begin
        wide := gWindow^.portRect.right - gWindow^.portRect.left;
        if (gZoomed) then
            begin
                high := gFramePict^^.picFrame.top - 1;
                updateFlag := FALSE;
                gZoomed := FALSE;
                SetCtlValue(gZoomCtl, 0);
            end
        else
            begin
                high := gFramePict^^.picFrame.bottom + 5;
                updateFlag := TRUE;
                gZoomed := TRUE;
                SetCtlValue(gZoomCtl, 1);
            end;
        SizeWindow(gWindow, wide, high, updateFlag);
    end;

    procedure HandleMouseDown;
        var
            whichWindow: WindowPtr;
            thePart: INTEGER;
            dummy: Boolean;
            menuChoice, windSize: LONGINT;
            aControl: ControlHandle;
            iCtlPart: integer;
    begin
        thePart := FindWindow(gTheEvent.where, whichWindow);
        case thePart of
            inMenuBar:
                begin
                    menuChoice := MenuSelect(gTheEvent.where);
                    HandleMenuChoice(menuChoice);
                end;
            inSysWindow:
                SystemClick(gTheEvent, whichWindow);
            inZoomIn:
                if (TrackBox(gWindow, gTheEvent.where, inZoomIn)) then
                    HandleZoom;
            inZoomOut:
                if (TrackBox(gWindow, gTheEvent.where, inZoomOut)) then
                    HandleZoom;
            inDrag:
                begin
                    DragWindow(whichWindow, gTheEvent.where, screenBits.bounds);
                    dummy := CheckGWorlds;
                end;
            inGoAway:
                if (TrackGoAway(whichWindow, gTheEvent.where)) then
                    begin
                        gDone := TRUE;
                    end;
            inContent:
                if whichWindow <> FrontWindow then
                    begin
                        SelectWindow(whichWindow);
                    end
                else if whichWindow = gWindow then
                    begin
                        GlobalToLocal(gTheEvent.where);
                        iCtlPart := FindControl(gTheEvent.where, gWindow, aControl);
                        if ((iCtlPart = inCheckBox) and (aControl = gZoomCtl)) then
                            begin
                                if inCheckBox = TrackControl(aControl, gTheEvent.where, nil) then
                                    begin
                                        HandleZoom;
                                    end;
                            end;
                    end;
        end;
    end;

    procedure HandleEvent;
        var
            theChar: CHAR;
            myErr: OSErr;
    begin
        case gTheEvent.what of
            nullEvent:
                HandleNull;
            mouseDown:
                HandleMouseDown;
            kHighLevelEvent:
                myErr := AEProcessAppleEvent(gTheEvent);
            keyDown, autoKey:
                begin
                    theChar := CHR(BitAnd(gTheEvent.message, charCodeMask));
                    if (BitAnd(gTheEvent.modifiers, cmdKey) <> 0) then
                        HandleMenuChoice(MenuKey(theChar));
                end;
            updateEvt:
                begin
                    HandleUpdate;
                end;
            activateEvt:
                HandleActivate;
        end;
    end;
(* MainLoop, routine which keeps keeps calling for the next event and acting accordingly *)
    procedure MainLoop;
        var
            wNEImplemented, dummy: Boolean;
            endPoint: Point;
            iErr: OSErr;
    begin

        dummy := gPreferences.sayHours;
        gPreferences.sayHours := FALSE;
        HandleNull;
        gPreferences.sayHours := dummy;
        SetCursor(arrow);
        HandleZoom;
        ShowWindow(gWindow);
        dummy := FindDepth;
        DrawTheWatch;
        while (gDone = FALSE) do
            begin
                dummy := WaitNextEvent(everyEvent, gTheEvent, SLEEP, nil);
                HandleEvent;
            end;
        endPoint.h := 0;
        endPoint.v := 0;
        LocalToGlobal(endPoint);
        gPreferences.zoomed := gZoomed;
        gPreferences.location := endPoint;
        SaveMyPrefs(gPreferences);
    end;

begin (* main routine *)
    if Initialize = TRUE then
        begin
            MainLoop;
        end;
end.