[_CDCSL_93-16_]<1>Cedar>release>BiScrollers>BiAxialsImpl.mesa

BiAxialsImpl.mesa

Spreitze, March 20, 1992 7:45 am PST

DIRECTORY BiAxialMenu, BiAxials, BiAxialsPrivate, BiScrollers, FS, Geom2D, Imager, ImagerBox, ImagerError, ImagerFont, ImagerInterpress, ImagerTransformation, IO, Menus, PopUpButtons, Real, RealFns, Rope, SimpleFeedback, Vector2, VFonts, ViewerClasses, ViewerTools;

BiAxialsImpl: CEDAR PROGRAM

IMPORTS BiScrollers, FS, Geom2D, Imager, ImagerBox, ImagerError, ImagerFont, ImagerInterpress, ImagerTransformation, IO, Menus, PopUpButtons, Real, RealFns, Rope, SimpleFeedback, Vector2, VFonts, ViewerTools

EXPORTS BiAxials, BiAxialMenu

= BEGIN OPEN BiAxials, BS:BiScrollers, PUB:PopUpButtons;

Viewer: TYPE ~ ViewerClasses.Viewer;

BiScrollerStyle: TYPE ~ BiScrollers.BiScrollerStyle;

ClassPrivate: TYPE ~ REF ClassPrivateRep;

ClassPrivateRep: PUBLIC TYPE ~ BiAxialsPrivate.ClassPrivateRep;

BiAxialSpecific: TYPE ~ REF BiAxialSpecificRec;

BiAxialSpecificRec: TYPE ~ RECORD [

class: Class,

labelPolicies: LabelPolicies,

clientData: REF ANY,

parms: ARRAY Axis OF AxisParms,

state: ARRAY Axis OF AxisState ¬ []

];

AxisParms: TYPE ~ RECORD [

labelPara, labelPerp: REAL, --label size, parallel and perp to axis, in viewer coords

axisSep: REAL--viewer sep. betw. axis ctr. and client clip region-- ¬ 1.5,

axisRad: REAL--viewer-- ¬ 0.5,

tickLen: REAL--viewer-- ¬ 5.0,

tickWid: REAL--viewer-- ¬ 2.0,

tlSep: REAL--viewer-- ¬ 2.0,

edgeDistv: REAL--viewer, labelPerp+tlSep+tickLen+axisRad+axisSep-- ¬ 0

];

AxisState: TYPE ~ RECORD [

bMin, bMax: REAL ¬ 0.0, --bounds available to client, in client coords

aMin, aMax: REAL ¬ 0.0, --intersection with client extent

edgeDistc: REAL ¬ 0.0, --client width of edge crud

clientVal: REAL ¬ 0.0, --client other coord of axis

viewerVal: REAL ¬ 0.0 --viewer other coord of axis, incl axisSep effect

];

CreateClass: PUBLIC PROC [bsStyle: BS.BiScrollerStyle, bcc: ClassCommon, classData: REF ANY ¬ NIL] RETURNS [Class] ~ {

cp: ClassPrivate;

c: Class;

IF bcc.vanilla=NIL THEN bcc.vanilla ¬ BS.GenID;

IF bcc.menu=NIL THEN bcc.menu ¬ baMenu;

cp ¬ NEW [ClassPrivateRep ¬ [bcc]];

cp.bsClass ¬ bsStyle.NewBiScrollerClass[[

flavor: bcc.flavor,

extrema: Extrema,

notify: bcc.notify,

bsUserAction: BSUserAction,

paint: Paint,

modify: bcc.modify,

destroy: bcc.destroy,

copy: bcc.copy,

set: bcc.set,

get: bcc.get,

init: bcc.init,

finish: bcc.finish,

save: bcc.save,

caption: bcc.caption,

adjust: bcc.adjust,

menu: bcc.menu,

tipTable: bcc.tipTable,

icon: bcc.icon,

cursor: bcc.cursor,

mayStretch: bcc.mayStretch,

offsetsMustBeIntegers: bcc.offsetsMustBeIntegers,

preferIntegerCoefficients: bcc.preferIntegerCoefficients,

vanilla: Vanilla,

preserve: bcc.preserve

]];

c ¬ NEW [ClassRep ¬ [cp, classData]];

RETURN [c]};

