Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/CornerClock 1.9/CornerClock.p

Text File | 1997-06-23 | 18.3 KB | 783 lines | [TEXT/CWIE]

{
CornerClock is a pascal program based upon Masafumi Ueda's MBarClock program.

MBarClock was a program which displayed the time or date in the menu bar to the left
of the Apple menu.  CornerClock uses that same feature and adds some other features.

I converted Masafumi's MBarClock from C to Pascal, and then began forging it into
a chime replacement program.  Currently, if you have long chimes activated with your
clock which comes with system 7.5, you may experience a very annoying distorted
sound which interrupts your chime.  This is a known bug with the system, as it does not
appear to lock the sound handle when it plays it (it should lock it because it plays it
asynchronously).  CornerClock plays the hourly chime asynchronously, but locks the
handle so you get a smooth play.

CornerClock will play a grandfather clock chime on the hour (3 chimes as 3:00, 4 at 4:00, etc.).

When you place the cursor over the time, it will change to the date for 2 seconds, then change back
to the time (same feature in MBarClock except now there is sound).  I've also added some menus
to CornerClock so that you can toggle the date and time, and force a chime.

There are many enhancements which can be made, like changing the chime sound, changing the
volume, etc., but I'm releasing it as is to provide the Pascal community with some more sample
Pascal code.  Feel free to send me any questions or notes of thanks.

2/4/96:  v1.1 - Fixed bug so that 12:00 noon displays as 12:00 instead of 0:00.
2/10/96: v1.2 - Added a toggle under the File menu for disabling the chime.
2/29/96: v1.5 - Added a File menu item for choosing the default display (date or time).
              - Chime and default display selections are now saved in a Preference file.
              - Application now handles an AEQuit so that it properly exits when asked
                to quit from another app.
3/13/97: v1.6 - Preferences now use a dialog for selections, and added choice for chiming
                once or chiming number of hours.
3/14/97: v1.7 - Added a new style option in the preferences.
4/29/97: v1.8 - Fixed bug for chiming at 12:00 and midnight, and does CheckMachine first now.
                Added error dialog when quiting application on an error.
6/23/97: v1.9 - Added preference for 12-hour or 24-hour clock.

CornerClock ©Bill Catambay, 1997,  [e-mail]
All rights reserved worldwide.
}

Program CornerClock;
{$NR+}

Uses
    Toolbox, Sound, Resources, Icons;

Const
    sAbout = 0;
    sChime = 3;
    kDone = 1;
    kCancel = 2;
    kDisplayDate = 6;
    kDisplayTime = 7;
    kNoChime = 8;
    kChimeOnce = 9;
    kChimeMultiple = 10;
    kBlackWhite = 12;
    kYellowBlack = 13;
    kBWIcon = 14;
    kYBIcon = 15;
    kHour12 = 23;
    kHour24 = 24;
    iDate = 1;
    iTime = 2;
    iForce = 3;
    iPreferences = 5;
    iQuit = 7;
    mApple = 128;
    mFile = 129;
    mEdit = 130;

Type
    chimeChoices    =    (noChime, chimeOnce, chimeMultiple);
    displayChoices    =    (displayDate, displayTime);
    styleChoices    =    (blackOnWhite, yellowOnBlack);
    timeChoices        =    (hour12, hour24);
    PrefsRec    =    record
        chimeChoice:    chimeChoices;
        displayChoice:    displayChoices;
        styleChoice:    styleChoices;
        timeChoice:        timeChoices;
        reserved:        packed array[1..18] of integer;
        end;
    PrefsPtr    =    ^PrefsRec;
    PrefsHandle =    ^PrefsPtr;

Var
    AppleMenu, FileMenu,
    EditMenu:                 MenuHandle;
    ClockPort:                 CGrafPtr;
    NUMs:                     array[0..10] of CIconHandle;
    running:                 Boolean;
    ClockRect:                 array[0..3] of Rect;
    Corner:                 Rect;
    styleChoice:            styleChoices;
    displayChoice:             displayChoices;
    timeChoice:             timeChoices;
    dispStat:                 displayChoices;
    bkGnd:                     RgnHandle;
    chimes:                 integer;
    chimeStart:             longint;
    chimeChoice:             chimeChoices;
    timerStart:             longint;
    gBackground:             boolean;
    sounds:                 array[0..3] of SndListHandle;
    sndChans:                 array[0..3] of SndChannelPtr;
    backupChan:             SndChannelPtr;
    forceChime:             boolean;
    fRefnum,vRefnum:         integer;
    gOSErr:                 OSErr;

