DIRECTORY
TrcStandardClasses,
Abutters USING [Create, QuaViewer, vanilla],
AIS USING [Error, Histogram, OpenFile, ReadHistogram],
Buttons USING [ButtonProc, Create],
ChoiceButtons USING [BuildTextPrompt, PromptDataRef],
FS USING [Error, FileInfo],
IO USING [GetAtom, GetCedarTokenRope, GetCard, GetReal, PutF, PutRope, TokenKind],
KnobAttach USING [Attach, Create, KnobAttachViewer],
Labels USING [Create, Label],
MessageWindow USING [Append, Blink],
RealFns USING [Tan],
RealOps USING [RoundC],
Rope USING [ROPE, Concat, Equal, Length, Substr],
Sliders USING [Create, Slider, SliderProc],
Trc, --USING Lots!
UserProfile USING [Boolean, Number],
ViewerClasses USING [Viewer],
ViewerOps USING [MoveViewer],
ViewerTools USING [GetContents];
Chain Class
ChainInstance:
TYPE ~
REF ChainInstanceRep;
ChainInstanceRep: TYPE ~ RECORD [SEQUENCE n: NAT OF ChainElement];
ChainElement:
TYPE ~
RECORD [
trc: TRC,
listenerReg: REF ← NIL --So we can detach ourselves
];
ChainFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
instance: ChainInstance ~ NARROW[trc.instance];
b ← a;
FOR k:
NAT
IN [0..instance.n)
DO
b ← Trc.ApplyFcn[instance[k].trc, b];
ENDLOOP;
};
ChainBlockFcn: Trc.BlockFcn =
UNCHECKED {
[trc: TRC, from: Trc.UnsafeTable, to: Trc.UnsafeTable, count: NAT]
instance: ChainInstance ~ NARROW[trc.instance];
IF instance.n=0 THEN ERROR; --It's gotta have SOMETHING in it...
Trc.ApplyBlockFcn[trc: instance[0].trc, from: from, to: to, count: count];
FOR k:
NAT
IN [1..instance.n)
DO
Trc.ApplyBlockFcn[trc: instance[k].trc, from: to, to: to, count: count]; --In place change
ENDLOOP;
};
ChainPickleProc: Trc.PickleProc = {
[trc: TRC, stream: STREAM, indentation: ROPE ← NIL]
instance: ChainInstance ~ NARROW[trc.instance];
newIndentation: ROPE ~ Rope.Concat[indentation, "\t"];
IO.PutF[stream: stream, format: " %g", v1: [cardinal[instance.n]]];
FOR k:
NAT
IN [0..instance.n)
DO
IO.PutF[stream: stream, format: "\n%g%g ", v1: [rope[indentation]], v2: [atom[instance[k].trc.class.flavor]]];
Trc.Pickle[trc: instance[k].trc, stream: stream, indentation: newIndentation];
ENDLOOP;
};
ChainDepickleProc: Trc.DepickleProc = {
[class: Trc.Class, stream: STREAM] RETURNS [trc: TRC]
nElements: NAT ~ IO.GetCard[stream: stream];
instance: ChainInstance ~ NEW[ChainInstanceRep[nElements]];
trc ←
NEW[Trc.TRCRep ← [
class: chainClass,
instance: instance
]];
FOR k:
NAT
IN [0..instance.n)
DO
flavor: ATOM ~ IO.GetAtom[stream: stream];
class: Trc.Class ~ Trc.ClassFromFlavor[flavor: flavor];
instance[k].trc ← Trc.Depickle[class, stream];
instance[k].listenerReg ← Trc.InstallListener[trc: instance[k].trc, listener: [ChainListener, trc]];
ENDLOOP;
};
ChainBackgroundProc: Trc.BackgroundProc = {
[trc: TRC, context: Imager.Context, rectangle: ImagerTransformation.Rectangle]
instance: ChainInstance ~ NARROW[trc.instance];
FOR k:
NAT
IN [0..instance.n)
DO
Trc.PaintBackground[trc: instance[k].trc, context: context, rectangle: rectangle, whatChanged: $Chain];
ENDLOOP;
};
ChainListener: Trc.ListenerProc = {
[trc: TRC, listenerData: REF ANY]
chain: TRC ~ NARROW[listenerData];
Trc.NotifyListeners[trc: chain];
};
chainClass: Trc.Class ~
NEW[Trc.ClassRep ← [
flavor: $Chain,
fcn: ChainFcn,
copy: Trc.DefaultCopy,
blockFcn: ChainBlockFcn,
pickle: ChainPickleProc,
depickle: ChainDepickleProc,
notify: Trc.DefaultNotify,
control: NIL,
background: ChainBackgroundProc
]];
NewChainTrc:
PUBLIC
PROC [dependents:
LIST
OF
TRC]
RETURNS [trc:
TRC] ~ {
NElements:
PROC [list:
LIST
OF
TRC]
RETURNS [count:
NAT ← 0] ~ {
FOR each:
LIST
OF TRC ← list, each.rest
UNTIL each=
NIL
DO
count ← count+1;
ENDLOOP;
};
nElements: NAT ~ NElements[dependents];
instance: ChainInstance ~ NEW[ChainInstanceRep[nElements]];
trc ←
NEW[Trc.TRCRep ← [
class: chainClass,
instance: instance
]];
FOR k:
NAT
IN [0..nElements)
DO
instance[k].trc ← dependents.first;
instance[k].listenerReg ← Trc.InstallListener[trc: instance[k].trc, listener: [ChainListener, trc]];
dependents ← dependents.rest;
ENDLOOP;
};
ReplaceNthTrcInChain:
PUBLIC
PROC [chain, new:
TRC, n:
NAT, notify:
BOOL ←
TRUE] ~ {
instance: ChainInstance ~ NARROW[chain.instance];
Trc.DeinstallListener[registration: instance[n].listenerReg];
instance[n].trc ← new;
instance[n].listenerReg ← Trc.InstallListener[trc: instance[n].trc, listener: [ChainListener, chain]];
IF notify THEN Trc.NotifyListeners[trc: chain];
};
ChainInfo:
PUBLIC
PROC [chain:
TRC]
RETURNS [n:
NAT] ~ {
instance: ChainInstance ~ NARROW[chain.instance];
RETURN [instance.n]
};
GetNthTrcInChain:
PUBLIC PROC [chain:
TRC, n:
NAT]
RETURNS [trc:
TRC] ~ {
instance: ChainInstance ~ NARROW[chain.instance];
RETURN [instance[n].trc];
};
ExtendChain:
PUBLIC
PROC [chain:
TRC, newLinks:
NAT ← 1, atPosition:
NAT ←
NAT.
LAST] ~ {
instance: ChainInstance ~ NARROW[chain.instance];
newInstance: ChainInstance ~ NEW[ChainInstanceRep[instance.n+newLinks]];
IF atPosition > instance.n THEN atPosition ← instance.n;
FOR k:
NAT
IN [0 .. instance.n)
DO
newInstance[
IF k<atPosition
THEN k
ELSE k+newLinks] ← instance[k];
ENDLOOP;
FOR k:
NAT
IN [atPosition .. atPosition+newLinks)
DO
newInstance[k].trc ← NewIdentityTrc[];
newInstance[k].listenerReg ← Trc.InstallListener[trc: newInstance[k].trc, listener: [ChainListener, chain]]
ENDLOOP;
chain.instance ← newInstance;
Shouldn't need to NotifyListeners, as this should have not affected any data which comes out.
};
DeleteNthTrcInChain:
PUBLIC
PROC [chain:
TRC, n:
NAT, notify:
BOOL ←
TRUE] ~ {
instance: ChainInstance ~ NARROW[chain.instance];
newInstance: ChainInstance ~ NEW[ChainInstanceRep[instance.n-1]];
Trc.DeinstallListener[registration: instance[n].listenerReg];
FOR k:
NAT
IN [0 .. newInstance.n)
DO
newInstance[k] ← instance[IF k<n THEN k ELSE k+1];
ENDLOOP;
chain.instance ← newInstance;
IF notify THEN Trc.NotifyListeners[trc: chain];
};
Parametric Sublasses
ParmInstance:
TYPE ~
REF ParmInstanceRep;
ParmInstanceRep:
TYPE ~
RECORD [
SEQUENCE n: NAT OF REAL
];
ParmPickleProc: Trc.PickleProc = {
[trc: TRC, stream: STREAM, indentation: ROPE ← NIL]
instance: ParmInstance ~ GetParmInstance[trc];
k: NAT ← 0;
IO.PutRope[stream, " {"];
FOR each:
LIST
OF Parm ←
NARROW[trc.class.classData], each.rest
UNTIL each=
NIL
DO
IO.PutF[stream: stream, format: "\n%g\t\"%g\"\t%g", v1: [rope[indentation]], v2: [rope[each.first.name]], v3: [real[instance[k]]]];
k ← k+1;
ENDLOOP;
IO.PutF[stream: stream, format: "\n%g\t}", v1: [rope[indentation]]];
};
ParmDepickleProc: Trc.DepickleProc = {
[class: Trc.Class, stream: STREAM] RETURNS [trc: TRC]
token: ROPE;
tokenKind: IO.TokenKind;
instance: ParmInstance;
parms: LIST OF Parm ~ NARROW[class.classData];
trc ← NewParametricTrc[class];
instance ← GetParmInstance[trc];
IF ~ IO.GetCedarTokenRope[stream].token.Equal["{"] THEN ERROR;
WHILE ([tokenKind: tokenKind, token: token] ←
IO.GetCedarTokenRope[stream: stream]).tokenKind = tokenROPE
DO
token ← Rope.Substr[base: token, start: 1, len: Rope.Length[token]-2];
instance[IndexIntoParmList[name: token, parms: parms]] ← IO.GetReal[stream];
ENDLOOP;
IF ~ token.Equal["}"] THEN ERROR;
};
ControlSliderData:
TYPE ~
REF ControlSliderDataRep;
ControlSliderDataRep:
TYPE ~
RECORD [
trc: Trc.TRC,
index: NAT
];
GetParmInstance:
PROC [trc:
TRC]
RETURNS [instance: ParmInstance] ~
INLINE {
IF trc.instance=NIL THEN trc.instance ← NewParametricTrc[trc.class].instance;
RETURN [NARROW[trc.instance]];
};
ParmBuildControlViewerProc: Trc.BuildControlViewerProc = {
[trc: TRC, info: ViewerClasses.ViewerRec] RETURNS [viewer: ViewerClasses.Viewer]
nominalViewerWidth: INTEGER ~ 255;
maxX: CARDINAL ← 0;
MakeSliderWithTitle:
PROC [title:
ROPE, index:
NAT, initialValue:
REAL] ~ {
kav: KnobAttach.KnobAttachViewer;
slider: Sliders.Slider;
label: Labels.Label;
data: ControlSliderData ~ NEW[ControlSliderDataRep ← [trc: trc, index: index]];
slider ← Sliders.Create[
info: [ wx: 2*margin+sliderHeight, wy: thisY, ww: nominalViewerWidth - 3*margin - sliderHeight, wh: sliderHeight, parent: viewer],
sliderProc: ParmSliderProc,
orientation: horizontal,
value: initialValue,
clientData: data,
paint: FALSE
];
kav ← KnobAttach.Create[
info: [ wx: margin, wy: thisY, ww: sliderHeight, wh: sliderHeight, parent: viewer],
turnProc: ParmSliderProc,
slider: slider,
clientData: data,
paint: FALSE
];
IF UserProfile.Boolean[key: "Trc.AutoSelectKnobs", default:
TRUE]
THEN
SELECT index
FROM
--Default behavior is to select knobs
0 => KnobAttach.Attach[viewer: kav, whichKnob: left, paint: FALSE];
1 => KnobAttach.Attach[viewer: kav, whichKnob: right, paint: FALSE];
ENDCASE;
label ← Labels.Create[ info: [name: title, wx: slider.wx + slider.ww + margin, wy: thisY, parent: viewer, border: FALSE], paint: FALSE];
maxX ← MAX[maxX, label.wx+label.ww];
thisY ← thisY + slider.wh + margin;
};
margin: INTEGER ~ 8;
sliderHeight: INTEGER ~ 12;
thisY: INTEGER ← margin;
index: NAT ← 0;
instance: ParmInstance;
instance ← GetParmInstance[trc];
info.scrollable ← FALSE;
viewer ← Abutters.Create[viewerFlavor: Abutters.vanilla, info: info, paint: FALSE].QuaViewer[];
FOR each:
LIST
OF Parm ←
NARROW[trc.class.classData], each.rest
UNTIL each=
NIL
DO
initialValueInt: INT ← UserProfile.Number[key: Rope.Concat["Trc.InitialParameter.", each.first.name], default: INT.LAST];
initialValue: REAL ~ IF initialValueInt=INT.LAST THEN instance[index] ELSE REAL[initialValueInt]/100.0;
MakeSliderWithTitle[title: each.first.name, index: index, initialValue: initialValue];
index ← index+1;
ENDLOOP;
ViewerOps.MoveViewer[viewer: viewer, x: viewer.wx, y: viewer.wy, w: maxX+margin, h: thisY, paint: paint];
};
ParmSliderProc: Sliders.SliderProc = {
[slider: Sliders.Slider, reason: Sliders.Reason, value: Sliders.NormalizedSliderValue, clientData: REF ANY ← NIL]
data: ControlSliderData ~ NARROW[clientData];
instance: ParmInstance ~ NARROW[data.trc.instance];
IF instance[data.index]#value
THEN {
--This avoids some extra paints
instance[data.index] ← value;
Trc.NotifyListeners[trc: data.trc];
};
};
NElementsInParmList:
PROC [list:
LIST
OF Parm]
RETURNS [count:
NAT ← 0] ~ {
FOR each:
LIST
OF Parm ← list, each.rest
UNTIL each=
NIL
DO
count ← count+1;
ENDLOOP;
};
IndexIntoParmList:
PROC [name:
ROPE, parms:
LIST
OF Parm]
RETURNS [index:
NAT ← 0] ~ {
FOR each:
LIST
OF Parm ← parms, each.rest
UNTIL each=
NIL
DO
IF Rope.Equal[s1: name, s2: each.first.name] THEN RETURN;
index ← index+1;
ENDLOOP;
ERROR;
};
CreateParametricSubclass:
PUBLIC
PROC [flavor:
ATOM, fcn: Trc.Fcn, blockFcn: Trc.BlockFcn, parms:
LIST
OF Parm, register:
BOOL ←
TRUE]
RETURNS [class: Trc.Class] ~ {
class ←
NEW[Trc.ClassRep ← [
flavor: flavor,
fcn: fcn,
blockFcn: blockFcn,
copy: Trc.DefaultCopy,
pickle: ParmPickleProc,
depickle: ParmDepickleProc,
notify: Trc.DefaultNotify,
background: Trc.DefaultBackground,
control: ParmBuildControlViewerProc,
classData: parms
]];
IF register THEN Trc.RegisterClass[class: class];
};
EnumerateRegisteredParametricClasses:
PUBLIC PROC [proc: Trc.ClassEnumProc] ~ {
CheckForParametrics: Trc.ClassEnumProc ~ {
IF class.classData#NIL AND ISTYPE[class.classData, LIST OF Parm] THEN RETURN [proc[class]];
};
Trc.EnumerateRegisteredClasses[CheckForParametrics];
};
NewParametricTrc:
PUBLIC
PROC [class: Class]
RETURNS [trc:
TRC] ~ {
parms: LIST OF Parm ← NARROW[class.classData];
n: NAT ~ NElementsInParmList[parms];
instance: ParmInstance ~ NEW[ParmInstanceRep[n]];
trc ←
NEW[Trc.TRCRep ← [
class: class,
instance: instance
]];
FOR k:
NAT
IN [0..n)
DO
instance[k] ← parms.first.initialValue;
parms ← parms.rest;
ENDLOOP;
};
p: REAL ← 3.141592653589793238462643383279;
LinearFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
brightness: NAT ~ 0;
contrast: NAT ~ 1;
instance: ParmInstance ~ GetParmInstance[trc];
slope: REAL ~ RealFns.Tan[(p/2)*instance[contrast]];
intercept: REAL ~ (slope+1)*instance[brightness]-slope;
RETURN [slope*a + intercept];
};
LinearBlockFcn: Trc.BlockFcn =
UNCHECKED {
[trc: TRC, from: Trc.UnsafeTable, to: Trc.UnsafeTable, count: NAT]
brightness: NAT ~ 0;
contrast: NAT ~ 1;
instance: ParmInstance ~ GetParmInstance[trc];
slope: REAL ~ RealFns.Tan[(p/2.0001)*instance[contrast]]; --Get close to, but not quite, vertical
intercept: REAL ~ (slope+1)*instance[brightness]-slope;
FOR k:
NAT
IN [0..count)
DO
to[k] ← slope*from[k] + intercept;
ENDLOOP;
};
linearClass: Class ~ CreateParametricSubclass[
flavor: $Linear,
fcn: LinearFcn,
blockFcn: LinearBlockFcn,
parms: LIST[["Brightness"], ["Contrast"]]
];
midtoneClass: Trc.Class ~ CreateParametricSubclass[flavor: $Midtone, fcn: MidtoneFcn, blockFcn: MidtoneBlockFcn, parms: LIST [["Brightness"], ["Contrast"], ["Midtone"], ["Low Midtone"], ["High Midtone"]]];
RAY: TYPE ~ RECORD [x, y, m: REAL ← 0.0];
CalcMidtoneParms:
PROC [instance: ParmInstance]
RETURNS [points:
ARRAY [0..5)
OF
RAY] ~
INLINE {
Interpolate:
PROC [p1, p2:
RAY, dy:
REAL]
RETURNS [p:
RAY] ~
INLINE {
RETURN [[x: (p1.x+p2.x)*0.5, y: p1.y + dy*(p2.y-p1.y)]];
};
brightness: NAT ~ 0; contrast: NAT ~ 1; midtone: NAT ~ 2; loMidtone: NAT ~ 3; hiMidtone: NAT ~ 4;
slope: REAL ~ RealFns.Tan[(p/2.001)*instance[contrast]];
intercept: REAL ~ (slope+1)*instance[brightness]-slope;
points[0] ← IF intercept<0 THEN [x: -intercept/slope, y: 0.0] ELSE [x: 0, y: intercept];
points[4] ← IF slope+intercept>1.0 THEN [x: (1.0-intercept)/slope, y: 1.0] ELSE [x: 1.0, y: slope+intercept];
points[2] ← Interpolate[points[0], points[4], instance[midtone]];
points[1] ← Interpolate[points[0], points[2], instance[loMidtone]];
points[3] ← Interpolate[points[2], points[4], instance[hiMidtone]];
FOR k:
NAT
IN [0..4)
DO
IF points[k].x<points[k+1].x
THEN points[k].m ← (points[k+1].y-points[k].y)/(points[k+1].x-points[k].x)
ENDLOOP;
points[4].m ← 0.0;
};
CalcMidtoneValue:
PROC [points:
ARRAY [0..5)
OF
RAY, a:
REAL]
RETURNS [b:
REAL] ~
INLINE {
RETURN [
SELECT
TRUE
FROM
a<points[0].x => 0.0,
a<points[1].x => (a-points[0].x)*points[0].m+points[0].y,
a<points[2].x => (a-points[1].x)*points[1].m+points[1].y,
a<points[3].x => (a-points[2].x)*points[2].m+points[2].y,
a<points[4].x => (a-points[3].x)*points[3].m+points[3].y,
ENDCASE => 1.0
];
};
MidtoneBlockFcn: Trc.BlockFcn =
UNCHECKED {
[trc: TRC, from: Trc.UnsafeTable, to: Trc.UnsafeTable, count: NAT]
points: ARRAY [0..5) OF RAY ~ CalcMidtoneParms[GetParmInstance[trc]];
FOR k:
NAT
IN [0..count)
DO
to[k] ← CalcMidtoneValue[points, from[k]];
ENDLOOP;
};
MidtoneFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
points: ARRAY [0..5) OF RAY ~ CalcMidtoneParms[GetParmInstance[trc]];
RETURN [CalcMidtoneValue[points, a]];
};
BilinearFunction:
PROC [sslope, sintercept, hslope, hintercept, a:
REAL]
RETURNS [answer:
REAL] ~
INLINE {
RETURN [(1-a)*(sslope*a + sintercept) + a*(hslope*a + hintercept)]
};
BilinearFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
sbrightness: NAT ~ 0;
scontrast: NAT ~ 1;
hbrightness: NAT ~ 2;
hcontrast: NAT ~ 3;
instance: ParmInstance ~ GetParmInstance[trc];
sslope: REAL ~ RealFns.Tan[(p/2)*instance[scontrast]];
sintercept: REAL ~ (sslope+1)*instance[sbrightness]-sslope;
hslope: REAL ~ RealFns.Tan[(p/2)*instance[hcontrast]];
hintercept: REAL ~ (hslope+1)*instance[hbrightness]-hslope;
RETURN [BilinearFunction[sslope, sintercept, hslope, hintercept, a]];
};
BilinearBlockFcn: Trc.BlockFcn =
UNCHECKED {
[trc: TRC, from: Trc.UnsafeTable, to: Trc.UnsafeTable, count: NAT]
sbrightness: NAT ~ 0;
scontrast: NAT ~ 1;
hbrightness: NAT ~ 2;
hcontrast: NAT ~ 3;
instance: ParmInstance ~ GetParmInstance[trc];
sslope: REAL ~ RealFns.Tan[(p/2)*instance[scontrast]];
sintercept: REAL ~ (sslope+1)*instance[sbrightness]-sslope;
hslope: REAL ~ RealFns.Tan[(p/2)*instance[hcontrast]];
hintercept: REAL ~ (hslope+1)*instance[hbrightness]-hslope;
FOR k:
NAT
IN [0..count)
DO
to[k] ← BilinearFunction[sslope, sintercept, hslope, hintercept, from[k]];
ENDLOOP;
};
bilinearClass: Class ~ CreateParametricSubclass[
flavor: $Bilinear,
fcn: BilinearFcn,
blockFcn: BilinearBlockFcn,
parms: LIST[["Shadow Brightness"], ["Shadow Contrast"], ["Hilight Brightness"], ["Hilight Contrast"]]
];
SliderValueToSlope:
PROC [value:
REAL]
RETURNS [slope:
REAL] ~
INLINE {
RETURN [RealFns.Tan[(p/2)*value]];
};
AffectedSliderValue:
PROC [basic, affector:
REAL]
RETURNS [affected:
REAL] ~
INLINE {
Typically, one might have a single slider which affects a group of values ganged together, but each value has its own affector to tweak that value. If the affector~0.5, then affected=basic. Otherwise an affector in the range [0 .. 0.5] to map affected to the range [0 .. basic], while an affector in the range [0.5 .. 1.0] will map affected to the range [basic .. 1.0].
RETURN [
IF affector > 0.5
THEN affector*(2-basic-basic) + basic + basic - 1
ELSE affector*(basic+basic)
];
};
SetUpQuadFunction:
PROC [instance: ParmInstance]
RETURNS [coeff0, coeff1, coeff2:
REAL] ~
INLINE {
brightness: NAT ~ 0;
contrast: NAT ~ 1;
shadowContrast: NAT ~ 2;
hilightContrast: NAT ~ 3;
slope0: REAL ~ SliderValueToSlope[AffectedSliderValue[instance[contrast], instance[shadowContrast]]];
slope1: REAL ~ SliderValueToSlope[AffectedSliderValue[instance[contrast], instance[hilightContrast]]];
coeff1 ← slope0;
coeff2 ← (slope1 - slope0)/2.0;
coeff0 ← instance[brightness] - coeff2/3.0 - coeff1/2.0;
};
QuadFunction:
PROC [a, coeff0, coeff1, coeff2:
REAL]
RETURNS [b:
REAL] ~
INLINE {
RETURN [coeff2*a*a + coeff1*a + coeff0]
};
QuadFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
coeff0, coeff1, coeff2: REAL;
[coeff0, coeff1, coeff2] ← SetUpQuadFunction[NARROW[trc.instance, ParmInstance]];
RETURN [QuadFunction[a, coeff0, coeff1, coeff2]]
};
QuadBlockFcn: Trc.BlockFcn =
UNCHECKED {
[trc: TRC, from: Trc.UnsafeTable, to: Trc.UnsafeTable, count: NAT]
coeff0, coeff1, coeff2: REAL;
[coeff0, coeff1, coeff2] ← SetUpQuadFunction[NARROW[trc.instance, ParmInstance]];
FOR k:
NAT
IN [0..count)
DO
to[k] ← QuadFunction[from[k], coeff0, coeff1, coeff2];
ENDLOOP;
};
quadClass: Class ~ CreateParametricSubclass[
flavor: $Quadratic,
fcn: QuadFcn,
blockFcn: QuadBlockFcn,
parms: LIST[["Brightness"], ["Contrast"], ["Shadow Contrast"], ["Hilight Contrast"]]
];
AIS Classes
AISInstance:
TYPE ~
REF AISInstanceRep;
AISInstanceRep:
TYPE ~
RECORD [
SEQUENCE n: NAT OF REAL
];
EqualizeFunction:
PROC [instance: AISInstance, a:
REAL]
RETURNS [result:
REAL] ~
INLINE {
SELECT
TRUE
FROM
a < 0.0 => RETURN [0];
a >= 1.0 => RETURN [1];
ENDCASE => {
index: NAT ~ RealOps.RoundC[a*instance.n, [round: rm]]; --Round down!
RETURN [instance[index]];
};
};
EqualizeFcn: Trc.Fcn = {
[trc: TRC, a: REAL] RETURNS [b: REAL]
instance: AISInstance ~ NARROW[trc.instance];
RETURN [EqualizeFunction[instance, a]];
};
EqualizeBlockFcn: Trc.BlockFcn =
UNCHECKED {
[trc: TRC, from: Trc.UnsafeTable, to: Trc.UnsafeTable, count: NAT]
instance: AISInstance ~ NARROW[trc.instance];
FOR k:
NAT
IN [0..count)
DO
to[k] ← EqualizeFunction[instance, from[k]];
ENDLOOP;
};
EqualizePickleProc: Trc.PickleProc = {
[trc: TRC, stream: STREAM, indentation: ROPE ← NIL]
instance: AISInstance ~ NARROW[trc.instance];
IO.PutF[stream: stream, format: " %g ", v1: [cardinal[instance.n]]];
FOR k:
NAT
IN [0 .. instance.n)
DO
IF k MOD 8=0 THEN IO.PutF[stream: stream, format: "\n%g", v1: [rope[indentation]]];
IO.PutF[stream: stream, format: "%g ", v1: [real[instance[k]]]];
ENDLOOP;
IO.PutRope[self: stream, r: "\n"];
};
EqualizeDepickleProc: Trc.DepickleProc = {
[class: Trc.Class, stream: STREAM] RETURNS [trc: TRC]
nElements: NAT ~ IO.GetCard[stream: stream];
instance: AISInstance ~ NEW[AISInstanceRep[nElements]];
trc ←
NEW[Trc.TRCRep ← [
class: equalizeClass,
instance: instance
]];
FOR k:
NAT
IN [0..instance.n)
DO
instance[k] ← IO.GetReal[stream];
ENDLOOP;
};
EqualizeBuildControlViewerProc: Trc.BuildControlViewerProc = {
[trc: TRC, info: ViewerClasses.ViewerRec] RETURNS [viewer: ViewerClasses.Viewer]
button: ViewerClasses.Viewer;
margin: NAT ~ 4;
pdr: ChoiceButtons.PromptDataRef;
IF trc.instance=
NIL
THEN {
--Instantiate something for new viewer
instance: AISInstance;
trc.instance ← instance ← NEW[AISInstanceRep[1]];
instance[0] ← 0;
};
viewer ← Abutters.Create[viewerFlavor: Abutters.vanilla, info: info, paint: FALSE].QuaViewer[];
pdr ← ChoiceButtons.BuildTextPrompt[viewer: viewer, x: 0, y: 0, title: "AIS File:", clientdata: trc];
button ← Buttons.Create[info: [name: "Load!", wy: pdr.textViewer.wh + margin, border: TRUE, parent: viewer], proc: EqualizeLoadHistogramProc, clientData: pdr, documentation: "Click again to compute TRC from Histogram", guarded: TRUE, paint: FALSE];
ViewerOps.MoveViewer[viewer: viewer, x: viewer.wx, y: viewer.wy, w: viewer.ww, h: button.wy + button.wh + margin, paint: paint];
};
Complain:
PROC [msg:
ROPE] ~ {
MessageWindow.Append[message: msg, clearFirst: TRUE];
MessageWindow.Blink[];
};
EqualizeLoadHistogramProc: Buttons.ButtonProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
ComputeHistoSum:
PROC [h:
AIS.Histogram]
RETURNS [sum:
INT ← 0] ~ {
FOR k:
NAT
IN [0..h.length)
DO
sum ← sum+h[k];
ENDLOOP;
};
pdr: ChoiceButtons.PromptDataRef ~ NARROW[clientData];
trc: TRC ~ NARROW[pdr.clientdata];
instance: AISInstance;
fileName: ROPE ← ViewerTools.GetContents[pdr.textViewer];
histo: AIS.Histogram;
sum, runningSum: INT ← 0;
fileName ←
FS.FileInfo[name: fileName ! FS.Error => {
Complain["File name not found."];
GOTO Fail;
};].fullFName;
histo ← AIS.ReadHistogram[f: AIS.OpenFile[name: fileName ! AIS.Error => {Complain["Not an AIS file."]; GOTO Fail}] ! AIS.Error => {Complain["AIS file does not have a histogram."]; GOTO Fail}];
IF histo=NIL THEN {Complain["AIS file does not have a histogram."]; GOTO Fail};
sum ← ComputeHistoSum[histo];
trc.instance ← instance ← NEW[AISInstanceRep[histo.length]];
FOR k:
NAT
IN [0 .. instance.n)
DO
runningSum ← runningSum + histo[k];
instance[k] ← REAL[runningSum]/REAL[sum];
ENDLOOP;
Trc.NotifyListeners[trc: trc];
EXITS Fail => NULL;
};
equalizeClass: Class ~
NEW[Trc.ClassRep ← [
flavor: $Equalize,
fcn: EqualizeFcn,
blockFcn: EqualizeBlockFcn,
copy: Trc.DefaultCopy,
pickle: EqualizePickleProc,
depickle: EqualizeDepickleProc,
notify: Trc.DefaultNotify,
background: Trc.DefaultBackground,
control: EqualizeBuildControlViewerProc
]];