Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/Billiards/simplewindow.p

Text File | 1996-09-29 | 6.8 KB | 328 lines | [TEXT/Rich]

{ simple window interface for Object Pascal }
{ written by Tim Budd, Oregon State University }
{ April 1990 }

unit SimpleWindow;

interface

    type
        SimpleMenu = object
                    { data fields }
                theMenuID: Integer;
                theMenuPtr: MenuHandle;
                link: SimpleMenu;
                    { creation methods }
                procedure readFromResource (id: integer);
                procedure createNewMenu (title: Str255);
                procedure createAppleMenu (aboutTitle: Str255);
                    { adding elements to menu }
                procedure addItem (title: Str255);
                procedure addSeparator;
                    { action to take when selected }
                    { must be overridden by user }
                procedure selectItem (itemNumber: integer);
            end;

        SimpleWindow = object
                    { data fields }
                theWindowPtr: windowPtr;
                name: STR255;
                windowRect: Rect;
                winType: integer;
                done: boolean;
                event: eventRecord;
                    { creation methods }
                procedure setAttributes;
                procedure establish;
                    { event handling }
                procedure eventLoop;
                procedure eventLoopTask;
                procedure endEventLoop;
                    { window events - seldom overridden }
                procedure activate;
                procedure deactivate;
                procedure menu (which: LongInt);
                procedure menuChoice (theMenu, theItem: integer);
                procedure buttonDownEvent;
                procedure keyEvent;
                procedure handleDrag;
                procedure handleGrow;
                procedure doGoAway;
                    { window events - often overridden }
                procedure buttonDown (x, y: integer);
                procedure keyPressed (c: char);
                procedure update;
            end;
    var
        nextMenuID: Integer;
        globalMenuList: SimpleMenu;

    procedure setNextMenuID (id: integer);
    procedure globalInitializations;