DecomposeClass: PUBLIC PROC [c: Class] RETURNS [bsClass: BiScrollerClass, bcc: ClassCommon, classData: REF ANY] ~ {

RETURN [c.private.bsClass, c.private.bcc, c.classData]};

Create: PUBLIC PROC [class: Class, labelPolicies: LabelPolicies, info: ViewerClasses.ViewerRec, paint: BOOL ¬ TRUE] RETURNS [ba: BiAxial] ~ {

bsClass: BiScrollerClass ~ class.private.bsClass;

lszx: VEC ~ labelPolicies[X].EstimateLabelSize[labelPolicies[X], X];

lszy: VEC ~ labelPolicies[Y].EstimateLabelSize[labelPolicies[Y], Y];

bas: BiAxialSpecific ~ NEW [BiAxialSpecificRec ¬ [class, labelPolicies, info.data, [X: [lszx.x, lszx.y], Y: [lszy.y, lszy.x]] ]];

FOR axis: Axis IN Axis DO

bas.parms[axis].edgeDistv ¬ bas.parms[axis].labelPerp + bas.parms[axis].tlSep + bas.parms[axis].tickLen + bas.parms[axis].axisRad + bas.parms[axis].axisSep;

ENDLOOP;

info.data ¬ bas;

ba ¬ bsClass.style.CreateBiScroller[bsClass, info, paint];

RETURN};

ClientDataOf: PUBLIC PROC [bs: BiAxial] RETURNS [REF ANY] ~ {

bas: BiAxialSpecific ~ NARROW[bs.ClientDataOf];

RETURN [bas.clientData]};

Extrema: PROC [clientData: REF ANY, direction: VEC] RETURNS [min, max: VEC] --BS.ExtremaProc-- ~ {

bas: BiAxialSpecific ~ NARROW[clientData];

[min, max] ¬ bas.class.private.bcc.extrema[bas.clientData, direction];

NULL--It's slightly bogus to use values (..edgeDistc) only calculated last time Paint was executed, but that's probably good enough--;

IF direction.x < 0 THEN max.x ¬ max.x - bas.state[Y].edgeDistc ELSE min.x ¬ min.x - bas.state[Y].edgeDistc;

IF direction.y < 0 THEN max.y ¬ max.y - bas.state[X].edgeDistc ELSE min.y ¬ min.y - bas.state[X].edgeDistc;

RETURN};

Vanilla: PROC [bs: BiScroller] RETURNS [t: BS.Transform] --BS.TransformGenerator-- ~ {

bas: BiAxialSpecific ~ NARROW[BS.ClientDataOf[bs]];

cp: ClassPrivate ~ bas.class.private;

t ¬ cp.bcc.vanilla[bs];

t ¬ t.PostTranslate[[bas.parms[Y].edgeDistv, bas.parms[X].edgeDistv]];

RETURN};

BSUserAction: PROC [bs: BiScroller, input: LORA, device, user, display: REF ANY] ~ {

bas: BiAxialSpecific ~ NARROW[BS.ClientDataOf[bs]];

orgInput: LORA ¬ input;

paint: BOOL ¬ TRUE;

age: BS.AgeOp ¬ remember;

SELECT input.first FROM

$First => {paint ¬ FALSE; input ¬ input.rest};

$Last => {age ¬ ignore; input ¬ input.rest};

$Mid => {paint ¬ FALSE; age ¬ ignore; input ¬ input.rest};

ENDCASE => NULL;

SELECT input.first FROM

$FitXY => Fit[bs, paint, FALSE];

$FitUniformly => Fit[bs, paint, TRUE];

$AlignFracs => {

v: Viewer ~ BS.QuaViewer[bs, TRUE];

clientFrac: VEC ~ BeVec[input.rest.first];

inrViewer: VEC ~ BeVec[input.rest.rest.first];

doX: BOOL ~ BeBool[input.rest.rest.rest.first];

doY: BOOL ~ BeBool[input.rest.rest.rest.rest.first];

viewer: BS.Location ~ [coord[

bas.parms[Y].edgeDistv + inrViewer.x*(v.cw-bas.parms[Y].edgeDistv),

bas.parms[X].edgeDistv + inrViewer.y*(v.ch-bas.parms[X].edgeDistv) ]];

cx, cy: REAL ¬ 0.0;

min, max: VEC;

IF doX THEN {

[min, max] ¬ bas.class.private.bcc.extrema[bas.clientData, [1.0, 0.0]];

cx ¬ Blend[clientFrac.x, min.x, max.x]};

IF doY THEN {

[min, max] ¬ bas.class.private.bcc.extrema[bas.clientData, [0.0, 1.0]];

cy ¬ Blend[clientFrac.y, min.y, max.y]};

BS.Align[bs, [coord[cx, cy]], viewer, doX, doY, paint, age]};

ENDCASE => BS.DoBSUserAction[bs, orgInput, device, user, display];

RETURN};

