Tricks of the Mac Game Programming Gurus/TricksOfTheMacGameProgrammingGurus.iso/More Source/Pascal/Brain Damage/BrainDamage.p

Text File | 1994-10-21 | 5.5 KB | 211 lines | [TEXT/PJMM]

{BrainDamage}
{Originally written by Scott T Boyd in 1987. His original message included:}
{}
{***}
{Enclosed is a binhex'ed packit file containing an application to remind us}
{all to be happy that we've spent so much money on Macintosh hardware.}
{The .hqx file is about 12K.}
{***}
{}
{Since then, the Mac way has proven to be the right way, and the fanatics of the Old Way}
{have grown very few - and most PC users now use the same things that the old PC}
{users used to flame the Mac for (windows, menus and toy-like floppies) - and the Macs}
{aren't expensive any more. :-)}
{}
{Slightly modernized by Ingemar Ragnemalm. This new version supports bigger screens,}
{uses a real window instead of drawing in the WMgrPort, and… well, not much more, just}
{a few minor cleanups. I just couldn't let this hack collect dust forever.}

program BrainDamage;
    var
        theEvent: EventRecord;
        wMgr: GrafPtr;
        gWind: WindowPtr;
        cursorRect: Rect;
        cursorPos: Point;
        theChar: Char;
        cursorOn: Boolean;
        theFontInfo: FontInfo;
        bitmapSize: Longint;
        offBits: Bitmap;

    procedure MoveCursor (h, v: integer);
    begin
        with cursorRect do
            OffsetRect(cursorRect, -left, -top);
        OffsetRect(cursorRect, h * (cursorRect.right + 1), v * (cursorRect.bottom + 1) + thefontInfo.descent);
        with cursorRect do
            MoveTo(left, bottom - theFontInfo.descent);
        cursorPos.h := h;
        cursorPos.v := v;
    end;{MoveTo}

    procedure ScrollPage;
        var
            i: integer;
            onScreenRect, screenRect, lineRect: rect;
            lineHeight: integer;
            whoCares: longint;
            realWMgr, oldPort: windowPtr;
    begin
        GetWMgrPort(realWMgr);
        GetPort(oldPort);
        SetPort(realWMgr);
        ClipRect(screenBits.bounds);
        RectRgn(realWMgr^.visRgn, screenBits.bounds);
        lineHeight := theFontInfo.ascent + theFontInfo.descent + 2;
        CopyBits(screenBits, offBits, screenBits.bounds, screenBits.bounds, srcCopy, nil);
        FillRect(thePort^.portRect, black);
        Delay(10, whoCares);
        screenRect := screenBits.bounds;
        OffsetRect(screenRect, 0, -lineHeight);
        if SectRect(screenRect, screenBits.bounds, screenRect) then
            ;
        onScreenRect := screenRect;
        OffsetRect(onScreenRect, 0, lineHeight);
        CopyBits(offBits, screenbits, onScreenRect, screenRect, srcCopy, nil);
        SetPort(oldPort);
        MoveCursor(0, (thePort^.portBits.bounds.bottom - thePort^.portBits.bounds.top) div lineHeight + 3); {25}
    end;{ScrollPage}

    procedure NewLine;
        var
            lineHeight: integer;
    begin
        lineHeight := theFontInfo.ascent + theFontInfo.descent + 2;
        MoveCursor(0, cursorPos.v + 1);
        if cursorPos.v > (thePort^.portBits.bounds.bottom - thePort^.portBits.bounds.top) div lineHeight + 3 then {25}
            ScrollPage;
    end;{NewLine}

    procedure CursorOff;
    begin
        if cursorOn then
            InvertRect(cursorRect);
        if cursorOn then
            cursorOn := false;
    end;{cursorOff}

    procedure FlashCursor;
    begin
        if TickCount mod 30 = 0 then
            begin
                InvertRect(cursorRect);
                cursorOn := not cursorOn;
            end;
    end;{FlashCursor}

    procedure Print (myStr: Str255);
        var
            character: integer;
    begin
        cursorOff;
        for character := 1 to length(myStr) do
            begin
                DrawChar(myStr[character]);
                MoveCursor(cursorPos.h + 1, cursorPos.v);
                if cursorPos.h > 80 then
                    NewLine;
            end;
    end;{print}

    procedure InterpretCommand;
    begin
        CursorOff;
        if cursorPos.h > 2 then
            begin
                NewLine;
                Print('Err:  Command Not Found');
                SysBeep(1);
            end;
        NewLine;
        Print('A>');
    end;{interpretCommand}

begin
    GetWMgrPort(wMgr);
    SetPort(wMgr);
    gWind := NewWindow(nil, thePort^.portBits.bounds, '', true, 8, pointer(-1), true, 0);
    SetPort(gWind);
    RectRgn(gWind^.visRgn, thePort^.portBits.bounds);
    ClipRect(thePort^.portBits.bounds);
    BackPat(black);
    TextFont(4);
    TextSize(9);

    with screenBits, bounds do
        begin
            bitmapSize := longint((right - left + 15) div 16 * 2) * longint(bounds.bottom - bounds.top);
            offBits.baseAddr := NewPtr(bitmapSize);
            offBits.bounds := screenBits.bounds;
            offBits.rowBytes := (right - left + 15) div 16 * 2;
        end;

    GetFontInfo(theFontInfo);
    HideCursor;
    cursorOn := false;
    ClipRect(thePort^.portBits.bounds);
    FillRect(thePort^.portBits.bounds, black);
    with thefontInfo do
        SetRect(cursorRect, 0, 0, widMax, ascent + descent);
    MoveCursor(0, 1); {22}
    TextMode(srcXor);
    Print('READY');
    MoveCursor(0, 2); {23}
    Print('A>');
    repeat
        FlashCursor;
        if GetNextEvent(everyEvent, theEvent) then
            begin
                case theEvent.what of
                    keyDown, autoKey:
                        begin
                            theChar := chr(BitAnd(charCodeMask, theEvent.message));
                            case ord(theChar) of{ord(theChar[1])}
                                3: {enter}
                                    begin
                                        CursorOff;
                                        Print('^C');
                                        NewLine;
                                        Print('A>');
                                    end;
                                8: {backspace}
{Is it command-alt-delete?}
                                    if (BitAnd(theEvent.modifiers, optionKey) <> 0) and (BitAnd(theEvent.modifiers, cmdKey) <> 0) then
                                        begin
                                            ExitToShell;
                                        end
                                    else
{…or just backspace?}
                                        begin
                                            cursorOff;
                                            if cursorPos.h > 2 then
                                                begin
                                                    MoveCursor(cursorPos.h - 1, cursorPos.v);
                                                    FillRect(cursorRect, black);
                                                end;
                                        end;
                                13: {return}
                                    InterpretCommand;
                                28: {arrow left}
                                    Print('^H');
                                29:  {arrow right}
                                    Print('^K');
                                30:  {arrow up}
                                    Print('^U');
                                31:  {arrow down}
                                    Print('^J');
                                otherwise
                                    Print(theChar);
                            end;
                        end;
                    otherwise
                        begin
                        end
                end;
            end;
    until false;
{ BackPat(white);}
{ DisposeWindow(gWind);}
{ DisposPtr(offBits.baseAddr); }
end.