Function UDec(i,len: integer): str255;

Var
    str: str255;

    begin
    numToString(i,str);
    while length(str) < len do
        str := '0' + str;
    UDec := str;
    end;

Procedure Die(str: str255);

    begin
      ParamText(str,'','','');
    Alert(128,nil);
    ExitToShell;
    end;

Procedure CheckMachine;

Var
    sysEnv: SysEnvRec;
    i: integer;

    begin
    i := SysEnvirons(curSysEnvVers, sysEnv);
    if i <> noErr then
        Die('Error '+udec(i,3)+' while loading system environment');
    if not sysEnv.hasColorQD then
        Die('CornerClock requires ColorQuickDraw to run.');
    if sysEnv.systemVersion < $700 then
        Die('CornerClock requires Mac OS 7.0 or higher to run.');
    end;

Procedure OpenClockPort;

    begin
    ClockPort := CGrafPtr(NewPtrClear(sizeof(CGrafPort)));
    if ClockPort = NIL then
        Die('Error occurred trying to create the Clock port');
    OpenCPort(ClockPort);
    end;

Procedure SetupMenu;

    begin
    ClearMenuBar;
    AppleMenu := GetMenu(mApple);
    InsertMenu(AppleMenu,0);
    AppendResMenu(AppleMenu,'DRVR');
    FileMenu := GetMenu(mFile);
    InsertMenu(FileMenu,0);
    EditMenu := GetMenu(mEdit);
    InsertMenu(EditMenu,0);
    DrawMenuBar;
    end;

Procedure LoadIcons;

Var
    i: integer;

    begin
    for i := 0 to 10 do
        NUMs[i] := GetCIcon((1+integer(styleChoice))*1000 + i);
    end;

Procedure SetupRects;

Var
    rgn: RgnHandle;
    r: Rect;

    begin
    SetRect(ClockRect[0], 2,2,10,10);
    SetRect(ClockRect[1], 8,2,16,10);
    SetRect(ClockRect[2], 2,10,10,18);
    SetRect(ClockRect[3], 8,10,16,18);
    bkGnd := NewRgn;
    SetRect(corner,0,0,16,19);
    RectRgn(bkGnd,corner);
    UnionRect(ClockRect[0], ClockRect[3], r);
    r.bottom := r.bottom - 1;
    r.right := r.right - 2;
    rgn := NewRgn;
    RectRgn(rgn, r);
    DiffRgn(bkGnd, rgn, bkGnd);
    DisposeRgn(rgn);
    end;

Function SavePrefs: OSErr;

Var
    myPrefs:    PrefsHandle;

    Procedure Check(result: OSErr; isResource: boolean);

        begin
        if result <> noErr then
            begin
            if myPrefs <> nil then
                if isResource then
                    ReleaseResource(Handle(myPrefs))
                else
                    DisposeHandle(Handle(myPrefs));
            SavePrefs := result;
            exit(SavePrefs);
            end;
        end;

    begin
    myPrefs := PrefsHandle(GetResource('pref', 128));
    if myPrefs = NIL then
        begin
        myPrefs := PrefsHandle(NewHandleClear(sizeof(PrefsRec)));
        Check(MemError, false);
        AddResource(handle(myPrefs), 'pref', 128, 'Defaults');
        Check(ResError, false);
        end;
    myPrefs^^.chimeChoice := chimeChoice;
    myPrefs^^.displayChoice := displayChoice;
    myPrefs^^.styleChoice := styleChoice;
    myPrefs^^.timeChoice := timeChoice;
    ChangedResource(Handle(myPrefs));
    Check(ResError, true);
    UpdateResFile(CurResFile);
    Check(ResError, true);
    ReleaseResource(Handle(myPrefs));
    SavePrefs := noErr;
    end; { of SavePrefs }