Fit: PROC [bs: BiScroller, paint, uniformly: BOOL] ~ {

bas: BiAxialSpecific ~ NARROW[BS.ClientDataOf[bs]];

v: Viewer ~ BS.QuaViewer[bs, TRUE];

limits: Box;

[limits.xmin, limits.xmax] ¬ ViewLimitsOfImage[bs, X];

[limits.ymin, limits.ymax] ¬ ViewLimitsOfImage[bs, Y];

BS.BoxScale[bs, limits.RectangleFromBox, ImagerBox.RectangleFromBox[[bas.parms[Y].edgeDistv, bas.parms[X].edgeDistv, v.cw, v.ch]], paint, uniformly];

RETURN};

ViewLimitsOfImage: PROC [ba: BiAxial, axis: Axis] RETURNS [vmin, vmax: REAL] = {

bs: BiScroller ~ ba;

bas: BiAxialSpecific ~ NARROW[BS.ClientDataOf[bs]];

t: BS.Transform ¬ bs.style.GetTransforms[bs].clientToViewer;

tn: Geom2D.Trans ¬ Geom2D.ToTrans[t];

norm, min, max: VEC;

SELECT axis FROM

X => norm ¬ [tn.dxdx, tn.dxdy];

Y => norm ¬ [tn.dydx, tn.dydy];

ENDCASE => ERROR;

[min, max] ¬ bas.class.private.bcc.extrema[bas.clientData, norm];

min ¬ t.Transform[min];

max ¬ t.Transform[max];

SELECT axis FROM

X => {vmin ¬ min.x; vmax ¬ max.x};

Y => {vmin ¬ min.y; vmax ¬ max.y};

ENDCASE => ERROR;

RETURN};

Paint: PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL ¬ FALSE] --ViewerClasses.PaintProc--

~ {quit ¬ InnerPaint[self, context, screen, whatChanged, clear]};