implementation

    { the necessary Macintosh initializations }
    procedure globalInitializations;
    begin
        initGraf(@ThePort);
        InitFonts;
        InitWindows;
        FlushEvents(everyEvent, 0);
        InitMenus;
        DrawMenuBar;
        TEInit;
        InitDialogs(nil);
        initCursor;
        nextMenuID := 512;
        globalMenuList := nil;
    end;

    { set the attributes on the simple window }
    procedure SimpleWindow.setAttributes;
    begin
        name := 'unknown window';
        SetRect(windowRect, 50, 70, 350, 270);
        winType := DocumentProc;
        done := false;
    end;

    { open (establish) a simple window }
    procedure SimpleWindow.establish;
        var
            tempPort: Grafptr;
    begin
        GetPort(tempPort);
        theWindowPtr := NewWindow(nil, windowRect, name,
            TRUE, winType, WindowPtr(-1), TRUE, LongInt(0));
        SelectWindow(theWindowPtr);
        ShowWindow(theWindowPtr);
    end;

    { start up a main event loop }
    procedure SimpleWindow.eventLoop;
    begin
        while not done do
            self.eventLoopTask;
    end;

    procedure SimpleWindow.eventLoopTask;
        var
            ignore: boolean;
    begin
        systemTask;
        ignore := GetNextEvent(everyEvent, event);

        case event.what of

            mouseDown:
                self.buttonDownEvent;

            keyDown:
                self.keyEvent;

            activateEvt:
                if BitAnd(event.modifiers, activeFlag) <> 0 then
                    self.activate
                else
                    self.deactivate;

            updateEvt:
                self.update;

            otherwise
                ;
        end;
    end;

    procedure SimpleWindow.endEventLoop;
    begin
        done := true
    end;

    procedure SimpleWindow.buttonDownEvent;
        var
            localPoint: Point;
            wp: WindowPtr;
    begin
        case FindWindow(event.where, wp) of

            inSysWindow:
                SystemClick(event, wp);

            inMenuBar:
                self.menu(menuSelect(event.where));

            inGrow:
                self.handleGrow;

            inDrag:
                self.handleDrag;

            inContent:
                if wp <> FrontWindow then
                    SelectWindow(wp)
                else
                    begin
                        localPoint := event.where;
                        GlobalToLocal(localPoint);
                        self.buttonDown(localPoint.h, localPoint.v);
                    end;

            inGoAway:
                self.doGoAway;

        end;
    end;

    procedure SimpleWindow.keyEvent;
        var
            chCode: integer;
            ch: char;
    begin
        chCode := BitAnd(event.message, CharCodeMask);
        ch := chr(chCode);
        if BitAnd(event.modifiers, CmdKey) <> 0 then
            begin
                if event.what <> AutoKey then
                    self.menu(MenuKey(ch))
            end
        else
            self.keyPressed(ch);
    end;

    { handle a conventional key press - overridden in subclasses }
    procedure SimpleWindow.keyPressed (c: char);
    begin
    end;

    { handle a window activation }
    procedure SimpleWindow.activate;
    begin
        SetPort(self.theWindowPtr);
    end;

    procedure SimpleWindow.deactivate;
    begin
        { subclasses may do something, we don't }
    end;

    procedure SimpleWindow.menu (which: LongInt);
        var
            theMenu, theItem: integer;
    begin
        if which <> 0 then
            self.menuChoice(HiWord(which), LoWord(which));
    end;

    procedure SimpleWindow.handleDrag;
    begin
        dragWindow(theWindowPtr, event.where, ScreenBits.bounds);
    end;

    procedure SimpleWindow.handleGrow;
    begin
        { assumption is that windows can't grow  }
        { can be overridden in subclasses }
    end;

    { handle a menu selection }
    procedure SimpleWindow.menuChoice (theMenu, theItem: Integer);
        var
            menuPtr: SimpleMenu;
    begin
        menuPtr := globalMenuList;
        while menuPtr <> nil do
            if menuPtr.theMenuID = theMenu then
                begin
                    menuPtr.selectItem(theItem);
                    menuPtr := nil
                end
            else
                menuPtr := menuPTr.link;
    end;

    { handle a window update - usually modified in subclasses }
    procedure SimpleWindow.update;
    begin
        SetPort(self.theWindowPtr);
        ClipRect(self.theWindowPtr^.portRect);
    end;

    { handle a button down event - usually overridden in subclasses}
    procedure SimpleWindow.buttonDown (x, y: integer);
    begin
    end;

    { handle button press in go away box }
    procedure SimpleWindow.doGoAway;
    begin
    end;

    { insert a menu into the menu bar }
    procedure insertAndDraw (menu: SimpleMenu);
    begin
        InsertMenu(menu.theMenuPtr, 0);
        DrawMenuBar;
        menu.link := globalMenuList;
        globalMenuList := menu;
    end;

    { read a menu description from resource file }
    procedure SimpleMenu.readFromResource (id: integer);
    begin
        theMenuPtr := GetMenu(id);
        theMenuID := id;
        insertAndDraw(self);
    end;

    { create a new menu }
    procedure SimpleMenu.createNewMenu (title: Str255);
    begin
        theMenuID := nextMenuID;
        nextMenuID := nextMenuID + 1;
        theMenuPtr := NewMenu(theMenuID, title);
        InsertAndDraw(self);
    end;

    { create the special Apple menu item }
    procedure SimpleMenu.createAppleMenu (aboutTitle: Str255);
        var
            appleTitle: Str255;
    begin
        appleTitle := '@';
        appleTitle[1] := CHR(AppleMark);
        self.createNewMenu(appleTitle);
        self.addItem(aboutTitle);
        self.addSeparator;
        AddResMenu(theMenuPtr, 'DRVR');
    end;

    { add an item to a menu }
    procedure SimpleMenu.addItem (title: Str255);
    begin
        AppendMenu(theMenuPtr, title);
    end;

    { add a separator bar to a menu }
    procedure SimpleMenu.addSeparator;
    begin
        self.addItem('(-----------------');
    end;

    procedure SimpleMenu.selectItem (itemNumber: integer);
        var
            accName: Str255;
            accNumber: Integer;
    begin
    { this is just to handle the Apple menu }
    { should be overridden in all other subclasses }
        if itemNumber > 1 then
            begin
                GetItem(self.theMenuPtr, itemNumber, accName);
                accNumber := OpenDeskAcc(accName);
            end;
    end;
end.