Function LoadPrefs: OSerr;

Var
    myPrefs:    PrefsHandle;

    begin
    myPrefs := PrefsHandle(GetResource('pref',128));
    if myPrefs = NIL then
        begin
        chimeChoice := chimeMultiple;
        displayChoice := displayTime;
        styleChoice := yellowOnBlack;
        timeChoice := hour12;
        LoadPrefs := SavePrefs;
        end
    else
        begin
        chimeChoice := myPrefs^^.chimeChoice;
        displayChoice := myPrefs^^.displayChoice;
        styleChoice := myPrefs^^.styleChoice;
        timeChoice := myPrefs^^.timeChoice;
        ReleaseResource(handle(myPrefs));
        LoadPrefs := noErr;
        end;
    end; { of LoadPrefs }

Function OpenPrefs(var fRefnum: integer; var vRefnum: integer; prefName: Str255): OSerr;

Var
    err:        OSerr;
    DirID:        longint;
    fileSpec:    FSSpec;

    begin
    Err := FindFolder(kOnSystemDisk, kPreferencesFolderType,
        kCreateFolder, vRefNum, DirID);
    if Err <> noErr then
        begin
        openPrefs := err;
        exit(openPrefs);
        end;
    Err := FSMakeFSSpec(vRefNum, DirID, prefName, fileSpec);
    if (err <> Noerr) and (err <> fnfErr) then
        begin
        openPrefs := err;
        exit(openPrefs);
        end;
    if Err = fnfErr then { not there so create it }
        begin
        Err := FSpCreate (fileSpec, 'CCLK', 'pref', 0);
        if err <> Noerr then
            begin
            openPrefs := err;
            exit(openPrefs);
            end;
        end;
    fRefnum := FSpOpenResFile(fileSpec, fsCurPerm);
    if fRefnum < 0 then
        begin
        FSpCreateResFile(fileSpec, 'CCLK', 'pref', smSystemScript);
        err := ResError;
        if err <> Noerr then
            begin
            openPrefs := err;
            exit(openPrefs);
            end;
        fRefnum := FSpOpenResFile(fileSpec, fsCurPerm);
        end;
    err := ResError;
    if err <> Noerr then
        begin
        openPrefs := err;
        exit(openPrefs);
        end;
    openPrefs := LoadPrefs;
    end;

Function GotRequiredParams (var theAppleEvent: AppleEvent): OSErr;

Var
    myErr: OSErr;
    returnedType: DescType;
    actualSize: Size;

    Begin
    myErr := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, returnedType,
        Nil, 0, actualSize);
    If myErr = errAEDescNotFound Then
        GotRequiredParams := noErr
    Else If myErr = noErr Then
        GotRequiredParams := errAEParamMissed;
    End;    { of GotRequiredParams }

Function HandleQuitEvent(var theAppleEvent: AppleEvent; var reply: AppleEvent;
                           handlerRefcon: LongInt): OSErr;

    Begin
    gOSErr := GotRequiredParams(theAppleEvent);
    If gOSErr = noErr Then
        running := false;
    if (reply.dataHandle = NIL) | (handlerRefcon = 0) then  ; { read variable to eliminate compiler warning }
    HandleQuitEvent := gOSErr;
    End;    { of MyHandleQuiteEvent }

Procedure AdjustMenu;

Var
    err:    OSErr;

    begin
    if chimeChoice = noChime then
        begin
        err := SndDisposeChannel(backupChan, True);
        backupChan := NIL;
        DisableItem(FileMenu, iForce);
        end
    else
        begin
        chimes := 0;
        chimeStart := 0;
        forceChime := False;
        EnableItem(FileMenu, iForce);
        end;
    end; { AdjustMenu }

Procedure InitAppl;