InnerPaint: PROC [self: Viewer, context: Imager.Context, dest: ImageDestination, whatChanged: REF ANY, clear: BOOL] RETURNS [quit: BOOL ¬ FALSE] --ViewerClasses.PaintProc-- ~ {

bs: BiScroller ~ BS.QuaBiScroller[self];

bas: BiAxialSpecific ~ NARROW[BS.ClientDataOf[bs]];

class: Class ~ bas.class;

clipBox: Box;

DrawAxes: PROC ~ {

t, u: BS.Transform;

clientVptMin, clientVptMax: VEC;

Prepare: PROC [axis, other: Axis, vw: INTEGER, scale, offset: REAL, Cons: PROC [REAL, REAL] RETURNS [VEC], Uncons: PROC [VEC] RETURNS [a, o: REAL]] ~ {

clientExtMin, clientExtMax: VEC;

[clientExtMin, clientExtMax] ¬ bas.class.private.bcc.extrema[bas.clientData, Cons[1.0, 0.0]];

bas.state[axis].bMax ¬ Uncons[clientVptMax].a;

bas.state[other].clientVal ¬ bas.state[axis].aMin ¬ bas.state[axis].bMin ¬ MAX[Uncons[clientExtMin].a, Uncons[clientVptMin].a];

bas.state[axis].aMax ¬ MIN[Uncons[clientExtMax].a, bas.state[axis].bMax];

RETURN};

PaintAxis: PROC [axis, other: Axis, vw: INTEGER, invScale, scale, offset: REAL, Cons: PROC [REAL, REAL] RETURNS [VEC], Uncons: PROC [VEC] RETURNS [a, o: REAL]] ~ {

axdelt: VEC ~ Cons[0.0, bas.parms[axis].axisSep+bas.parms[axis].axisRad];

maxTick: REAL ¬ bas.state[axis].aMax;

ConsumeTick: PROC [

coord: REAL--in client cordinates--,

labelBounds: Box--Viewer scale--,

DrawLabel: PROC [org: VEC] ¬ NIL

] ~ {

clientTick: VEC ~ Cons[coord, bas.state[axis].clientVal];

viewerTick: VEC--at edge of axis-- ~ t.Transform[clientTick].Sub[axdelt];

tickEnd: VEC ~ viewerTick.Sub[Cons[0.0, bas.parms[axis].tickLen]];

boxCtr: VEC ~ [(labelBounds.xmin + labelBounds.xmax)*0.5, (labelBounds.ymin + labelBounds.ymax)*0.5];

boxOff: VEC ~ Cons[Uncons[boxCtr].a, Uncons[[labelBounds.xmax, labelBounds.ymax]].o];

context.MaskVector[p1: viewerTick, p2: tickEnd];

maxTick ¬ MAX[maxTick, coord];

IF DrawLabel#NIL THEN DrawLabel[tickEnd.Sub[Cons[0.0, bas.parms[axis].tlSep]].Sub[boxOff]];

RETURN};

context.SetStrokeWidth[bas.parms[axis].tickWid];

bas.labelPolicies[axis].EnumerateTicks[bas.labelPolicies[axis], bs, axis, dest, bas.state[axis].bMin, bas.state[axis].bMax, bas.state[axis].aMin, bas.state[axis].aMax, bas.parms[axis].labelPara*invScale, context, ConsumeTick];

IF maxTick >= bas.state[other].clientVal THEN {

axendc: VEC ~ Cons[maxTick, bas.state[axis].clientVal];

axendv: VEC ~ t.Transform[axendc].Sub[Cons[0.0, bas.parms[axis].axisSep]];

context.SetStrokeWidth[bas.parms[axis].axisRad*2.0];

context.MaskVector[p1: [bas.state[Y].viewerVal, bas.state[X].viewerVal], p2: axendv]};

RETURN};

[t, u] ¬ bs.style.GetTransforms[bs];

[[bas.state[Y].edgeDistc, bas.state[X].edgeDistc]] ¬ u.TransformVec[[bas.parms[Y].edgeDistv, bas.parms[X].edgeDistv]];

clientVptMin ¬ u.Transform[[bas.parms[Y].edgeDistv, bas.parms[X].edgeDistv]];

clientVptMax ¬ u.Transform[[self.cw, self.ch]];

Prepare[X, Y, self.cw, t.a, t.c, ConsX, UnconsX];

Prepare[Y, X, self.ch, t.e, t.f, ConsY, UnconsY];

[[bas.state[Y].viewerVal, bas.state[X].viewerVal]] ¬ t

.Transform[[bas.state[Y].clientVal, bas.state[X].clientVal]]

.Sub[[bas.parms[Y].axisSep, bas.parms[X].axisSep]];

context.ConcatT[u];

PaintAxis[X, Y, self.cw, u.a, t.a, t.c, ConsX, UnconsX];

PaintAxis[Y, X, self.ch, u.e, t.e, t.f, ConsY, UnconsY];

RETURN};

IF clear THEN context.DoSave[DrawAxes];

clipBox ¬ [xmin: bas.state[X].bMin, xmax: bas.state[X].bMax, ymin: bas.state[Y].bMin, ymax: bas.state[Y].bMax];

context.ClipRectangle[ImagerBox.RectangleFromBox[clipBox]];

quit ¬ class.private.bcc.paint[self, context, clipBox, dest, whatChanged, clear];

RETURN};

ConsX: PROC [a, o: REAL] RETURNS [VEC] ~ {RETURN [[a, o]]};

ConsY: PROC [a, o: REAL] RETURNS [VEC] ~ {RETURN [[o, a]]};

UnconsX: PROC [v: VEC] RETURNS [a, o: REAL] ~ {RETURN [v.x, v.y]};

UnconsY: PROC [v: VEC] RETURNS [a, o: REAL] ~ {RETURN [v.y, v.x]};

CreateDrawingButton: PUBLIC PROC [viewerInfo: ViewerClasses.ViewerRec, ba: BiAxial, font: Font ¬ NIL] RETURNS [button: Viewer] = {

IF viewerInfo.name = NIL THEN viewerInfo.name ¬ "Draw";

button ¬ drawClass.Instantiate[viewerInfo, ba, PUB.ImageForRope[rope: viewerInfo.name, font: font]];

RETURN};

