Spiffy Color 1
Volume Number: 6
Issue Number: 11
Column Tag: Color Workshop
Spiffy Color Demo 
By John A. Love, III, Springfield, VA
Note: Source code files accompanying article are located on MacTech CD-ROM orsource 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 TRUEbutalso 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 codeyour 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