Var
    i: integer;
    err: OSErr;

    begin
    OpenClockPort;
    SetupMenu;
    SetupRects;
    running := true;
    chimes := 0;
    chimeStart := 0;
    forceChime := False;
    gBackground := false;
    for i := sAbout to sChime do
        begin
        sounds[i] := SndListHandle(GetResource(soundListRsrc,128 + i));
        HLockHi(Handle(sounds[i]));
        sndChans[i] := NIL;
        end;
    backupChan := NIL;
    err := OpenPrefs(fRefnum,vRefnum,'CornerClock Preferences');
    if err <> noErr then
        Die('Error '+udec(err,3)+' while trying to open the preferences');
    dispStat := displayChoice;
    LoadIcons;
    AdjustMenu;
    gOSErr := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication,
        @HandleQuitEvent, 0, false);
    end;

Procedure DoSound(sndID: integer);

Var
    err: OSErr;
    sndCmd: SndCommand;
    sndHead: SoundHeaderPtr;
    SndChanStat: SCStatus;

    begin
    if sounds[sndID] = NIL then
        begin
        sysBeep(1);
        exit(DoSound);
        end;
    if (sndChans[sndID] <> NIL) and (backupChan <> NIL) then
        begin
        err := SndDisposeChannel(backupChan, True);
        backupChan := NIL;
        end;
    if sndChans[sndID] <> NIL then
        begin
        backupChan := sndChans[sndID];
        sndChans[sndID] := NIL;
        end;
    err := SndNewChannel(sndChans[sndID], sampledSynth, 0, NIL);
    if (err <> noErr) or (sndChans[sndID] = NIL) then
        begin
        sysBeep(1);
        exit(DoSound);
        end;
    sndHead := SoundHeaderPtr(longint(sounds[sndID]^) + 20);
    sndCmd.cmd := bufferCmd;
    sndCmd.param1 := 0;
    sndCmd.param2 := ORD4(sndHead);
    err := SndDoCommand(sndChans[sndID], sndCmd, false);
    err := SndChannelStatus(sndChans[sndID], sizeof(SndChanStat), @SndChanStat);
    if err <> noErr then
        begin
        sysBeep(1);
        err := SndDisposeChannel(sndChans[sndID], True);
        sndChans[sndID] := NIL;
        exit(DoSound);
        end;
    end;

Procedure DoAbout;

Var
    p: GrafPtr;
    d: DialogPtr;

    begin
    GetPort(p);
    d := GetNewDialog(128, NIL, WindowPtr(-1));
    if d = NIL then
        die('Error while reading dialog resource #128');
    DrawDialog(d);
    DoSound(sAbout);
    repeat until Button;
    DisposeDialog(d);
    SetPort(p);
    FlushEvents(mDownMask, 0);
    end;

Procedure SetRadioItem(dlog: DialogPtr; itemNum: integer; on: boolean);

Var
    iType:         integer;
    iHandle:    Handle;
    iRect:        Rect;

    begin
    GetDialogItem(dlog,itemNum,iType,iHandle,iRect);
    if on then
        SetControlValue(ControlHandle(iHandle),1)
    else
        SetControlValue(ControlHandle(iHandle),0);
    end;

Procedure ChangeDisplay(newValue:    displayChoices;
                        dlg:        dialogPtr);

    begin
    SetRadioItem(dlg, kDisplayDate + integer(displayChoice), FALSE);
    displayChoice := newValue;
    SetRadioItem(dlg, kDisplayDate + integer(displayChoice),TRUE);
    end;

Procedure ChangeStyle(newValue:    styleChoices;
                      dlg:        dialogPtr);

    begin
    SetRadioItem(dlg, kBlackWhite + integer(styleChoice), FALSE);
    styleChoice := newValue;
    SetRadioItem(dlg, kBlackWhite + integer(styleChoice),TRUE);
    end;

Procedure ChangeTime(newValue:    timeChoices;
                      dlg:        dialogPtr);

    begin
    SetRadioItem(dlg, kHour12 + integer(timeChoice), FALSE);
    timeChoice := newValue;
    SetRadioItem(dlg, kHour12 + integer(timeChoice),TRUE);
    end;

Procedure ChangeChime(newValue:    chimeChoices;
                      dlg:        dialogPtr);

    begin
    SetRadioItem(dlg, kNoChime + integer(chimeChoice), FALSE);
    chimeChoice := newValue;
    SetRadioItem(dlg, kNoChime + integer(chimeChoice),TRUE);
    end;