drawClass: PUB.Class ¬ PUB.MakeClass[[

proc: DrawCtl,

choices: LIST[

[$ToIP, "Create an interpress master of viewer contents"] ],

doc: "Drawing control operations"]];

DrawCtl: PROC [view, instanceData, classData, key: REF ANY] --PUB.PopUpButtonProc-- = {

ba: BiAxial ~ NARROW[instanceData];

bas: BiAxialSpecific ~ NARROW[BS.ClientDataOf[ba]];

SELECT key FROM

$ToIP => {

fileName: ROPE ~ ViewerTools.GetSelectionContents[];

writtenName: ROPE;

width, height: REAL;

[writtenName, width, height] ¬ ToIP[ba, fileName, ".ip" !FS.Error => {

SimpleFeedback.Append[$BiAxials, oneLiner, $Error, Rope.Concat["File create error: ", error.explanation]];

GOTO Dun}];

SimpleFeedback.PutFL[$BiAxials, oneLiner, $Error, "%g is %g by %g", LIST[[rope[FS.ExpandName[writtenName].fullFName]], [real[width]], [real[height]] ]];

key ¬ key};

ENDCASE => ERROR;

RETURN

EXITS Dun => key ¬ key};

DrawButt: PROC [parent: Viewer, clientData: REF ANY ¬ NIL, mouseButton: ViewerClasses.MouseButton ¬ red, shift, control: BOOL ¬ FALSE] ~ {

ba: BiAxial ~ BS.QuaBiScroller[parent];

DrawCtl[parent, ba, NIL, $ToIP];

RETURN};

ToIP: PUBLIC PROC [ba: BiAxial, fileName, defaultExtension: ROPE ¬ NIL] RETURNS [writtenName: ROPE, width, height: REAL] ~ {

asBS: BiScroller ~ ba;

self: Viewer ~ BS.QuaViewer[asBS, FALSE];

bas: BiAxialSpecific ~ NARROW[BS.ClientDataOf[asBS]];

xfm: BS.Transform ~ asBS.style.GetTransforms[asBS].clientToViewer;

IF fileName.Length=0 THEN fileName ¬ self.name.Concat[defaultExtension]

ELSE IF fileName.Find["."]<0 THEN fileName ¬ fileName.Concat[defaultExtension];

{file: ImagerInterpress.Ref ~ ImagerInterpress.Create[fileName];

PaintPage: PROC [context: Imager.Context] ~ {

context.ConcatT[xfm];

[] ¬ InnerPaint[self, context, print, NIL, TRUE];

RETURN};

width ¬ self.cw/ppi;

height ¬ self.ch/ppi;

file.DoPage[PaintPage, Imager.metersPerInch/ppi];

file.Close[];

RETURN [fileName, width, height]}};

ppi: REAL ¬ 72.0;

baMenu: PUBLIC Menus.Menu ¬ Menus.CopyMenu[BS.bsMenu];

LinearSpecific: TYPE ~ REF LinearSpecificRec;

LinearSpecificRec: TYPE ~ RECORD [

axis: Axis,

format: ROPE,

labelChars: NAT,

font: ARRAY ImageDestination OF Font,

log: BOOL,

bt, bc, cc, zc: REAL,

lnbt, lnbc, lncc: REAL ¬ 1.0,

labelSizeEstv: VEC ¬ [0.0, 0.0],

labelWidthEstc: REAL ¬ 0.0, --for which below are valid

bMin, bMax: REAL ¬ 0.0, --visible area bounds, for which below are valid

aMin, aMax: REAL ¬ 0.0, --intersection with client bounds, for which below are valid

imin, imax: INT ¬ 0,

period: REAL ¬ 0.0,

invert: BOOL ¬ FALSE];

When logarithmic:

period = n, and invert=(p<0) (see comment on LinearAxisSpec).

bt ^ (mi * np) = cc * bc ^ x <=> mi * np ln bt = ln cc + x ln bc

<=> mi = (ln cc + x ln bc) / (np ln bt)

between ticks, np ln bt = ln bc Dx

ln10: REAL ~ RealFns.Ln[10.0];

nMax: INTEGER ¬ 10;

decimalCoefs: RealSeq ¬ NEW [RealSequence[4]];

