|
Volume Number: | 6 | |
Issue Number: | 11 | |
Column Tag: | Color Workshop |
Related Info: Color Quickdraw Memory Manager
Spiffy Color Demo
By John A. Love, III, Springfield, VA
Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.
Spiffy Color Effects Demo
Part I
[John is a member of theWashington Apple Pi Users’ Group from the greater Washington D.C. metropolitan area and can be reached on Applelink {D3471} and on GEnie {J.LOVE7}]
Although the application file on the MacTutor disk is named “Rotation Demo”, the color effects illustrated are more inclusive, as follows:
a) Rotation.
b) Dissolve.
c) Text Scrolling & Un-Rolling. Select the “About ...” Menu item to observe these.
d) PICT/PICT2 scrolling.
e) Just for hex, press “z” or “Z” and enjoy!!
In addition, you’ll observe color menus, color windows, color icons, color Scroll Bars, color CuRSoRs and rotating CURSors (sorry, the latter are in “yucky” black-and-white). Found the hidden treasure(e) in the source listing yet-- I know it’s old stuff to some of you, but I’m still fascinated by it. Finally, you’ll listen to the joyous sound of Macintosh Developer Tech Support’s (MacDTS) mascot, DogCow™. All of this is in a MultiFinder™-aware demo package.
By the way, this daggum demo has successfully run on a:
• Mac IIx with Apple’s standard color monitor
• Mac IIci with Raster Op’s monitor & their 24-bit color card { will miracles never cease ????? }
• MacIIci mated with Radius’ Two Page Display and Apple’s standard color monitor, with my window entirely on one or the other. Pleeeeese don’t ask about my window overlapping both !!!!!
• I’m still looking for some rich soul with a Mac IIfx
I wrote this demo using Symantec’s THINKPascal© {Version 3.Ø} in conjunction with my all-time favorite assembler, “McAssembly©”, authored by Dave McWherter and formerly distributed by Signature Software. Followers of MacTutor may recall an article of mine in April, 1989, wherein I described “McAssembly©” in reasonable detail. Dave also authored a super text-processing DA, Vantage™, distributed by Preferred Publishers, which I also talked about in that same article.
As a programmer, I have only one regret; namely, I have just received Version 3.Ø of THINKPascal© which is MacApp™-compatible. I am still learning MacApp™ so I wrote the demo in the procedural mode. Since it is now April, maybe by the time this article is printed, I will feel more at ease with MacApp™.
Speaking of MacApp™, if you’re just beginning to program using MacApp™ or are thinking of starting but the thought scares ‘the-heck-out-of-you’ because of its reported complexity, I whole-heartedly suggest you get the following docs from APDA:
a) Introduction to MacApp v. 2.0 and Object-Oriented- Programming, Beta Draft
b) MacApp v. 2.0 Tutorial, Beta Draft
c) MacApp v. 2.0 Cookbook, Beta Draft
They are really excellent!!! They cover the waterfront, yet adhere to the KISS principle.
Before I progress to some of the programming goodies, let me say that beyond any doubt whatsoever, I would never have ‘gotten to first base’ without the patient assists of Mr. Jon Zap from MacDTS. His tutorials via Applelink™ were superb. In addition, take a gander at some of Mr. SkippyWhite’s great off-screen device code on “Phil and Dave’s Excellent CD”. Because I relied principally on off-screen pixmaps, vice off-screen devices, I used only a tiny portion of Skippy White’s code. ‘How-some-ever’, I learned a heck-of-a-lot. Good stuff ... Thanks Jon & Skippy!!!!!
Before I end this thing, I would like to share with you some of my findings while working in the color world. I’ll try to be brief simply because by the time the source listings end below, Kirk Chase will be ready to kill me:
Color Controls
Some wierd goings-on here as described in the following code-segment in my “UpActionProc”:
{1} newCtlValue := oldCtlValue - 1; { Decrement 1 line } { _SetCtlValue appears buggy for a Mac II set to black-and- } { white. Works okay in color, though ????? } temp := ctl^^.contrlRect; InsetRect(temp, 1, 1); ClipRect(temp); SetCtlValue(ctl, newCtlValue); ClipRect(ctl^^.contrlOwner^.portRect); { Reset. }
Actually the above craziness is necessary anytime I call _SetCtlValue or something comparable such as _SetCtlMax; for example, in my “DoPeriodic” PROC wherein I look to see if the ctlMax needs to be reset which it must be when I either resize the window or zoom it. Please don’t ask me why this craziness is required!!!!! By the way, my scrolling code is simply Dan Weston’s Assembly code converted to Pascal (see his positively super two book series about programming in Assembly).
Color Menus
Nothing fancy here. I simply used RMaker™ to construct a “mctb” resource with ID=0 because that is the resource loaded when _InitMenus is executed. Within this resource, the so-called menubar entry led, followed by the appropriate exceptions to this menubar entry; for example, a particular menu title or a particular menu item. Without these exceptions, the leading menubar entry takes care of the whole thing.
I suppose I could have constructed “mctb” resources for each individual menu, with matching IDs. These resources are loaded by _GetMenu. However, since the effect for my particular demo is the same, I chose the “ID=0” approach.
Rotation in Color
I used John Olsen’s bit rotation scheme as originally published in MacTutor (February,1988). John’s code was in Assembly language, so I continued his example. Its conversion to color turned out to be a bear because I kept getting bus errors. There is nothing fancy about its conversion to color -- simply rotate pixels, rather than bits.
Dissolve in Color
I used Mike Morton’s dissolve scheme that he wrote in Assembly language and originally published in MacTutor (December,1985). Dig up this oldie and track down Mike’s subroutine that he entitles “Convert” and that’s the only place that multiple bits-per-pixel enter the picture. It took me longer to find that ‘antique’ issue of MacTutor than it did to implement the required changes.
Scrolling PICTs ...
Just to convey some idea of the speed & resultant efficiency of creating and using off-screen bitmaps/pixmaps, the following code could have been used to scroll the PICT drawn in the content region of the active window in response to a mouseDown Event in one of its scroll bars:
{2} PROCEDURE ScrollContents (ctl: ControlHandle; dh, dv: INTEGER); VAR window: WindowPtr; oldClip: RgnHandle; myPic: PicHandle; BEGIN window := ctl^^.contrlOwner; { We KNOW this is the GrafPort.} oldClip := NewRgn; GetClip(oldClip); { I placed it here, vice in the windowPic field--so sue me. } myPic := PicHandle(WindowPeek(window)^.refCon); ; ClipRect(windPICTrect); { These rects are globals. } EraseRect(windPICTrect); OffsetRect(scrolledFullPICTrect, dh, dv); DrawPicture(myPic, scrolledFullPICTrect); ; SetClip(oldClip); ValidRect(windPICTrect); { NO updates please !! } DisposeRgn(oldClip); END; { ScrollContents }
This works; however, the effects of _EraseRect are visible. In short, as you scroll the PICT, the image blinks ... even on a MacII set to black-and-white. The method of choice then becomes creating an off-screen bitmap/pixmap, scrolling it off-screen and finally _CopyBits-ing it on-screen. Granted ... in color the PICT does blink, but only slightly and in black-and-white on a MacII there is no blinking that I can discern, anyway.
Zooming a window in response to a keypress
This last ‘goodie’ has nothing to do with strictly color, but applies also to black-and-white. “Inside Macintosh”, Volume IV, stipulates that “ZoomWindow is in no way tied to the TrackBox function...”. Neat!! So, take a gander:
{3} PROCEDURE HandleKey; VAR keyASCII: INTEGER; key: char; BEGIN IF NOT applWind THEN EXIT(HandleKey); ; IF BitAnd(Event.modifiers, $0F00) = cmdKey THEN { ONLY the Command Key } HandleMenu ELSE BEGIN keyASCII := BitAnd(Event.message, CharCodeMask); key := CHR(keyASCII); IF (key = ‘z’) | (key = ‘Z’) THEN doZoom(FrontWindow, nextState) { More on “nextState” below. } ELSE SysBeep(10); END; { ELSE no leading Command key } END; { HandleKey }
The key is to keep your ‘doZoom’ PROC separate so your ‘HandleMouse’ PROC looks something like:
{4} PROCEDURE HandleMouse; VAR ... BEGIN CASE windowLoc OF { windowLoc + others below = Globals } ... inZoomOut, inZoomIn: IF TrackBox(TheWindow, Event.where, windowLoc) THEN doZoom(TheWindow, windowLoc); ... END; { CASE } END; { HandleMouse }
But ... (there’s always one!! in every crowd) ... I’ve got to determine what ‘state’ the window is currently in, the userState that depicts the to-be-zoomed-out state or the stdState that depicts the to-be-zoomed-in state. Well, that part’s easy--my “nextState” global (see my HandleKey PROC above) is:
a) initialized to inZoomOut upon start--up.
b) set to inZoomOut at the end of my windowLoc: inZoomIn code.
c) set to inZoomIn at the end of my windowLoc: inZoomOut code.
d) set to inZoomOut at the end of my ‘doGrow’ PROC.
The real rub comes within the windowLoc = ‘inDrag’ part of my ‘HandleMouse’ PROC:
{6} inDrag: BEGIN ... { DragWindow forces the Mouse to stay inside of tempRect } { which has already been quantified } DragWindow(TheWindow, Event.where, tempRect); { The following craziness ????? is required ’cause I zoom } { the window in response to a keypress. I call SizeWindow } { with NO effective change just to re-quantify the user } { State in the WStateRec(ord. } WITH TheWindow^.portRect DO SizeWindow(TheWindow, right - left, bottom - top, FALSE); { NO update !! } GetMouse(mouseLoc); LocalToGlobal(mouseLoc); IF PtInRect(mouseLoc, tempRect) THEN { It’s a drag, allright !! } nextState := inZoomOut; { ELSE NO change !! } END; { inDrag }
Color CuRSoRs
Color Cursors are wierd, just plain wierd. In the black-and-white world, the call to change the Cursor is always to the ROM pair, _GetCursor and _SetCursor. Watch out, color
a) _GetCCursor once and only upon an Activate/Resume Event.
b) _DisposCCursor upon a DeActivate/Suspend Event.
c) _SetCCursor when your _PtInRect call returns TRUE but also set a flag, to whit:
{7} IF NOT stillColorCrsr AND PtInRect( ) THEN BEGIN SetCCursor(yourCrsrHdl); stillColorCrsr := TRUE; END;
As I said, ‘Watch Out!!!
Just in case the sub-title of this article failed to catch your eye, namely the “Part I”, there’s something deliberately missing from this month’s article due to length restrictions. That which is missing is ALL the assembly source code and the “RMaker” source code your patience will be rewarded next month.
Figured out the treasure hidden in (e) yet ... if not, read on, for the source now begins:
Listing: rotInterface.p UNIT rotInterface; INTERFACE { ----------------------} { Memory Manager stuff: } { ----------------------} FUNCTION NewClearHandle (logicalSize: Size): Handle; INLINE { The PASCAL-supplied interface is } { denoted with "***": } { } { *** subq.w #4,sp } { *** move.l logicalSize,-(sp) } { $201F:move.l (sp)+,d0 } { $A322: _NewHandle,clear } { $31C00220:move.w d0,MemErr } { $2E88:move.l a0,(sp) } { *** move.l (sp)+,xxxx } $201F, $A322, $31C0, $0220, $2E88; FUNCTION NewSysHandle (logicalSize: Size): Handle; INLINE $201F, $A522, $31C0, $0220, $2E88; FUNCTION NewSysClearHandle (logicalSize: Size): Handle; INLINE $201F, $A722, $31C0, $0220, $2E88; FUNCTION NewClearPtr (logicalSize: Size): Ptr; INLINE $201F, $A31E, $31C0, $0220, $2E88; FUNCTION NewSysPtr (logicalSize: Size): Ptr; INLINE $201F, $A51E, $31C0, $0220, $2E88; FUNCTION NewSysClearPtr (logicalSize: Size): Ptr; INLINE $201F, $A71E, $31C0, $0220, $2E88; { ------------------ } { Keeping A5 around: } { ------------------ } PROCEDURE PushA5; INLINE $2F0D; { MOVE.L A5,-(SP) } PROCEDURE PopA5; INLINE $2A5F; { MOVE.L (SP)+,A5 } { will point to our parmeter block. Therefore, the value } { of CurrentA5 that we stored will be at - 4(A0). } PROCEDURE GetMyA5; INLINE $2A68, $FFFC; { MOVE.L -4(A0),A5 } { ---------------------------------------------------- } { Assembly Language routines } { -> in “rotAsm.Lib”: } { ---------------------------------------------------- } FUNCTION RotateBits (srcBits, dstBits: BitMap): OSErr; PROCEDURE DissBits (srcBits, dstBits: BitMap; srcRect, dstRect: Rect); IMPLEMENTATION FUNCTION RotateBits (srcBits, dstBits: BitMap): OSErr; external; PROCEDURE DissBits (srcBits, dstBits: BitMap; srcRect, dstRect: Rect); external; END. { UNIT = rotInterface }
Listing: rotGlobals.p UNIT rotGlobals; INTERFACE USES Palettes; { --------------------------------- } { Global constants: } { --------------------------------- } CONST SP = ' '; CurrentA5 = $904; { low-mem globals... } GrayRgn = $9EE; { Handle to region drawn as desktop. } ROM85Loc = $28E; mBarHeightLoc = $BAA; AppleMenuID = 1001; { My specific constants ... } AboutItem = 1; AdisabledItem = 2; EditMenuId = 1002; UndoItem = 1; EdisabledItem = 2; CutItem = 3; CopyItem = 4; PasteItem = 5; ClearItem = 6; GraphicsMenuID = 1003; RotateItem = 1; DissolveItem = 2; GdisabledItem = 3; QuitItem = 4; monsterID = 128; { PICTs ... } bwGigantorID = 129; colorGigantorID = 130; logoID = 131; acurWorld = 128; { Rotating CURSors... } acurDogCow = 129; mainWindowID = 128; horizScrollID = 128; { ... also, the CNTL’s refCon. } vertScrollID = 129; growBoxSize = 15; scrollWidth = 16; { Samo-Samo } scrollHeight = 16; { ---------- } logoWindowID = 129; pmWhite = 0; {Palette Mgr stuff...} pmBlack = 1; pmYellow = 2; pmMagenta = 3; pmRed = 4; pmCyan = 5; pmGreen = 6; pmBlue = 7; pmLtBlue = 8; pmLtGray = 9; IACScicnID = 128; HANDcrsrID = 129; { -------------------------------------------------------------------------------------------------------------- } { ... for Error handling in my Off-screen map routine(s): } { -------------------------------------------------------------------------------------------------------------- } NewPtrError = -10000; NewHdlError = -15000; CloneHdlError = -20000; MaxDevError = -25000; { ------------------------------------ } { MultiFinder stuff: } { ------------------------------------ } _WaitNextEvent = $A860; _Unimplemented = $A89F; SysEnvironsVersion = 1; { OSEvent is the event number of the suspend/resume and } { mouse-moved Events sent by MultiFinder. Once you } { determine that an event is an OSEvent, look at the High } { byte of the message sent with the event to determine } { which kind it is. To differentiate between suspend & } { resume, look at resumeMask bit. } OSEvent = app4Evt; suspendResumeMessage = 1; mouseMovedMessage = $FA; resumeMask = 1; { -------------------------- } { Global types: } { -------------------------- } TYPE RgnHandlePtr = ^RgnHandle; wordPtr = ^INTEGER; longPtr = ^LONGINT; BitMapPtr = ^BitMap; MyVBLType = RECORD CurrA5: LONGINT; { Lost & Found!! } MyVBL: VBLTask; { The actual Task } END; { MyVBLType } acurType = RECORD {Poetry in motion!!} nbrCursors: INTEGER; frameCounter: INTEGER; cursorIDs: ARRAY[0..0] OF LONGINT; {in High word. } END; { acurType } acurPtr = ^acurType; acurHandle = ^acurPtr; WStatePtr = ^WStateData; { For zooming the window in } WStateHdl = ^WStatePtr; { response to a keypress. } { -------------------------------------- } { Global variables: } { -------------------------------------- } VAR screen: Rect; ROM: wordPtr; mBarHt: INTEGER; AppleMenu, EditMenu, GraphicsMenu: MenuHandle; aMac2: BOOLEAN; colorDepth: INTEGER; monsterPicHdl: PicHandle; fullPICTrect, windPICTrect: Rect; TheWindow: WindowPtr; windDef: INTEGER; { Variation Code } horizControl, vertControl: ControlHandle; Event: EventRecord; windowLoc: INTEGER; daWind, applWind: BOOLEAN; currEdit, currGraphics: BOOLEAN; myVBLRec: MyVBLType; acurHdl: Handle; CURS_ID0, nbrGlobe: INTEGER; Done, InWindow: BOOLEAN; WNE, InForeGround, justOpened, justBragging: BOOLEAN; Sleep, finalTicks: LONGINT; colorHandCrsr: CCrsrHandle; stillColorCrsr: BOOLEAN; CreateOffScreenError: OSErr; { usual off-screen stuff } oldDevice, myMaxDevice: GDHandle; offBitMapPtr, onScreenBitsPtr: BitMapPtr; myBits: Ptr; offGrafPort: GrafPort; offGrafPtr, onBWScreen: GrafPtr; offCGrafPort: CGrafPort; offCGrafPtr, onCScreen: CGrafPtr; ourCTHandle: CTabHandle; scrolledFullPICTrect: Rect; { For scrolling. } zoomBackIn: Rect; { For zooming ... } nextState: INTEGER; stateHandle: WStateHdl; saveWindPICTrect, saveFullPICTrect, saveScrolledFullPICTrect: Rect; IMPLEMENTATION END. { UNIT = rotGlobals }
Listing: rotMiscSubs.p UNIT rotMiscSubs; INTERFACE USES Palettes, Retrace, Sound, rotInterface, rotGlobals; PROCEDURE InitManagers; FUNCTION TestForMac2: BOOLEAN; FUNCTION TestForColor: INTEGER; PROCEDURE LocalGlobal (VAR r: Rect); PROCEDURE GlobalLocal (VAR r: Rect); FUNCTION WNEisImplemented: BOOLEAN; PROCEDURE PlaySound (mySound: Str255); PROCEDURE InstallVBLTask (rsrcID: INTEGER); PROCEDURE RemoveVBLTask; FUNCTION GetMouseMovement (gMouse0: Point): Size; FUNCTION DoubleClick: BOOLEAN; IMPLEMENTATION PROCEDURE FatalSystemCrash; BEGIN ExitToShell; END; { FatalSystemCrash } PROCEDURE InitManagers; BEGIN MoreMasters; MoreMasters; MoreMasters; MoreMasters; InitGraf(@thePort); InitFonts; InitWindows; InitMenus; TEInit; InitDialogs(@FatalSystemCrash); ; FlushEvents(everyEvent, 0); InitCursor; END; { InitManagers } { ============================================== } { Test for a Mac II, or an SE30 for that matter: } { ============================================== } FUNCTION TestForMac2: BOOLEAN; VAR theWorld: SysEnvRec; error: OSErr; BEGIN TestForMac2 := FALSE; { Assume the old stuff !! } error := SysEnvirons(1, theWorld); IF error <> 0 THEN EXIT(TestForMac2); IF theWorld.machineType >= envMacII THEN TestForMac2 := TRUE; END; { TestForMac2 } { ======================================================== } { Test for the presence of a Mac with Color QuickDraw and } { a Color Monitor set to Color via the Control Panel or } { using the “Switch-A-Roo” FKEY. Return the color depth: } { ======================================================== } FUNCTION TestForColor: INTEGER; LABEL 100; VAR theWorld: SysEnvRec; error: OSErr; BEGIN TestForColor := 1;{ Assume B&W } error := SysEnvirons(1, theWorld); IF error <> 0 THEN EXIT(TestForColor); IF NOT theWorld.hasColorQD THEN GOTO 100; TestForColor := GetGDevice^^.gdPMap^^.pixelSize; 100: END; { TestForColor } { =================== } { A short-cut or two: } { =================== } PROCEDURE LocalGlobal (VAR r: Rect); BEGIN LocalToGlobal(r.topLeft); LocalToGlobal(r.botRight); END; { LocalGlobal } PROCEDURE GlobalLocal (VAR r: Rect); BEGIN GlobalToLocal(r.topLeft); GlobalToLocal(r.botRight); END; { GlobalLocal } { =================================== } { Common to the routines that follow: } { =================================== } FUNCTION TrapAvailable (myTrapNbr: INTEGER; myTrapType: TrapType): BOOLEAN; VAR UnimplementedTrapNbr: INTEGER; BEGIN { LONGINT -> INTEGER } UnimplementedTrapNbr := LoWord(BXOR(_Unimplemented, $A800)); TrapAvailable := (NGetTrapAddress(myTrapNbr, myTrapType) <> GetTrapAddress(UnimplementedTrapNbr)); END; { TrapAvailable } { ============================================== } { Check to see if _WaitNextEvent is implemented: } { ============================================== } FUNCTION WNEisImplemented: BOOLEAN; VAR WNEtrapNbr: INTEGER; theWorld: SysEnvRec; discardError: OSErr; BEGIN WNEtrapNbr := LoWord(BXOR(_WaitNextEvent, $A800)); { Since _WaitNextEvent and _HFSDispatch have the same trap } { number ( = $60 ), we can call “TrapAvailable” for } { _WaitNextEvent ONLY if we are on a machine that supports } { separate OS and ToolBox trap tables. Therefore, we } { need to check for a machineType that is >= 0. NOTE that } { even if we get an error calling _SysEnvirons, the } { compiler’s glue has filled-in the machineType field: } discardError := SysEnvirons(SysEnvironsVersion, theWorld); IF theWorld.machineType < 0 THEN WNEisImplemented := FALSE ELSE WNEisImplemented := TrapAvailable(WNEtrapNbr, ToolTrap); END; { WNEisImplemented } { ===================== } { Play it again, Sam !! } { ===================== } PROCEDURE PlaySound (mySound: Str255); CONST _SndPlay = $A805; VAR SndPlayTrapNbr: INTEGER; theWorld: SysEnvRec; discardError: OSErr; SndPlayIsImplemented: BOOLEAN; sndHandle: Handle; BEGIN SndPlayTrapNbr := LoWord(BXOR(_SndPlay, $A800)); discardError := SysEnvirons(SysEnvironsVersion, theWorld); IF theWorld.machineType < 0 THEN SndPlayIsImplemented := FALSE ELSE SndPlayIsImplemented := TrapAvailable(SndPlayTrapNbr, ToolTrap); ; sndHandle := GetNamedResource(‘snd ‘, mySound); IF NOT SndPlayIsImplemented | (sndHandle = NIL) THEN EXIT(PlaySound); discardError := SndPlay(NIL, sndHandle, FALSE); END; { PlaySound } { ======================== } { My spinning CURSor Task: } { ======================== } PROCEDURE SpinTheBottle; { Love it !!! } VAR globe: cursHandle; globeID: INTEGER; BEGIN PushA5; GetMyA5; globeID := CURS_ID0 + nbrGlobe - 1; globe := GetCursor(globeID); SetCursor(globe^^); nbrGlobe := nbrGlobe - 1; { Reset stuff for next time } IF nbrGlobe = 0 THEN nbrGlobe := acurHandle(acurHdl)^^.nbrCursors; myVBLRec.MyVBL.vblCount := 10; PopA5; END; { SpinTheBottle } { ============================= } { Round-and-around she goes ... } { ============================= } PROCEDURE InstallVBLTask (rsrcID: INTEGER); VAR watch: cursHandle; ignore: INTEGER; BEGIN acurHdl := GetResource(‘acur’, rsrcID); IF acurHdl = NIL THEN BEGIN watch := GetCursor(watchCursor); SetCursor(watch^^); { Reset later by HandleCursor. } END { IF acurHdl = NIL } ELSE BEGIN CURS_ID0 := HiWord(acurHandle(acurHdl)^^.cursorIDs[0]); nbrGlobe := acurHandle(acurHdl)^^.nbrCursors; ; WITH myVBLRec, MyVBL DO BEGIN CurrA5 := longPtr(CurrentA5)^; vblAddr := @SpinTheBottle; vblCount := 10; { Six times every second. } qType := ORD(vType); vblPhase := 0; END; { WITH } ignore := VInstall(@myVBLRec.MyVBL); END; { ELSE } END; { InstallVBLTask } PROCEDURE RemoveVBLTask; VAR ignore: INTEGER; BEGIN IF acurHdl <> NIL THEN ignore := VRemove(@myVBLRec.MyVBL); acurHdl := NIL; { Mark as gone. } { CURSor reset later by “HandleCursor”.} Sleep := 1; { ... so above happens under MultiFinder. } stillColorCrsr := FALSE; { See “HandleCursor”. } END; { RemoveVBLTask } { ===================================================== } { Returns vertical movement in High word and horizontal } { movement in low word, similar to _GrowWindow. } { } { Note the input Point is in GLOBAL coordinates. } { Otherwise, dragging a window will return 0 movement. } { ===================================================== } FUNCTION GetMouseMovement (gMouse0: Point): Size; VAR mouseLoc: Point; mouseDH, mouseDV: INTEGER; sizeMove: Size; BEGIN GetMouse(mouseLoc); LocalToGlobal(mouseLoc); mouseDH := mouseLoc.h - gMouse0.h; mouseDV := mouseLoc.v - gMouse0.v; IF mouseDH < 0 THEN { Abs vals } mouseDH := -mouseDH; IF mouseDV < 0 THEN mouseDV := -mouseDV; sizeMove := mouseDV; sizeMove := BSL(sizeMove, 16); sizeMove := sizeMove + mouseDH; GetMouseMovement := sizeMove; END; { GetMouseMovement } { ================================= } { Note that the algorithm I used } { returns FALSE if we are dragging. } { ================================= } FUNCTION DoubleClick: BOOLEAN; VAR startTime, endTime, doubleTime: LONGINT; mouseLoc0: Point; sizeMove: Size; BEGIN { DoubleClick } DoubleClick := FALSE; {Assume Nada!!} doubleTime := GetDblTime; startTime := TickCount; { Initial time. } endTime := startTime; GetMouse(mouseLoc0); { Initial mouse location. } LocalToGlobal(mouseLoc0); WHILE StillDown & ((endTime - startTime) <= doubleTime) DO { 1st mouse click. } endTime := TickCount; { Times out if dragging ... } sizeMove := GetMouseMovement(mouseLoc0); WHILE ((endTime - startTime) <= doubleTime) & (LoWord(sizeMove) <= 5) & (HiWord(sizeMove) <= 5) DO BEGIN IF Button THEN BEGIN DoubleClick := TRUE; { 2nd time’s a charm !! } Leave; END; { IF Button } endTime := TickCount; sizeMove := GetMouseMovement(mouseLoc0); END; { WHILE small delta Time AND small delta movement} END; { DoubleClick } END. { UNIT = rotMiscSubs } Listing: OffscreenSubs.p { -------------------------------------------------------------------------- } { From: Apple MacDTS } { } { Some of “Skippy White’s Famous High } { Level Off-Screen Map Routines” } { } { These routines provide a high-level } { interface to the QuickDraw & Color } { Manager routines which allow the } { creation and manipulation of } { off-screen bitmaps and pixmaps. They } { are designed to run on any machine } { with 128K or later ROMs. } { } { NOTE that I’ve modified some of } { Skippy’s routines and, therefore, any } { resultant errors in syntax or logic } { belong solely to me. } { -------------------------------------------------------------------------- } UNIT OffscreenSubs; INTERFACE USES rotInterface, rotGlobals, rotMiscSubs; FUNCTION GetMaxAreaDevice (globalRect: Rect): GDHandle; FUNCTION CreateOffScreen (VAR myRect: Rect): OSErr; PROCEDURE ToOnScreen; PROCEDURE DisposOffScreen; IMPLEMENTATION { ********** } FUNCTION GetMaxAreaDevice (globalRect: Rect): GDHandle; { Find largest overlap device for given global rectangle. } VAR area: LONGINT; maxArea: LONGINT; device: GDHandle; intersection: Rect; BEGIN GetMaxAreaDevice := NIL; maxArea := 0; device := GetDeviceList; WHILE device <> NIL DO BEGIN IF TestDeviceAttribute(device, screenDevice) THEN IF TestDeviceAttribute(device, screenActive) THEN IF SectRect(globalRect, device^^.gdRect, intersection) THEN BEGIN WITH intersection DO area := LONGINT(right - left) * LONGINT(bottom - top); IF area > maxArea THEN BEGIN GetMaxAreaDevice := device; maxArea := area; END; { IF area > maxArea } END; { IF SectRect ... } device := GetNextDevice(device); END; { WHILE device <> NIL } END; { GetMaxAreaDevice } { ************************************* } { For scrolling & other nifty stuff ... } { ************************************* } FUNCTION CreateOffScreen (VAR myRect: Rect): OSErr; { Reference: Tech Note #120 } { with special thanks to Jon Zap of MacDTS } { NOTE: Local window coords are input but local screen } { coordinates are returned for drawing purposes. } VAR offRowBytes: LONGINT; sizeOfOff: LONGINT; localRect, globRect: Rect; i, maxDepth: INTEGER; err: OSErr; PROCEDURE ErrorOut (error: OSErr); BEGIN CreateOffScreen := error; EXIT(CreateOffScreen); END; { ErrorOut } BEGIN { CreateOffScreen } CreateOffScreen := noErr; globRect := myRect; { We’re about to switch the Port to off-screen: } LocalGlobal(globRect); IF colorDepth = 1 THEN BEGIN offGrafPtr := @offGrafPort; OpenPort(offGrafPtr); maxDepth := 1; END { IF colorDepth = 1 } ELSE BEGIN myMaxDevice := GetMaxAreaDevice(globRect); IF myMaxDevice = NIL THEN ErrorOut(MaxDevError); oldDevice := GetGDevice; SetGDevice(myMaxDevice); offCGrafPtr := @offCGrafPort; { Initialize this guy. } OpenCPort(offCGrafPtr); maxDepth := offCGrafPtr^.portPixMap^^.pixelSize; END; { ELSE: colorDepth > 1 } { Before we do ANYthing more, we set the off-screen’s } { visRgn to the FULL size of the input rect so the } { image stays whole if the window has been dragged } { partly beyond the physical edge(s) of the screen. } { Otherwise, the visRgn^^.rgnBBox in local coordinates } { remains equal to screenBits.bounds as inited when } { _Open(C)Port was called: } IF colorDepth > 1 THEN RectRgn(offCGrafPort.visRgn, globRect) ELSE RectRgn(offGrafPort.visRgn, globRect); localRect := globRect; GlobalLocal(localRect); WITH localRect DO BEGIN offRowBytes := (maxDepth * (right - left) + 15) DIV 16; { # of words. } IF ODD(offRowBytes) THEN {Made even.} offRowBytes := offRowBytes + 1; offRowBytes := offRowBytes * 2; { Back to bytes. } sizeOfOff := LONGINT(bottom - top) * offRowBytes; END; { WITH } myBits := NewClearPtr(sizeOfOff); { Allocate space for the pixel image.} IF MemError <> noErr THEN ErrorOut(NewPtrError); { NOTE that we’re filling in the BitMap/PixMap fields of } { the new Port directly, so we do NOT call _ SetPortBits } { or _SetCPortPix later: } IF colorDepth > 1 THEN BEGIN WITH offCGrafPtr^.portPixMap^^ DO BEGIN baseAddr := myBits; rowBytes := offRowBytes + $8000; { Be a PixMap. } bounds := localRect; END; { WITH } offBitMapPtr := BitMapPtr(offCGrafPtr^.portPixMap^); END { IF colorDepth > 1 } ELSE { “Yucky” black-and-white. } BEGIN WITH offGrafPtr^.portBits DO BEGIN baseAddr := myBits; rowBytes := offRowBytes; bounds := localRect; END; offBitMapPtr := @offGrafPtr^.portBits; END; IF colorDepth > 1 THEN BEGIN { Next, we clone the color table of the maxDevice } { and put it into our off-screen pixel map. } ourCTHandle := myMaxDevice^^.gdPMap^^.pmTable; err := HandToHand(Handle(ourCTHandle)); IF err <> noErr THEN ErrorOut(CloneHdlError); FOR i := 0 TO ourCTHandle^^.ctSize DO ourCTHandle^^.ctTable[i].value := i; { The following is required to convert } { GDevice cluts to Pixmap cluts. } ourCTHandle^^.ctFlags:= BAND(ourCTHandle^^.ctFlags, $7FFF); ourCTHandle^^.ctSeed := GetCTSeed; offCGrafPtr^.portPixMap^^.pmTable := ourCTHandle; { --> the off-screen map. } END; { IF colorDepth > 1 } myRect := localRect; { Return local screen coordinates.} END; { CreateOffScreen } { ******************* } { Back to “Square 1”: } { ******************* } PROCEDURE ToOnScreen; BEGIN IF colorDepth > 1 THEN BEGIN GetCWMgrPort(onCScreen); SetPort(GrafPtr(onCScreen)); SetGDevice(oldDevice); onScreenBitsPtr := BitMapPtr(onCScreen^.portPixMap^); END { IF colorDepth > 1 } ELSE BEGIN GetWMgrPort(onBWScreen); SetPort(onBWScreen); onScreenBitsPtr := @onBWScreen^.portBits; END; { ELSE = “Yucky” black-and-white } END; { ToOnScreen} { **************************** } { Out with the new. } { Whoops -- I meant the old !! } { **************************** } PROCEDURE DisposOffScreen; LABEL 100, 200; BEGIN IF CreateOffScreenError = MaxDevError THEN EXIT(DisposOffScreen) ELSE IF CreateOffScreenError = NewPtrError THEN GOTO 200 ELSE IF CreateOffScreenError = CloneHdlError THEN GOTO 100; { noErr ... } IF colorDepth > 1 THEN DisposHandle(Handle(ourCTHandle)); 100: DisposPtr(myBits); 200: IF colorDepth > 1 THEN CloseCPort(offCGrafPtr) ELSE ClosePort(offGrafPtr); END; { DisposOffScreen } END. { UNIT = OffscreenSubs }
Continued in next frame | ||
Volume Number: | 6 | |
Issue Number: | 11 | |
Column Tag: | Color Workshop |
Related Info: Color Quickdraw Memory Manager
Spiffy Color Demo (code)
By John A. Love, III, Springfield, VA
Listing: rotScrollSubs.p UNIT rotScrollSubs; { Thanks, Dan Weston !!!!! } INTERFACE USES Palettes, rotGlobals, rotMiscSubs, OffScreenSubs; PROCEDURE ScrollText (myText: QDPtr; box: Rect); PROCEDURE Scroll (ctl: ControlHandle; part: INTEGER; Pt: Point); FUNCTION DrawMyControl (ctl: ControlHandle): BOOLEAN; FUNCTION ScrollHoriz (windPtr: WindowPtr): ControlHandle; FUNCTION ScrollVert (windPtr: WindowPtr): ControlHandle; PROCEDURE ScrollShow (windPtr: WindowPtr); PROCEDURE ScrollHide (windPtr: WindowPtr); PROCEDURE InvalidScroll (windPtr: WindowPtr); PROCEDURE ValidScroll (windPtr: WindowPtr); PROCEDURE ScrollResize (windPtr: WindowPtr); PROCEDURE SetMaxCtls (windPtr: WindowPtr); PROCEDURE SetCtlsToMin (windPtr: WindowPtr); VAR window: WindowPtr; VertOrHoriz: LONGINT; oldCtlValue: INTEGER; stillThere: INTEGER; temp: Rect; IMPLEMENTATION { ---------------------------------------------------------------------------------------- } { Scrolls your text string from right to left. } { ---------------------------------------------------------------------------------------- } PROCEDURE ScrollText (myText: QDPtr; box: Rect); LABEL 100, 200, 300, 400, 500, 600; VAR myPort: GrafPtr; buffer: ARRAY[0..255] OF SignedByte; textBuf: QDPtr; boxWidth: INTEGER; leftJustify: BOOLEAN; x0, y0: INTEGER; widthSpace: INTEGER; textLen: SignedByte; bufWidth: INTEGER; firstChar: INTEGER; lastChar: INTEGER; charCount: INTEGER; finalTicks: LONGINT; BEGIN GetPort(myPort); ClipRect(myPort^.portRect); textLen := myText^; IF textLen = 0 THEN { Null string. } EXIT(ScrollText); textBuf := QDPtr(ORD4(@buffer)); { Include the length byte. } textLen := SignedByte(ORD(textLen) + 1); BlockMove(Ptr(myText), Ptr(textBuf), size(textLen)); ; buffer[0] := textLen; { textLen = textLen + 1 from above.} { Add a trailing space. } buffer[ORD(textLen)] := SignedByte(SP); widthSpace := CharWidth(SP); WITH box DO BEGIN boxWidth := right - left; y0 := bottom - top; IF y0 < 10 THEN { NOT tall enough !! } EXIT(ScrollText); y0 := (y0 - 6) DIV 2; y0 := bottom - y0; { y0 = bottom - 7 for box.tall=20 } END; leftJustify := FALSE; { Assume right-justified text. } ; firstChar := 1; { Start AFTER length byte. } lastChar := 1; charCount := 1; { Scroll the text: } 100: bufWidth := TextWidth(textBuf, firstChar, charCount); IF bufWidth > boxWidth THEN { Text does NOT fit !! } BEGIN firstChar := firstChar + 1; { Drop 1st character and } charCount := charCount - 1; { try for fit again. } leftJustify := TRUE; GOTO 100; END; { IF bufWidth > boxWidth } { it Fits } 200: EraseRect(box); x0 := box.right - bufWidth; IF x0 < box.left THEN { Needed ONLY for very short strings. } leftJustify := TRUE; IF leftJustify THEN x0 := box.left; { y0 := box.bottom - 7; } MoveTo(x0, y0); DrawText(textBuf, firstChar, charCount); lastChar := lastChar + 1; IF lastChar <= ORD(textLen) THEN { Haven’t reached end of string. } GOTO 400; IF leftJustify THEN { We’ve reached the left edge. } GOTO 300; { Not to left edge yet. } bufWidth := bufWidth + widthSpace; Delay(10, finalTicks); { ... otherwise too quick. } GOTO 200; { At left edge. } 300: firstChar := firstChar + 1; charCount := charCount - 1; IF charCount = 0 THEN { All characters moved left. } GOTO 600; { Fini !! } GOTO 500; { Next character. } 400: charCount := charCount + 1; { Bump the length. } 500: Delay(10, finalTicks); { ... otherwise too quick. } GOTO 100; { Scroll again. } { Fini!! } 600: ValidRect(box); { No Updates, please } END; { ScrollText } { -------------------------------------------------------- } { Scroll PICTure displayed in } { the window’s content region: } { -------------------------------------------------------- } PROCEDURE ScrollContents (ctl: ControlHandle; dh, dv: INTEGER); VAR oldClip: RgnHandle; myPic: PicHandle; gWindPICTrect, kWindPICTrect, oldScrolledRect, newScrolledRect: Rect; BEGIN { GetPort(oldPort); -- we KNOW it’s the passed window. } { window := ctl^^.contrlOwner; } oldClip := NewRgn; GetClip(oldClip); myPic := PicHandle(WindowPeek(window)^.refCon); gWindPICTrect := windPICTrect; LocalGlobal(gWindPICTrect); oldScrolledRect := scrolledFullPICTrect; CreateOffScreenError := CreateOffScreen(oldScrolledRect); kWindPICTrect := gWindPICTrect; WITH screenBits.bounds DO { See “DoRotate”. } OffsetRect(kWindPICTrect, left, top); IF CreateOffScreenError = noErr THEN BEGIN ClipRect(oldScrolledRect); { Same ole stuff ... } EraseRect(oldScrolledRect); DrawPicture(myPic, oldScrolledRect); ; ToOnScreen; ; { Scrolling up & down the avenue. } newScrolledRect := oldScrolledRect; OffsetRect(newScrolledRect, dh, dv); OffsetRect(scrolledFullPICTrect, dh, dv); { ... for next time. } ; BackColor(whiteColor); ForeColor(blackColor); ClipRect(kWindPICTrect); EraseRect(kWindPICTrect); { Erase old image. } CopyBits(offBitMapPtr^, onScreenBitsPtr^, oldScrolledRect, newScrolledRect, srcCopy, NIL); END; { IF CreateOffScreenError = noErr } DisposOffScreen; SetPort(window); { Re-group ... } SetClip(oldClip); ValidRect(windPICTrect); { NO updates please !! } DisposeRgn(oldClip); END; { ScrollContents } { ------------------------------------------------------------------------------------------------------------ } { Mouse clicked on the line arrows: } { } { NOTE: As a matter of academic principle, avoid speed } { penalities associated with TRAP overhead if possible. } { ------------------------------------------------------------------------------------------------------------ } PROCEDURE UpActionProc (ctl: ControlHandle; part: INTEGER); VAR newCtlValue: INTEGER; { # of lines } dv, dh, difference: INTEGER; { # of pixels } BEGIN IF part = 0 THEN { Mouse moved OUTSIDE the Control !! } EXIT(UpActionProc); oldCtlValue := ctl^^.contrlValue; dv := 12; {Vertical, NOT sideways !!} dh := 0; difference := (oldCtlValue - ctl^^.contrlMin) * 12; IF difference = 0 THEN { Prevent flickering. } EXIT(UpActionProc); IF difference < dv THEN dv := difference; { Decrement one line’s worth. } newCtlValue := oldCtlValue - 1; temp := ctl^^.contrlRect; { Just because SetCtlValue is buggy for a Mac II set to } { black-and-white. Set to color, it works okay, though? } InsetRect(temp, 1, 1); ClipRect(temp); SetCtlValue(ctl, newCtlValue); ClipRect(window^.portRect); { Reset. } IF VertOrHoriz = horizScrollID THEN BEGIN dh := dv; {Sideways, NOT vertical !} dv := 0; END; { IF } ScrollContents(ctl, dh, dv); Delay(8, finalTicks); { ... otherwise too fast. } END; { UpActionProc } { ------------------------------------------------------------------ } { Mouse clicked on the line arrows: } { ------------------------------------------------------------------ } PROCEDURE DownActionProc (ctl: ControlHandle; part: INTEGER); VAR newCtlValue: INTEGER; dv, dh, difference: INTEGER; BEGIN IF part = 0 THEN { Mouse moved OUTSIDE the Control !! } EXIT(DownActionProc); oldCtlValue := ctl^^.contrlValue; dv := 12; {Vertical, NOT sideways !} dh := 0; difference := (ctl^^.contrlMax - oldCtlValue) * 12; IF difference = 0 THEN { Prevent flickering. } EXIT(DownActionProc); IF difference < dv THEN dv := difference; { Bump it one line’s worth. } newCtlValue := oldCtlValue + 1; temp := ctl^^.contrlRect; InsetRect(temp, 1, 1); ClipRect(temp); SetCtlValue(ctl, newCtlValue); ClipRect(window^.portRect); { Reset. } IF VertOrHoriz = horizScrollID THEN BEGIN dh := dv; {Sideways, NOT vertical !} dv := 0; END; { IF } ScrollContents(ctl, -dh, -dv); Delay(8, finalTicks); END; { DownActionProc } { ------------------------------------------------------ } { Our main Scrolling routine: } { ------------------------------------------------------ } PROCEDURE Scroll (ctl: ControlHandle; part: INTEGER; Pt: Point); { ------------------------------------------------------------------ } { Scroll contents of window to } { match pre-set Scroll Bar setting: } { ------------------------------------------------------------------ } PROCEDURE ScrollToThumbPosition (ctl: ControlHandle); VAR newCtlValue, dh, dv: INTEGER; BEGIN dh := 0; dv := 0; newCtlValue := ctl^^.contrlValue; IF VertOrHoriz = horizScrollID THEN dh := -(newCtlValue - oldCtlValue) * 12 { Normally, * teLineHite } ELSE { = vertScrollID } dv := -(newCtlValue - oldCtlValue) * 12; ScrollContents(ctl, dh, dv); Delay(8, finalTicks); END; { ScrollToThumbPosition } { ---------------------------------------------------------------------------------------------- } { Thumb goes UP; text, PICTure etc. scrolls DOWN: } { ---------------------------------------------------------------------------------------------- } PROCEDURE DoPageUp (ctl: ControlHandle); VAR partControl, newCtlValue, dv, ctlDelta: INTEGER; newPoint: Point; BEGIN WITH window^.portRect DO BEGIN IF VertOrHoriz = horizScrollID THEN dv := right - left - growBoxSize; { = (right+1-left) - scrollWidth } IF VertOrHoriz = vertScrollID THEN dv := bottom - top - growBoxSize; { = (bottom+1-top) - scrollHeight } END; { WITH window^.portRect } ctlDelta := dv; { Normally divide by teLineHite, a field of TERecord whose } { Handle is usually stored in wRefCon field of WindowRecord: } ctlDelta := (ctlDelta DIV 12) - 1; { Leave 1 line } WHILE StillDown DO BEGIN GetMouse(newPoint); partControl := TestControl(ctl, newPoint); IF partControl = inPageUp THEN { Still INSIDE Control ... } BEGIN oldCtlValue := ctl^^.contrlValue; newCtlValue := oldCtlValue - ctlDelta; temp := ctl^^.contrlRect; InsetRect(temp, 1, 1); ClipRect(temp); { Compensates if newCtlValue overshoots ctlMin. } SetCtlValue(ctl, newCtlValue); ClipRect(window^.portRect); ScrollToThumbPosition(ctl); END; { IF partControl = inPageUp } END; { WHILE StillDown } END; { DoPageUp } { ---------------------------------------------------------------------------------------------- } { Thumb goes DOWN; text, PICTure etc. scrolls UP: } { ---------------------------------------------------------------------------------------------- } PROCEDURE DoPageDown (ctl: ControlHandle); VAR partControl, newCtlValue, dv, ctlDelta: INTEGER; newPoint: Point; BEGIN WITH window^.portRect DO BEGIN IF VertOrHoriz = horizScrollID THEN dv := right - left - growBoxSize ELSE { = vertScrollID } dv := bottom - top - growBoxSize; END; { WITH window^.portRect } ctlDelta := (dv DIV 12) - 1; WHILE StillDown DO BEGIN GetMouse(newPoint); partControl := TestControl(ctl, newPoint); IF partControl = inPageDown THEN { Still INSIDE Control ... } BEGIN oldCtlValue := ctl^^.contrlValue; newCtlValue := oldCtlValue + ctlDelta; temp := ctl^^.contrlRect; InsetRect(temp, 1, 1); ClipRect(temp); { Compensates if newCtlValue overshoots ctlMax. } SetCtlValue(ctl, newCtlValue); ClipRect(window^.portRect); ScrollToThumbPosition(ctl); END; { IF partControl = inPageDown } END; { WHILE StillDown } END; { DoPageDown } BEGIN { Scroll } window := ctl^^.contrlOwner; SetPort(window); VertOrHoriz := ctl^^.contrlRFcon; {Up/Down or sideways??} oldCtlValue := GetCtlValue(ctl); CASE part OF inUpButton: stillThere := TrackControl(ctl, Pt, @UpActionProc); inDownButton: stillThere := TrackControl(ctl, Pt, @DownActionProc); inPageUp: DoPageUp(ctl); inPageDown: DoPageDown(ctl); inThumb: BEGIN temp := ctl^^.contrlRect; InsetRect(temp, 1, 1); ClipRect(temp); IF TrackControl(ctl, Pt, NIL) <> 0 THEN ScrollToThumbPosition(ctl); ClipRect(window^.portRect); { Reset. } END; { InThumb } OTHERWISE BEGIN END; { OTHERWISE } END; { CASE } END; { Scroll } ------------------------------------------------------ } { Does she or doesn’t she ?? } { ---------------------------------------------------- } FUNCTION DrawMyControl (ctl: ControlHandle): BOOLEAN; BEGIN IF (ctl <> NIL) & (ctl^^.contrlMax > ctl^^.contrlMin) THEN DrawMyControl := TRUE ELSE DrawMyControl := FALSE; END; { DrawMyControl } { ---------------------------------------------------------------- } { Retrieve Control Handle, if any: } { ---------------------------------------------------------------- } FUNCTION ScrollHoriz (windPtr: WindowPtr): ControlHandle; VAR ourControl: ControlHandle; BEGIN ourControl := WindowPeek(windPtr)^.controlList; WHILE ourControl <> NIL DO BEGIN IF ourControl^^.contrlRFcon = horizScrollID THEN LEAVE; ourControl := ourControl^^.nextControl; END; { WHILE ourControl <> NIL } ScrollHoriz := ourControl; END; { ScrollHoriz } FUNCTION ScrollVert (windPtr: WindowPtr): ControlHandle; VAR ourControl: ControlHandle; BEGIN ourControl := WindowPeek(windPtr)^.controlList; WHILE ourControl <> NIL DO BEGIN IF ourControl^^.contrlRFcon = vertScrollID THEN LEAVE; ourControl := ourControl^^.nextControl; END; { WHILE } ScrollVert := ourControl; END; { ScrollVert } { ------------------------------------ } { Hello, or GoodBye: } { ------------------------------------ } PROCEDURE ScrollShow (windPtr: WindowPtr); VAR ctlHndl: ControlHandle; BEGIN ctlHndl := ScrollVert(windPtr); IF DrawMyControl(ctlHndl) THEN {Tests for NIL ctlHndl.} ShowControl(ctlHndl); { ---------- } ctlHndl := ScrollHoriz(windPtr); ; IF DrawMyControl(ctlHndl) THEN ShowControl(ctlHndl); END; { ScrollShow } PROCEDURE ScrollHide (windPtr: WindowPtr); VAR ctlHndl: ControlHandle; BEGIN ctlHndl := ScrollVert(windPtr); IF DrawMyControl(ctlHndl) THEN HideControl(ctlHndl); { ---------- } ctlHndl := ScrollHoriz(windPtr); ; IF DrawMyControl(ctlHndl) THEN HideControl(ctlHndl); END; { ScrollHide } { ---------------------------------------------------------------------------------------------------- } { Explicitly include the Scroll Bars in the window’s } { Update region. This Update region will purposely } { overlap the Grow Box. } { ---------------------------------------------------------------------------------------------------- } PROCEDURE InvalidScroll (windPtr: WindowPtr); VAR updateRect: rect; BEGIN IF DrawMyControl(ScrollVert(windPtr)) THEN BEGIN updateRect := windPtr^.portRect; InsetRect(updateRect, -1, -1); { Include window frame. } updateRect.left := updateRect.right - scrollWidth; InvalRect(updateRect); END; { IF } IF DrawMyControl(ScrollHoriz(windPtr)) THEN BEGIN updateRect := windPtr^.portRect; InsetRect(updateRect, -1, -1); updateRect.top := updateRect.bottom - scrollHeight; InvalRect(updateRect); END; { IF } END; { InvalidScroll } PROCEDURE ValidScroll (windPtr: WindowPtr); VAR updateRect: rect; BEGIN IF DrawMyControl(ScrollVert(windPtr)) THEN BEGIN updateRect := windPtr^.portRect; InsetRect(updateRect, -1, -1); updateRect.left := updateRect.right - scrollWidth; ValidRect(updateRect); END; { IF } IF DrawMyControl(ScrollHoriz(windPtr)) THEN BEGIN updateRect := windPtr^.portRect; InsetRect(updateRect, -1, -1); updateRect.top := updateRect.bottom - scrollHeight; ValidRect(updateRect); END; { IF } END; { ValidScroll } PROCEDURE ScrollResize (windPtr: WindowPtr); VAR contentRect: Rect; ctlHndl: ControlHandle; ctlWidth, ctlHeight, ctlTop, ctlLeft: INTEGER; BEGIN contentRect := windPtr^.portRect; { Remember, the portRect does NOT include the window frame, } { whereas the Scroll Bar and Grow Box sizes do: } InsetRect(contentRect, -1, -1); ClipRect(contentRect); { Sigh !! } ScrollHide(windPtr); { Hide-and-Go Seek !! } ctlHndl := ScrollVert(windPtr); IF ctlHndl <> NIL THEN BEGIN WITH contentRect DO BEGIN ctlHeight := bottom - top - growBoxSize; ctlTop := top; ctlLeft := right - scrollWidth; END; { WITH contentRect } SizeControl(ctlHndl, scrollWidth, ctlHeight); MoveControl(ctlHndl, ctlLeft, ctlTop); END; { IF ctlHndl <> NIL } { ---------- } ctlHndl := ScrollHoriz(windPtr); IF ctlHndl <> NIL THEN BEGIN WITH contentRect DO BEGIN ctlWidth := right - left - growBoxSize; ctlTop := bottom - scrollHeight; ctlLeft := left; END; { WITH contentRect } SizeControl(ctlHndl, ctlWidth, scrollHeight); MoveControl(ctlHndl, ctlLeft, ctlTop); END; { IF ctlHndl <> NIL } ScrollShow(windPtr);{ Peek-a-Boo !! } ValidScroll(windPtr); ClipRect(windPtr^.portRect); { Reset. } END; { ScrollResize } { -------------------------------------------------------------------------------------------------------------- } { Set ONLY the maximum value(s) because the attached CNTL } { resources(s) specify the minimum -- generally zero. } { -------------------------------------------------------------------------------------------------------------- } PROCEDURE SetMaxCtls (windPtr: WindowPtr); VAR oldClip: RgnHandle; ctlHndl: ControlHandle; dest, view: INTEGER; PROCEDURE SetMaxCtlValue (ctl: ControlHandle; excess: INTEGER); VAR maxValue: INTEGER; temp: Rect; BEGIN IF excess <= 0 THEN maxValue := ctl^^.contrlMin { Inactivates Control since max = min. } ELSE { PICTure taller than window } maxValue := (excess + 11) DIV 12; { ... by this much [rounded up]. } IF maxValue <> ctl^^.contrlMax THEN BEGIN temp := ctl^^.contrlRect; InsetRect(temp, 1, 1); ClipRect(temp); SetCtlMax(ctl, maxValue); END; END; { SetMaxCtlValue } BEGIN { SetMaxCtls } oldClip := NewRgn; GetClip(oldClip); ctlHndl := ScrollVert(windPtr); IF ctlHndl <> NIL THEN BEGIN WITH windPICTrect DO { from my GetPicRects Proc. } view := bottom - top; WITH fullPICTrect DO { Ditto. } dest := bottom - top; SetMaxCtlValue(ctlHndl, dest - view); END; { IF ctlHndl <> NIL } { ---------- } ctlHndl := ScrollHoriz(windPtr); IF ctlHndl <> NIL THEN BEGIN WITH windPICTrect DO view := right - left; WITH fullPICTrect DO dest := right - left; SetMaxCtlValue(ctlHndl, dest - view); END; { IF ctlHndl <> NIL } SetClip(oldClip); DisposeRgn(oldClip); END; { SetMaxCtls } { -------------------------------------------------------------------- } { Called by the “HandleMouse” PROC: } { -------------------------------------------------------------------- } PROCEDURE SetCtlsToMin (windPtr: WindowPtr); VAR oldClip: RgnHandle; PROCEDURE SetCtlValueToMin (ctl: ControlHandle); VAR temp: Rect; BEGIN IF ctl = NIL THEN EXIT(SetCtlValueToMin); temp := ctl^^.contrlRect; InsetRect(temp, 1, 1); {See comments in “UpActionProc”.} ClipRect(temp); SetCtlValue(ctl, GetCtlMin(ctl)); END; { SetCtlValueToMin } BEGIN { SetCtlsToMin } oldClip := NewRgn; GetClip(oldClip); ; SetCtlValueToMin(ScrollHoriz(windPtr)); SetCtlValueToMin(ScrollVert(windPtr)); ; SetClip(oldClip); DisposeRgn(oldClip); END; { SetCtlsToMin } END. { UNIT = rotScrollSubs }
Listing: rotWindowSubs.p UNIT rotWindowSubs; INTERFACE USES Palettes, rotInterface, rotGlobals, rotMiscSubs, rotScrollSubs; FUNCTION GetWindowPartColor (window: WindowPtr; part: INTEGER; VAR color: RGBColor): BOOLEAN; PROCEDURE SetWindowPalette (wPtr: WindowPtr; plttID: INTEGER); PROCEDURE CalcWindowFrame (window: WindowPtr; VAR r: Rect); PROCEDURE DisplayWindow (window: WindowPtr); PROCEDURE CloseOurWindow (wPtr: WindowPtr); PROCEDURE DoCloseAll; PROCEDURE ZoomRect (sourceR, destR: Rect); IMPLEMENTATION { ---------------------------------------- } { Finder’s keepers ... } { ---------------------------------------- } FUNCTION GetWindowPartColor (window: WindowPtr; part: INTEGER; VAR color: RGBColor): BOOLEAN; VAR auxWindowHdl: AuxWinHndl; windowCTab: CTabHandle; BEGIN { Assume NADA !! } GetWindowPartColor := FALSE; IF GetAuxWin(window, auxWindowHdl) THEN BEGIN windowCTab := auxWindowHdl^^.awCTable; IF (part < 0) | (part > windowCTab^^.ctSize) THEN { Color me paranoid !! } EXIT(GetWindowPartColor); color := windowCTab^^.ctTable[part].rgb; GetWindowPartColor := TRUE; END; { IF window has a AuxWinRec } END; { GetWindowPartColor } { ---------------------------------------------- } { ... in living Color !! } { ---------------------------------------------- } PROCEDURE SetWindowPalette (wPtr: WindowPtr; plttID: INTEGER); VAR pal: PaletteHandle; BEGIN IF NOT aMac2 THEN EXIT(SetWindowPalette); pal := GetNewPalette(plttID); IF Handle(pal) <> NIL THEN BEGIN SetPalette(wPtr, pal, TRUE); ActivatePalette(wPtr); END; { IF Handle(pal) <> NIL } END; { SetWindowPalette } { ------------------------------------------------------------------------ } { CanNOT use the “structRgn” field of } { window since this region hdl will be } { NIL if the window is NOT visible. } { ------------------------------------------------------------------------ } PROCEDURE CalcWindowFrame (window: WindowPtr; VAR r: Rect); CONST frame = 1; shadow = 1; title = 18; VAR windDef: INTEGER; BEGIN windDef := GetWVariant(window); r := window^.portRect; InsetRect(r, -frame, -frame); IF (windDef = 0) OR (windDef > 3) THEN r.top := r.top - title; { Window has a title bar. } IF (windDef = documentProc) OR (windDef = altDBoxProc) OR (windDef = noGrowDocProc) OR (windDef = zoomDocProc) THEN BEGIN r.bottom := r.bottom + shadow; r.right := r.right + shadow; END; { Window has a shadow frame. } END; { CalcWindowFrame } { ---------------------------------------------------- } { Before showing the window, } { center it on the screen. } { ---------------------------------------------------- } PROCEDURE DisplayWindow (window: WindowPtr); CONST frame = 1; { shadow = 1; - considered within CalcWindowFrame PROC } title = 18; VAR wFrameRect: rect; temp: INTEGER; Pt: Point; BEGIN CalcWindowFrame(window, wFrameRect); ; windDef := GetWVariant(window); { In DoActivate, also. } WITH screen DO temp := bottom - top; WITH wFrameRect DO temp := temp - (bottom - top); { screen ht - window ht } { temp := temp + mBarHt; -- NO!! because } { screen based on GrayRgn, NOT screenBits. } temp := temp DIV 2; temp := temp + frame; IF (windDef = 0) OR (windDef > 3) THEN temp := temp + title; { Window has a title bar. } Pt.v := screen.top + temp; { ---------- } WITH screen DO temp := right - left; WITH wFrameRect DO temp := temp - (right - left); { screen - window width } Pt.h := screen.left + temp DIV 2; MoveWindow(window, Pt.h, Pt.v, TRUE); ShowWindow(window); ScrollResize(window); END; { DisplayWindow } { ---------------------------------------------- } { One at a time, folks !! } { ---------------------------------------------- } PROCEDURE CloseOurWindow (wPtr: WindowPtr); VAR myPic: PicHandle; pal: PaletteHandle; aux: BOOLEAN; auxWind: AuxWinHndl; BEGIN IF aMac2 THEN BEGIN pal := GetPalette(wPtr); IF pal <> NIL THEN DisposePalette(pal); aux := GetAuxWin(wPtr, auxWind); IF aux THEN ReleaseResource(Handle(auxWind)); END; { IF aMac2 } myPic := GetWindowPic(wPtr); IF myPic <> NIL THEN BEGIN HUnlock(Handle(myPic)); ReleaseResource(Handle(myPic)); END; { IF myPic <> NIL } horizControl := ScrollHoriz(wPtr); IF horizControl <> NIL THEN { Calls ReleaseResource(Handle(AuxCtlHndl)); } DisposeControl(horizControl); { -------- } vertControl := ScrollVert(wPtr); IF vertControl <> NIL THEN DisposeControl(vertControl); { -------- } DisposeWindow(wPtr); END; { CloseOurWindow } { -------------------------------------------------------------------------------------------------------- } { DoCloseAll is called from the “Quit” command on the } { main Menu, and when we close our main window. } { -------------------------------------------------------------------------------------------------------- } PROCEDURE DoCloseAll; VAR window: WindowPeek; BEGIN window := WindowPeek(FrontWindow); WHILE window <> NIL DO BEGIN IF window^.windowKind < 0 THEN CloseDeskAcc(window^.windowKind) ELSE CloseOurWindow(WindowPtr(window)); window := window^.nextWindow; END; { WHILE window <> NIL } END; { DoCloseAll } PROCEDURE ZoomRect (sourceR, destR: Rect); {Global coords} CONST DragPatternLoc = $A34; pixPatID = 128; VAR oldPort: GrafPtr; oldWindow: WindowPtr; bigGrafPort: GrafPort; bigGrafPtr: GrafPtr; bigCGrafPort: CGrafPort; bigCGrafPtr: CGrafPtr; union, srcRect, dstRect, box: Rect; increment, delTop, delLeft, delBottom, delRight, i: INTEGER; aux: BOOLEAN; frameColor: RGBColor; bwDragPattern: Pattern; cDragPattern: PixPatHandle; BEGIN IF EqualRect(sourceR, destR) THEN EXIT(ZoomRect); UnionRect(sourceR, destR, union); IF (NOT EqualRect(union, sourceR)) & (NOT EqualRect(union, destR)) THEN EXIT(ZoomRect); { One does NOT enclose the other !! } GetPort(oldPort); oldWindow := FrontWindow; IF (oldWindow <> NIL) & (colorDepth > 1) THEN aux := GetWindowPartColor(oldWindow, wFrameColor, frameColor); IF colorDepth = 1 THEN BEGIN bigGrafPtr := @bigGrafPort; OpenPort(bigGrafPtr); SetPort(bigGrafPtr); END { IF colorDepth = 1 } ELSE BEGIN bigCGrafPtr := @bigCGrafPort; OpenCPort(bigCGrafPtr); SetPort(GrafPtr(bigCGrafPtr)); END; srcRect := sourceR; dstRect := destR; GlobalLocal(srcRect); GlobalLocal(dstRect); increment := 5; delTop := (dstRect.top - srcRect.top) DIV increment; delLeft := (dstRect.left - srcRect.left) DIV increment; delBottom := (dstRect.bottom - srcRect.bottom) DIV increment; delRight := (dstRect.right - srcRect.right) DIV increment; bwDragPattern := PatPtr(DragPatternLoc)^; PenPat(bwDragPattern); { My default state ... } PenMode(patXor); IF colorDepth > 1 THEN { in color } BEGIN cDragPattern := GetPixPat(pixPatID); IF cDragPattern <> NIL THEN BEGIN IF (oldWindow <> NIL) & aux THEN MakeRGBPat(cDragPattern, frameColor); PenPixPat(cDragPattern); END; { IF cDragPattern <> NIL } END; { in color } { Start AWAY from source AND stop short of destination. } box := srcRect; FOR i := 1 TO (increment - 1) DO BEGIN WITH box DO SetRect(box, left + delLeft, top + delTop, right + delRight, bottom + delBottom); FrameRect(box); ; Delay(15, finalTicks); { Hang on, Mac !! } END; { FOR } PenNormal; IF colorDepth > 1 THEN BEGIN CloseCPort(bigCGrafPtr); { Done by _CloseCPort: } { IF cDragPattern <> NIL THEN } { DisposPixPat(cDragPattern); } END ELSE { B&W } ClosePort(bigGrafPtr); SetPort(oldPort); END; { ZoomRect } END. { UNIT = rotWindowSubs } Listing: Rotate.p PROGRAM Rotate; {$I-} USES Palettes, rotInterface, rotGlobals, rotMiscSubs, OffscreenSubs, rotScrollSubs, rotWindowSubs; LABEL 100; { ---------------------------------------------- } { Guess what this does ?? } { ---------------------------------------------- } PROCEDURE HandleCursor; VAR mouse: Point; CURS_Hdl: CursHandle; BEGIN IF daWind OR NOT InForeGround THEN EXIT(HandleCursor); { DAs & other applications roll their own } GetMouse(mouse); IF PtInRect(mouse, FrontWindow^.portRect) THEN BEGIN InWindow := TRUE; ; IF aMac2 THEN BEGIN IF colorHandCrsr <> NIL THEN {Activate Event 1st! } IF NOT stillColorCrsr THEN { ROM problem. } BEGIN SetCCursor(colorHandCrsr); stillColorCrsr := TRUE; END; { IF...IF } END { IF aMac2 } ELSE { NOT aMac2 } InitCursor; END { IF PtInRect(...) } ELSE { NOT PtInRect() } BEGIN InWindow := FALSE; InitCursor; stillColorCrsr:= FALSE END; { ELSE } END; { HandleCursor } { ------------------------------------------ } { To be or not to be !! } { ------------------------------------------ } PROCEDURE SetEnable (menu: MenuHandle; item: INTEGER; enabled: BOOLEAN); BEGIN IF enabled THEN EnableItem(menu, item) ELSE DisableItem(menu, item); END; { SetEnable } { -------------------------------------------------------------------------------------------------------------- } { PeriodicMenus is called before action is taken on menu } { commands to correctly enable or disable the “Edit” Menu } { in case a Desk Accessory owns the front window or no } { window is up, respectively. The latter affects } { individual items in other Menu(s). } {---------------------------------------------------------------------------------------------------------------- } PROCEDURE PeriodicMenus; VAR FW: WindowPeek; BEGIN FW := WindowPeek(FrontWindow); daWind := (FW <> NIL) & (FW^.windowKind < 0); { Used by HandleCursor. } applWind := (FW <> NIL) & (NOT daWind); IF applWind <> currGraphics THEN { No need to repeat yourself !! } BEGIN SetEnable(GraphicsMenu, RotateItem, applWind); SetEnable(GraphicsMenu, DissolveItem, applWind); currGraphics := applWind; { Reset. } END; IF daWind = currEdit THEN { Avoid a flickering Menu Bar. } EXIT(PeriodicMenus); currEdit := daWind; { Reset. } IF daWind THEN { the WHOLE thing !! } EnableItem(EditMenu, 0) ELSE DisableItem(EditMenu, 0); DrawMenuBar; END; { PeriodicMenus } { -------------------- } { Bye-Bye !! } { -------------------- } PROCEDURE DoQuit; BEGIN HUnlock(Handle(monsterPicHdl)); ReleaseResource(Handle(monsterPicHdl)); IF aMac2 & (colorHandCrsr <> NIL) THEN DisposCCursor(colorHandCrsr); DoCloseAll; Done := TRUE; END; { DoQuit } { ---------------- } { Enjoy !! } { ---------------- } PROCEDURE SpiffyRoll; LABEL 100, 200, 300; VAR bragging: WindowPtr; logoPicHdl: PicHandle; bragRect: Rect; tempX, tempY: INTEGER; rollRect: Rect; maskPercent: INTEGER; BEGIN { I get here ONLY when I have a window. } bragging := FrontWindow; IF bragging = NIL THEN { ... but just in case !! } GOTO 300; logoPicHdl := PicHandle(GetWRefCon(bragging)); IF logoPicHdl = NIL THEN GOTO 200; bragRect := bragging^.portRect; WITH bragRect DO BEGIN IF (ScrollVert(bragging) <> NIL) | (ScrollHoriz(bragging) <> NIL) THEN BEGIN right := (right + 1) - scrollWidth; bottom := (bottom + 1) - scrollHeight; END; { IF there are Scroll Bar(s) } tempX := right - left; tempY := bottom - top; END; { WITH bragRect } { Because I know my WINDow & PICT sizes, } { tempX & tempY are always > 0: } WITH logoPicHdl^^.picFrame DO BEGIN tempX := tempX - (right - left); tempY := tempY - (bottom - top); END; { WITH logoPicHdl^^.picFrame } WITH bragRect DO BEGIN top := top + tempY DIV 2; bottom := top + (logoPicHdl^^.picFrame.bottom - logoPicHdl^^.picFrame.top); left := left + tempX DIV 2; right := left + (logoPicHdl^^.picFrame.right - logoPicHdl^^.picFrame.left); END; { WITH bragRect } { ------------------------------------------------ } { Place my PICTure into an } { off screen BitMap. } { ------------------------------------------------ } { Local window coordinates are input; } { local screen coordinates are returned.} CreateOffScreenError := CreateOffScreen(bragRect); IF CreateOffScreenError <> noErr THEN GOTO 100; ClipRect(bragRect); { Draw off-screen. } EraseRect(bragRect); { Eliminate all stray matter. } DrawPicture(logoPicHdl, bragRect); ToOnScreen; { Back to “Square 1”. } BackColor(whiteColor); ForeColor(blackColor); { ---------- } ClipRect(bragRect); rollRect := bragRect; maskPercent := 1; WHILE maskPercent <= 100 DO BEGIN WITH bragRect DO rollRect.bottom := top + ((bottom - top) * maskPercent) DIV 100; CopyBits(offBitMapPtr^, onScreenBitsPtr^, rollRect, rollRect, srcCopy, NIL); IF colorDepth = 1 THEN Delay(10, finalTicks) { Black-and-white too doggone fast !! } ELSE Delay(7, finalTicks); { Color a tad better. } maskPercent := maskPercent + 1; END; { WHILE maskPercent <= 100 } { ---------- } Delay(240, finalTicks); {Take a gander at its beauty !!} 100: DisposOffScreen; HUnlock(Handle(logoPicHdl)); ReleaseResource(Handle(logoPicHdl)); 200: CloseOurWindow(bragging); {Activates window behind it.} 300: RemoveVBLTask; SysBeep(10); { Wake Up Call !! } END; { SpiffyRoll } { -------------------------------------------------------- } { Now for Mike Morton’s spiffy } { dissolve stuff ... } { -------------------------------------------------------- } PROCEDURE SpiffyDissolve; LABEL 100, 200; VAR oldPort: GrafPtr; gigantorPicHdl: picHandle; gigantorRect: Rect; tempX, tempY: INTEGER; offBitMap, onScreenBits: BitMap; BEGIN GetPort(oldPort); IF colorDepth > 1 THEN gigantorPicHdl := GetPicture(colorGigantorID) { They’re SO ugly, they’re cute !! } ELSE gigantorPicHdl := GetPicture(bwGigantorID); IF gigantorPicHdl = NIL THEN GOTO 200; HLock(Handle(gigantorPicHdl)); WITH gigantorPicHdl^^.picFrame DO { First, center the PICTure ... } BEGIN tempX := right - left; tempY := bottom - top; END; WITH oldPort^.portRect DO BEGIN tempX := right - left - tempX; tempX := left + tempX DIV 2; tempY := bottom - top - tempY; tempY := top + tempY DIV 2; END; { I KNOW that the portRect of the attached WINDow is larger } { than the PICT, so I did NOT need to test above for fit. } WITH gigantorRect DO BEGIN top := tempY; left := tempX; bottom := top + gigantorPicHdl^^.picFrame.bottom - gigantorPicHdl^^.picFrame.top; right := left + gigantorPicHdl^^.picFrame.right - gigantorPicHdl^^.picFrame.left; END; { -------------------------------------------------------------------------------------- } { Place my PICTure into an off screen BitMap } { -------------------------------------------------------------------------------------- } CreateOffScreenError := CreateOffScreen(gigantorRect); IF CreateOffScreenError <> noErr THEN GOTO 100; ClipRect(gigantorRect); { Draw off-screen ... } EraseRect(gigantorRect); DrawPicture(gigantorPicHdl, gigantorRect); ToOnScreen; { Then, back to “Square 1” ... } ClipRect(gigantorRect); { So funny colorization doesn’t happen. } BackColor(whiteColor); ForeColor(blackColor); DissBits(offBitMapPtr^, onScreenBitsPtr^, gigantorRect, gigantorRect); { -------------------------------------------------------------- } { Now, wasn’t that neat, folks !! } { -------------------------------------------------------------- } 100: DisposOffScreen; SetPort(oldPort); HUnlock(Handle(gigantorPicHdl)); ReleaseResource(Handle(gigantorPicHdl)); 200: Delay(60, finalTicks); END; { SpiffyDissolve } { -------------------------------------------------------------------------- } { DoApple is the code for the “Apple” } { Menu. The other two Menus follow. } { NOTE: CanNOT use “TheWindow” from the } { FindWindow call in the MainEventLoop } { because TheWindow = NIL for a } { windowLoc = inMenuBar: } { -------------------------------------------------------------------------- } PROCEDURE DoApple (item: INTEGER); CONST MyString = ‘Programming by I•A•C•S Software and John A. Love, III of the Washington Apple Pi Users’ Group’; VAR oldPort: GrafPtr; window, bragging: WindowPtr; logoPicHdl: PicHandle; skipScroll: BOOLEAN; scrollStr: Str255; IACSBuffer: QDPtr; IACSBox: Rect; tempX, tempY: INTEGER; accName: Str255; accNumber: INTEGER; oldForeColor, oldBackColor, contentColor: RGBColor; BEGIN CASE item OF AboutItem: BEGIN IF NOT applWind THEN { NO window. } EXIT(DoApple); skipScroll := FALSE; { Everything's cool !! } window := FrontWindow; { Determine the visible part of the window's } { content region, LESS any Scroll Bar(s): } IACSBox := window^.portRect; { For starters ... } ; WITH IACSBox DO BEGIN IF (ScrollVert(window) <> NIL) | (ScrollHoriz(window) <> NIL) THEN BEGIN right := (right + 1) - scrollWidth; bottom := (bottom + 1) - scrollHeight; END; { IF } END; { WITH IACSBox } ; LocalGlobal(IACSBox); WITH screenBits.bounds DO BEGIN IF IACSBox.top < top THEN IACSBox.top := top; IF IACSBox.left < left THEN IACSBox.left := left; IF IACSBox.bottom > bottom THEN IACSBox.bottom := bottom; IF IACSBox.right > right THEN IACSBox.right := right; END; { WITH screenBits.bounds } GlobalLocal(IACSBox); ; WITH IACSBox DO BEGIN tempX := right - left; tempY := bottom - top; top := top + (tempY - 20) DIV 2; bottom := top + 20; left := left + 10; right := right - 10; END; ; IF (tempX < 40) OR (tempY < 20) THEN skipScroll := TRUE; { NOT wide or tall enough !! } InstallVBLTask(acurWorld); { ========== } IF NOT skipScroll THEN BEGIN scrollStr := MyString; IACSBuffer := QDPtr(ORD4(@scrollStr)); IF colorDepth > 1 THEN BEGIN GetBackColor(oldBackColor); PmBackColor(pmLtGray); GetForeColor(oldForeColor); PmForeColor(pmRed); END; { IF colorDepth > 1 } ScrollText(IACSBuffer, IACSBox); { ********** } IF colorDepth > 1 THEN BEGIN IF GetWindowPartColor(window, wContentColor, contentColor) THEN RGBBackColor(contentColor) ELSE RGBBackColor(oldBackColor); RGBForeColor(oldForeColor); END; { IF colorDepth > 1 } ; EraseRect(IACSBox); { In above background color. } InvalRect(IACSBox); { --> an Update Event. } END; { IF NOT skipScroll } { ========== } bragging := GetNewWindow(logoWindowID, NIL, WindowPtr(-1)); { ////////// } IF bragging <> NIL THEN BEGIN logoPicHdl := GetPicture(logoID); SetWRefCon(bragging, LONGINT(logoPicHdl)); { Save for retrieval in "SpiffyRoll". } IF logoPicHdl <> NIL THEN BEGIN HLock(Handle(logoPicHdl)); ; SetPort(bragging); DisplayWindow(bragging); ; justBragging := TRUE; ValidRect(bragging^.portRect); { ... so we don't draw in the darn thing !! } END; { IF logoPicHdl <> NIL } END; { IF bragging <> NIL } { ////////// } END; { AboutItem } { NEVER seen -- shown for completeness, only. } AdisabledItem: BEGIN END; { AdisabledItem } OTHERWISE BEGIN GetPort(oldPort); ; GetItem(AppleMenu, item, accName); accNumber := OpenDeskAcc(accName); ; SetPort(oldPort); END; { OTHERWISE } END; { CASE...OF } END; { DoApple } PROCEDURE DoEdit (item: INTEGER); BEGIN IF SystemEdit(item - 1) THEN EXIT(DoEdit); { DAs do their own thing !! } CASE item OF UndoItem, EdisabledItem, CutItem, CopyItem, PasteItem, ClearItem: BEGIN END; END; { CASE...OF } END; { DoEdit } { -------------------------------------------------------------------------------------------- } { Jon Zap definitely scored a homer on this one: } { This is truly a journey into CopyBits ‘Hell’ } { -------------------------------------------------------------------------------------------- } PROCEDURE DoGraphics (item: INTEGER); LABEL 100, 200; VAR oldPort: GrafPtr; kFullPICTrect, gWindPICTrect, kWindPICTrect: Rect; {g:global & k:local} offBitMap, rotBitMap1, rotBitMap2, rotBitMap3, rotBitMap4: BitMap; rotBitMapPtr1, rotBitMapPtr2, rotBitMapPtr3, rotBitMapPtr4: BitMapPtr; onScreenRgn: Rgnhandle; copyRect: Rect; myRotHdl1, myRotHdl2, myRotHdl3, myRotHdl4: Handle; rotPixMap1, rotPixMap2, rotPixMap3, rotPixMap4: PixMapHandle; err: OSErr; toooooFast: BOOLEAN; PROCEDURE ErrorOut (iteration: INTEGER; rotBitMap: BitMap; error: OSErr); VAR rotHandle: Handle; BEGIN IF iteration > 1 THEN { Disposes of stuff even if NO error. } BEGIN rotHandle := RecoverHandle(rotBitMap.baseAddr); HUnlock(rotHandle); DisposHandle(rotHandle); END; { IF } IF error = memFullErr THEN GOTO 100; END; { ErrorOut } BEGIN { DoGraphics } CASE item OF RotateItem: BEGIN IF NOT applWind THEN { Whoops !! } EXIT(DoRotate); GetPort(oldPort); { Where in the ?!*!? are we } { ------------------------------------------------------------------------ } { Place my PICTure into an off screen } { BitMap so we can rotate this dude !! } { } { ... should be old-hat by now. } { ------------------------------------------------------------------------ } SetPort(FrontWindow); InstallVBLTask(acurDogCow); { Round-and-around she goes ... } { We’re about to switch the Port off-screen: } { NOTE: keep original rects intact by using copies. } kFullPICTrect := scrolledFullPICTrect; gWindPICTrect := windPICTrect; LocalGlobal(gWindPICTrect); CreateOffScreenError := CreateOffScreen(kFullPICTrect); IF CreateOffScreenError <> noErr THEN GOTO 200; offBitMap := offBitMapPtr^; { We canNOT call _GlobalToLocal here because we’ve changed } { the portBits.bounds rect of our off-screen port within } { “CreateOffScreen”. See “_GlobalToLocal” within Inside Mac. } kWindPICTrect := gWindPICTrect; WITH screenBits.bounds DO { Bounds BEFORE change. } OffsetRect(kWindPICTrect, left, top); IF colorDepth > 1 THEN BEGIN rotPixMap1 := NewPixMap; { Everything but the Color Table. It comes next ...} CopyPixMap(offCGrafPtr^.portPixMap, rotPixMap1); rotBitMapPtr1 := BitMapPtr(rotPixMap1^); ; rotPixMap2 := NewPixMap; CopyPixMap(offCGrafPtr^.portPixMap, rotPixMap2); rotBitMapPtr2 := BitMapPtr(rotPixMap2^); ; rotPixMap3 := NewPixMap; CopyPixMap(offCGrafPtr^.portPixMap, rotPixMap3); rotBitMapPtr3 := BitMapPtr(rotPixMap3^); ; rotPixMap4 := NewPixMap; CopyPixMap(offCGrafPtr^.portPixMap, rotPixMap4); rotBitMapPtr4 := BitMapPtr(rotPixMap4^); END { IF colorDepth > 1 } ELSE BEGIN rotBitMapPtr1 := BitMapPtr(NewClearPtr(SIZEOF(BitMap))); rotBitMapPtr2 := BitMapPtr(NewClearPtr(SIZEOF(BitMap))); rotBitMapPtr3 := BitMapPtr(NewClearPtr(SIZEOF(BitMap))); rotBitMapPtr4 := BitMapPtr(NewClearPtr(SIZEOF(BitMap))); END; { ELSE } rotBitMap1 := rotBitMapPtr1^; rotBitMap2 := rotBitMapPtr2^; rotBitMap3 := rotBitMapPtr3^; rotBitMap4 := rotBitMapPtr4^; { -------------------------------------- } { Draw off-screen ... } { -------------------------------------- } ClipRect(kFullPICTrect); { Eliminate all stray matter. } EraseRect(kFullPICTrect); DrawPicture(monsterPicHdl, kFullPICTrect); { -------------------------------------------- } { Back to “Square 1” ... } { -------------------------------------------- } ToOnScreen; ClipRect(kWindPICTrect); { ---------------------------------------------------- } { Now, for the fun stuff ... } { ---------------------------------------------------- } { So funny colorization doesn’t happen. } BackColor(whiteColor); ForeColor(blackColor); { Black-and-white TOOOOO fast !! } toooooFast := aMac2 & (colorDepth = 1); err := RotateBits(offBitMap, rotBitMap1); ErrorOut(1, offBitMap, err); IF colorDepth > 1 THEN BlockMove(Ptr(@rotBitMap1), Ptr(rotPixMap1^), SIZEOF(BitMap)); EraseRect(kWindPICTrect); copyRect := rotBitMap1.bounds; IF colorDepth = 1 THEN CopyBits(rotBitMap1, onBWScreen^.portBits, copyRect, copyRect, srcCopy, NIL) ELSE CopyBits(BitMapPtr(rotPixMap1^)^, BitMapPtr(onCScreen^.portPixMap^)^, copyRect, copyRect, srcCopy, NIL); IF toooooFast THEN Delay(90, finalTicks); { +++++ } err := RotateBits(rotBitMap1, rotBitMap2); ErrorOut(2, rotBitMap1, err); IF colorDepth > 1 THEN BlockMove(Ptr(@rotBitMap2), Ptr(rotPixMap2^), SIZEOF(BitMap)); EraseRect(kWindPICTrect); copyRect := rotBitMap2.bounds; IF colorDepth = 1 THEN CopyBits(rotBitMap2, onBWScreen^.portBits, copyRect, copyRect, srcCopy, NIL) ELSE CopyBits(BitMapPtr(rotPixMap2^)^, BitMapPtr(onCScreen^.portPixMap^)^, copyRect, copyRect, srcCopy, NIL); IF toooooFast THEN Delay(90, finalTicks); { +++++ } err := RotateBits(rotBitMap2, rotBitMap3); ErrorOut(3, rotBitMap2, err); IF colorDepth > 1 THEN BlockMove(Ptr(@rotBitMap3), Ptr(rotPixMap3^), SIZEOF(BitMap)); EraseRect(kWindPICTrect); copyRect := rotBitMap3.bounds; IF colorDepth = 1 THEN CopyBits(rotBitMap3, onBWScreen^.portBits, copyRect, copyRect, srcCopy, NIL) ELSE CopyBits(BitMapPtr(rotPixMap3^)^, BitMapPtr(onCScreen^.portPixMap^)^, copyRect, copyRect, srcCopy, NIL); IF toooooFast THEN Delay(90, finalTicks); { +++++ } err := RotateBits(rotBitMap3, rotBitMap4); ErrorOut(4, rotBitMap3, err); IF colorDepth > 1 THEN BlockMove(Ptr(@rotBitMap4), Ptr(rotPixMap4^), SIZEOF(BitMap)); EraseRect(kWindPICTrect); copyRect := rotBitMap4.bounds; IF colorDepth = 1 THEN CopyBits(rotBitMap4, onBWScreen^.portBits, copyRect, copyRect, srcCopy, NIL) ELSE CopyBits(BitMapPtr(rotPixMap4^)^, BitMapPtr(onCScreen^.portPixMap^)^, copyRect, copyRect, srcCopy, NIL); myRotHdl4 := RecoverHandle(rotBitMap4.baseAddr); { The last straggler ... } HUnlock(myRotHdl4); DisposHandle(myRotHdl4); { -------------------------------------------------------------- } { Now, wasn’t that neat, folks !! } { -------------------------------------------------------------- } 100: IF colorDepth > 1 THEN BEGIN DisposHandle(Handle(ourCTHandle)); DisposPixMap(rotPixMap1); DisposPixMap(rotPixMap2); DisposPixMap(rotPixMap3); DisposPixMap(rotPixMap4); END { IF colorDepth > 1 } ELSE BEGIN DisposPtr(Ptr(rotBitMapPtr1)); DisposPtr(Ptr(rotBitMapPtr2)); DisposPtr(Ptr(rotBitMapPtr3)); DisposPtr(Ptr(rotBitMapPtr4)); END; { ELSE } 200: DisposOffScreen; SetPort(oldPort); RemoveVBLTask; END; { RotateItem } DissolveItem: BEGIN IF NOT applWind THEN { Whoops !! } EXIT(DoGraphics); ; GetPort(oldPort); { ------------------- } { Here we go again !! } { ------------------- } kFullPICTrect := scrolledFullPICTrect; LocalGlobal(kFullPICTrect); ; kWindPICTrect := windPICTrect; CreateOffScreenError := CreateOffScreen(kWindPICTrect); IF CreateOffScreenError <> noErr THEN GOTO 300; ; WITH screenBits.bounds DO { _GlobalToLocal } OffsetRect(kFullPICTrect, left, top); ClipRect(kWindPICTrect); EraseRect(kWindPICTrect); { ... a clean slate. } ; BackColor(whiteColor); ForeColor(blackColor); ; onScreenRgn := NewRgn; RectRgn(onScreenRgn, screenBits.bounds); CopyBits(oldPort^.portBits, offBitMapPtr^, windPICTrect, kWindPICTrect, srcCopy, onScreenRgn); DisposeRgn(onScreenRgn); ToOnScreen; ClipRect(kWindPICTrect); EraseRect(kWindPICTrect); WITH screenBits.bounds DO { Bomb-aroo if dissolving OFF screen !! } BEGIN IF kWindPICTrect.top < top THEN kWindPICTrect.top := top; IF kWindPICTrect.left < left THEN kWindPICTrect.left := left; IF kWindPICTrect.bottom > bottom THEN kWindPICTrect.bottom := bottom; IF kWindPICTrect.right > right THEN kWindPICTrect.right := right; END; { WITH } ; ignore := SectRect(kWindPICTrect, kFullPICTrect, kFullPICTrect); { Just the pic. } DissBits(offBitMapPtr^, onScreenBitsPtr^, kFullPICTrect, kFullPICTrect); 300: DisposOffScreen; SetPort(oldPort); END; { DissolveItem } GdisabledItem: BEGIN END; { RdisabledItem } QuitItem: DoQuit; OTHERWISE BEGIN END; { OTHERWISE } END; { CASE...OF } END; { DoGraphics } { -------------------------------------------------------------------------- } { HandleMenu is the top level dispatch } { routine for menu commands. The item } { selected is passed to the appropriate } { menu handler. } { -------------------------------------------------------------------------- } PROCEDURE HandleMenu; VAR menuCode: LONGINT; charCode: INTEGER; BEGIN IF Event.what = MouseDown THEN menuCode := MenuSelect(Event.where) ELSE BEGIN charCode := BitAnd(Event.message, CharCodeMask); menuCode := MenuKey(CHR(charCode)); END; { ELSE } CASE HiWord(menuCode) OF AppleMenuID: DoApple(LoWord(menuCode)); EditMenuID: DoEdit(LoWord(menuCode)); GraphicsMenuID: DoGraphics(LoWord(menuCode)); OTHERWISE IF Event.what = KeyDown THEN SysBeep(10); END; { CASE } HiLiteMenu(0) END; { HandleMenu } PROCEDURE SetUpMenus; BEGIN AppleMenu := GetMenu(AppleMenuID); InsertMenu(AppleMenu, 0); AddResMenu(AppleMenu, ‘DRVR’); { + DAs } ; EditMenu := GetMenu(EditMenuID); InsertMenu(EditMenu, 0); DisableItem(EditMenu, 0); { The WHOLE thing !! } currEdit := FALSE; ; GraphicsMenu := GetMenu(GraphicsMenuID); InsertMenu(GraphicsMenu, 0); currGraphics := TRUE; DrawMenuBar; END; { SetUpMenus } { ---------------------------------------------------------------------------------------------------------------- } { Quantify two rectangles for our PICTure. The 1st is the } { window’s portRect, less any Scroll Bar area. The 2nd is } { for the full PICTure centered in the window. If the } { PICTure is too large to fit, then he topLeft of this } { “fullPICTrect” is shoved toward the window's topLeft. } { ---------------------------------------------------------------------------------------------------------------- } PROCEDURE GetPicRects (window: WindowPtr); LABEL 100; VAR myWindowPic: picHandle; tempX, tempY: INTEGER; BEGIN windPICTrect := window^.portRect; ; WITH windPICTrect DO {Clip to this before drawing PICT.} BEGIN IF (ScrollVert(window) <> NIL) | (ScrollHoriz(window) <> NIL) THEN BEGIN right := (right + 1) - scrollWidth; bottom := (bottom + 1) - scrollHeight; END; { IF } END; { WITH } myWindowPic := picHandle(GetWRefCon(window)); IF myWindowPic = NILTHEN BEGIN fullPICTrect := windPICTrect; GOTO 100; END; { IF myWindowPic = NIL } WITH windPICTrect DO BEGIN tempX := right - left; tempY := bottom - top; END; { WITH } WITH myWindowPic^^.picFrame DO BEGIN tempX := tempX - (right - left); {window - PICT width} tempY := tempY - (bottom - top); {window - PICT height} END; { WITH } IF tempX < 0 THEN tempX := 0; IF tempY < 0 THEN tempY := 0; WITH fullPICTrect DO {_DrawPicture within this for 1:1} BEGIN top := windPICTrect.top + tempY DIV 2; bottom := top + (myWindowPic^^.picFrame.bottom - myWindowPic^^.picFrame.top); left := windPICTrect.left + tempX DIV 2; right := left + (myWindowPic^^.picFrame.right - myWindowPic^^.picFrame.left); END; { WITH } 100: scrolledFullPICTrect := fullPICTrect; { I lied ... a 3rd rect for scrolling. } END; { GetPicRects } PROCEDURE RememberPicRects; BEGIN saveWindPICTrect := windPICTrect; saveFullPICTrect := fullPICTrect; saveScrolledFullPICTrect := scrolledFullPICTrect; END; { RememberPicRects } { ---------- } PROCEDURE ResetPicRects; BEGIN windPICTrect := saveWindPICTrect; fullPICTrect := saveFullPICTrect; scrolledFullPICTrect := saveScrolledFullPICTrect; END; { ResetPicRects } { ---------- } PROCEDURE ResetCtls (windPtr: WindowPtr); VAR oldClip: RgnHandle; HCtlValue, VCtlValue: INTEGER; PROCEDURE SetMyCtlValue (ctlHndl: ControlHandle; value: INTEGER); VAR temp: Rect; BEGIN IF ctlHndl = NIL THEN EXIT(SetMyCtlValue); temp := ctlHndl^^.contrlRect; InsetRect(temp, 1, 1); ClipRect(temp); SetCtlValue(ctlHndl, value); END; { SetMyCtlValue } BEGIN { ResetCtls } oldClip := NewRgn; GetClip(oldClip); HCtlValue := -(scrolledFullPICTrect.left - fullPICTrect.left) DIV 12; VCtlValue := -(scrolledFullPICTrect.top - fullPICTrect.top) DIV 12; SetMyCtlValue(ScrollHoriz(windPtr), HCtlValue); SetMyCtlValue(ScrollVert(windPtr), VCtlValue); SetClip(oldClip); DisposeRgn(oldClip); END; { ResetCtls } { -------------------------------------------------------------------------------------------------------- } { Make a separate PROC so we can zoom independently of } { _TrackBox, for example, in response to a Menu } { selection or a keypress: } { -------------------------------------------------------------------------------------------------------- } PROCEDURE doZoom (window: WindowPtr; partCode: INTEGER); VAR oldPort: GrafPtr; tempRect, srcZoomRect, dstZoomRect: Rect; PROCEDURE AdjustWindRect (window: WindowPtr; VAR r: Rect); CONST frame = 1; shadow = 1; title = 18; VAR windDef: INTEGER; BEGIN { AdjustWindRect } windDef := GetWVariant(window); InsetRect(r, -frame, -frame); { ---- } IF (windDef = 0) OR (windDef > 3) THEN r.top := r.top - title; { Window has a title bar. } { ---- } IF (windDef = documentProc) OR (windDef = altDBoxProc) OR (windDef = noGrowDocProc) OR (windDef = zoomDocProc) THEN WITH r DO { Window has a shadow frame. } BEGIN bottom := bottom + shadow; right := right + shadow; END; { WITH r } END; { AdjustWindRect } BEGIN { doZoom } IF NOT applWind THEN EXIT(doZoom); GetPort(oldPort); SetPort(window); CASE partCode OF inZoomOut: BEGIN IF NOT WindowPeek(window)^.spareFlag THEN BEGIN { no Zoom box. } tempRect := screen; InsetRect(tempRect, 2, 2); { Max zoom rect. } CalcWindowFrame(window, srcZoomRect); LocalGlobal(srcZoomRect); zoomBackIn := srcZoomRect; { Save for ... } dstZoomRect := tempRect; END ELSE { has a Zoom box. } BEGIN stateHandle := WStateHdl(WindowPeek(window)^.dataHandle); WITH stateHandle^^ DO BEGIN srcZoomRect := userState; dstZoomRect := stdState; { ONLY portRects ... so we need to adjust the sizes: } AdjustWindRect(window, srcZoomRect); AdjustWindRect(window, dstZoomRect); END; { WITH stateHandle^^ } END; { ELSE has a Zoom box } { ---------- } ZoomRect(srcZoomRect, dstZoomRect); PlaySound('ZoomOut'); ShowHide(window, FALSE); { NOW, wave the magic wand.} InvalidScroll(window); RememberPicRects; ZoomWindow(window, partCode, TRUE); GetPicRects(window); { ... for NEW portRect. } ScrollResize(window); InvalidScroll(window); ShowHide(window, TRUE); nextState := inZoomIn; END; { inZoomOut } inZoomIn: BEGIN IF NOT WindowPeek(window)^.spareFlag THEN BEGIN tempRect := screen; InsetRect(tempRect, 2, 2); { Max zoom rect. } srcZoomRect := tempRect; dstZoomRect := zoomBackIn; END { no Zoom box. } ELSE BEGIN stateHandle := WStateHdl(WindowPeek(window)^.dataHandle); WITH stateHandle^^ DO BEGIN srcZoomRect := stdState; dstZoomRect := userState; AdjustWindRect(window, srcZoomRect); AdjustWindRect(window, dstZoomRect); END; { WITH stateHandle^^ } END; { ELSE has a Zoom box } { ---------- } ZoomRect(srcZoomRect, dstZoomRect); PlaySound('ZoomIn'); ShowHide(window, FALSE); { Magic wand time !! } InvalidScroll(window); ZoomWindow(window, partCode, TRUE); ScrollResize(window); ResetPicRects; SetMaxCtls(window);{ For IMMEDIATE seeing of } ResetCtls(window); {former control values -- SIGH!!} InvalidScroll(window); ShowHide(window, TRUE); nextState := inZoomOut; END; { inZoomIn } OTHERWISE { Nada !! } BEGIN END; END; { CASE } SetPort(oldPort); END; { doZoom } PROCEDURE HandleMouse; VAR tempRect: rect; newSize: LONGINT; windWidth, windHt: INTEGER; mouseLoc: Point; theControl: ControlHandle; partControl: INTEGER; BEGIN CASE windowLoc OF inDesk: BEGIN END; { inDesk } inMenuBar: HandleMenu; inSysWindow: SystemClick(Event, TheWindow); { A DA window. } inContent: BEGIN IF TheWindow <> FrontWindow THEN BEGIN SelectWindow(TheWindow); { Generates an Activate Event. } EXIT(HandleMouse); END; { IF TheWindow <> FrontWindow } mouseLoc := Event.where; GlobalToLocal(mouseLoc); partControl := FindControl(mouseLoc, TheWindow, theControl); IF partControl <> 0 THEN Scroll(theControl, partControl, mouseLoc) ELSE IF DoubleClick THEN doGraphics(QuitItem); END; { inContent } inDrag: BEGIN IF DoubleClick & (nextState = inZoomOut) THEN BEGIN doZoom(TheWindow, inZoomOut); EXIT(HandleMouse); END; { IF ... } tempRect := screen; WITH TheWindow^.portRect DO BEGIN windWidth := right - left; windHt := bottom - top; END; { WITH TheWindow^.portRect } WITH tempRect DO BEGIN left := left + windWidth DIV 10; right := right - windWidth DIV 10; IF (windHt DIV 10 > mBarHt) THEN BEGIN top := top + windHt DIV 10; bottom := bottom - windHt DIV 10; END ELSE BEGIN top := top + mBarHt; bottom := bottom - mBarHt; END; { ELSE } END; { WITH tempRect } { _DragWindow forces the Mouse to stay inside of tempRect. } DragWindow(TheWindow, Event.where, tempRect); { This craziness ????? is required because I zoom the } { window in response to a keypress. I call _SizeWindow } { with NO effective change just to re-quantify the } { userState in the WStateRec(ord). } WITH TheWindow^.portRect DO SizeWindow(TheWindow, right - left, bottom - top, FALSE); { NO update !! } GetMouse(mouseLoc); LocalToGlobal(mouseLoc); IF PtInRect(mouseLoc, tempRect) THEN { It’s a drag, allright !! } nextState := inZoomOut; { ELSE NO change !! } END; { inDrag } inGrow: BEGIN WITH screen DO BEGIN SetRect(tempRect, left, top, right - left, bottom - top); InsetRect(tempRect, mBarHt, mBarHt); END; { WITH screen } newSize := GrowWindow(TheWindow, Event.where, tempRect); IF newSize = 0 THEN EXIT(HandleMouse); { NO change. } EraseRect(TheWindow^.portRect); { The OLD portRect.} { InvalRect(TheWindow^.portRect); -- passed TRUE to _SizeWindow. } SizeWindow(TheWindow, LoWord(newSize), HiWord(newSize), TRUE); GetPicRects(TheWindow); {_SizeWindow’s NEW portRect affects our picFrame.} ScrollResize(TheWindow); SetCtlsToMin(TheWindow); InvalRect(TheWindow^.portRect); nextState := inZoomOut; END; { inGrow } inGoAway: BEGIN IF TrackGoAway(TheWindow, Event.where) THEN DoQuit; END; { inGoAway } inZoomOut, inZoomIn: IF TrackBox(TheWindow, Event.where, windowLoc) THEN doZoom(TheWindow, windowLoc); END; { CASE } END; { HandleMouse } PROCEDURE HandleKey; VAR keyASCII: INTEGER; key: char; BEGIN IF NOT applWind THEN EXIT(HandleKey); IF BitAnd(Event.modifiers, $0F00) = cmdKey THEN { ONLY the Command Key } HandleMenu ELSE BEGIN keyASCII := BitAnd(Event.message, CharCodeMask); key := CHR(keyASCII); IF (key = ‘z’) | (key = ‘Z’) THEN doZoom(FrontWindow, nextState) ELSE SysBeep(10); END; { ELSE no Command Key } END; { HandleKey } { ===================================================== } { HandleUpdate re-draws any controls, text, or PICTs as } { well as the Grow Icon. } { ===================================================== } PROCEDURE HandleUpdate; VAR oldPort: GrafPtr; window: WindowPtr; HcntlHdl, VcntlHdl: ControlHandle; BEGIN GetPort(oldPort); window := WindowPtr(Event.message); SetPort(window); HcntlHdl := ScrollHoriz(window); VcntlHdl := ScrollVert(window); BeginUpDate(window); ClipRect(window^.portRect); EraseRect(window^.portRect); DrawControls(window); IF (HcntlHdl <> NIL) | (VcntlHdl <> NIL) THEN DrawGrowIcon(window); { Clip to the window LESS Scroll Bar(s). } ClipRect(windPICTrect); DrawPicture(monsterPicHdl, scrolledFullPICTrect); { ... but still draw 1:1 } ClipRect(window^.portRect); { Reset to see Scroll Bars move and be highlighted -- Sigh !! } EndUpdate(window); SetPort(oldPort) END; { HandleUpdate } { ---------------------------------------------------------------------------------------------------- } { Need to separate them because we’re trying to make } { this blasted thing MultiFinder-compatible: } { ---------------------------------------------------------------------------------------------------- } PROCEDURE DoActivate (window: WindowPtr); VAR HcntlHdl, VcntlHdl: ControlHandle; BEGIN SetPort(window); windDef := GetWVariant(window); {In DisplayWindow, also.} HcntlHdl := ScrollHoriz(window); IF HcntlHdl <> NIL THEN HiliteControl(HcntlHdl, 0); VcntlHdl := ScrollVert(window); IF VcntlHdl <> NIL THEN HiliteControl(VcntlHdl, 0); IF (HcntlHdl <> NIL) | (VcntlHdl <> NIL) THEN DrawGrowIcon(window); IF aMac2 & (colorHandCrsr = NIL) THEN { Color me paranoid !! } colorHandCrsr := GetCCursor(HANDcrsrID); END; { DoActivate } PROCEDURE DoDeactivate (window: WindowPtr); VAR HcntlHdl, VcntlHdl: ControlHandle; BEGIN HcntlHdl := ScrollHoriz(window); IF HcntlHdl <> NIL THEN HiliteControl(HcntlHdl, 255); VcntlHdl := ScrollVert(window); IF VcntlHdl <> NIL THEN HiliteControl(VcntlHdl, 255); IF (HcntlHdl <> NIL) | (VcntlHdl <> NIL) THEN DrawGrowIcon(window); IF aMac2 & (colorHandCrsr <> NIL) THEN BEGIN DisposCCursor(colorHandCrsr); colorHandCrsr := NIL; { Mark as gone !! } stillColorCrsr := FALSE; END; { IF aMac2 & () } END; { DoDeactivate } PROCEDURE HandleActivate; VAR window: WindowPtr; BEGIN window := WindowPtr(Event.message); IF ODD(Event.modifiers) THEN DoActivate(window) ELSE DoDeactivate(window); END; { HandleActivate } PROCEDURE DoPeriodic; VAR ignoreError: OSErr; BEGIN IF NOT WNE THEN SystemTask; colorDepth := TestForColor; PeriodicMenus; { Feeds HandleCursor. } HandleCursor; IF Sleep = 1 THEN Sleep := GetCaretTime; { Reset after special effects. } IF applWind & InForeGround THEN BEGIN SetMaxCtls(FrontWindow); IF justOpened THEN BEGIN justOpened := FALSE;{ Just once, Sam !! } SpiffyDissolve; { Retrieve Scroll Bars AFTER the } { dissolve so they don’t get in the way:} horizControl := GetNewControl(horizScrollID, TheWindow); vertControl := GetNewControl(vertScrollID, TheWindow); ScrollResize(TheWindow); GetPicRects(TheWindow); InvalRect(TheWindow^.portRect); {NOW do Update !!} END; { IF justOpened } IF justBragging THEN BEGIN justBragging := FALSE; SpiffyRoll; END; { IF justBragging } END; { IF applWind & InForeGround } END; { DoPeriodic } PROCEDURE MainEventLoop; VAR ignoreResult: BOOLEAN; BEGIN REPEAT IF WNE THEN ignoreResult := WaitNextEvent(everyEvent, Event, Sleep, NIL) ELSE ignoreResult := GetNextEvent(everyEvent, Event); CASE Event.what OF NullEvent: DoPeriodic; MouseDown: BEGIN { Fills in 'TheWindow'. } windowLoc := FindWindow(Event.where, TheWindow); HandleMouse; END; MouseUp: BEGIN END; KeyDown, AutoKey: HandleKey; KeyUp: BEGIN END; UpdateEvt: HandleUpdate; DiskEvt: BEGIN MouseDown: BEGIN windowLoc := FindWindow(Event.where, TheWindow); { Fills in ‘TheWindow’. } HandleMouse; END; MouseUp: BEGIN END; KeyDown, AutoKey: HandleKey; KeyUp: BEGIN END; UpdateEvt: HandleUpdate; DiskEvt: BEGIN END; ActivateEvt: HandleActivate; NetworkEvt, DriverEvt: BEGIN END; App1Evt, App2Evt, App3Evt: BEGIN END; OSEvent: { MultiFinder Event = app4Evt } BEGIN CASE BSR(Event.message, 24) OF { High byte } mouseMovedMessage: HandleCursor; suspendResumeMessage: BEGIN IF BAND(Event.message, resumeMask) <> 0 THEN BEGIN InForeGround := TRUE; DoActivate(FrontWindow) END { Resume } ELSE { Suspend } BEGIN InForeGround := FALSE; DoDeactivate(FrontWindow); END; { ELSE } END; { suspendResumeMessage } OTHERWISE END; { CASE BSR(Event.message, 24) OF } END; { MultiFinder Event } OTHERWISE END; { CASE Event.what OF } UNTIL Done; END; { MainEventLoop } BEGIN { Program } InitManagers; { The usual stuff ... } PlaySound(‘Oops’); Done := FALSE; aMac2 := TestForMac2; colorHandCrsr := NIL; stillColorCrsr := FALSE; InForeGround := TRUE; { Assume UniFinder. } WNE := WNEisImplemented; Sleep := GetCaretTime; acurHdl := NIL; { See “RemoveVBLTask”. } nextState := inZoomOut; SetUpMenus; screen := RgnHandlePtr(GrayRgn)^^^.rgnBBox; ROM := wordPtr(ROM85Loc); IF ROM^ > 0 THEN mBarHt := wordPtr(mBarHeightLoc)^ ELSE mBarHt := 20; monsterPicHdl := GetPicture(monsterID); IF Handle(monsterPicHdl) = NIL THEN GOTO 100; HLock(Handle(monsterPicHdl)); IF aMac2 THEN TheWindow := GetNewCWindow(mainWindowID, NIL, WindowPtr(-1)) ELSE TheWindow := GetNewWindow(mainWindowID, NIL, WindowPtr(-1)); IF TheWindow = NIL THEN BEGIN HUnlock(Handle(monsterPicHdl)); ReleaseResource(Handle(monsterPicHdl)); GOTO 100; END; { IF TheWindow = NIL } SetPort(TheWindow); { Retrieve Scroll Bars AFTER the dissolve } { so they don’t get drawn pre-maturely. } SetWindowPalette(TheWindow, mainWindowID); { Palette ID = Window ID. } SetWRefCon(TheWindow, LONGINT(monsterPicHdl)); { Save for scrolling later. } DisplayWindow(TheWindow); ValidRect(TheWindow^.portRect); { Postpone Update until AFTER the dissolve. } justOpened := TRUE; { See “DoPeriodic” ... } justBragging := FALSE; MainEventLoop; PlaySound(‘Moof’); 100: ExitToShell; END. { Program }
- SPREAD THE WORD:
- Slashdot
- Digg
- Del.icio.us
- Newsvine