<> <> <> <<>> 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]; TrcStandardClassesImpl: CEDAR PROGRAM IMPORTS Abutters, AIS, Buttons, ChoiceButtons, FS, IO, KnobAttach, Labels, MessageWindow, RealFns, RealOps, Rope, Sliders, Trc, UserProfile, ViewerOps, ViewerTools EXPORTS TrcStandardClasses ~ BEGIN OPEN TrcStandardClasses; <> IdentityFcn: Trc.Fcn = { <<[trc: TRC, a: REAL] RETURNS [b: REAL]>> RETURN [a]; }; IdentityBlockFcn: Trc.BlockFcn = UNCHECKED { <<[trc: TRC, from: Trc.UnsafeTable, to: Trc.UnsafeTable, count: NAT]>> FOR k: NAT IN [0 .. count) DO to[k] _ from[k]; ENDLOOP; }; identityClass: Trc.Class ~ NEW[Trc.ClassRep _ [ flavor: $Identity, fcn: IdentityFcn, blockFcn: IdentityBlockFcn, copy: Trc.DefaultCopy, pickle: Trc.DefaultPickle, depickle: Trc.DefaultDepickle, background: Trc.DefaultBackground, notify: Trc.DefaultNotify, control: Trc.DefaultControl ]]; NewIdentityTrc: PUBLIC PROC RETURNS [trc: TRC] ~ { trc _ NEW[Trc.TRCRep _ [ class: identityClass, instance: NIL ]]; }; <> 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> }; 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> 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; }; LinearFcn: Trc.Fcn = { <<[trc: TRC, a: REAL] RETURNS [b: REAL]>> brightness: NAT ~ 0; contrast: NAT ~ 1; instance: ParmInstance ~ GetParmInstance[trc]; slope: REAL ~ RealFns.Tan[( 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[( 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[( 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 0.0, a (a-points[0].x)*points[0].m+points[0].y, a (a-points[1].x)*points[1].m+points[1].y, a (a-points[2].x)*points[2].m+points[2].y, a (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[( sintercept: REAL ~ (sslope+1)*instance[sbrightness]-sslope; hslope: REAL ~ RealFns.Tan[( 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[( sintercept: REAL ~ (sslope+1)*instance[sbrightness]-sslope; hslope: REAL ~ RealFns.Tan[( 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[( }; AffectedSliderValue: PROC [basic, affector: REAL] RETURNS [affected: REAL] ~ INLINE { <> 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"]] ]; <> 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 ]]; <> Trc.RegisterClass[identityClass]; Trc.RegisterClass[chainClass]; Trc.RegisterClass[equalizeClass]; END.