Procedure SwitchView;

    begin
    if dispStat = displayDate then
        dispStat := displayTime
    else
        dispStat := displayDate;
    doSound(1 + integer(dispStat));
    if dispStat <> displayChoice then
        timerStart := TickCount;
    end;

Procedure ForceView(newView: displayChoices);

    begin
    dispStat := newView;
    doSound(1 + integer(dispStat));
    if dispStat <> displayChoice then
        timerStart := TickCount;
    end;

Procedure DoPreferences;

Var
    p: GrafPtr;
    d: DialogPtr;
    item: integer;
    saveChime: ChimeChoices;
    saveDisplay: DisplayChoices;
    saveStyle: StyleChoices;
    saveTime: TimeChoices;

    begin
    GetPort(p);
    d := GetNewDialog(129, NIL, WindowPtr(-1));
    if d = NIL then
        die('Error while reading dialog resource #129');
    saveChime := chimeChoice;
    saveDisplay := displayChoice;
    saveStyle := styleChoice;
    saveTime := timeChoice;
    case chimeChoice of
    noChime:        SetRadioItem(d, kNoChime, TRUE);
    chimeOnce:        SetRadioItem(d, kChimeOnce, TRUE);
    chimeMultiple:    SetRadioItem(d, kChimeMultiple, TRUE);
    {CASE}            end;
    case displayChoice of
    displayDate:    SetRadioItem(d, kDisplayDate, TRUE);
    displayTime:    SetRadioItem(d, kDisplayTime, TRUE);
    {CASE}            end;
    case styleChoice of
    blackOnWhite:    SetRadioItem(d, kBlackWhite, TRUE);
    yellowOnBlack:    SetRadioItem(d, kYellowBlack, TRUE);
    {CASE}            end;
    case timeChoice of
    hour12:            SetRadioItem(d, kHour12, TRUE);
    hour24:            SetRadioItem(d, kHour24, TRUE);
    {CASE}            end;
    ShowWindow(d);
    repeat
        ModalDialog(NIL, item);
        case item of
            kDisplayDate:    ChangeDisplay(displayDate, d);
            kDisplayTime:    ChangeDisplay(displayTime, d);
            kNoChime:        ChangeChime(noChime, d);
            kChimeOnce:        ChangeChime(chimeOnce, d);
            kChimeMultiple:    ChangeChime(chimeMultiple, d);
            kBlackWhite:    ChangeStyle(blackOnWhite, d);
            kYellowBlack:    ChangeStyle(yellowOnBlack, d);
            kHour12:        ChangeTime(hour12, d);
            kHour24:        ChangeTime(hour24, d);
            otherwise;
        {CASE}         end;
    until (item = kCancel) or (item = kDone);
    if item = kCancel then
        begin
        chimeChoice := saveChime;
        displayChoice := saveDisplay;
        styleChoice := saveStyle;
        timeChoice := saveTime;
        end
    else
        begin
        AdjustMenu;
        LoadIcons;
        ForceView(displayChoice);
        SavePrefs;
        end;
    DisposeDialog(d);
    SetPort(p);
    FlushEvents(mDownMask, 0);
    end; { of DoPreferences }

Procedure DoMenu(SelMenu: longint);

Var
    item,i: integer;
    s:         Str255;

    begin
    item := LoWord(SelMenu);
    case HiWord(SelMenu) of
        mApple:    if item = 1 then
                    DoAbout
                else
                    begin
                    GetMenuItemText(AppleMenu, item, s);
                    i := OpenDeskAcc(s);
                    end;
        mFile:    case item of
                iDate:    ForceView(displayDate);
                iTime:    ForceView(displayTime);
                iForce:    if chimeChoice <> noChime then
                            forceChime := True;
                iPreferences:
                        DoPreferences;
                iQuit:    running := false;
                {CASE}    end;
    {CASE}        end;
    HiliteMenu(0);
    end;

Procedure UpdateWindow(wp: WindowPtr);

    begin
    SetPort(wp);
    BeginUpdate(wp);
    EndUpdate(wp);
    end;

Procedure DrawDigit(upper,lower: integer; upShow10, loShow10: boolean);

