mirror of
https://github.com/elliotnunn/mac-rom.git
synced 2024-06-01 23:41:27 +00:00
4325cdcc78
Resource forks are included only for .rsrc files. These are DeRezzed into their data fork. 'ckid' resources, from the Projector VCS, are not included. The Tools directory, containing mostly junk, is also excluded.
3048 lines
90 KiB
OpenEdge ABL
3048 lines
90 KiB
OpenEdge ABL
{
|
|
File: ColorPicker.p
|
|
|
|
Contains: Color Picker package
|
|
|
|
This is the heart of the ColorPicker package, the part which presents the
|
|
color selection dialog, animates it, and lets the user ultimately select
|
|
a color. It changes the color table, if there is one, so that the user
|
|
sees the real color, not just the current "best match" returned by Quickdraw.
|
|
The conversion routines for the various color models, the assembly dispatcher
|
|
for the package, and the glue code that unlocks the package upon exit are
|
|
all elsewhere.
|
|
|
|
Copyright: © 1987-1991 by Apple Computer, Inc., all rights reserved.
|
|
|
|
This file is used in these builds: BigBang Sys606
|
|
|
|
Change History (most recent first):
|
|
|
|
<13> 5/21/91 gbm Stop using "empty" units like Memtypes...
|
|
<12> 1/18/91 gbm (csd) Change prompt string so it will be truncated instead of
|
|
wrapping around.
|
|
<11> 1/10/91 SMC Added code to ignore strings with non-numeric characters when
|
|
pasting into a number field. With KON.
|
|
<10> 12/14/90 dvb Eyedropper
|
|
<9> 12/14/90 gbm & JDR; Dispose the palette after closing the window, instead of
|
|
setting the palette to nil and disposing it first. This has the
|
|
side effect of causing more updates in some cases, but avoids
|
|
the unsightly color table change while the color wheel is still
|
|
visible. I am not completely sure that this is the right thing.
|
|
An alternative is to return to the old way, but to erase the
|
|
contents of the color picker dialog before changing the palette
|
|
(and indirectly, the color table).
|
|
<8> 10/12/90 dvb Remove color arrows
|
|
<7> 9/4/90 dvb Make whizzier.
|
|
<6> 8/28/90 dvb Numbering mixed up because project was corrupted and restored.
|
|
|
|
|
|
<8> 8/27/90 dvb Fix sample draw on non-clut devices
|
|
<7> 8/27/90 dvb NEEDED FOR SIXPACK: Remove calls to PixPatChanged and
|
|
CTabChanged... does this break 8¥24 GC?
|
|
<6> 8/15/90 dvb NEEDED FOR SIXPACK: Fix to work an b/w machines
|
|
<5> 6/12/90 DVB Make main-screen preferred in case of depth tie.
|
|
<4> 5/30/90 DVB Streamline: remove cWhite and cBlack. Use colors for input and
|
|
output in 2-bit mode.
|
|
<3> 5/23/90 DVB Make it use palettes instead of RestoreEntries, fix cursor bug
|
|
(7.0 only)
|
|
<2> 12/28/89 dba got rid of obsolete compile-time options (options are passed in
|
|
by the Makefile)
|
|
<1.4> 12/14/89 dvb NEEDED for 6.0.5: Change default roundrect to conform to Inside
|
|
Mac recommendations, make 'esc' key the same as cmd-. .
|
|
<1.3> 8/3/89 CSD NEEDED For 6.0.4: Set Cursor to an arrow when dialog opens (BRC
|
|
#30423). Also, changed the way that the scroll bar CDEF was
|
|
called to make it safer for 32-Bit Memory Manager.
|
|
<1.2> 8/3/89 CCH Changed references to "transIndex" to "ctFlags".
|
|
<¥1.1> 7/24/89 CSD Forced submission of the Color Picker from 32-Bit QuickDraw. Too
|
|
many changes, too long ago to merge without causing havoc.
|
|
|
|
older Change History (oldest first, Darin is too lazy to convert it):
|
|
|
|
1.0d7 amy Updated PickDlgClose to use the new color manager proc DelSearch.
|
|
Note that 1.0d6 won't run on >B3 ROMs, since it does a DisposPtr
|
|
on the proc queue element, which is now a handle.
|
|
|
|
1.0b1 amy Made the model dialog inaccessible by moving the button offscreen.
|
|
|
|
1.0b2 amy Corrected colorOk test. We now test that the machine has a Mac II
|
|
or later ROM, rather than checking that CPUFlag = 2 (68020).
|
|
Paint the final "tint" on the wheel (no saturation) with FillOval,
|
|
rather than filling a separate arc for each color.
|
|
Added SetPort to the beginning of PickDlgDrawItem, to correct a bug
|
|
that shows up iff you're on a non-clutType device (wheel and new
|
|
sample were being drawn in the wrong port initially).
|
|
Changed SampleDraw to use lines, not FrameRect, so there's less
|
|
flicker while updating iNewSample on a non-clutType device.
|
|
Rearranged order of colors in PColor, to alter the priority with
|
|
which colors are matched as they are swiped from the color table.
|
|
Old order was colors, white, black, gray, input & output samples.
|
|
New order is nearly the same, but colors come last. This insures
|
|
that black and white are always substituted correctly, that the
|
|
color being picked, if on screen, is more likely to animate, and
|
|
that the colors in the wheel are lowest priority for matching.
|
|
When resolving which CLUT entries to swipe, come down from the top
|
|
of the color table, not up from the bottom.
|
|
When resolving which CLUT entries to swipe, avoid the hilight color,
|
|
and any grays (except black and white), since they may be used in
|
|
gray scale fonts.
|
|
Removed MakeITable calls, which were making it impossible to avoid the
|
|
hilight color if the input color was close to any of the entries
|
|
Color Picker installs in the color table. This should affect no
|
|
one (and should make the package less of a memory hog, and safer),
|
|
because Color Picker uses a search proc to get any of its colors.
|
|
Changed CTabSearch to return FALSE if gdType <> clutType, since we'd
|
|
rather have the default search proc get the best match for fixed
|
|
devices.
|
|
Don't artifically spread the colors before GetSubTable by upping the
|
|
brightness, and don't invert inColor either.
|
|
Turned off debugging and (unused) remodel dialog to save space. Turned
|
|
off skip gray also, and removed remodel resources from the .r file.
|
|
|
|
1.1a1 amy Updated to use MPW 2.0 interface files.
|
|
Removed $LOAD file to help out SCM.
|
|
|
|
1.2d1 amy Iff we're in 8 bit mode or more, on a clut device, use more colors in
|
|
the wheel (36 for now). This does NOT slow use down by 36/6,
|
|
because of a clever idea of David's for using FrameOval for the
|
|
saturation levels, which eliminates ((wheelTints - 1) * maxColors)
|
|
PaintArc calls to (wheelTints - 1) FrameOvals.
|
|
|
|
1.2b1 amy Do a SetPort after GetNewDialog, in case there is no port at start.
|
|
Handle autoKey events just like keydown events to get validation.
|
|
Increased size of editText fields by 2 each to get rid of jumping.
|
|
Art added NewPalette and SetPalette to render ActivatePalette harmless,
|
|
so that the color environment won't change (esp. between the time
|
|
we chose which entries to animate and the dialog appears).
|
|
|
|
1.2b2 amy Preserve caller's port around calls to GetColor.
|
|
|
|
1.3b1 amy Fix HSL2RGB once and for all by replacing HiWrd, which is broken in tests.
|
|
|
|
1.4a2 CSD Added constants for resources STR# $E980, ppat $E980, wedg $E980-$E981, and
|
|
CURS $E980
|
|
Used STR# for drawing wedge names in 1 and 2 bit modes.
|
|
Make a where parameter of (-1, -1) place the dialog on the deepest screen.
|
|
|
|
1.4a3 CSD Accept arrow keys as well as digits and backspace.
|
|
Handle CMD-X, CMD-C, CMD-V as cut, copy, paste.
|
|
Handle CMD-. as cancel with a brief hilite of the cancel button.
|
|
Briefly hilite Ok button for return and enter.
|
|
Option-click in up and down arrows sets value to max and min.
|
|
|
|
1.4a4 CSD With a where parameter of (-1, -1), use the "best" screen, not neccessarily
|
|
the deepest screen. (i.e. color 4-bit is better than mono 8-bit)
|
|
Erase the hot-spot before redrawing the wheel to prevent trash from being
|
|
left outside the wheel.
|
|
Test for required memory and show an alert if we don't think we can
|
|
run safely.
|
|
If possible, animate the colors while the user is dragging the thumb
|
|
in the brightness scroll bar.
|
|
1.4a5 CSD Reduced the amount of memory that guarantees we can run. It used to have
|
|
about 9K of slop, now it has about 2K.
|
|
1.4a6 CSD Instead of testing for required memory by calling PurgeSpace, actually
|
|
allocate a handle and then dispos it. This will cause the heap to
|
|
grow if it can, giving us a more correct result.
|
|
When looking for the 'best' device, don't count inactive screens.
|
|
dvb 17 April 1989 - Fixed searchproc to work in 16-bit mode, made 8-color
|
|
wheel less interesting and much faster.
|
|
1.4b2 CSD Fixed test to see if we should allocate a palette for the window. It
|
|
used to test colorOk which wasn't setup yet.
|
|
Fixed bug where RGB/HSV values wouldn't update if the thumb was
|
|
dragged to one of the control extremes on an 8-bit display.
|
|
|
|
To Do:
|
|
Add error handling for pickDlg = NIL
|
|
Handle CLUTFixed, CLUTDirect better
|
|
Nicer looking cursor and hot spot
|
|
Use dithering to smooth color wheel appearance
|
|
Test for wheel hits via radius from center, not wheelRgn?
|
|
Build custom brightness control?
|
|
Beef up error handling throughout
|
|
Make model selection dialog work
|
|
Add YIQ conversion routines
|
|
Get Gerard's sqrt & get rid of SANE
|
|
|
|
What if calling app has protected lots of CLUT entries?
|
|
SetDAFont(applFont), and make prompt a user item in System font
|
|
How to check that we aren't swiping the CLUT entry for a desktop color?
|
|
Whenever editField is used, watch out for editField < 0?
|
|
Put scaling in model selection dialog?
|
|
Add graphical component legends?
|
|
Help button and text?
|
|
Keyboard equivalents?
|
|
|
|
Change setting of colorOk to use SysEnvirons
|
|
|
|
}
|
|
|
|
{$SETC HSV := TRUE} {Use HSV color model (FALSE=HSL)}
|
|
{$SETC GRUNGY := TRUE} {Grungy behavior that needs to be cleaner}
|
|
{$SETC UsePalette := TRUE}
|
|
|
|
UNIT ColorPicker;
|
|
|
|
INTERFACE
|
|
|
|
USES
|
|
Types, Memory, QuickDraw, Palettes, Resources, Fonts, Dialogs,
|
|
Packages, GestaltEqu, FixMath, ToolUtils, OSUtils, SysEqu,
|
|
ColorConvert;
|
|
|
|
FUNCTION GetColor(where: Point; prompt: Str255; inColor: RGBColor;
|
|
VAR outColor: RGBColor): BOOLEAN;
|
|
|
|
IMPLEMENTATION
|
|
|
|
CONST
|
|
arrowDeltaLow = 1; {Change in component value for inc/dec}
|
|
arrowDeltaMed = 10; {1st level of inc/dec acceleration}
|
|
arrowDeltaHi = 100; {2nd level of inc/dec acceleration}
|
|
arrowSlop = 2; {Slop around each arrow rect for tracking}
|
|
inputSlop = 4; {Slop around input sample for tracking}
|
|
lineBright = $100; {Change in bright control for scroll arrow}
|
|
maxColors = 36; {Wheel wedges if 8 bit mode w/ animation}
|
|
minColors = 6; {Wheel wedges otherwise}
|
|
pageBright = $10; {Change in bright control for scroll page}
|
|
pickClientID = 12; {Client ID used with picker's search proc}
|
|
slopRim = 10; {Rim outside wheel that still tracks}
|
|
twoPi = $0006487F; {Two times Pi, in Fixed format}
|
|
wheelTints = 5; {Number of saturation levels in wheel}
|
|
|
|
{Resource IDs}
|
|
rPickDlg = $E980; {Color picker dialog}
|
|
rArrowPic = $E980; {Inc/dec control picture}
|
|
rRemodelDlg = $E981; {Remodel dialog}
|
|
rColorNamesStr = $E980; {STR# of color slice names}
|
|
rGreenWedge = $E980; {Green wedge bits for wheel}
|
|
rRedWedge = $E981; {Red wedge bits for wheel}
|
|
rCursor = $E980; {A good looking cursor}
|
|
rMemShortageID = $E982; {Not enough memory alert}
|
|
|
|
{Memory Requirements}
|
|
kDirectMemReq = 55600; {RAM needed on 16/32 bit devices. Actually Å53608}
|
|
kClutMemReq = 24000; {RAM needed on clut devices. Actually Å22200}
|
|
|
|
{Items in the dialog}
|
|
{ok = 1;} {Defined for us by the Toolbox}
|
|
{cancel = 2;} {Defined for us by the Toolbox}
|
|
iRemodel = 3; {Button to bring up remodel dialog}
|
|
iPrompt = 4; {User-supplied prompt string}
|
|
iBrightCtl = 5; {Brightness control}
|
|
{Items iFirstUI to iLastUI are drawn by DrawUserItem}
|
|
iFirstUI = 6; {First of user items in dialog}
|
|
iOkOutline = 6; {Outline for OK button}
|
|
iWheel = 7; {Hue/saturation wheel}
|
|
iNewSample = 8; {Sample square of current color}
|
|
iOldSample = 9; {Sample square of input color}
|
|
iVersion = 10; {Color picker version number, writ small}
|
|
iFirstArrow = 11; {First of up/down controls}
|
|
iHSxArrows = 11; {First of three HSx up/down controls}
|
|
iRGBArrows = 14; {First of three RGB up/down controls}
|
|
iLastArrow = 16; {Last of up/down controls}
|
|
iLastUI = 16; {Last of user items in dialog}
|
|
{Color component labels are items 17-22, edit fields are below}
|
|
iFirstComponent = 23; {First color component text string}
|
|
iHue = 23;
|
|
iSaturation = 24;
|
|
iLightness = 25;
|
|
iRed = 26;
|
|
iGreen = 27;
|
|
iBlue = 28;
|
|
iLastComponent = 28; {Last color component text string}
|
|
|
|
TYPE
|
|
ColorItem = (rgbText, hsText, lText, hsWheel, lWheel, bright);
|
|
ColorItemSet = SET OF ColorItem;
|
|
|
|
IntPtr = ^INTEGER;
|
|
LongPtr = ^LONGINT;
|
|
RGBColorPtr = ^RGBColor;
|
|
|
|
PColor = (cInput, cSample, cGray, cSlice1);
|
|
|
|
PickColor = RECORD CASE INTEGER OF
|
|
0: (hsx : HSLColor;
|
|
rgb : RGBColor);
|
|
1: (components : ARRAY [0..5] OF INTEGER);
|
|
END;
|
|
|
|
ReqListPtr = ^ReqListRec;
|
|
ReqListHandle = ^ReqListPtr;
|
|
|
|
PickInfo = RECORD {Picker's "global" vars stick with dialog}
|
|
dlgRec: DialogRecord; {Dialog record must be first}
|
|
rgbInput: RGBColor; {Color the caller supplied as input}
|
|
theColor: PickColor; {Color being picked, in all req'd transforms}
|
|
showModel: BOOLEAN; {Show primary color model?}
|
|
showAltModel: BOOLEAN; {Show alternate color model?}
|
|
slopRgn: RgnHandle; {Region slightly larger than the wheel}
|
|
wheelRgn: RgnHandle; {Region of the wheel itself}
|
|
wheelCenter: Point; {Center of the color wheel}
|
|
wheelRadius: Fixed; {Radius of the color wheel}
|
|
wheelColors: INTEGER; {Number of wedges in the color wheel}
|
|
lastColor: PColor; {Color table index of last color in wheel}
|
|
whichPart: INTEGER; {Part of control we started tracking in}
|
|
ourCursor: BOOLEAN; {Is our cursor set (or the usual arrow)?}
|
|
cursorRgn: RgnHandle; {Composite of item rects in which we want ourCursor}
|
|
cursorHand: CursHandle; {Handle to our cursor}
|
|
hotSpot: Point; {Displayed hot spot (HS) on wheel, if any)}
|
|
pixSize: INTEGER; {pixelsize of screen we are on}
|
|
gdType: INTEGER; {type of gDevice we are on}
|
|
colorOK: BOOLEAN; {Not ok if: 128k ROM or one bit per pixel}
|
|
itsGDev: GDHandle; {deepest device the dlog intersects}
|
|
pickCTab: CTabHandle; {Table of colors picker borrows, or nil}
|
|
{$IFC UsePalette}
|
|
pickPal: PaletteHandle; {Handle to a palette full of animated entries}
|
|
{$ELSEC}
|
|
whichColor: PColor; {Which entry in pickCTab search proc should return}
|
|
saveCTab: CTabHandle; {Table of pre-picker CLUT entries, or nil}
|
|
saveIRes: INTEGER; {Caller's inverse table resolution value}
|
|
pickReqList: ReqListHandle; {List of stolen CLUT entries, or nil}
|
|
{$ENDC}
|
|
END;
|
|
PickInfoPtr = ^PickInfo; {Ptr to our info, and the dialog}
|
|
|
|
QDGlobals = RECORD
|
|
randSeed: LONGINT;
|
|
screenBits: BitMap;
|
|
arrow: Cursor;
|
|
dkGray: Pattern;
|
|
ltGray: Pattern;
|
|
gray: Pattern;
|
|
black: Pattern;
|
|
white: Pattern;
|
|
thePort: GrafPtr;
|
|
END;
|
|
QDGlobalsPtr = ^QDGlobals;
|
|
|
|
ControlThumbInfo = RECORD
|
|
limitRect: Rect;
|
|
slopRect: Rect;
|
|
axis: INTEGER;
|
|
startPoint: Point;
|
|
END;
|
|
ControlThumbInfoPtr = ^ControlThumbInfo;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
Declare some EXTERNALS that are in ColorPicker.a.
|
|
}
|
|
FUNCTION NibbleUnpack(src,dst:LONGINT):LONGINT; EXTERNAL;
|
|
PROCEDURE SetGray25Pat; EXTERNAL;
|
|
PROCEDURE SetGray50Pat; EXTERNAL;
|
|
PROCEDURE SetGray75Pat; EXTERNAL;
|
|
PROCEDURE SetGray50BPat; EXTERNAL;
|
|
|
|
|
|
{---------------------------------------------------------------------------------
|
|
Declare everything FORWARD, so we can order the source alphabetically. Paired
|
|
routines are together. GetColor, the only one that will (eventually) be PACKaged,
|
|
is last.
|
|
}
|
|
|
|
FUNCTION ArrowTrack(theDialog: DialogPtr; where: Point; option : Boolean): BOOLEAN; FORWARD;
|
|
|
|
PROCEDURE BrightAdjust(pickDlg: DialogPtr; ctlHand: ControlHandle; forceIt : Boolean); FORWARD;
|
|
PROCEDURE BrightCtlGet(ctlHand: ControlHandle; VAR lightness: SmallFract); FORWARD;
|
|
PROCEDURE BrightCtlSet(ctlHand: ControlHandle; lightness: SmallFract); FORWARD;
|
|
FUNCTION BrightTrack(theDialog: DialogPtr; where: Point): BOOLEAN; FORWARD;
|
|
PROCEDURE BrightTrackScroll(theControl: ControlHandle; partCode: INTEGER); FORWARD;
|
|
|
|
FUNCTION CallControl(theControl : ControlHandle; message : Integer;
|
|
param : LongInt) : LongInt; FORWARD;
|
|
PROCEDURE CTabAdjust(pickDlg: DialogPtr; newBright: BOOLEAN); FORWARD;
|
|
PROCEDURE CTabBuild(VAR pickData: PickInfo; inColor: RGBColor); FORWARD;
|
|
PROCEDURE CTabInstall(pickDlg: DialogPtr; newBright: BOOLEAN); FORWARD;
|
|
PROCEDURE CTabRestore(pickPtr: PickInfoPtr); FORWARD;
|
|
PROCEDURE CTabSave(pickPtr: PickInfoPtr); FORWARD;
|
|
FUNCTION CTabSearch(myColor: RGBColor; VAR index: LONGINT): BOOLEAN; FORWARD;
|
|
|
|
FUNCTION DeviceCTab: CTabHandle; FORWARD;
|
|
FUNCTION DeviceITab: ITabHandle; FORWARD;
|
|
|
|
PROCEDURE RGBNormal; FORWARD;
|
|
|
|
FUNCTION GetIHand(theDialog: DialogPtr; item: INTEGER): Handle; FORWARD;
|
|
PROCEDURE GetIRect(theDialog: DialogPtr; item: INTEGER; VAR itemRect: Rect); FORWARD;
|
|
FUNCTION GetQDGlobals: QDGlobalsPtr; FORWARD;
|
|
|
|
PROCEDURE HSx2RGB(hsx: HSLColor; VAR rgb: RGBColor); FORWARD;
|
|
|
|
PROCEDURE MakeWedges32(wheelRect:Rect; brite:INTEGER); FORWARD;
|
|
|
|
PROCEDURE PickDlgClose(infoPtr: PickInfoPtr); FORWARD;
|
|
PROCEDURE PickDlgDrawItem(theWindow: WindowPtr; item: INTEGER); FORWARD;
|
|
FUNCTION PickDlgFilter(theDialog: DialogPtr; VAR theEvent: EventRecord; VAR itemHit: INTEGER): BOOLEAN; FORWARD;
|
|
FUNCTION PickDlgOpen(infoPtr: PickInfoPtr; where: Point; prompt: Str255): DialogPtr; FORWARD;
|
|
|
|
PROCEDURE RemodelDlg(pickRect: Rect; VAR showModel, showAltModel: BOOLEAN); FORWARD;
|
|
PROCEDURE RemodelDlgDrawItem(theWindow: WindowPtr; item: INTEGER); FORWARD;
|
|
PROCEDURE RGB2HSx(rgb: RGBColor; VAR hsx: HSLColor); FORWARD;
|
|
|
|
PROCEDURE SampleDraw(pickDlg: DialogPtr; item: INTEGER; sampleRect: Rect); FORWARD;
|
|
FUNCTION SampleTrack(theDialog: DialogPtr; where: Point): BOOLEAN; FORWARD;
|
|
|
|
PROCEDURE ShowAffected(pickDlg: DialogPtr; item: INTEGER); FORWARD;
|
|
PROCEDURE ShowHotSpot(where: Point); FORWARD;
|
|
PROCEDURE ShowNewColor(pickDlg: DialogPtr; affected: ColorItemSet); FORWARD;
|
|
PROCEDURE ShowNewValues(pickDlg: DialogPtr; newRGB: BOOLEAN; affected: ColorItemSet); FORWARD;
|
|
PROCEDURE SnareNewComponents(pickDlg: DialogPtr); FORWARD;
|
|
PROCEDURE StuffIt(pickDlg: DialogPtr; theItem: INTEGER; newVal: SmallFract); FORWARD;
|
|
|
|
PROCEDURE WheelDraw(pickDlg: DialogPtr; wheelRect: Rect); FORWARD;
|
|
PROCEDURE WheelPos2HS(pickDlg: DialogPtr; where: Point); FORWARD;
|
|
PROCEDURE HS2WheelPos(pickDlg: DialogPtr; VAR where: Point); FORWARD;
|
|
PROCEDURE WheelTintPattern(whichTint: INTEGER; VAR pat: Pattern); FORWARD;
|
|
FUNCTION WheelTrack(theDialog: DialogPtr; where: Point): BOOLEAN; FORWARD;
|
|
|
|
|
|
FUNCTION CallCDEFProc(varCode : Integer; theControl : ControlHandle; message : Integer;
|
|
param : LongInt; defProcPtr : ProcPtr) : LongInt;
|
|
INLINE $205F, {MOVE.L (A7)+, A0 ;Get procPtr}
|
|
$4E90; {JSR (A0) ;Call the defProc}
|
|
|
|
PROCEDURE CopyPix(src:PixMap;dst:BitMap; srcRect, dstRect: Rect;
|
|
mode: INTEGER; maskRgn: RgnHandle);
|
|
INLINE $A8EC;
|
|
|
|
|
|
|
|
{--------------------------------------------------------------------------------
|
|
ArrowTrack - track mouse-down in component plus/minus controls. All of the
|
|
control accelerate, but they purposely do NOT accelerate to really great
|
|
speed. The maximum speed they attain is one that takes the user through the
|
|
entire range of a given component (like hue or saturation) in a slightly
|
|
leisurely fashion, so they can see everything.
|
|
1.4a3 If the user option-clicks in an arrow, set the value to its upper or
|
|
lower limit and don't bother to keep tracking.
|
|
}
|
|
|
|
FUNCTION ArrowTrack(theDialog: DialogPtr; where: Point; option : Boolean): BOOLEAN;
|
|
VAR
|
|
c, i: INTEGER;
|
|
delta: Fixed;
|
|
doDelay: BOOLEAN;
|
|
finalTicks: LONGINT;
|
|
nextDelta: Fixed;
|
|
goingUp: BOOLEAN;
|
|
item: INTEGER;
|
|
lastKick: Fixed;
|
|
midLine: INTEGER;
|
|
slopRect: Rect;
|
|
temp: Fixed;
|
|
up: BOOLEAN;
|
|
BEGIN
|
|
ArrowTrack := FALSE;
|
|
item := -1; { signal if an arrow found }
|
|
WITH PickInfoPtr(theDialog)^, theColor DO
|
|
BEGIN
|
|
{The only areas in cursorRgn besides the wheel are the inc/dec
|
|
controls. Since WheelTrack has already had a shot at this
|
|
event, if it's in cursorRgn, it's ours. First, figure out
|
|
which control we're in.}
|
|
FOR i := iFirstArrow TO iLastArrow DO
|
|
BEGIN
|
|
GetIRect(theDialog, i, slopRect);
|
|
IF PtInRect(where, slopRect) THEN
|
|
BEGIN
|
|
ArrowTrack := TRUE;
|
|
c := i - iFirstArrow;
|
|
item := c + iFirstComponent;
|
|
InsetRect(slopRect, -arrowSlop, -arrowSlop);
|
|
WITH slopRect DO
|
|
midLine := (bottom + top) DIV 2;
|
|
LEAVE; {exit FOR}
|
|
END;
|
|
END;
|
|
|
|
IF item = -1 THEN EXIT(ArrowTrack);
|
|
|
|
{Now we know which component we're in. If the user held the option
|
|
key while clicking, slam the value to the upper or lower limit
|
|
as appropriate.}
|
|
IF option THEN
|
|
BEGIN
|
|
IF where.v < midLine THEN
|
|
components[c] := Fix2SMallFract(MaxSmallFract)
|
|
ELSE
|
|
components[c] := Fix2SMallFract(0);
|
|
ShowAffected(theDialog, item);
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
|
|
{Now that we know which component the user is changing, track it.
|
|
Like WheelTrack, we use repeat here so that the block executes
|
|
at least once, and quick mouse clicks are seen.}
|
|
doDelay := TRUE;
|
|
REPEAT
|
|
GetMouse(where);
|
|
IF PtInRect(where, slopRect) THEN
|
|
BEGIN
|
|
up := (where.v < midLine);
|
|
temp := SmallFract2Fix(components[c]);
|
|
|
|
{Before inc/dec-ing the value, see if it's time to
|
|
accelerate, or to quit accelerating because of a
|
|
change in direction.}
|
|
IF up <> goingUp THEN
|
|
BEGIN
|
|
goingUp := up;
|
|
lastKick := temp;
|
|
delta := arrowDeltaLow;
|
|
nextDelta := arrowDeltaMed;
|
|
END
|
|
ELSE IF (Abs(temp-lastKick) >= nextDelta) &
|
|
(temp MOD nextDelta = 0) THEN
|
|
BEGIN
|
|
lastKick := temp;
|
|
delta := nextDelta;
|
|
IF delta = arrowDeltaMed
|
|
THEN nextDelta := arrowDeltaHi
|
|
ELSE nextDelta := MaxSmallFract;
|
|
END;
|
|
|
|
{If there's still room to move in the current direction,
|
|
do so.}
|
|
IF (up & (temp < MaxSmallFract)) |
|
|
(NOT up & (temp > 0)) THEN
|
|
BEGIN
|
|
IF up
|
|
THEN temp := Min(MaxSmallFract, temp + delta)
|
|
ELSE temp := Max(0, temp - delta);
|
|
components[c] := Fix2SmallFract(temp);
|
|
ShowAffected(theDialog, item);
|
|
END
|
|
|
|
{If the component we're tracking is hue, let the user
|
|
wrap around, so they can have fun circling the wheel.
|
|
lastKick is set so that the difference between it and
|
|
temp will remain < MaxSmallFract, and delta is set so
|
|
that the user keeps moving in the same sort of jumps
|
|
that they were before passing zero hue.}
|
|
ELSE IF (item = iHue) THEN
|
|
BEGIN
|
|
IF up THEN
|
|
BEGIN
|
|
lastKick := 1;
|
|
temp := delta;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
lastKick := MaxSmallFract - 1;
|
|
temp := MaxSmallFract - (MaxSmallFract MOD delta);
|
|
END;
|
|
temp := BAnd(temp, MaxSmallFract);
|
|
components[c] := Fix2SmallFract(temp);
|
|
ShowAffected(theDialog, item);
|
|
END;
|
|
END;
|
|
|
|
{Now that we've reflected the new value, check to see if
|
|
this is the first time 'round the loop. If so, we do
|
|
a small delay, to make life easier for slow clickers.}
|
|
IF doDelay THEN
|
|
BEGIN
|
|
Delay(3, finalTicks);
|
|
doDelay := FALSE;
|
|
END;
|
|
UNTIL NOT WaitMouseUp;
|
|
END;
|
|
|
|
{Regardless of where the user moused up, we've handled the mouse
|
|
down; let the filter proc know so ModalDialog will ignore it.}
|
|
END;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
BrightAdjust - Adjust to new value in brightness control. This routine
|
|
is called by both of the scroll bar tracking action procedures (BrightTrack
|
|
and BrightCtlTrack) once the new control value has been set.
|
|
}
|
|
|
|
PROCEDURE BrightAdjust(pickDlg: DialogPtr; ctlHand: ControlHandle; forceIt : Boolean);
|
|
VAR
|
|
newBright: SmallFract;
|
|
BEGIN
|
|
{See what lightness value the new control value translates to. If it's
|
|
the same as the current lightness, none of picker's values have
|
|
changed; don't bother updating them unless forceIt is set.}
|
|
BrightCtlGet(ctlHand, newBright);
|
|
WITH PickInfoPtr(pickDlg)^.theColor.hsx DO
|
|
IF (newBright <> lightness) OR forceIt THEN
|
|
BEGIN
|
|
lightness := newBright;
|
|
ShowNewValues(pickDlg, FALSE, [rgbText, lText, lWheel]);
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
BrightCtlGet - get the brightness control value into lightness range
|
|
BrightCtlSet - set the brightness control value from lightness
|
|
|
|
The following procedures convert between the brightness scroll bar control
|
|
value (which ranges from -32768 to 32767), and lightness/value (which ranges
|
|
from 0 to 1). In doing so, they also invert the value, because the scroll
|
|
bar minimum is at the top, where we want the lightness/value maximum to be.
|
|
}
|
|
|
|
PROCEDURE BrightCtlGet(ctlHand: ControlHandle; VAR lightness: SmallFract);
|
|
BEGIN
|
|
lightness := Fix2SmallFract(MaxSmallFract - MAXINT - 1 - GetCtlValue(ctlHand));
|
|
END;
|
|
|
|
PROCEDURE BrightCtlSet(ctlHand: ControlHandle; lightness: SmallFract);
|
|
BEGIN
|
|
SetCtlValue(ctlHand, MaxSmallFract - MAXINT - 1 - SmallFract2Fix(lightness));
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
BrightThumbTrack - update the colors while dragging the brightness thumb
|
|
}
|
|
|
|
PROCEDURE BrightThumbTrack;
|
|
CONST
|
|
kArrowHeight = 15; {Height in pixels of a single scroll bar arrow}
|
|
kThumbHeight = 16; {Height in pixels of the scroll bar thumb}
|
|
VAR
|
|
dlgPtr: DialogPtr;
|
|
ctlHand: ControlHandle;
|
|
startValue: LongInt;
|
|
pThumbData: ControlThumbInfoPtr;
|
|
curMouse: Point;
|
|
deltaV: LongInt;
|
|
pixelRange: LongInt;
|
|
newValue: LongInt;
|
|
newBright: SmallFract;
|
|
oldPenState:PenState;
|
|
gdType: INTEGER;
|
|
BEGIN
|
|
dlgPtr := DialogPtr(FrontWindow);
|
|
gdType := PickInfoPtr(dlgPtr)^.gdType;
|
|
ctlHand := ControlHandle(GetIHand(dlgPtr, iBrightCtl));
|
|
startValue := GetCtlValue(ctlHand);
|
|
pThumbData := ControlThumbInfoPtr(GetCRefCon(ctlHand));
|
|
GetMouse(curMouse);
|
|
|
|
IF PtInRect(curMouse, pThumbData^.slopRect)
|
|
THEN
|
|
{Calculate what the new control value would be if the user released
|
|
the mouse button at this point. Too bad this isn't done for us.}
|
|
BEGIN
|
|
deltaV := curMouse.v - pThumbData^.startPoint.v;
|
|
WITH ctlHand^^.contrlRect
|
|
DO
|
|
pixelRange := bottom - top - 2 * kArrowHeight - kThumbHeight;
|
|
newValue := startValue + (deltaV * 65535) DIV pixelRange;
|
|
IF newValue < -32768
|
|
THEN
|
|
newValue := -32768
|
|
ELSE IF newValue > 32767
|
|
THEN
|
|
newValue := 32767;
|
|
END
|
|
ELSE
|
|
newValue := startValue;
|
|
|
|
newBright := Fix2SmallFract(MaxSmallFract - MAXINT - 1 - newValue);
|
|
WITH PickInfoPtr(dlgPtr)^.theColor.hsx DO
|
|
IF newBright <> lightness
|
|
THEN
|
|
BEGIN
|
|
lightness := newBright;
|
|
GetPenState(oldPenState); { control mgr uses weird xor mode }
|
|
PenNormal;
|
|
IF gdType = clutType { <8> }
|
|
THEN
|
|
ShowNewValues(dlgPtr, FALSE, [lText,rgbText,lWheel]) { <8> }
|
|
ELSE { <8> }
|
|
ShowNewValues(dlgPtr, FALSE, [lText,rgbText]); { <8> }
|
|
SetPenState(oldPenState);
|
|
END
|
|
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
BrightTrack - track mouse-down inside brightness scroll bar
|
|
1.4a4 If we're on a clut device, do our color table animation
|
|
of the wheel and selection color while the user is
|
|
dragging the thumb in the scroll bar.
|
|
}
|
|
|
|
FUNCTION BrightTrack(theDialog: DialogPtr; where: Point): BOOLEAN;
|
|
VAR
|
|
ctlHand: ControlHandle;
|
|
itemHand: Handle;
|
|
partCode: INTEGER;
|
|
upCode: INTEGER;
|
|
thumbData: ControlThumbInfo;
|
|
dummyResult: LongInt;
|
|
BEGIN
|
|
BrightTrack := FALSE;
|
|
partCode := FindControl(where, WindowPtr(theDialog), ctlHand);
|
|
itemHand := GetIHand(theDialog, iBrightCtl);
|
|
|
|
IF (partCode <> 0) AND (ctlHand = ControlHandle(itemHand)) THEN
|
|
BEGIN
|
|
IF partCode = inThumb THEN
|
|
BEGIN
|
|
thumbData.startPoint := where;
|
|
thumbData.limitRect.topLeft := where;
|
|
{Ask the scroll bar defProc to calculate the slopRect we'll need in the
|
|
action proc.}
|
|
dummyResult := CallControl(ctlHand, thumbCntl, LongInt(@thumbData));
|
|
SetCRefCon(ctlHand, LongInt(@thumbData));
|
|
upCode := TrackControl(ctlHand, where, @BrightThumbTrack);
|
|
BrightAdjust(theDialog, ctlHand, TRUE);
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
PickInfoPtr(theDialog)^.whichPart := partCode;
|
|
upCode := TrackControl(ctlHand, where, @BrightTrackScroll);
|
|
END;
|
|
|
|
{Regardless of where the user moused up, we've handled the mouse
|
|
down; let the filter proc know so ModalDialog will ignore it.}
|
|
BrightTrack := TRUE;
|
|
END;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
BrightTrackScroll - Adjust the value of the scroll bar for page/line up/down.
|
|
}
|
|
|
|
PROCEDURE BrightTrackScroll(theControl: ControlHandle; partCode: INTEGER);
|
|
VAR
|
|
ctlVal: INTEGER;
|
|
delta: INTEGER;
|
|
newVal: LONGINT;
|
|
pickDlg: DialogPtr;
|
|
up: BOOLEAN;
|
|
BEGIN
|
|
pickDlg := FrontWindow;
|
|
WITH PickInfoPtr(pickDlg)^ DO
|
|
IF (whichPart = partCode) THEN
|
|
BEGIN
|
|
{Figure out whether the user wants to scroll up or down.}
|
|
IF partCode IN [inUpButton, inPageUp]
|
|
THEN delta := -lineBright
|
|
ELSE delta := lineBright;
|
|
|
|
{Change movement to a page if appropriate.}
|
|
IF partCode IN [inPageUp, inPageDown] THEN
|
|
delta := delta * pageBright;
|
|
|
|
{Hooray! Now do the scroll.}
|
|
ctlVal := GetCtlValue(theControl);
|
|
newVal := ORD4(ctlVal) + delta;
|
|
IF newVal > MAXINT THEN
|
|
newVal := MAXINT
|
|
ELSE IF newVal < (-MAXINT - 1) THEN
|
|
newVal := (-MAXINT - 1);
|
|
|
|
SetCtlValue(theControl, newVal);
|
|
BrightAdjust(pickDlg, theControl, FALSE);
|
|
END
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
CallControl - Safely get the control variant and definition procedure and call the
|
|
control with the given message and parameter.
|
|
}
|
|
|
|
FUNCTION CallControl(theControl : ControlHandle; message : Integer;
|
|
param : LongInt) : LongInt;
|
|
|
|
VAR
|
|
savedPort : GrafPtr;
|
|
ctlProcHandle : Handle;
|
|
savedState : SignedByte;
|
|
|
|
BEGIN
|
|
CallControl := 0; {This is the default, in case of error.}
|
|
|
|
GetPort(savedPort);
|
|
SetPort(theControl^^.contrlOwner);
|
|
|
|
|
|
ctlProcHandle := Handle(StripAddress(Ptr(theControl^^.contrlDefProc)));
|
|
IF ctlProcHandle^ = NIL THEN
|
|
LoadResource(ctlProcHandle);
|
|
|
|
IF ctlProcHandle^ <> NIL THEN BEGIN
|
|
savedState := HGetState(ctlProcHandle);
|
|
HLock(ctlProcHandle);
|
|
CallControl := CallCDEFProc(GetCVariant(theControl), theControl, message, param, ctlProcHandle^);
|
|
HSetState(ctlProcHandle, savedState);
|
|
END;
|
|
|
|
SetPort(savedPort);
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
CTabAdjust - adjust one or more of the colors in picker's color table
|
|
}
|
|
|
|
PROCEDURE CTabAdjust(pickDlg: DialogPtr; newBright: BOOLEAN);
|
|
VAR
|
|
c: PColor;
|
|
hsx: HSLColor;
|
|
update: BOOLEAN;
|
|
BEGIN
|
|
WITH PickInfoPtr(pickDlg)^
|
|
DO
|
|
BEGIN
|
|
IF colorOK
|
|
THEN
|
|
BEGIN
|
|
WITH pickCTab^^, hsx
|
|
DO
|
|
BEGIN
|
|
IF newBright
|
|
THEN
|
|
FOR c := cInput TO lastColor
|
|
DO
|
|
BEGIN
|
|
update := TRUE;
|
|
CASE c OF
|
|
cSample:
|
|
hsx := theColor.hsx;
|
|
cInput:
|
|
update := FALSE;
|
|
cGray:
|
|
BEGIN
|
|
hue := 0;
|
|
saturation := 0;
|
|
END;
|
|
OTHERWISE {wheel colors}
|
|
BEGIN
|
|
IF wheelColors > minColors
|
|
THEN
|
|
BEGIN
|
|
hue := Fix2SmallFract(FixRatio(ORD(c) - ORD(cSlice1), wheelColors div 2)mod 65536);
|
|
IF(ORD(c) - ORD(cSlice1) >= wheelColors div 2)
|
|
THEN
|
|
saturation := 32767
|
|
ELSE
|
|
saturation := 65535;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
hue := Fix2SmallFract(FixRatio(ORD(c) - ORD(cSlice1), wheelColors));
|
|
saturation := 65535;
|
|
END
|
|
END
|
|
END; {case}
|
|
|
|
IF update
|
|
THEN
|
|
BEGIN
|
|
lightness := theColor.hsx.lightness;
|
|
HSx2RGB(hsx, ctTable[ORD(c)].RGB);
|
|
END;
|
|
END
|
|
|
|
{If the lightness is the same, only the color in the sample
|
|
swatch (the one the user is picking) needs adjustment,
|
|
and the new value is already computed.}
|
|
ELSE
|
|
ctTable[ORD(cSample)].RGB := theColor.rgb;
|
|
END; {with pickdlgptr}
|
|
{$IFC UsePalette}
|
|
AnimatePalette(pickDlg,pickCTab,0,0,pickCTab^^.ctSize+1);
|
|
{$ENDC}
|
|
END; {if colorOK}
|
|
END;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
CTabBuild - build picker's color table, and the list of CLUT entries to borrow
|
|
}
|
|
|
|
{$IFC UsePalette}
|
|
PROCEDURE CTabBuild(VAR pickData: PickInfo; inColor: RGBColor);
|
|
VAR
|
|
globRect: Rect;
|
|
|
|
BEGIN
|
|
WITH pickData
|
|
DO
|
|
BEGIN
|
|
{
|
|
First, make sure we have color. If not, we'll make do with black
|
|
and white, avoid calling any of color quickdraw, and building
|
|
the table is a null operation: we don't need it
|
|
|
|
Figure out whether or not we have color quickdraw, and enough
|
|
bits per pixel to really use color. For now, we check that the
|
|
machine has a Mac II or later ROM to see if color Quickdraw
|
|
is available. There should be a better way to do this
|
|
}
|
|
|
|
wheelColors := minColors;
|
|
pixSize := 1;
|
|
colorOK := (BAnd(IntPtr(ROM85)^, BNot($3FFF)) = 0);
|
|
|
|
IF colorOK
|
|
THEN
|
|
BEGIN
|
|
globRect := dlgRec.window.port.portRect; { figure global rect }
|
|
LocalToGlobal(globRect.topLeft);
|
|
LocalToGlobal(globRect.botRight);
|
|
|
|
itsGDev := GetMaxDevice(globRect); { find deepest device sect }
|
|
|
|
IF itsGDev = NIL { if no sect, fake it }
|
|
THEN
|
|
itsGDev := GetGDevice;
|
|
|
|
pixSize := PixMapHandle(itsGDev^^.gdPMap)^^.pixelSize;
|
|
gdType := itsGDev^^.gdType;
|
|
IF (gdType = clutType)
|
|
THEN
|
|
IF (pixSize >= 8)
|
|
THEN
|
|
wheelColors := maxColors
|
|
ELSE IF (pixSize = 2)
|
|
THEN
|
|
wheelColors := -1 { so all we get is input and sample }
|
|
END;
|
|
|
|
colorOK := colorOK AND (pixSize >= 2);
|
|
lastColor := PColor(ORD(cSlice1) + wheelColors - 1);
|
|
|
|
IF NOT colorOK
|
|
THEN
|
|
BEGIN
|
|
pickCTab := NIL;
|
|
pickPal := NIL;
|
|
lastColor := PColor(0);
|
|
EXIT (CTabBuild);
|
|
END;
|
|
|
|
{Allocate our color table.}
|
|
pickCTab := CTabHandle(NewHandle(
|
|
Sizeof(ColorTable) + (Sizeof(ColorSpec) * ORD(lastColor))));
|
|
|
|
{Set up our color table.}
|
|
WITH pickCTab^^
|
|
DO
|
|
BEGIN
|
|
ctSize := ORD(lastColor);
|
|
ctSeed := 0;
|
|
ctFlags := 0; { 1.2 }
|
|
END;
|
|
|
|
{Next, figure out which CLUT entries to borrow. For now, we get
|
|
the widest possible distribution (try to avoid conflicts) by
|
|
trying to match the hues at maximum brightness, the gray at
|
|
medium range, and the input and current sample as complements.
|
|
Surely there is better way to distribute the colors?}
|
|
pickCTab^^.ctTable[ORD(cInput)].rgb := inColor;
|
|
pickPal := NewPalette(pickCTab^^.ctSize+1,pickCTab,pmAnimated,0);
|
|
SetEntryUsage(pickPal,ORD(cInput),pmTolerant,0);
|
|
SetPalette(WindowPtr(@dlgRec),pickPal,TRUE);
|
|
CTabAdjust(DialogPtr(@pickData), TRUE);
|
|
END;
|
|
END;
|
|
|
|
|
|
{$ELSEC} {UsePalette}
|
|
PROCEDURE CTabBuild(VAR pickData: PickInfo; inColor: RGBColor);
|
|
CONST
|
|
HiliteRGB = $DA0;
|
|
VAR
|
|
c: PColor;
|
|
hiliteColor: INTEGER;
|
|
nextTry: INTEGER;
|
|
saveLight: SmallFract;
|
|
skipsAllowed: INTEGER;
|
|
tempColor: RGBColor;
|
|
saveGDev: GDHandle;
|
|
globRect: Rect; { rect to globalize port in, for maxDev }
|
|
|
|
FUNCTION BadChoice(index: INTEGER; c: PColor; doSkip: BOOLEAN): BOOLEAN;
|
|
BEGIN
|
|
IF index = hiliteColor THEN
|
|
BadChoice := TRUE
|
|
ELSE
|
|
BadChoice := FALSE;
|
|
END;
|
|
|
|
FUNCTION Conflict(index: INTEGER; c: PColor): BOOLEAN;
|
|
VAR
|
|
p: PColor;
|
|
BEGIN
|
|
{Return TRUE iff index is used in any earlier table entry.}
|
|
IF BadChoice(index, c, FALSE) THEN
|
|
Conflict := TRUE
|
|
ELSE
|
|
BEGIN
|
|
Conflict := FALSE;
|
|
WITH pickData.pickReqList^^ DO
|
|
FOR p := cInput TO PRED(c) DO
|
|
IF reqLData[ORD(p)] = index THEN
|
|
BEGIN
|
|
Conflict := TRUE;
|
|
EXIT (Conflict);
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
FUNCTION Taken(index: INTEGER; c: PColor): BOOLEAN;
|
|
VAR
|
|
p: PColor;
|
|
BEGIN
|
|
{Return TRUE iff index, an entry we're considering stealing, is
|
|
already in the table, and taking it would cause a conflict.}
|
|
IF BadChoice(index, c, TRUE) THEN
|
|
Taken := TRUE
|
|
ELSE
|
|
BEGIN
|
|
Taken := FALSE;
|
|
WITH pickData, pickReqList^^ DO
|
|
FOR p := cInput TO lastColor DO
|
|
IF reqLData[ORD(p)] = index THEN
|
|
BEGIN
|
|
Taken := TRUE;
|
|
EXIT (Taken);
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
BEGIN {CTabBuild}
|
|
WITH pickData DO
|
|
BEGIN
|
|
{First, make sure we have color. If not, we'll make do with black
|
|
and white, avoid calling any of color quickdraw, and building
|
|
the table is a null operation: we don't need it.}
|
|
{$IFC GRUNGY}
|
|
{Figure out whether or not we have color quickdraw, and enough
|
|
bits per pixel to really use color. For now, we check that the
|
|
machine has a Mac II or later ROM to see if color Quickdraw
|
|
is available. There should be a better way to do this.}
|
|
wheelColors := minColors;
|
|
pixSize := 1;
|
|
colorOK := (BAnd(IntPtr(ROM85)^, BNot($3FFF)) = 0);
|
|
IF colorOK THEN
|
|
BEGIN
|
|
|
|
globRect := dlgRec.window.port.portRect; { figure global rect }
|
|
LocalToGlobal(globRect.topLeft);
|
|
LocalToGlobal(globRect.botRight);
|
|
|
|
itsGDev := GetMaxDevice(globRect); { find deepest device sect }
|
|
|
|
IF itsGDev = NIL { if no sect, fake it }
|
|
THEN
|
|
itsGDev := GetGDevice;
|
|
|
|
pixSize := PixMapHandle(itsGDev^^.gdPMap)^^.pixelSize;
|
|
gdType := itsGDev^^.gdType;
|
|
IF (gdType = clutType) AND (pixSize >= 8) THEN
|
|
wheelColors := maxColors;
|
|
END;
|
|
colorOK := colorOK AND (pixSize >= 4);
|
|
lastColor := PColor(ORD(cSlice1) + wheelColors - 1);
|
|
{$ENDC}
|
|
IF NOT colorOK THEN
|
|
BEGIN
|
|
pickCTab := NIL;
|
|
pickReqList := NIL;
|
|
EXIT (CTabBuild);
|
|
END;
|
|
|
|
{For a time, work in the GDev containing the picker...}
|
|
saveGDev := GetGDevice;
|
|
SetGDevice(itsGDev);
|
|
itsGDev^^.gdPMap^^.pmTable^^.ctSeed := GetCTSeed;
|
|
|
|
{Allocate our color table.}
|
|
pickCTab := CTabHandle(NewHandle(
|
|
Sizeof(ColorTable) + (Sizeof(ColorSpec) * ORD(lastColor))));
|
|
|
|
{Set up our color table.}
|
|
WITH pickCTab^^ DO
|
|
BEGIN
|
|
ctSize := ORD(lastColor);
|
|
ctSeed := 0;
|
|
ctFlags := 0; { 1.2 }
|
|
|
|
{Next, figure out which CLUT entries to borrow. For now, we get
|
|
the widest possible distribution (try to avoid conflicts) by
|
|
trying to match the hues at maximum brightness, the gray at
|
|
medium range, and the input and current sample as complements.
|
|
Surely there is better way to distribute the colors?}
|
|
WITH pickCTab^^ DO
|
|
BEGIN
|
|
CTabAdjust(DialogPtr(@pickData), TRUE);
|
|
ctTable[ORD(cInput)].rgb := inColor;
|
|
END;
|
|
|
|
{Now that we've distributed the colors, call GetSubTable to fill in
|
|
the indices of the nearest matches among current CLUT entries.}
|
|
GetSubTable(pickCTab, 4, NIL);
|
|
|
|
{Allocate the request list.}
|
|
pickReqList := ReqListHandle(NewHandle(
|
|
Sizeof(ReqListRec) + (Sizeof(INTEGER) * ORD(lastColor))));
|
|
|
|
{Set up the request list, which we'll need to save and restore
|
|
the colors set when we were called, and those we borrow.}
|
|
WITH pickCTab^^, pickReqList^^ DO
|
|
BEGIN
|
|
reqLSize := ORD(lastColor);
|
|
FOR c := cInput TO lastColor DO
|
|
reqLData[ORD(c)] := ctTable[ORD(c)].value;
|
|
|
|
{See if the CLUT indices returned by GetSubTable are unique.
|
|
If not, resolve the conflicts by finding other unmatched
|
|
entries.}
|
|
tempColor := RGBColorPtr(HiliteRGB)^;
|
|
hiliteColor := Color2Index(tempColor);
|
|
|
|
{Figure out how many colors we can pass up as poor choices for
|
|
conflict resolution. The value computed below is:
|
|
|
|
Number of entries in the color table
|
|
- Number of entries we require
|
|
+2 (Entries for black and white, which we must skip)
|
|
-1 (One held in reserve for skipping the hilite color)
|
|
------------------------------------------------------------
|
|
skips we can make before we run out
|
|
|
|
The entries we skip over (in Conflict and Taken) are the current
|
|
hilight color and, if possible, grays. Grays are skipped
|
|
because they may be used in gray scale fonts, which may be
|
|
on the screen, and look remarkable ugly animated.}
|
|
skipsAllowed := BSL(1, pixSize) - (ORD(lastColor) + 1) + 1;
|
|
|
|
nextTry := BSL(1, pixSize) - 1;
|
|
FOR c := cInput TO lastColor DO
|
|
BEGIN
|
|
IF Conflict(reqLData[ORD(c)], c) THEN
|
|
BEGIN
|
|
WHILE Taken(nextTry, c) DO
|
|
nextTry := nextTry - 1;
|
|
reqLData[ORD(c)] := nextTry;
|
|
ctTable[ORD(c)].value := nextTry;
|
|
nextTry := nextTry - 1;
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
SetGDevice(saveGDev); {restore old GDev}
|
|
|
|
END; {with pickData}
|
|
END; {CTabBuild}
|
|
{$ENDC} { UsePalette }
|
|
|
|
{---------------------------------------------------------------------------------
|
|
CTabInstall - (re)install color picker's color table to get new colors
|
|
}
|
|
|
|
PROCEDURE CTabInstall(pickDlg: DialogPtr; newBright: BOOLEAN);
|
|
VAR
|
|
loneReq: ReqListRec;
|
|
loneColor: CTabHandle;
|
|
saveGDev: GDHandle;
|
|
BEGIN
|
|
{$IFC NOT UsePalette}
|
|
WITH PickInfoPtr(pickDlg)^ DO
|
|
IF colorOK THEN
|
|
IF newBright THEN
|
|
BEGIN
|
|
HLock(Handle(pickReqList));
|
|
saveGDev := GetGDevice;
|
|
SetGDevice(itsGDev);
|
|
RestoreEntries(pickCTab, NIL, pickReqList^^);
|
|
SetGDevice(saveGDev);
|
|
|
|
HUnlock(Handle(pickReqList));
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
loneColor := CTabHandle (NewHandle (SIZEOF (ColorTable)));
|
|
WITH loneColor^^ DO
|
|
BEGIN
|
|
ctSeed := pickCTab^^.ctSeed;
|
|
ctFlags := pickCTab^^.ctFlags; { 1.2 }
|
|
ctSize := 0;
|
|
ctTable[0] := pickCTab^^.ctTable[ORD(cSample)];
|
|
END;
|
|
WITH loneReq DO
|
|
BEGIN
|
|
reqLSize := 0;
|
|
reqLData[0] := pickReqList^^.reqLData[ORD(cSample)];
|
|
END;
|
|
|
|
saveGDev := GetGDevice;
|
|
SetGDevice(itsGDev);
|
|
RestoreEntries(loneColor, NIL, loneReq);
|
|
SetGDevice(saveGDev);
|
|
|
|
DisposHandle (Handle (loneColor));
|
|
END;
|
|
{$ENDC}
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
CTabRestore - restore color table to pre-picker condition
|
|
}
|
|
|
|
PROCEDURE CTabRestore(pickPtr: PickInfoPtr);
|
|
VAR
|
|
saveGDev: GDHandle;
|
|
BEGIN
|
|
{$IFC NOT UsePalette}
|
|
WITH pickPtr^ DO
|
|
IF colorOK THEN
|
|
BEGIN
|
|
HLock(Handle(pickReqList));
|
|
|
|
saveGDev := GetGDevice;
|
|
SetGDevice(itsGDev);
|
|
RestoreEntries(saveCTab, NIL, pickReqList^^);
|
|
SetGDevice(saveGDev);
|
|
|
|
HUnlock(Handle(pickReqList));
|
|
DisposHandle(Handle(saveCTab));
|
|
END;
|
|
{$ENDC}
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
CTabSave - save pre-picker color table
|
|
}
|
|
|
|
PROCEDURE CTabSave(pickPtr: PickInfoPtr);
|
|
VAR
|
|
saveGDev: GDHandle;
|
|
BEGIN
|
|
{$IFC NOT UsePalette}
|
|
{We know which CLUT slots we're going to borrow, and what colors to
|
|
replace them with. All that remains is to save the current entries,
|
|
so we can restore them before leaving.}
|
|
WITH pickPtr^ DO
|
|
IF colorOK THEN
|
|
BEGIN
|
|
saveCTab := CTabHandle(NewHandle(0));
|
|
HLock(Handle(pickReqList));
|
|
saveGDev := GetGDevice;
|
|
SetGDevice(itsGDev);
|
|
SaveEntries(NIL, saveCTab, pickReqList^^);
|
|
SetGDevice(saveGDev);
|
|
HUnlock(Handle(pickReqList));
|
|
END
|
|
ELSE
|
|
saveCTab := NIL;
|
|
{$ENDC}
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
CTabSearch - return index of CLUT entry we requested
|
|
}
|
|
|
|
FUNCTION CTabSearch(myColor: RGBColor; VAR index: LONGINT): BOOLEAN;
|
|
BEGIN
|
|
|
|
{Return true (and a CLUT index) iff the main color picker dialog is
|
|
the one requesting the color. If so, the client ID will be set
|
|
and we can get at picker's vars via FrontWindow.
|
|
We don't really do any searching, since the table may have duplicate
|
|
entries; instead we return the index CLUT represented in whichColor.
|
|
We've known that all along, but without color quickdraw routines
|
|
IndexForeColor and IndexBackColor, the search proc is the only way
|
|
to coerce the CLUT entries we want.
|
|
We don't need to worry about checking colorOK here, since this routine
|
|
is called iff it's true.
|
|
Finally, do nothing unless we're on a CLUT device; on a fixed device, we
|
|
want the default search proc to get the closest current match.}
|
|
|
|
CTabSearch := FALSE;
|
|
WITH GetGDevice^^
|
|
DO
|
|
IF (gdID = pickClientID) AND
|
|
(myColor.red = 12) AND
|
|
(myColor.green = 34)
|
|
THEN
|
|
WITH PickInfoPtr(FrontWindow)^.pickCTab^^.ctTable[myColor.blue]
|
|
DO
|
|
BEGIN
|
|
CTabSearch := TRUE;
|
|
IF gdType = clutType
|
|
THEN
|
|
index := value
|
|
ELSE
|
|
IF (gdPMap^^.pixelSize = 32)
|
|
THEN
|
|
index := (BAnd(LONGINT(rgb.red),$0000FFFF) div 256) * 256*256 +
|
|
(BAnd(LONGINT(rgb.green),$0000FFFF) div 256) * 256 +
|
|
(BAnd(LONGINT(rgb.blue),$0000FFFF) div 256)
|
|
ELSE
|
|
index := (BAnd(LONGINT(rgb.red),$0000FFFF) div 2048) * 32*32 +
|
|
(BAnd(LONGINT(rgb.green),$0000FFFF) div 2048) * 32 +
|
|
(BAnd(LONGINT(rgb.blue),$0000FFFF) div 2048);
|
|
END;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
Dither1, Dither50 - set up a dither pattern
|
|
}
|
|
|
|
PROCEDURE Dither50(which1, which2: pColor);
|
|
{
|
|
Set the foreground color to which1, and the
|
|
background color to which2.
|
|
Set the pattern to 50% gray.
|
|
}
|
|
BEGIN
|
|
{$IFC UsePalette}
|
|
PmForeColor(ORD(which1));
|
|
PmBackColor(ORD(which2));
|
|
{$ELSEC}
|
|
anRGB.red := 12;
|
|
anRGB.green := 34;
|
|
anRGB.blue := ORD(which1);
|
|
RGBForeColor(anRGB);
|
|
anRGB.blue := ORD(which2);
|
|
RGBNormal;
|
|
{$ENDC}
|
|
PenPat (GetQDGlobals^.gray);
|
|
END;
|
|
|
|
|
|
PROCEDURE Dither1(which1: pColor);
|
|
VAR
|
|
anRGB: RGBColor;
|
|
BEGIN
|
|
{$IFC UsePalette}
|
|
PmForeColor(ORD(which1));
|
|
{$ELSEC}
|
|
anRGB.red := 12;
|
|
anRGB.green := 34;
|
|
anRGB.blue := ORD(which1);
|
|
RGBForeColor(anRGB);
|
|
{$ENDC}
|
|
PenPat (GetQDGlobals^.black);
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
DeviceCTab - return handle to the current graphics device's CLUT, if any
|
|
}
|
|
|
|
FUNCTION DeviceCTab: CTabHandle;
|
|
BEGIN
|
|
DeviceCTab := PixMapHandle(GetGDevice^^.gdPMap)^^.pmTable;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
DeviceITab - return handle to the current graphics device's inverse table, if any
|
|
}
|
|
|
|
FUNCTION DeviceITab: ITabHandle;
|
|
BEGIN
|
|
DeviceITab := GetGDevice^^.gdITable;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
RGBNormal - Fore and back to black and white, please
|
|
}
|
|
|
|
PROCEDURE RGBNormal;
|
|
BEGIN
|
|
|
|
IF (BAnd(IntPtr(ROM85)^, BNot($3FFF)) = 0)
|
|
THEN
|
|
BEGIN
|
|
RGBForeColor(RGBColorPtr(RGBBlack)^);
|
|
RGBBackColor(RGBColorPtr(RGBWhite)^);
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
GetIHand - get handle for given dialog item
|
|
GetIRect - get rectangle for given dialog item
|
|
}
|
|
|
|
FUNCTION GetIHand(theDialog: DialogPtr; item: INTEGER): Handle;
|
|
VAR
|
|
itemHand: Handle;
|
|
itemRect: Rect;
|
|
itemType: INTEGER;
|
|
BEGIN
|
|
GetDItem(theDialog, item, itemType, itemHand, itemRect);
|
|
GetIHand := itemHand;
|
|
END;
|
|
|
|
PROCEDURE GetIRect(theDialog: DialogPtr; item: INTEGER; VAR itemRect: Rect);
|
|
VAR
|
|
itemType: INTEGER;
|
|
itemHand: Handle;
|
|
BEGIN
|
|
GetDItem(theDialog, item, itemType, itemHand, itemRect);
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
GetQDGlobals - return pointer to quickdraw globals
|
|
}
|
|
|
|
FUNCTION GetQDGlobals: QDGlobalsPtr;
|
|
TYPE
|
|
LPtr = ^LONGINT;
|
|
LPtrPtr = ^LPtr;
|
|
BEGIN
|
|
{Get pointer to thePort, which is at offset zero from A5, and adjust
|
|
it to point at the base of the quickdraw globals. We have to do
|
|
this to reference those globals from a PACK. $904 is the low
|
|
memory variable CurrentA5.}
|
|
GetQDGlobals := QDGlobalsPtr(
|
|
LPtrPtr($904)^^ + Sizeof(GrafPtr) - Sizeof(QDGlobals));
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
HSx2RGB - convert HSL/HSV color to RGB, based on HSV compile time flag
|
|
RGB2HSx - convert RGB color to HSL/HSV, based on HSV compile time flag
|
|
}
|
|
|
|
PROCEDURE HSx2RGB(hsx: HSLColor; VAR rgb: RGBColor);
|
|
BEGIN
|
|
{$IFC HSV}
|
|
HSV2RGB(HSVColor(hsx), rgb);
|
|
{$ELSEC}
|
|
HSL2RGB(hsx, rgb);
|
|
{$ENDC}
|
|
END;
|
|
|
|
PROCEDURE RGB2HSx(rgb: RGBColor; VAR hsx: HSLColor);
|
|
BEGIN
|
|
{$IFC HSV}
|
|
RGB2HSV(rgb, HSVColor(hsx));
|
|
{$ELSEC}
|
|
RGB2HSL(rgb, hsx);
|
|
{$ENDC}
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
PickDlgClose - close down the color picker dialog
|
|
}
|
|
|
|
PROCEDURE PickDlgClose(infoPtr: PickInfoPtr);
|
|
VAR
|
|
itemList: Handle;
|
|
saveGDev: GDHandle;
|
|
BEGIN
|
|
WITH infoPtr^ DO
|
|
BEGIN
|
|
DisposeRgn(wheelRgn);
|
|
DisposeRgn(slopRgn);
|
|
DisposeRgn(cursorRgn);
|
|
ReleaseResource(Handle(cursorHand));
|
|
|
|
itemList := dlgRec.items;
|
|
|
|
IF colorOK THEN
|
|
BEGIN
|
|
{Restore pre-picker colors, and dispose of related memory.}
|
|
CTabRestore(infoPtr);
|
|
DisposHandle(Handle(pickCTab));
|
|
{$IFC NOT UsePalette}
|
|
DisposHandle(Handle(pickReqList));
|
|
{Get rid of the search proc we added.}
|
|
|
|
saveGDev := GetGDevice;
|
|
SetGDevice(itsGDev);
|
|
DelSearch(@CTabSearch);
|
|
SetGDevice(saveGDev);
|
|
{$ENDC}
|
|
{ADD: Use QDErr here, to check that the rebuild succeeded.}
|
|
END;
|
|
|
|
CloseDialog(DialogPtr(infoPtr));
|
|
|
|
IF colorOK THEN {<9>}
|
|
DisposePalette(pickPal); {<9>}
|
|
END;
|
|
|
|
DisposHandle(itemList);
|
|
|
|
InitCursor;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
PickDlgDrawItem - draw requested user item in picker dialog
|
|
}
|
|
|
|
PROCEDURE PickDlgDrawItem(theWindow: WindowPtr; item: INTEGER);
|
|
VAR
|
|
fontStuff: FontInfo;
|
|
itemRect: Rect;
|
|
version: Str255;
|
|
arrowPic: PicHandle;
|
|
BEGIN
|
|
SetPort(GrafPtr(theWindow));
|
|
GetIRect(DialogPtr(theWindow), item, itemRect);
|
|
|
|
CASE item OF
|
|
iOkOutline:
|
|
BEGIN
|
|
PenNormal;
|
|
PenSize(3,3);
|
|
FrameRoundRect(itemRect, 16, 16);
|
|
END;
|
|
|
|
iWheel:
|
|
WheelDraw(DialogPtr(theWindow), itemRect);
|
|
|
|
iOldSample,
|
|
iNewSample:
|
|
SampleDraw(DialogPtr(theWindow), item, itemRect);
|
|
|
|
iVersion:
|
|
BEGIN
|
|
TextFont(applFont);
|
|
TextSize(9);
|
|
GetWTitle(theWindow, version);
|
|
GetFontInfo(fontStuff);
|
|
WITH itemRect DO
|
|
MoveTo(left, top+fontStuff.ascent);
|
|
DrawString(version);
|
|
END;
|
|
|
|
OTHERWISE
|
|
BEGIN
|
|
arrowPic := GetPicture(rArrowPic);
|
|
DrawPicture(arrowPic,itemRect);
|
|
END;
|
|
END;
|
|
|
|
RGBNormal;
|
|
PenNormal;
|
|
TextFont(systemFont);
|
|
TextSize(0);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
PickDlgFilter - respond to mousing around in color wheel, etc
|
|
}
|
|
|
|
FUNCTION PickDlgFilter(theDialog: DialogPtr; VAR theEvent: EventRecord; VAR itemHit: INTEGER): BOOLEAN;
|
|
CONST
|
|
kUpArrow = $1E; {Character codes (NOT key codes) for the arrow keys}
|
|
kDnArrow = $1F;
|
|
kLtArrow = $1C;
|
|
kRtArrow = $1D;
|
|
|
|
VAR
|
|
key: INTEGER;
|
|
itemHand: Handle;
|
|
s: Str255;
|
|
savePort: GrafPtr;
|
|
wantOurCursor: BOOLEAN;
|
|
where: Point;
|
|
btnControl: ControlHandle;
|
|
dummyTicks: LongInt;
|
|
|
|
thatPixel: RGBColor;
|
|
oldColor: RGBColor;
|
|
BEGIN
|
|
PickDlgFilter := FALSE;
|
|
GetPort(savePort);
|
|
SetPort(theDialog);
|
|
|
|
{Handle mouse commands in the color wheel and the increment/decrement
|
|
arrows for the color specs. Also handle keyboard shortcuts for
|
|
fine cursor control, and mimic the standard filter's behavior for
|
|
the return and enter keys.}
|
|
|
|
GetMouse(where);
|
|
WITH PickInfoPtr(theDialog)^ { This used to be in the nullevent action, }
|
|
DO { but System 7 didn't give us nulls! -dvb }
|
|
BEGIN
|
|
wantOurCursor := PtInRgn(where, cursorRgn);
|
|
IF wantOurCursor <> ourCursor
|
|
THEN
|
|
BEGIN
|
|
IF ourCursor
|
|
THEN
|
|
SetCursor(GetQDGlobals^.arrow)
|
|
ELSE
|
|
SetCursor(cursorHand^^);
|
|
ourCursor := wantOurCursor;
|
|
END;
|
|
END;
|
|
|
|
where := theEvent.where;
|
|
GlobalToLocal(where);
|
|
|
|
CASE theEvent.what OF
|
|
autoKey, {1.2b1}
|
|
keyDown:
|
|
BEGIN
|
|
WITH theEvent DO
|
|
key := BAnd(message, charCodeMask);
|
|
|
|
IF (BAnd(theEvent.modifiers, cmdKey) <> 0) OR (key=27) THEN
|
|
{Handle pseudo key equivalents for Cut, Copy, and Paste}
|
|
BEGIN
|
|
CASE Chr(key) OF
|
|
'x', 'X' :
|
|
BEGIN
|
|
DlgCut(theDialog);
|
|
SnareNewComponents(theDialog);
|
|
END;
|
|
'c', 'C' :
|
|
BEGIN
|
|
DlgCopy(theDialog);
|
|
SnareNewComponents(theDialog);
|
|
END;
|
|
'v', 'V' :
|
|
BEGIN
|
|
DlgPaste(theDialog);
|
|
SnareNewComponents(theDialog);
|
|
END;
|
|
'.', chr(27) :
|
|
BEGIN
|
|
btnControl := ControlHandle(GetIHand(theDialog, cancel));
|
|
HiliteControl(btnControl, inButton);
|
|
Delay(8, dummyTicks);
|
|
HiliteControl(btnControl, 0);
|
|
itemHit := cancel;
|
|
END;
|
|
OTHERWISE
|
|
SysBeep(1);
|
|
END;
|
|
PickDlgFilter := TRUE;
|
|
END
|
|
|
|
ELSE IF (key = $03) OR (key = $0D) THEN
|
|
{Make return and enter the same as pushing the OK button.}
|
|
BEGIN
|
|
SnareNewComponents(theDialog);
|
|
btnControl := ControlHandle(GetIHand(theDialog, ok));
|
|
HiliteControl(btnControl, inButton);
|
|
Delay(8, dummyTicks);
|
|
HiliteControl(btnControl, 0);
|
|
itemHit := OK;
|
|
PickDlgFilter := TRUE;
|
|
END
|
|
|
|
{If the user is tabbing, get any new value in field they're
|
|
leaving. Note that PickDlgFilter remains FALSE, so that
|
|
ModalDialog will change fields in response to the tab.}
|
|
ELSE IF (key = $09) THEN
|
|
SnareNewComponents(theDialog)
|
|
|
|
{If the key isn't a digit or backspace or one of the arrow keys,
|
|
ignore it, and indicate to ModalDialog that we've handled
|
|
the (unwanted) event.}
|
|
ELSE IF (key < ORD('0')) OR (key > ORD('9')) THEN
|
|
BEGIN
|
|
IF (key <> $08) AND (key <> kUpArrow) AND (key <> kDnArrow) AND
|
|
(key <> kLtArrow) AND (key <> kRtArrow) THEN
|
|
BEGIN
|
|
SysBeep(1);
|
|
PickDlgFilter := TRUE;
|
|
END;
|
|
END
|
|
|
|
{The key is a digit. But if the field less the current selection
|
|
is already five digits wide, we don't even want a digit.}
|
|
ELSE WITH DialogPeek(theDialog)^ DO
|
|
BEGIN
|
|
itemHand := GetIHand(theDialog, editField + 1);
|
|
GetIText(itemHand, s);
|
|
WITH textH^^ DO
|
|
IF (Length(s) - (selEnd - selStart) >= 5) THEN
|
|
BEGIN
|
|
SysBeep(1);
|
|
PickDlgFilter := TRUE;
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
mouseDown:
|
|
BEGIN
|
|
|
|
IF ( (NOT PtInRect(where,theDialog^.portRect)) AND
|
|
(BAnd(theEvent.modifiers, optionKey) <> 0) )
|
|
THEN
|
|
BEGIN
|
|
oldColor := PickInfoPtr(theDialog)^.theColor.rgb;
|
|
REPEAT
|
|
IF (PtInRect(where,theDialog^.portRect))
|
|
THEN
|
|
thatPixel := oldColor
|
|
ELSE
|
|
GetCPixel(where.h,where.v,thatPixel);
|
|
PickInfoPtr(theDialog)^.theColor.rgb := thatPixel;
|
|
ShowNewValues(theDialog, TRUE, [rgbText..bright]);
|
|
GetMouse(where);
|
|
UNTIL NOT WaitMouseUp;
|
|
|
|
PickDlgFilter := TRUE;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
SnareNewComponents(theDialog);
|
|
PickDlgFilter :=
|
|
BrightTrack(theDialog, where) |
|
|
WheelTrack(theDialog, where) |
|
|
SampleTrack(theDialog, where) |
|
|
ArrowTrack(theDialog, where, BAnd(theEvent.modifiers, optionKey) <> 0);
|
|
END;
|
|
END;
|
|
END; {case}
|
|
|
|
SetPort(savePort);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
PickDlgOpen - get the picker dialog and set it up
|
|
If where is (-1, -1), then put the dialog on the best screen, with
|
|
the measure of "goodness" coming from this ordering:
|
|
either 1-bit, mono 2-bit, color 2-bit, mono 4-bit, mono 8-bit, color >= 4
|
|
}
|
|
|
|
FUNCTION PickDlgOpen(infoPtr: PickInfoPtr; where: Point; prompt: Str255): DialogPtr;
|
|
VAR
|
|
useBest: BOOLEAN; {true if v=h=-1}
|
|
i: INTEGER;
|
|
truncResult: INTEGER; {Result of TruncString call... ignored <12>}
|
|
itemHand: Handle; {Dialog item handle got by GetDItem}
|
|
itemRect: Rect; {Dialog item rectangle got by GetDItem}
|
|
itemType: INTEGER; {Dialog item type got by GetDItem}
|
|
pickDlg: DialogPtr; {Dialog pointer we'll return eventually}
|
|
pickPltt: PaletteHandle; {Dialog palette to avoid the ActivatePalette}
|
|
aDevice: GDHandle; {Handle for traversing device list}
|
|
bestDevice: GDHandle; {Handle to the "best" device}
|
|
devRating: Integer; {Value of device's "goodness"}
|
|
bestDevRating: Integer; {Value of best device's "goodness"}
|
|
BEGIN
|
|
{Get the dialog from the system resource file.}
|
|
pickDlg := GetNewDialog(rPickDlg, Pointer(infoPtr), WindowPtr(-1));
|
|
SetPort (pickDlg); {1.2b1}
|
|
{$IFC NOT UsePalette}
|
|
IF (BAnd(IntPtr(ROM85)^, BNot($3FFF)) = 0) THEN {Same test as info^.colorOk} {1.2b1}
|
|
BEGIN
|
|
pickPltt := NewPalette(1, NIL, pmCourteous, 0);
|
|
SetPalette(pickDlg, pickPltt, TRUE)
|
|
END;
|
|
{$ENDC}
|
|
{Make the user items reference the procedures to draw them.}
|
|
FOR i := iFirstUI TO iLastUI DO
|
|
BEGIN
|
|
GetDItem(pickDlg, i, itemType, itemHand, itemRect);
|
|
SetDItem(pickDlg, i, itemType, Handle(@PickDlgDrawItem), itemRect);
|
|
|
|
{For the wheel, use the itemRect to determine the region of the
|
|
enclosed circle, which we'll need for hit testing later.}
|
|
IF i = iWheel THEN
|
|
WITH infoPtr^ DO
|
|
BEGIN
|
|
wheelRgn := NewRgn;
|
|
OpenRgn;
|
|
FrameOval(itemRect);
|
|
CloseRgn(wheelRgn);
|
|
WITH itemRect DO
|
|
BEGIN
|
|
wheelRadius := FixRatio(right-left, 2);
|
|
WITH wheelCenter DO
|
|
BEGIN
|
|
h := (left + right) DIV 2;
|
|
v := (top + bottom) DIV 2;
|
|
END;
|
|
END;
|
|
slopRgn := NewRgn;
|
|
OpenRgn;
|
|
InsetRect(itemRect, -slopRim, -slopRim);
|
|
FrameOval(itemRect);
|
|
CloseRgn(slopRgn);
|
|
END;
|
|
END;
|
|
|
|
{Set up cursor variables.}
|
|
WITH infoPtr^ DO
|
|
BEGIN
|
|
cursorRgn := NewRgn;
|
|
OpenRgn;
|
|
{ FOR i := iFirstArrow TO iLastArrow DO
|
|
BEGIN
|
|
GetIRect(pickDlg, i, itemRect);
|
|
FrameRect(itemRect);
|
|
END; }
|
|
GetIRect(pickDlg, iOldSample, itemRect);
|
|
FrameRect(itemRect);
|
|
CloseRgn(cursorRgn);
|
|
UnionRgn(wheelRgn, cursorRgn, cursorRgn);
|
|
cursorHand := GetCursor(rCursor);
|
|
SetCursor(GetQDGlobals^.arrow); {08Aug89 CSD Vers 1.3 -- Fixes BRC 30423}
|
|
ourCursor := FALSE;
|
|
|
|
HS2WheelPos(pickDlg, hotSpot);
|
|
END;
|
|
|
|
{Position the dialog. If where is (0,0), position the dialog neatly
|
|
for the user: center it horizontally, and leave one third of the
|
|
margin above and two thirds below vertically.}
|
|
WITH where DO
|
|
BEGIN
|
|
useBest := (h = -1) AND (v = -1);
|
|
IF ((h = 0) AND (v = 0)) OR (useBest AND
|
|
NOT (BAnd(IntPtr(ROM85)^, BNot($3FFF)) = 0)) THEN
|
|
BEGIN
|
|
WITH GetQDGlobals^.screenBits.bounds DO
|
|
BEGIN
|
|
h := right - left;
|
|
v := bottom - top - IntPtr(mBarHeight)^;
|
|
END;
|
|
{$IFC GRUNGY}
|
|
{Using the portRect here looks wrong on the Mac+, because the
|
|
portRect does not include the (outset) border of the dialog.
|
|
We could get the rectangle, including the border, from the
|
|
structure region's bounding box, but really need a cleaner
|
|
way to do thisÉ}
|
|
WITH pickDlg^.portRect DO
|
|
BEGIN
|
|
h := (h - (right - left)) DIV 2;
|
|
v := (v - (bottom - top)) DIV 3 + IntPtr(mBarHeight)^;
|
|
END;
|
|
{$ENDC}
|
|
END
|
|
ELSE IF useBest THEN
|
|
BEGIN
|
|
bestDevRating := 0;
|
|
aDevice := GetDeviceList;
|
|
WHILE aDevice <> NIL DO
|
|
BEGIN
|
|
IF NOT TestDeviceAttribute(aDevice, screenActive) THEN
|
|
devRating := 0
|
|
ELSE IF aDevice^^.gdPMap^^.pixelSize >= 16 THEN
|
|
devRating := 8 + aDevice^^.gdPMap^^.pixelSize
|
|
ELSE
|
|
CASE BAnd(aDevice^^.gdFlags, 1) * 128 + aDevice^^.gdPMap^^.pixelSize OF
|
|
1 : devRating := 1;
|
|
129 : devRating := 2;
|
|
2 : devRating := 3;
|
|
130 : devRating := 4;
|
|
4 : devRating := 5;
|
|
8 : devRating := 6;
|
|
132 : devRating := 7;
|
|
136 : devRating := 8;
|
|
END;
|
|
IF (devRating > bestDevRating) OR
|
|
((devRating = bestDevRating) AND (aDevice = GetMainDevice)) {settle tie}
|
|
THEN
|
|
BEGIN
|
|
bestDevRating := devRating;
|
|
bestDevice := aDevice;
|
|
END;
|
|
aDevice := GetNextDevice(aDevice);
|
|
END;
|
|
|
|
WITH bestDevice^^.gdRect DO
|
|
BEGIN
|
|
h := right - left;
|
|
IF bestDevice = GetMainDevice THEN
|
|
v := bottom - top - IntPtr(mBarHeight)^
|
|
ELSE
|
|
v := bottom - top;
|
|
END;
|
|
{$IFC GRUNGY}
|
|
{Using the portRect here looks wrong on the Mac+, because the
|
|
portRect does not include the (outset) border of the dialog.
|
|
We could get the rectangle, including the border, from the
|
|
structure region's bounding box, but really need a cleaner
|
|
way to do thisÉ}
|
|
WITH pickDlg^.portRect DO
|
|
BEGIN
|
|
h := (h - (right - left)) DIV 2 + bestDevice^^.gdRect.left;
|
|
IF bestDevice = GetMainDevice THEN
|
|
v := (v - (bottom - top)) DIV 3 + IntPtr(mBarHeight)^ + bestDevice^^.gdRect.top
|
|
ELSE
|
|
v := (v - (bottom - top)) DIV 3 + bestDevice^^.gdRect.top;
|
|
END;
|
|
{$ENDC}
|
|
END;
|
|
MoveWindow(WindowPtr(pickDlg), h, v, FALSE);
|
|
|
|
END;
|
|
|
|
{Stuff the user's prompt.}
|
|
itemHand := GetIHand(pickDlg, iPrompt);
|
|
GetIRect(pickDlg, iPrompt, itemRect); {<12>}
|
|
truncResult := TruncString( (itemRect.right - itemRect.left) - 1, prompt, smTruncEnd ); {<12>}
|
|
SetIText(itemHand, prompt);
|
|
|
|
{Convert the two color specs to numbers that the user can edit.}
|
|
|
|
PickDlgOpen := pickDlg;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
RemodelDlg - display and respond to remodel dialog
|
|
}
|
|
|
|
PROCEDURE RemodelDlg(pickRect: Rect; VAR showModel, showAltModel: BOOLEAN);
|
|
CONST
|
|
iOkRim = 3;
|
|
iRmTitle = 4;
|
|
iShowModel = 5;
|
|
iShowAltModel = 6;
|
|
iFirstAltModel =7;
|
|
iRGBModel = 7;
|
|
iCMYModel = 8;
|
|
iHSLModel = 9;
|
|
iLastAltModel = 9;
|
|
VAR
|
|
ctlHand: ControlHandle;
|
|
dlgPtr: DialogPtr;
|
|
dlgRec: DialogRecord;
|
|
h, v: INTEGER;
|
|
itemHand: Handle;
|
|
itemHit: INTEGER;
|
|
itemList: Handle;
|
|
itemRect: Rect;
|
|
itemType: INTEGER;
|
|
newCtlValue: INTEGER;
|
|
whichRadio: INTEGER;
|
|
|
|
|
|
BEGIN
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
RemodelDlgDrawItem - draw user items in remodel dialog
|
|
}
|
|
|
|
PROCEDURE RemodelDlgDrawItem(theWindow: WindowPtr; item: INTEGER);
|
|
VAR
|
|
itemRect: Rect;
|
|
BEGIN
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
SampleDraw - draw one of the color samples in the dialog
|
|
}
|
|
|
|
PROCEDURE SampleDraw(pickDlg: DialogPtr; item: INTEGER; sampleRect: Rect);
|
|
VAR
|
|
height: INTEGER;
|
|
width: INTEGER;
|
|
whichSample: PColor;
|
|
saveID: INTEGER;
|
|
saveGDev: GDHandle;
|
|
BEGIN
|
|
WITH sampleRect DO
|
|
BEGIN
|
|
height := bottom - top;
|
|
width := right - left;
|
|
|
|
IF item = iNewSample THEN
|
|
BEGIN
|
|
MoveTo(left, bottom);
|
|
height := -height; {flip height so open side of box border is down}
|
|
whichSample := cSample;
|
|
bottom := bottom + 1;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
whichSample := cInput;
|
|
top := top - 1;
|
|
MoveTo(left, top); {after top-1 so that pen hanging down & right works}
|
|
END;
|
|
END;
|
|
{Draw the open sided box around the sample first.}
|
|
Line(0, height);
|
|
Line(width-1, 0);
|
|
Line(0, -height);
|
|
|
|
InsetRect(sampleRect, 1, 1);
|
|
|
|
WITH pickInfoPtr(pickDlg)^
|
|
DO
|
|
BEGIN
|
|
IF colorOK
|
|
THEN
|
|
IF gdType <> clutType { a fixed device? <8> dvb }
|
|
THEN { <8> dvb }
|
|
BEGIN { <8> dvb }
|
|
IF whichSample = cInput { <8> dvb }
|
|
THEN { <8> dvb }
|
|
RGBForeColor(rgbInput) { <8> dvb }
|
|
ELSE { <8> dvb }
|
|
RGBForeColor(theColor.rgb); { <8> dvb }
|
|
PaintRect(sampleRect); { <8> dvb }
|
|
END { <8> dvb }
|
|
ELSE { <8> dvb }
|
|
BEGIN { <8> dvb }
|
|
{$IFC UsePalette} { <8> dvb }
|
|
Dither1(whichSample); { <8> dvb }
|
|
PaintRect(sampleRect); { <8> dvb }
|
|
{$ELSC} { <8> dvb }
|
|
saveGDev := GetGDevice; { save current gDevice }
|
|
SetGDevice(itsGDev); { set to our gDev }
|
|
saveID := itsGDev^^.gdID; { save old client }
|
|
SetClientID(pickClientID); { set client to us, for matching }
|
|
SetGDevice(saveGDev); { set back to primary gDev }
|
|
Dither1(whichSample);
|
|
PaintRect(sampleRect); { paint the rect }
|
|
SetGDevice(itsGDev); { set to our GDev }
|
|
SetClientID(saveID); { restore client ID }
|
|
SetGDevice(saveGDev); { set to real gDev }
|
|
{$ENDC} { <8> dvb }
|
|
END
|
|
ELSE {colorOK}
|
|
PaintRect(sampleRect); { paint the rect black }
|
|
END;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
SampleTrack - During mouse down in input sample, reset output to that color
|
|
}
|
|
|
|
FUNCTION SampleTrack(theDialog: DialogPtr; where: Point): BOOLEAN;
|
|
VAR
|
|
inputShown: BOOLEAN;
|
|
newPt: Point;
|
|
saveRGB: RGBColor;
|
|
slopRect: Rect;
|
|
wantInput: BOOLEAN;
|
|
BEGIN
|
|
SampleTrack := FALSE;
|
|
GetIRect(theDialog, iOldSample, slopRect);
|
|
|
|
WITH PickInfoPtr(theDialog)^, theColor DO
|
|
IF PtInRect(where, slopRect) THEN
|
|
BEGIN
|
|
{Save the current color, in case the user drags out of the
|
|
sample and mouses up there. Fudge where so that it and newPt
|
|
aren't equal the first time through the loop, so that the
|
|
color at mouseDown gets set.}
|
|
saveRGB := rgb;
|
|
InsetRect(slopRect, -inputSlop, -inputSlop);
|
|
SetPt(where, 0, 0);
|
|
inputShown := FALSE;
|
|
|
|
{While the user remains in the input swatch, reset the current
|
|
color to it. Revert to the saved value if user drifts out.
|
|
Like WheelTrack, we use repeat here so that the block runs
|
|
at least once, and quick mouse clicks are seen.}
|
|
REPEAT
|
|
GetMouse(newPt);
|
|
IF NOT EqualPt(where, newPt) THEN
|
|
BEGIN
|
|
where := newPt;
|
|
wantInput := PtInRect(newPt, slopRect);
|
|
IF wantInput <> inputShown THEN
|
|
BEGIN
|
|
IF wantInput
|
|
THEN rgb := rgbInput
|
|
ELSE rgb := saveRGB;
|
|
ShowNewValues(theDialog, TRUE, [rgbText..bright]);
|
|
inputShown := wantInput;
|
|
END;
|
|
END;
|
|
UNTIL NOT WaitMouseUp;
|
|
|
|
{Regardless of where the user moused up, we've handled the mouse
|
|
down; let the filter proc know so ModalDialog will ignore it.}
|
|
SampleTrack := TRUE;
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
ShowAffected - call ShowNewValues, as appropriate for changed color component
|
|
}
|
|
|
|
PROCEDURE ShowAffected(pickDlg: DialogPtr; item: INTEGER);
|
|
VAR
|
|
affected: ColorItemSet;
|
|
BEGIN
|
|
CASE item OF
|
|
iRed, iBlue, iGreen:
|
|
affected := [rgbText, hsText, lText, hsWheel, lWheel, bright];
|
|
iHue, iSaturation:
|
|
affected := [hsText, rgbText, hsWheel];
|
|
iLightness:
|
|
affected := [lText, rgbText, lWheel, bright];
|
|
END;
|
|
|
|
{Changing the saturation to zero has a side effect on the hue: it
|
|
becomes undefined. Force it to zero for consistency, rather
|
|
than leaving it at the old value.}
|
|
IF (item = iSaturation) THEN
|
|
WITH PickInfoPtr(pickDlg)^.theColor.hsx DO
|
|
IF (saturation = 0) THEN
|
|
hue := 0;
|
|
|
|
ShowNewValues(pickDlg, (item >= iRed), affected);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
ShowHotSpot - invert the area around the given "hot spot" (HS) on the wheel
|
|
}
|
|
|
|
PROCEDURE ShowHotSpot(where: Point);
|
|
VAR
|
|
r: Rect;
|
|
BEGIN
|
|
WITH r DO
|
|
BEGIN
|
|
topLeft := where;
|
|
botRight := where;
|
|
END;
|
|
|
|
InsetRect(r, -3, -3); { let r surround the hot point }
|
|
|
|
{Make the hot spot (in)visible by an oval frame 1 pixel wide.}
|
|
InvertOval(r);
|
|
InsetRect(r,1,1);
|
|
InvertOval(r);
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
ShowNewColor - update the colored dialog items
|
|
}
|
|
|
|
PROCEDURE ShowNewColor(pickDlg: DialogPtr; affected: ColorItemSet);
|
|
VAR
|
|
newBright: BOOLEAN;
|
|
BEGIN
|
|
{If any of the items affected by lightness has changed, we have a new
|
|
lightness value; our color table must be adjusted accordingly.}
|
|
newBright := lWheel IN affected;
|
|
|
|
{Adjust picker's colors as necessary, then reinstall the color table
|
|
so that they show up.}
|
|
CTabAdjust(pickDlg, newBright);
|
|
CTabInstall(pickDlg, newBright);
|
|
|
|
{If user has no color table, we can't "animate" with it; our color
|
|
object must be redrawn to show up in the new colors.}
|
|
IF PickInfoPtr(pickDlg)^.colorOK THEN
|
|
IF PickInfoPtr(pickDlg)^.gdType <> clutType THEN
|
|
BEGIN
|
|
PickDlgDrawItem(WindowPtr(pickDlg), iNewSample);
|
|
IF lWheel IN affected THEN
|
|
BEGIN
|
|
{Erase the hotspot before redrawing the wheel. The wheel draw
|
|
routine will re-show it.}
|
|
ShowHotSpot(PickInfoPtr(pickDlg)^.hotSpot); {1.4a4}
|
|
PickDlgDrawItem(WindowPtr(pickDlg), iWheel);
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
ShowNewValues - update the color component text items and controls
|
|
}
|
|
|
|
PROCEDURE ShowNewValues(pickDlg: DialogPtr; newRGB: BOOLEAN; affected: ColorItemSet);
|
|
VAR
|
|
ctlHand: ControlHandle;
|
|
item: ColorItem;
|
|
newHotSpot: Point;
|
|
oldLight: SmallFract;
|
|
BEGIN
|
|
WITH PickInfoPtr(pickDlg)^, theColor DO
|
|
BEGIN
|
|
IF newRGB
|
|
THEN RGB2HSx(rgb, hsx)
|
|
ELSE HSx2RGB(hsx, rgb);
|
|
|
|
{Update the colors on the screen first, since the user is likely to
|
|
be more intent on them than the controls and text values.}
|
|
ShowNewColor(pickDlg, affected);
|
|
|
|
{Update the component text items and other non-color information
|
|
(like the brightness scroll bar and the wheel hot spot).}
|
|
FOR item := rgbText TO bright DO
|
|
IF item IN affected THEN
|
|
CASE item OF
|
|
rgbText:
|
|
WITH rgb DO
|
|
BEGIN
|
|
StuffIt(pickDlg, iRed, red);
|
|
StuffIt(pickDlg, iGreen, green);
|
|
StuffIt(pickDlg, iBlue, blue);
|
|
END;
|
|
hsText:
|
|
WITH hsx DO
|
|
BEGIN
|
|
StuffIt(pickDlg, iHue, hue);
|
|
StuffIt(pickDlg, iSaturation, saturation);
|
|
END;
|
|
lText:
|
|
StuffIt(pickDlg, iLightness, hsx.lightness);
|
|
hsWheel:
|
|
BEGIN
|
|
{Compute hot spot based on new color. Update iff
|
|
the location has really changed.}
|
|
HS2WheelPos(pickDlg, newHotSpot);
|
|
IF NOT EqualPt(hotSpot, newHotSpot) THEN
|
|
BEGIN
|
|
{Erase old hot spot by re-inverting it.}
|
|
ShowHotSpot(hotSpot);
|
|
ShowHotSpot(newHotSpot);
|
|
hotSpot := newHotSpot;
|
|
END;
|
|
END;
|
|
bright:
|
|
BEGIN
|
|
{Again, to reduce flicker, check that the lightness
|
|
has really changed before updating it. We should
|
|
perhaps check that it has changed by an amount
|
|
that will be discernible on screen.}
|
|
ctlHand := ControlHandle(GetIHand(pickDlg, iBrightCtl));
|
|
BrightCtlGet(ctlHand, oldLight);
|
|
IF oldLight <> hsx.lightness THEN
|
|
BrightCtlSet(ctlHand, hsx.lightness);
|
|
END;
|
|
END; {case}
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
SnareNewComponents - adjust to any quiet (no tab) changes in component values
|
|
}
|
|
|
|
PROCEDURE SnareNewComponents(pickDlg: DialogPtr);
|
|
VAR
|
|
c: INTEGER;
|
|
item: INTEGER;
|
|
itemHand: Handle;
|
|
n: INTEGER;
|
|
newVal: LONGINT;
|
|
oldVal: LONGINT;
|
|
s: Str255;
|
|
BEGIN
|
|
{Get the value in the text field the user is currently editing, in case
|
|
s/he changed it without tabbing out of the field.}
|
|
item := DialogPeek(pickDlg)^.editField + 1;
|
|
itemHand := GetIHand(pickDlg, item);
|
|
GetIText(itemHand, s);
|
|
StringToNum(s, newVal);
|
|
|
|
{If the new value is too big, pin it at the maximum. ShowAffected
|
|
will redisplay it, because the newVal and the item text differ.}
|
|
IF newVal > MaxSmallFract THEN
|
|
newVal := MaxSmallFract;
|
|
|
|
{See if the selected component has changed; update if so.}
|
|
WITH PickInfoPtr(pickDlg)^.theColor DO
|
|
BEGIN
|
|
c := item - iFirstComponent;
|
|
oldVal := SmallFract2Fix(components[c]);
|
|
IF s[0] = chr(0) THEN
|
|
newVal := oldVal
|
|
ELSE
|
|
FOR n := 1 TO ORD(s[0]) DO
|
|
IF (s[n] < '0') | (s[n] > '9') THEN
|
|
BEGIN
|
|
newVal := oldVal;
|
|
SysBeep(1);
|
|
END;
|
|
|
|
IF oldVal <> newVal THEN
|
|
BEGIN
|
|
components[c] := Fix2SmallFract(newVal);
|
|
ShowAffected(pickDlg, item);
|
|
END
|
|
ELSE
|
|
{Regularize values that are numerically the same, but have
|
|
been typed in quaintly (get rid of leading zeroes, make
|
|
'' into '0', etc.).}
|
|
StuffIt(pickDlg, item, newVal);
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
StuffIt - update text item's text iff necessary
|
|
}
|
|
|
|
PROCEDURE StuffIt(pickDlg: DialogPtr; theItem: INTEGER; newVal: SmallFract);
|
|
VAR
|
|
itemHand: Handle;
|
|
s, sOld: Str255;
|
|
BEGIN
|
|
itemHand := GetIHand(pickDlg, theItem);
|
|
GetIText(itemHand, sOld);
|
|
NumToString(SmallFract2Fix(newVal), s);
|
|
|
|
{To reduce flicker, check that the value we're stuffing is different
|
|
than the one already there. We check the string, not the number,
|
|
so that values like '' and '00' are regularized to '0'.}
|
|
IF s <> sOld THEN
|
|
BEGIN
|
|
SetIText(itemHand, s);
|
|
{If the item being stuffed is the currently selected one,
|
|
make sure that the entire field is selected.}
|
|
IF (DialogPeek(pickDlg)^.editField + 1) = theItem THEN
|
|
SelIText(pickDlg, theItem, 0, 32767);
|
|
END;
|
|
END;
|
|
|
|
{---------------------------------------------------------------------------------
|
|
WheelDraw - draw the hue/saturation wheel
|
|
}
|
|
|
|
PROCEDURE WheelDraw(pickDlg: DialogPtr; wheelRect: Rect);
|
|
VAR
|
|
color: PColor; {Color wheel wedge being drawn}
|
|
nextColor: PColor; {Next color in wheel, for dithering}
|
|
halfColor: pColor; {half saturation edition of wedge being drawn}
|
|
nextHalfColor: pColor; {half saturation of next wedge}
|
|
inset: INTEGER; {Amount to inset each saturation level}
|
|
savePen: PenState; {Saved pen state}
|
|
sliceAngle: INTEGER; {Number of degrees of arc in each wheel wedge}
|
|
startAngle: INTEGER; {Angle at which to start drawing wheel wedge}
|
|
tint: INTEGER; {Index of color wheel saturation level}
|
|
HalfColors: INTEGER; {Offset to the half-bright elements}
|
|
ring2,ring3,ring4,ring5: Rect;
|
|
saveGDev: GDHandle; {Old GDevice}
|
|
saveID: INTEGER; {Old client ID}
|
|
RSpot, GSpot, BSpot: Point; {For b/w wheel, where to draw letters R, G, and B}
|
|
wheelCenter: Point;
|
|
colorNames: Handle; {Handle to STR# with color names}
|
|
colorString: StringPtr;
|
|
|
|
|
|
PROCEDURE WedgeName(angSin,angCos:LONGINT; n:String);
|
|
{ angSin and angCos are the sine and cosine times one hundred for where on the perimeter }
|
|
{ of the wheel to erase a circle and draw the wedge name, n. }
|
|
VAR
|
|
r:Rect;
|
|
i2,w:INTEGER;
|
|
BEGIN
|
|
WITH PickInfoPtr(pickDlg)^
|
|
DO
|
|
BEGIN
|
|
i2 := inset div 2;
|
|
w := (wheelRadius div 65536 - i2);
|
|
r.top := wheelCenter.v + angSin * w div 100;
|
|
r.left := wheelCenter.h + angCos * w div 100;
|
|
r.botRight := r.topLeft;
|
|
MoveTo(r.left - StringWidth(n) div 2,r.top + 5);
|
|
i2:=2-i2;
|
|
InsetRect(r,i2,i2);
|
|
EraseOval(r);
|
|
DrawString(n);
|
|
END;
|
|
END;
|
|
|
|
|
|
BEGIN
|
|
|
|
RGBNormal;
|
|
|
|
{Draw the wheel outline}
|
|
InsetRect(wheelRect, -1, -1);
|
|
FrameOval(wheelRect);
|
|
InsetRect(wheelRect, 1, 1);
|
|
inset := (wheelRect.right - wheelRect.left) DIV (wheelTints * 2-1 );
|
|
GetPenState (savePen);
|
|
|
|
ring2 := wheelRect;
|
|
InsetRect(ring2,inset,inset);
|
|
ring3 := ring2;
|
|
InsetRect(ring3,inset,inset);
|
|
ring4 := ring3;
|
|
InsetRect(ring4,inset,inset);
|
|
ring5 := ring4;
|
|
InsetRect(ring5,inset,inset);
|
|
|
|
WITH PickInfoPtr(pickDlg)^ DO
|
|
BEGIN
|
|
|
|
{$IFC NOT UsePalette}
|
|
IF ColorOK
|
|
THEN
|
|
BEGIN
|
|
saveID := itsGDev^^.gdID;
|
|
saveGDev := GetGDevice;
|
|
SetGDevice(itsGDev);
|
|
SetClientID(pickClientID);
|
|
SetGDevice(saveGDev);
|
|
END;
|
|
{$ENDC}
|
|
|
|
IF (pixSize <= 2)
|
|
THEN
|
|
{ Wheel drawing for 1 and 2 bit mode }
|
|
WITH GetQDGlobals^,wheelRect DO
|
|
BEGIN
|
|
PenSize(inset,inset);
|
|
PenPat(black);
|
|
FrameOval(wheelRect);
|
|
PenPat(dkGray);
|
|
FrameOval(ring2);
|
|
PenPat(gray);
|
|
FrameOval(ring3);
|
|
PenPat(ltGray);
|
|
FrameOval(ring4);
|
|
|
|
colorNames := GetResource('STR#',rColorNamesStr);
|
|
IF (LONGINT(colorNames) <> 0)
|
|
THEN
|
|
BEGIN
|
|
HLock(colorNames);
|
|
ColorString := StringPtr(Ord4(colorNames^) + 2);
|
|
WedgeName(0,100,ColorString^); {'R'}
|
|
ColorString := StringPtr(Ord4(ColorString) + Length(ColorString^) + 1);
|
|
WedgeName(-86,-50,ColorString^); {'G'}
|
|
ColorString := StringPtr(Ord4(ColorString) + Length(ColorString^) + 1);
|
|
WedgeName(86,-50,ColorString^); {'B'}
|
|
ColorString := StringPtr(Ord4(ColorString) + Length(ColorString^) + 1);
|
|
WedgeName(0,-100,ColorString^); {'C'}
|
|
ColorString := StringPtr(Ord4(ColorString) + Length(ColorString^) + 1);
|
|
WedgeName(86,50,ColorString^); {'M'}
|
|
ColorString := StringPtr(Ord4(ColorString) + Length(ColorString^) + 1);
|
|
WedgeName(-86,50,ColorString^); {'Y'}
|
|
ReleaseResource(colorNames);
|
|
END;
|
|
END
|
|
|
|
ELSE IF gdType <> clutType
|
|
THEN
|
|
MakeWedges32(wheelRect,PickInfoPtr(pickDlg)^.theColor.hsx.lightness) {!!!}
|
|
ELSE IF (pixSize = 8)
|
|
THEN
|
|
BEGIN
|
|
{ Wheel drawing for 8 bit mode}
|
|
|
|
{Paint the entire wheel, over which we'll dither in saturation levels.
|
|
Start at 3 o'clock, which is zero, zero degrees, and red on the HSx
|
|
scale, and run counter-clockwise. Quickdraw puts zero degrees at
|
|
12 o'clock and runs clockwise. The extra (sliceAngle/2) insures
|
|
that the first hue (red) will be centered at zero degrees, not
|
|
begin there.}
|
|
|
|
sliceAngle := 720 DIV wheelColors;
|
|
HalfColors := wheelColors DIV 2;
|
|
startAngle := 90 + (sliceAngle DIV 2);
|
|
|
|
PenSize(inset,inset);
|
|
|
|
FOR color := cSlice1 TO pColor(ord(cSlice1)+HalfColors-1)
|
|
DO
|
|
BEGIN
|
|
halfColor := pColor(ord(color)+halfColors);
|
|
|
|
PenMode(srcCopy);
|
|
Dither1(color);
|
|
PaintArc(wheelRect, startAngle, -sliceAngle);
|
|
Dither1(halfcolor);
|
|
PaintArc(ring3, startAngle, -sliceAngle);
|
|
PenMode(srcOr);
|
|
PenPat(GetQDGlobals^.gray);
|
|
FrameArc(ring2, startAngle, -sliceAngle);
|
|
startAngle := startAngle - sliceAngle;
|
|
END;
|
|
|
|
|
|
{Set RGB foreground color to current intensity gray}
|
|
Dither1(cGray);
|
|
PenMode(srcOr);
|
|
PenPat(GetQDGlobals^.gray);
|
|
FrameOval(ring4);
|
|
Dither1(cGray);
|
|
PaintOval(ring5);
|
|
END
|
|
ELSE
|
|
BEGIN { it must be four bits!}
|
|
|
|
{4 bit wheeldraw}
|
|
{Paint the entire wheel, over which we'll dither in saturation levels.
|
|
Start at 3 o'clock, which is zero, zero degrees, and red on the HSx
|
|
scale, and run counter-clockwise. Quickdraw puts zero degrees at
|
|
12 o'clock and runs clockwise. The extra (sliceAngle/2) insures
|
|
that the first hue (red) will be centered at zero degrees, not
|
|
begin there.}
|
|
|
|
sliceAngle := 90 DIV wheelColors;
|
|
startAngle := 90 + (sliceAngle DIV 2);
|
|
|
|
PenSize(2*inset,2*inset);
|
|
|
|
FOR color := cSlice1 TO lastColor
|
|
DO
|
|
BEGIN
|
|
IF color = lastColor
|
|
THEN
|
|
nextColor := cSlice1
|
|
ELSE
|
|
nextColor := succ(color);
|
|
|
|
Dither1(color);
|
|
FrameArc(wheelRect, startAngle, -sliceAngle);
|
|
startAngle := startAngle - sliceAngle;
|
|
|
|
Dither50(nextColor,color);
|
|
SetGray25Pat;
|
|
FrameArc(wheelRect, startAngle, -sliceAngle);
|
|
startAngle := startAngle - sliceAngle;
|
|
|
|
Dither50(color,nextColor);
|
|
FrameArc(wheelRect, startAngle, -sliceAngle);
|
|
startAngle := startAngle - sliceAngle;
|
|
|
|
Dither50(nextColor,color);
|
|
SetGray75Pat;
|
|
FrameArc(wheelRect, startAngle, -sliceAngle);
|
|
|
|
startAngle := startAngle +3*sliceAngle + (sliceAngle div 2);
|
|
|
|
Dither1(color);
|
|
FrameArc(ring3, startAngle, -2*sliceAngle);
|
|
startAngle := startAngle - (2*sliceAngle);
|
|
Dither50(color,nextColor);
|
|
SetGray50BPat;
|
|
FrameArc(ring3, startAngle, -2*sliceAngle);
|
|
startAngle := startAngle - (2*sliceAngle) - (sliceAngle div 2);
|
|
|
|
END;
|
|
|
|
{Set RGB foreground color to current intensity gray, back to white}
|
|
RGBNormal;
|
|
Dither1(cGray);
|
|
PenMode(srcOr);
|
|
SetGray50Pat; { stamp the inner ring with white checkers }
|
|
FrameOval(ring3);
|
|
PenNormal;
|
|
PaintOval(ring5);
|
|
END;
|
|
|
|
{$IFC NOT UsePalette}
|
|
IF ColorOK
|
|
THEN
|
|
BEGIN
|
|
SetGDevice(itsGDev);
|
|
SetClientID(saveID);
|
|
SetGDevice(saveGDev);
|
|
END;
|
|
{$ENDC}
|
|
|
|
SetPenState (savePen);
|
|
|
|
{Draw the hot spot, which we've just erased by redrawing the wheel over it.}
|
|
ShowHotSpot(PickInfoPtr(pickDlg)^.hotSpot);
|
|
|
|
END; {with pickdlg^}
|
|
|
|
END;
|
|
|
|
PROCEDURE TwoComponentCTab(rPart,gPart,bPart, brite:INTEGER; theCTab:CTabHandle);
|
|
{ A color table is constructed with 16 levels each of two colors. Which
|
|
two colors are specified by passing numbers 1,2, or 3 into rPart, gPart,
|
|
and cPart. 1: ctTable[i].rgb.x = i div 16,
|
|
2: ctTable[i].rgb.x = i mod 16,
|
|
3: ctTable[i].rgb.x = 65535.
|
|
all values are scaled by brite, which can range 0 to 65535.
|
|
}
|
|
|
|
VAR
|
|
parts: ARRAY [1..3] OF LONGINT;
|
|
lBrite: LONGINT;
|
|
i: INTEGER;
|
|
|
|
BEGIN
|
|
lBrite := brite;
|
|
lBrite := (BAnd(lBrite, $0000FFFF)+1) div 256; { treat as 0 to 256 }
|
|
|
|
parts[3] := brite; { fixed component }
|
|
|
|
SetHandleSize(Handle(theCTab),2056); { size for 256 entries }
|
|
|
|
WITH theCTab^^
|
|
DO
|
|
BEGIN
|
|
ctSeed := GetCTSeed;
|
|
ctFlags := 0; { 1.2 }
|
|
ctSize := 255;
|
|
FOR i:=0 TO 255
|
|
DO
|
|
WITH ctTable[i]
|
|
DO
|
|
BEGIN
|
|
parts[1] := (i div 16) * LONGINT(4369) * lBrite div 256;
|
|
parts[2] := (i mod 16) * LONGINT(4369) * lBrite div 256;
|
|
value := i;
|
|
|
|
rgb.red := parts[rPart];
|
|
rgb.green := parts[gPart];
|
|
rgb.blue := parts[bPart];
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
PROCEDURE UnpackRect(srcStart, dstStart: LONGINT; dstStep, height: INTEGER);
|
|
{ Use NibbleUnpack to unpack a section of the colorful wedges.
|
|
srcStart is a pointer to packed data, dstStart is the target
|
|
bitmap's 1st address. dstStep is how much to add to the address
|
|
AFTER each unpacked line. height is how many lines to unpack.}
|
|
VAR
|
|
i,h: INTEGER;
|
|
dummy: INTEGER;
|
|
|
|
BEGIN
|
|
h := height div 2;
|
|
FOR i:=1 TO h
|
|
DO
|
|
BEGIN
|
|
dummy := NibbleUnpack(srcStart,dstStart);
|
|
dstStart := dstStart + LONGINT(dstStep);
|
|
srcStart := srcStart + NibbleUnpack(srcStart,dstStart);
|
|
dstStart := dstStart + LONGINT(dstStep);
|
|
END;
|
|
END;
|
|
|
|
|
|
|
|
PROCEDURE MakeWedges32(wheelRect:Rect; brite:INTEGER);
|
|
|
|
{
|
|
This diagram shows the points used to construct the clipping regions
|
|
for the three wedges drawn, and the names of the points describing it.
|
|
The center lines are cx,cy, and the corners and edges are wheelRect.
|
|
x1
|
|
-------+----
|
|
| | |__y1
|
|
| / |
|
|
+-----+ +
|
|
| \ |__y2
|
|
| | |
|
|
-------+----
|
|
|
|
Also, this routine is full of hardcoded 200-bits diameter slime. This is
|
|
because the data in the Wedg resrouces are 200-bit diameter wedges.
|
|
}
|
|
|
|
TYPE
|
|
bmptr = ^BitMap;
|
|
|
|
VAR
|
|
wedge1Bits: PixMap;
|
|
wedge1Handle:Handle;
|
|
wedge2Handle:Handle;
|
|
wedgeClip,
|
|
wheelClip: RgnHandle;
|
|
srcWalker: LONGINT;
|
|
dstWalker: LONGINT;
|
|
i,cx,cy,
|
|
x1,y1,y2: INTEGER;
|
|
square: Rect;
|
|
qdVersion: LONGINT;
|
|
copyMode: INTEGER;
|
|
|
|
BEGIN
|
|
RGBNormal;
|
|
|
|
copyMode := srcCopy;
|
|
IF Gestalt(gestaltQuickdrawVersion,qdVersion) = noErr
|
|
THEN
|
|
IF qdVersion >= gestalt32BitQD
|
|
THEN
|
|
copyMode := ditherCopy;
|
|
|
|
SetRect(square,0,0,200,200); { Hard coded: a no-no, I know }
|
|
|
|
WITH wedge1Bits
|
|
DO
|
|
BEGIN
|
|
baseAddr := NewPtr(40000);
|
|
rowBytes := 200;
|
|
bounds := square;
|
|
pmVersion := 0;
|
|
packType := 0;
|
|
pixelType := 0;
|
|
pixelSize := 8;
|
|
cmpCount := 1;
|
|
cmpSize := 8;
|
|
pmTable := CTabHandle(NewHandle(2056));
|
|
|
|
{Build a wheel shaped clipping region}
|
|
wheelClip := NewRgn;
|
|
OpenRgn;
|
|
FrameOval(wheelRect);
|
|
CloseRgn(wheelClip);
|
|
|
|
cx := (wheelRect.left + wheelRect.right) div 2;
|
|
cy := (wheelRect.top + wheelRect.bottom) div 2;
|
|
x1 := cx+ (wheelRect.right-cx) div 2-1;
|
|
y1 := cy+ LONGINT(wheelRect.top-cy)*866 div 1000 -4;
|
|
y2 := cy+cy-y1;
|
|
wedgeClip := NewRgn;
|
|
|
|
{Do the upper red wedge}
|
|
TwoComponentCTab(3,1,2,brite,pmTable);
|
|
wedge1Handle := GetResource('wedg',rRedWedge);
|
|
|
|
UnpackRect(LONGINT(wedge1Handle^),LONGINT(baseAddr)+100,
|
|
rowBytes,100);
|
|
|
|
|
|
{Upper red wedge clip region }
|
|
WITH wheelRect
|
|
DO
|
|
BEGIN
|
|
OpenRgn;
|
|
MoveTo(cx,cy);
|
|
LineTo(x1,y1);
|
|
LineTo(x1,top);
|
|
LineTo(right,top);
|
|
LineTo(right,cy);
|
|
LineTo(cx,cy);
|
|
CloseRgn(wedgeClip);
|
|
END;
|
|
SectRgn(wedgeClip,wheelClip,wedgeClip);
|
|
|
|
rowBytes := LONGINT(rowBytes)+LONGINT(32768);
|
|
CopyPix(wedge1Bits,GetQDGlobals^.thePort^.portBits,
|
|
square,wheelRect,
|
|
copyMode,wedgeClip);
|
|
rowBytes := LONGINT(rowBytes)-LONGINT(32768);
|
|
|
|
{Do the green wedge}
|
|
TwoComponentCTab(1,3,2,brite,pmTable);
|
|
wedge2Handle := GetResource('wedg',rGreenWedge);
|
|
UnpackRect(LONGINT(wedge2Handle^),LONGINT(baseAddr),
|
|
rowBytes,100);
|
|
|
|
{ Green wedge clip region }
|
|
WITH wheelRect
|
|
DO
|
|
BEGIN
|
|
OpenRgn;
|
|
MoveTo(left,cy);
|
|
LineTo(cx,cy);
|
|
LineTo(x1,y1);
|
|
LineTo(x1,top);
|
|
LineTo(left,top);
|
|
LineTo(left,cy);
|
|
CloseRgn(wedgeClip);
|
|
END;
|
|
SectRgn(wedgeClip,wheelClip,wedgeClip);
|
|
|
|
rowBytes := LONGINT(rowBytes)+LONGINT(32768);
|
|
CopyPix(wedge1Bits,GetQDGlobals^.thePort^.portBits,
|
|
square,wheelRect,
|
|
copyMode,wedgeClip);
|
|
rowBytes := LONGINT(rowBytes)-LONGINT(32768);
|
|
|
|
{ Move the source bitmap to the lower half of the wheel }
|
|
square.top := square.top - 0; {!!!}
|
|
|
|
{ Do the blue wedge }
|
|
TwoComponentCTab(1,2,3,brite,pmTable);
|
|
wedge2Handle := GetResource('wedg',rGreenWedge);
|
|
UnpackRect(LONGINT(wedge2Handle^),
|
|
LONGINT(baseAddr)+LONGINT(rowBytes)*199,
|
|
-rowBytes,100);
|
|
|
|
{ Blue wedge clip region }
|
|
WITH wheelRect
|
|
DO
|
|
BEGIN
|
|
OpenRgn;
|
|
MoveTo(left,cy);
|
|
LineTo(cx,cy);
|
|
LineTo(x1,y2);
|
|
LineTo(x1,bottom);
|
|
LineTo(left,bottom);
|
|
LineTo(left,cy);
|
|
CloseRgn(wedgeClip);
|
|
END;
|
|
SectRgn(wedgeClip,wheelClip,wedgeClip);
|
|
|
|
rowBytes := LONGINT(rowBytes)+LONGINT(32768);
|
|
CopyPix(wedge1Bits,GetQDGlobals^.thePort^.portBits,
|
|
square,wheelRect,copyMode,wedgeClip);
|
|
rowBytes := LONGINT(rowBytes)-LONGINT(32768);
|
|
|
|
{Do the Lower red wedge}
|
|
TwoComponentCTab(3,2,1,brite,pmTable);
|
|
wedge1Handle := GetResource('wedg',rRedWedge);
|
|
|
|
UnpackRect(LONGINT(wedge1Handle^),LONGINT(baseAddr)+LONGINT(rowBytes)*199+100,
|
|
-rowBytes,100);
|
|
|
|
{Lower red wedge clip region }
|
|
WITH wheelRect
|
|
DO
|
|
BEGIN
|
|
OpenRgn;
|
|
MoveTo(cx,cy);
|
|
LineTo(x1,y2);
|
|
LineTo(x1,bottom);
|
|
LineTo(right,bottom);
|
|
LineTo(right,cy);
|
|
LineTo(cx,cy);
|
|
CloseRgn(wedgeClip);
|
|
END;
|
|
SectRgn(wedgeClip,wheelClip,wedgeClip);
|
|
|
|
rowBytes := LONGINT(rowBytes)+LONGINT(32768);
|
|
CopyPix(wedge1Bits,GetQDGlobals^.thePort^.portBits,
|
|
square,wheelRect,
|
|
copyMode,wedgeClip);
|
|
rowBytes := LONGINT(rowBytes)-LONGINT(32768);
|
|
|
|
{Clean up}
|
|
DisposeRgn(wedgeClip);
|
|
DisposeRgn(wheelClip);
|
|
ReleaseResource(wedge1Handle);
|
|
ReleaseResource(wedge2Handle);
|
|
DisposHandle(Handle(pmTable));
|
|
DisposPtr(baseAddr);
|
|
|
|
END; {with wedge1bits}
|
|
END;
|
|
|
|
|
|
{--------------------------------------------------------------------------------
|
|
WheelPos2HS - convert mouse position within wheel to new H and S values
|
|
HS2WheelPos - convert H and S values to mouse position within wheel
|
|
}
|
|
|
|
PROCEDURE WheelPos2HS(pickDlg: DialogPtr; where: Point);
|
|
VAR
|
|
x,y: LONGINT;
|
|
r: Fixed;
|
|
radians: Fixed;
|
|
BEGIN
|
|
{Get the difference between center and where into normal cartesian
|
|
coordinates (if where is down and to the right of center, x is
|
|
positive and y is negative, etc.}
|
|
WITH PickInfoPtr(pickDlg)^ DO
|
|
BEGIN
|
|
WITH where DO
|
|
BEGIN
|
|
x := h - wheelCenter.h;
|
|
y := wheelCenter.v - v;
|
|
END;
|
|
|
|
WITH theColor.hsx DO
|
|
BEGIN
|
|
{Calculate the distance from where to the wheel center, and pin
|
|
that value at wheelRadius (in case they're in the rim of the
|
|
slop region that's actually outside the wheel).}
|
|
r := X2Fix(sqrt(x*x + y*y));
|
|
IF r >= wheelRadius
|
|
THEN saturation := Fix2SmallFract(MaxSmallFract)
|
|
ELSE saturation := Fix2SmallFract(FixDiv(r, wheelRadius));
|
|
|
|
radians := FixATan2(x, y);
|
|
hue := Fix2SmallFract(FixDiv(radians, twoPi));
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
PROCEDURE HS2WheelPos(pickDlg: DialogPtr; VAR where: Point);
|
|
VAR
|
|
x,y: INTEGER;
|
|
r: Fixed;
|
|
radians: Fixed;
|
|
BEGIN
|
|
{Given an angle (hue * 2Pi) and radius (saturation), find x and y in
|
|
normal cartesian coordinates. Then change to quickdraw coordinates
|
|
while moving (x,y) from the center of the wheel.}
|
|
WITH PickInfoPtr(pickDlg)^ DO
|
|
BEGIN
|
|
WITH theColor.hsx DO
|
|
BEGIN
|
|
radians := FixMul(SmallFract2Fix(hue), twoPi);
|
|
r := FixMul(SmallFract2Fix(saturation), wheelRadius);
|
|
x := HiWrd(FixMul(Frac2Fix(FracCos(radians)), r));
|
|
y := HiWrd(FixMul(Frac2Fix(FracSin(radians)), r));
|
|
END;
|
|
WITH where DO
|
|
BEGIN
|
|
h := wheelCenter.h + x;
|
|
v := wheelCenter.v - y;
|
|
END;
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
WheelTintPattern - get b/w pattern to dither manually for a given saturation.
|
|
When filling with a black and white pattern, quickdraw uses the foreground
|
|
color for bits that are set, and the background pattern for those that are
|
|
not. So the amount of color in the combination we're dithering corresponds
|
|
to the amount of black (we get pure color for tint level one). The higher
|
|
the tint level, the closer we are to white and the lower the saturation.
|
|
}
|
|
PROCEDURE WheelTintPattern(whichTint: INTEGER; VAR pat: Pattern);
|
|
BEGIN
|
|
WITH GetQDGlobals^ DO
|
|
CASE whichTint OF
|
|
5: pat := black;
|
|
4: pat := DkGray;
|
|
3: pat := Gray;
|
|
2: pat := LtGray;
|
|
1: pat := white;
|
|
END;
|
|
END;
|
|
|
|
{--------------------------------------------------------------------------------
|
|
WheelTrack - track mouse-down inside the color wheel
|
|
}
|
|
|
|
FUNCTION WheelTrack(theDialog: DialogPtr; where: Point): BOOLEAN;
|
|
VAR
|
|
newPt: Point;
|
|
reverted: BOOLEAN;
|
|
saveHSx: HSLColor;
|
|
BEGIN
|
|
WheelTrack := FALSE;
|
|
WITH PickInfoPtr(theDialog)^ DO
|
|
IF PtInRgn(where, wheelRgn) THEN
|
|
BEGIN
|
|
{Save the current HSx color, in case the user drags out of the
|
|
wheel and mouses up there. Fudge where so that it and newPt
|
|
aren't equal the first time through the loop, so that the
|
|
color at mouseDown gets set.}
|
|
saveHSx := theColor.hsx;
|
|
SetPt(where, 0, 0);
|
|
reverted := FALSE;
|
|
|
|
{Use repeat so that this always executes at least once. Otherwise,
|
|
if the use clicks quickly (and we're slow to get here because of
|
|
checking for component changesÉ), the new position is never shown,
|
|
because WaitMouseUp is already TRUE.}
|
|
REPEAT
|
|
GetMouse(newPt);
|
|
IF NOT EqualPt(where, newPt) THEN
|
|
BEGIN
|
|
where := newPt;
|
|
IF PtInRgn(newPt, slopRgn) THEN
|
|
BEGIN
|
|
WheelPos2HS(theDialog, newPt);
|
|
{Don't update hsWheel; hot spot fixed at end of track.}
|
|
ShowNewValues(theDialog, FALSE, [rgbText, hsText]);
|
|
reverted := FALSE;
|
|
END
|
|
ELSE IF NOT reverted THEN
|
|
BEGIN
|
|
theColor.hsx := saveHSx;
|
|
ShowNewValues(theDialog, FALSE, [rgbText, hsText]);
|
|
reverted := TRUE;
|
|
END;
|
|
END;
|
|
UNTIL NOT WaitMouseUp;
|
|
|
|
{Now that we're done tracking, move the hot spot.}
|
|
IF NOT reverted THEN
|
|
ShowNewValues(theDialog, FALSE, [hsWheel]);
|
|
|
|
{Regardless of where the user moused up, we've handled the mouse
|
|
down; let the filter proc know so ModalDialog will ignore it.}
|
|
WheelTrack := TRUE;
|
|
END;
|
|
END;
|
|
|
|
{================================================================================
|
|
GetColor - present the color picker dialog; let the user choose a color
|
|
}
|
|
|
|
FUNCTION GetColor(where: Point; prompt: Str255; inColor: RGBColor; VAR outColor: RGBColor): BOOLEAN;
|
|
VAR
|
|
itemHit: INTEGER;
|
|
pickData: PickInfo; {Our dialog, with color values tacked on}
|
|
pickDlg: DialogPtr; {Pointer to our dialog}
|
|
savePort: GrafPtr; {Caller's port}
|
|
tabHand: CTabHandle;
|
|
saveGDev: GDHandle;
|
|
memNeeded: LongInt; {How much free (or purgeable) memory we need}
|
|
tempHandle: Handle;
|
|
BEGIN
|
|
GetColor := FALSE; {Prepare for possible memory failure}
|
|
|
|
GetPort (savePort);
|
|
|
|
{Set up pickData.}
|
|
WITH pickData, theColor
|
|
DO
|
|
BEGIN
|
|
rgb := inColor;
|
|
RGB2HSx(inColor, hsx);
|
|
rgbInput := inColor;
|
|
showModel := TRUE;
|
|
showAltModel := TRUE;
|
|
END;
|
|
|
|
{Build picker's color table and save the current one, then swap in
|
|
picker's colors. Note that CTabBuild expects both versions of
|
|
theColor to be set.}
|
|
|
|
{Get the dialog, and set up all of its items.}
|
|
pickDlg := PickDlgOpen(@pickData, where, prompt);
|
|
|
|
CTabBuild(pickData, inColor);
|
|
{$IFC UsePalette}
|
|
CTabSave(@pickData);
|
|
{$ENDC}
|
|
CTabInstall(DialogPtr(@pickData), TRUE);
|
|
|
|
{1.4a4 We've done the initial setup and know about our environment. It's
|
|
time to see if we have enough memory to continue. The memory requirement
|
|
values were determined empirically, so I've purposely made them a little
|
|
bit conservative.}
|
|
|
|
IF pickData.pixSize >= 16
|
|
THEN
|
|
memNeeded := kDirectMemReq
|
|
ELSE
|
|
memNeeded := kClutMemReq;
|
|
tempHandle := NewHandle(memNeeded);
|
|
|
|
IF tempHandle <> NIL THEN
|
|
BEGIN
|
|
DisposHandle(tempHandle);
|
|
|
|
ShowNewValues(pickDlg, TRUE, [rgbText..bright]); { first values }
|
|
|
|
{Now that we're capable of drawing the dialog, and all the controls
|
|
are set up, make the dialog visible; the resource is invisible.}
|
|
ShowWindow(WindowPtr(@pickData));
|
|
|
|
{$IFC NOT UsePalette}
|
|
IF pickData.colorOK THEN
|
|
BEGIN
|
|
saveGDev := GetGDevice;
|
|
SetGDevice(pickData.itsGDev);
|
|
AddSearch(@CTabSearch);
|
|
SetGDevice(saveGDev);
|
|
END;
|
|
{$ENDC}
|
|
|
|
REPEAT
|
|
ModalDialog(@PickDlgFilter, itemHit);
|
|
IF itemHit = iRemodel THEN
|
|
WITH pickData DO
|
|
RemodelDlg(pickDlg^.portRect, showModel, showAltModel);
|
|
UNTIL (itemHit = ok) OR (itemHit = cancel);
|
|
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
itemHit := StopAlert(rMemShortageID, NIL);
|
|
itemHit := cancel;
|
|
END;
|
|
|
|
{Close up shop: close the dialog, restore the color table, get rid
|
|
of the search proc we installed, and free any memory we allocated.}
|
|
PickDlgClose(@pickData);
|
|
|
|
IF (itemHit = ok) THEN
|
|
BEGIN
|
|
outColor := pickData.theColor.rgb;
|
|
GetColor := TRUE;
|
|
END
|
|
ELSE
|
|
GetColor := FALSE;
|
|
|
|
SetPort (savePort)
|
|
END;
|
|
|
|
END.
|