linearDefaultScreenFont, linearDefaultPrintFont: Font ¬ NIL;

CreateLinearLabelPolicy: PUBLIC PROC

[

axis: Axis,

format: ROPE, --produces at most labelChars chars

labelChars: NAT,

ctl: LinearCoordToLabel,

font: ARRAY ImageDestination OF Font ¬ ALL[NIL] --NIL means pick a standard default

]

RETURNS [lp: LabelPolicy]

~ {

ls: LinearSpecific ~ NEW [LinearSpecificRec ¬ [axis, format, labelChars, font, ctl.log, ctl.bt, ctl.bc, ctl.cc, ctl.zc]];

charEst: ROPE ~ Rope.MakeConstantRope['7, labelChars];

screenEst, printEst: Imager.Rectangle;

IF ls.font[screen] = NIL THEN ls.font[screen] ¬ linearDefaultScreenFont;

IF ls.font[print] = NIL THEN ls.font[print] ¬ linearDefaultPrintFont;

IF ls.log THEN {

ls.lnbt ¬ RealFns.Ln[ctl.bt]; ls.lnbc ¬ RealFns.Ln[ctl.bc]; ls.lncc ¬ RealFns.Ln[ctl.cc]};

screenEst ¬ ls.font[screen].RopeBoundingBox[charEst] .BoxFromExtents .RectangleFromBox;

printEst ¬ ls.font[print].RopeBoundingBox[charEst] .BoxFromExtents .RectangleFromBox;

ls.labelSizeEstv ¬ [MAX[screenEst.w, printEst.w], MAX[screenEst.h, printEst.h]];

lp ¬ NEW [LabelPolicyRep ¬ [LinearEstimateLabelSize, LinearEnumerateTicks, NIL, ls]];

RETURN};

LinearEstimateLabelSize: PROC [lp: LabelPolicy, axis: Axis] RETURNS [VEC] ~ {

ls: LinearSpecific ~ NARROW[lp.data];

RETURN [ls.labelSizeEstv]};

LinearPrepare: PROC [ls: LinearSpecific, ba: BiAxial, bMin, bMax, aMin, aMax, labelSize: REAL--in client cordinates--] ~ {

minLabelSpacing: REAL ~ labelSize*1.1;

aWidth, bWidth, rough: REAL;

n: INTEGER;

ls.bMin ¬ bMin; ls.bMax ¬ bMax; ls.aMin ¬ aMin; ls.aMax ¬ aMax;

aWidth ¬ aMax - aMin;

bWidth ¬ bMax - bMin;

ls.labelWidthEstc ¬ labelSize;

IF aWidth = 0.0 THEN {

ls.imin ¬ ls.imax ¬ 1;

IF ls.log THEN { --n ln bt = ln cc + x ln bc

ls.period ¬ (ls.lncc + aMin * ls.lnbc) / ls.lnbt;

ls.invert ¬ FALSE;

}

ELSE ls.period ¬ aMin;

RETURN};

n ¬ Real.Floor[MAX[MIN[aWidth/minLabelSpacing, nMax], 1.0]];

rough ¬ aWidth/n;

IF ls.log THEN {

tp: REAL ~ ls.lnbt / ls.lnbc;

offset, fact: REAL;

smooth: REAL ¬ HarmonicCeiling[rough/tp]*tp;

offset ¬ ls.lncc / (ls.lnbc * smooth);

fact ¬ 1.0 / smooth;

ls.imin ¬ MAX[Real.Ceiling[offset + fact*bMin], Real.Floor[offset + fact*aMin]];

ls.imax ¬ MIN[Real.Floor[offset + fact*bMax], Real.Ceiling[offset + fact*aMax]];

IF ls.imax < ls.imin

THEN smooth ¬ HarmonicFloor[smooth*0.999/tp]*tp

ELSE EXIT;

ENDLOOP;

ls.period ¬ smooth/tp;

IF ls.period < 1.0

THEN {ls.period ¬ Real.Round[1.0/ls.period]; ls.invert ¬ TRUE}

ELSE {ls.period ¬ Real.Round[ls.period]; ls.invert ¬ FALSE};

RETURN}

ELSE {

smooth: REAL ¬ PositionalCeiling[rough*ls.bc, 10.0, ln10, decimalCoefs]/ls.bc;

aFirst, aLast, bFirst, bLast: REAL;

PickOne: PROC ~ {

ls.imin ¬ ls.imax ¬ 1;

ls.period ¬ aMin;

RETURN};

tmin, tmax: BOOL ¬ FALSE;

aFirst ¬ aMin/smooth;

aLast ¬ aMax/smooth;

bFirst ¬ bMin/smooth;

bLast ¬ bMax/smooth;

IF ABS[aFirst]>INT.LAST OR ABS[aLast]>INT.LAST OR ABS[bFirst]>INT.LAST OR ABS[bLast]>INT.LAST THEN --aWidth is tiny compared to min & max-- {PickOne[]; RETURN};

ls.imin ¬ MAX[Real.Floor[aFirst], Real.Ceiling[bFirst]];

ls.imax ¬ MIN[Real.Ceiling[aLast], Real.Floor[bLast]];

SELECT TRUE FROM

ls.imax < ls.imin => {rough ¬ rough*0.5;

smooth ¬ PositionalCeiling[rough*ls.bc, 10.0, ln10, decimalCoefs]/ls.bc;

ls.period ¬ smooth};

ls.imax = ls.imin => EXIT;

smooth*ls.imin = smooth*(REAL[ls.imin]+1.0) => {PickOne[]; RETURN};

smooth*ls.imax = smooth*(REAL[ls.imax]-1.0) => {PickOne[]; RETURN};

smooth < minLabelSpacing => {ls.imax ¬ ls.imin; EXIT};

ENDCASE => EXIT;

ENDLOOP;

ls.period ¬ smooth;

RETURN};

};

LinearEnumerateTicks: PROC [

labelPolicy: LabelPolicy,

ba: BiAxial,

axis: Axis,

imageDest: ImageDestination,

bMin, bMax: REAL, --bounds of visible area for ticks, client cordinates--

aMin, aMax: REAL, --intersection of above with extent of client data--

labelWidthEstc: REAL, --part of the above estimate, appropriately scaled

ctx: Imager.Context--Viewer coordinates--,

ConsumeTick: PROC [

coord: REAL--in client cordinates--,

labelBounds: Box--Viewer scale--,

DrawLabel: PROC [org: VEC] ¬ NIL

]]

~ {

ls: LinearSpecific ~ NARROW[labelPolicy.data];

font: Font ~ ls.font[imageDest];

IF aMax < aMin THEN RETURN;

IF aMin # ls.aMin OR aMax # ls.aMax OR bMin # ls.bMin OR bMax # ls.bMax OR labelWidthEstc # ls.labelWidthEstc THEN LinearPrepare[ls, ba, bMin, bMax, aMin, aMax, labelWidthEstc];

ctx.SetFont[font];

IF ls.log THEN {

invert: BOOL ~ ls.invert;

n: REAL ~ ls.period;

bt: REAL ~ ls.bt;

bc: REAL ~ ls.bc;

cc: REAL ~ ls.cc;

zc: REAL ~ ls.zc;

FOR i: INT IN [ls.imin .. ls.imax] DO

exp: REAL ~ IF invert THEN i/n ELSE i*n;

labX: REAL ~ RealFns.Power[bt, exp];

cX: REAL ~ RealFns.Log[bc, labX/cc];

label: ROPE ~ IO.PutFR1[ls.format, [real[IF cX>zc THEN labX ELSE 0.0]] ];

ext: ImagerFont.Extents ~ font.RopeBoundingBox[label];

DrawLogLabel: PROC [org: VEC] ~ {

ctx.SetXY[org];

ctx.ShowRope[label];

RETURN};

ConsumeTick[cX, ImagerBox.BoxFromExtents[ext], DrawLogLabel];

ENDLOOP;

}

ELSE {

FOR i: INT IN [ls.imin .. ls.imax] DO

cx: REAL ~ i*ls.period;

lx: REAL ~ ls.cc + cx*ls.bc;

label: ROPE ~ IO.PutFR1[ls.format, [real[lx]] ];

ext: ImagerFont.Extents ~ font.RopeBoundingBox[label];

DrawLinearLabel: PROC [org: VEC] ~ {

ctx.SetXY[org];

ctx.ShowRope[label];

RETURN};

ConsumeTick[cx, ImagerBox.BoxFromExtents[ext], DrawLinearLabel];

ENDLOOP;

};

RETURN};

PositionalCeiling: PUBLIC PROC [x, base, lnBase: REAL, coefs: RealSeq] RETURNS [REAL] ~ {

lnx: REAL ~ RealFns.Ln[x];

ilog: INTEGER ¬ Real.Round[lnx/lnBase];

basen: REAL ¬ RIExp[base, ilog];

seekc: REAL;

IF RealFns.AlmostEqual[x, basen, pcDist] THEN RETURN [basen];

IF basen > x THEN {ilog ¬ ilog - 1; basen ¬ basen/base};

seekc ¬ x/basen;

FOR i: NAT IN (0..coefs.length) DO --basen * coefs[i-1] <= x

c: REAL ~ coefs[i];

IF c > seekc OR RealFns.AlmostEqual[c, seekc, pcDist] THEN RETURN [basen * c];

ENDLOOP;

RETURN [basen*base]};

pcDist: INTEGER ¬ -5;

HarmonicCeiling: PUBLIC PROC [x: REAL] RETURNS [REAL] ~ {

IF x >= INT.LAST THEN RETURN [x];

IF x >= 1.0 THEN {n: INT ~ Real.Ceiling[x]; RETURN [n]};

{y: REAL ~ 1.0 / x;

IF y = 1.0 THEN RETURN [y];

RETURN [1.0 / HarmonicFloor[y] ]}};

HarmonicFloor: PUBLIC PROC [x: REAL] RETURNS [REAL] ~ {

IF x >= INT.LAST THEN RETURN [x];

IF x >= 1.0 THEN {n: INT ~ Real.Floor[x]; RETURN [n]};

{y: REAL ~ 1.0 / x;

IF y = 1.0 THEN RETURN [y];

RETURN [1.0 / HarmonicCeiling[y] ]}};

RIExp: PROC [base: REAL, exp: INTEGER] RETURNS [ans: REAL] ~ {

inv: BOOL ~ exp < 0;

pexp: NAT ¬ ABS[exp];

ans ¬ 1.0;

WHILE pexp#0 DO

IF (pexp MOD 2) # 0 THEN ans ¬ ans*base;

IF (pexp ¬ pexp/2) # 0 THEN base ¬ base*base;

ENDLOOP;

IF inv THEN ans ¬ 1.0/ans;

RETURN};

BeVec: PROC [ra: REF ANY] RETURNS [VEC]

~ {RETURN [NARROW[ra, REF VEC]]};

BeBool: PROC [ra: REF ANY] RETURNS [BOOL] ~ {RETURN [SELECT ra FROM

$FALSE => FALSE,

$TRUE => TRUE,

ENDCASE => ERROR]};

Blend: PROC [a: REAL, b0, b1: REAL] RETURNS [c: REAL]

= {c ¬ (1-a)*b0 + a*b1};

Start: PROC ~ {

decimalCoefs[0] ¬ 1.0;

decimalCoefs[1] ¬ 2.0;

decimalCoefs[2] ¬ 3.0;

decimalCoefs[3] ¬ 5.0;

linearDefaultPrintFont ¬ ImagerFont.Find["xerox/xc1-2-2/classic", substituteWithWarning !

Imager.Warning => {SimpleFeedback.PutFL[$BiAxialsImpl, oneLiner, $Warning, "Imager.Warning[%g, %g] trying to Find the default print font for linear label policies.", LIST[[atom[ImagerError.AtomFromErrorCode[error.code]]], [rope[error.explanation]] ]]; RESUME};

Imager.Error => {SimpleFeedback.PutFL[$BiAxialsImpl, oneLiner, $Error, "Imager.Error[%g, %g] trying to Find the default print font for linear label policies; VFonts.defaultFont will be used instead.", LIST[[atom[ImagerError.AtomFromErrorCode[error.code]]], [rope[error.explanation]] ]]; linearDefaultPrintFont ¬ VFonts.defaultFont; CONTINUE}

].Scale[10];

linearDefaultScreenFont ¬ VFonts.defaultFont;

Menus.ReplaceMenuEntry[baMenu, Menus.FindEntry[baMenu, "Rotate"], NIL];

Menus.ReplaceMenuEntry[baMenu, Menus.FindEntry[baMenu, "Draw"], Menus.CreateEntry["Draw", DrawButt]];

RETURN};

Start[];

END.