Var
    p: GrafPtr;

    begin
    GetPort(p);
    SetPort(GrafPtr(ClockPort));
    ForeColor(blackColor);
    PaintRgn(bkGnd);
    if (upper >= 10) | upShow10 then
        PlotCIcon(ClockRect[0], NUMs[ (upper div 10) mod 10])
    else
        PlotCIcon(ClockRect[0], NUMs[10]);
    PlotCIcon(ClockRect[1], NUMs[upper mod 10]);
    if (lower >= 10) | loShow10 then
        PlotCIcon(ClockRect[2], NUMs[(lower div 10) mod 10])
    else
        PlotCIcon(ClockRect[2], NUMs[10]);
    PlotCIcon(ClockRect[3], NUMs[lower mod 10]);
    SetPort(p);
    end;

Procedure DrawClock;

Const
    chimeMinute = 0;

Var
    dt: DateTimeRec;
    p: GrafPtr;
    pt: point;

    begin
    GetPort(p);
    SetPort(GrafPtr(ClockPort));
    GetTime(dt);
    GetMouse(pt);
    if PtInRect(pt, corner) and (dispStat = displayChoice) then
        SwitchView;
    if (dispStat <> displayChoice) & (timerStart + 300 < TickCount) then
        SwitchView;
    ForeColor(blackColor);
    PaintRgn(bkGnd);
    case dispStat of
        displayDate:    DrawDigit(dt.month, dt.day, false, false);
        displayTime:    if (timeChoice = Hour24) or (dt.hour = 12) then
                            DrawDigit(dt.hour, dt.minute, false, true)
                        else
                            DrawDigit(dt.hour mod 12, dt.minute, false, true);
    {CASE}                end;
    if chimeChoice <> noChime then
        begin
        if ((dt.minute = chimeMinute) or forceChime) and (chimes = 0) then
            begin
            if chimeChoice = chimeMultiple then
                begin
                chimes := dt.hour mod 12;
                if chimes = 0 then
                    chimes := 12;
                end
            else
                chimes := 1;
            end;
        if (chimes > 0) & ((chimeStart = 0) | (chimeStart + 120 < TickCount)) then
            begin
            doSound(sChime);
            chimeStart := TickCount;
            dec(chimes);
            if chimes = 0 then
                dec(chimes);
            end
        else if (chimes = -1) & (dt.minute <> chimeMinute) then
            begin
            chimes := 0;
            forceChime := False;
            chimeStart := 0;
            end;
        end;
    SetPort(p);
    end;

Procedure MainLoop;

Var
    event: EventRecord;
    dw: WindowPtr;
    ascii: char;
    sleep: longint;
    i: integer;
    err: OSErr;

    begin
    repeat
        DrawClock;
        if chimes > 0 then
            sleep := 1
        else
            sleep := 20;
        if WaitNextEvent(everyEvent, event, sleep, NIL) then
            case event.what of
                mouseDown:    case FindWindow(event.where, dw) of
                                inMenuBar:    DoMenu(MenuSelect(event.where));
                            {CASE}            end;
                keyDown:    begin
                            ascii := chr(BAnd(event.message,charCodeMask));
                            if BAnd(event.modifiers,cmdKey) > 0 then
                                DoMenu(MenuKey(ascii));
                            end;
                updateEvt:    UpdateWindow(WindowPtr(event.message));
                osEvt:        if BAnd(brotl(event.message,8),$FF) = suspendResumeMessage then
                                gBackground := BAnd(event.message,resumeFlag) = 0;
                kHighLevelEvent:
                            gOSErr := AEProcessAppleEvent(Event);
            {CASE}            end;
    until not running;
    if SavePrefs <> noErr then
        sysBeep(30);
    DisposeRgn(bkGnd);
    for i := 0 to 2 do
        begin
        HUnLock(Handle(sounds[i]));
        DisposeHandle(Handle(sounds[i]));
        err := SndDisposeChannel(sndChans[i], True);
        end;
    if backupChan <> NIL then
        err := SndDisposeChannel(backupChan, True);
    end;

begin
InitToolbox;
CheckMachine;
FlushEvents(everyEvent, 0);
InitAPPL;
MainLoop;
end.