<> <> <> <> <<>> DIRECTORY AtomButtonsTypes, CodeTimer, ColorTool, Feedback, FS, Imager, ImagerColor, ImagerColorMap, ImagerDitherContext, Real, RealFns, Rope, SVSceneTypes, SVUtility, Terminal, ViewerClasses, ViewerOps; SVUtilityImpl: CEDAR PROGRAM IMPORTS CodeTimer, ColorTool, Feedback, FS, ImagerColor, ImagerColorMap, ImagerDitherContext, Real, RealFns, Rope, Terminal, ViewerOps EXPORTS SVUtility = BEGIN FeatureData: TYPE = SVSceneTypes.FeatureData; FeedbackData: TYPE = AtomButtonsTypes.FeedbackData; MasterObject: TYPE = SVSceneTypes.MasterObject; MasterObjectList: TYPE = SVSceneTypes.MasterObjectList; Slice: TYPE = SVSceneTypes.Slice; SliceList: TYPE = SVSceneTypes.SliceList; SliceDescriptor: TYPE = SVSceneTypes.SliceDescriptor; Viewer: TYPE = ViewerClasses.Viewer; Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = Feedback.Problem; EntityNotFound: PUBLIC SIGNAL = CODE; <> LinearFormula: PROC [a, b: REAL] RETURNS [root: REAL, rootCount: NAT] = { <> IF a = 0 THEN { IF b = 0 THEN {root _ 0.0; rootCount _ 0; RETURN} ELSE {root _ 0.0; rootCount _ 0; RETURN} -- inconsistent case } ELSE { IF b = 0 THEN {root _ 0.0; rootCount _ 1; RETURN} ELSE {root _ -b/a; rootCount _ 1; RETURN}; }; }; QuadraticFormula: PUBLIC PROC [a, b, c: REAL] RETURNS [roots: ARRAY [1..2] OF REAL, rootCount: NAT] = { <> discriminant, temp: REAL; IF a = 0 THEN { [roots[1], rootCount] _ LinearFormula [b, c]; RETURN; }; IF c = 0 THEN { roots[1] _ 0.0; [roots[2], rootCount] _ LinearFormula[a, b]; rootCount _ rootCount + 1; IF roots[1] > roots[2] THEN { -- swap them temp _ roots[1]; roots[1] _ roots[2]; roots[2] _ temp; }; RETURN}; discriminant _ b*b - 4*a*c; -- 3 mult, 1 add SELECT discriminant FROM =0 => {rootCount _ 1; roots[1] _ -b/(2*a); RETURN}; -- 1 mult, 1 div (4 mult, 1 div, 1 add total) <0 => {rootCount _ 0; RETURN}; -- (3 mult, 1 add total) >0 => { sqrtRadical: REAL _ RealFns.SqRt[discriminant]; term: REAL; rootCount _ 2; term _ IF b < 0 THEN sqrtRadical - b ELSE -sqrtRadical - b; roots[1] _ term/(2.0*a); roots[2] _ (2.0*c)/term; IF roots[1] > roots[2] THEN { -- swap them temp _ roots[1]; roots[1] _ roots[2]; roots[2] _ temp; }; RETURN}; -- 1 SqRt, 2 mult, 2 div, 2 add (1 SqRt, 5 mult, 2 div, 3 add total) ENDCASE => ERROR; }; -- end of QuadraticFormula <> AppendToMasterObjects: PUBLIC PROC [mo: MasterObject, list: MasterObjectList] RETURNS [MasterObjectList] = { <> z: MasterObjectList _ list; IF z = NIL THEN RETURN[CONS[mo,NIL]]; UNTIL z.rest = NIL DO z _ z.rest; ENDLOOP; z.rest _ CONS[mo,NIL]; RETURN[list]; }; AppendToAssemblyList: PUBLIC PROC [assembly: Slice, list: SliceList] RETURNS [SliceList] = { <> z: LIST OF Slice _ list.list; IF z = NIL THEN {list.list _ CONS[assembly, NIL]; RETURN[list]}; UNTIL z.rest = NIL DO z _ z.rest; ENDLOOP; z.rest _ CONS[assembly,NIL]; RETURN[list]; }; <<>> <> StartSliceList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF Slice] = { ptr _ entityList _ NIL; }; AddSlice: PUBLIC PROC [slice: Slice, entityList, ptr: LIST OF Slice] RETURNS [newList, newPtr: LIST OF Slice] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[slice, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[slice, NIL]; newPtr _ ptr.rest; }; }; <> StartList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF REF ANY] = { ptr _ entityList _ NIL; }; AddEntity: PUBLIC PROC [entity: REF ANY, entityList, ptr: LIST OF REF ANY] RETURNS [newList, newPtr: LIST OF REF ANY] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; <<>> <> StartSliceDescriptorList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF SliceDescriptor] = { ptr _ entityList _ NIL; }; AddSliceDescriptor: PUBLIC PROC [entity: SliceDescriptor, entityList, ptr: LIST OF SliceDescriptor] RETURNS [newList, newPtr: LIST OF SliceDescriptor] = { IF ptr = NIL THEN { IF NOT entityList = NIL THEN ERROR; newPtr _ newList _ CONS[entity, NIL]; RETURN; } ELSE { newList _ entityList; ptr.rest _ CONS[entity, NIL]; newPtr _ ptr.rest; }; }; AppendSliceDescriptorList: PUBLIC PROC [list1, list2: LIST OF SliceDescriptor] RETURNS [result: LIST OF SliceDescriptor] = { pos: LIST OF SliceDescriptor; newCell: LIST OF SliceDescriptor; <> IF list1 = NIL THEN RETURN[list2]; result _ CONS[list1.first, NIL]; pos _ result; FOR l: LIST OF SliceDescriptor _ list1.rest, l.rest UNTIL l = NIL DO newCell _ CONS[l.first, NIL]; pos.rest _ newCell; pos _ newCell; ENDLOOP; pos.rest _ list2; }; DeleteSliceDescriptorFromList: PUBLIC PROC [sliceD: SliceDescriptor, sliceDList: LIST OF SliceDescriptor] RETURNS [smallerList: LIST OF SliceDescriptor] = { beforeEnt, ent, afterEnt: LIST OF SliceDescriptor; found: BOOL _ FALSE; [beforeEnt, ent, afterEnt, found] _ FindSliceDescriptorAndNeighbors[sliceD, sliceDList]; IF NOT found THEN RETURN[sliceDList]; IF beforeEnt = NIL THEN smallerList _ afterEnt ELSE { beforeEnt.rest _ afterEnt; smallerList _ sliceDList; }; }; FindSliceDescriptorAndNeighbors: PROC [sliceD: SliceDescriptor, sliceDList: LIST OF SliceDescriptor] RETURNS [beforeEnt, ent, afterEnt: LIST OF SliceDescriptor, found: BOOL _ FALSE] = { lastE: LIST OF SliceDescriptor _ NIL; eList: LIST OF SliceDescriptor _ sliceDList; IF eList = NIL THEN ERROR EntityNotFound; UNTIL eList = NIL DO IF eList.first = sliceD THEN { beforeEnt _ lastE; ent _ eList; afterEnt _ eList.rest; found _ TRUE; RETURN; }; lastE _ eList; eList _ eList.rest; ENDLOOP; }; <<>> <> CopyFeatureList: PUBLIC PROC [features: LIST OF FeatureData] RETURNS [copyList: LIST OF FeatureData] = { z: LIST OF FeatureData _ NIL; IF features = NIL THEN RETURN[NIL]; copyList _ CONS[features.first, NIL]; z _ copyList; UNTIL (features _ features.rest) = NIL DO z.rest _ CONS[features.first, NIL]; z _ z.rest; ENDLOOP; }; FeatureDataNconc: PUBLIC PROC [l1, l2: LIST OF FeatureData] RETURNS [bigList: LIST OF FeatureData] = { z: LIST OF FeatureData _ l1; IF z = NIL THEN RETURN[l2]; UNTIL z.rest = NIL DO z _ z.rest; ENDLOOP; z.rest _ l2; RETURN[l1]; }; <<>> <> GetInterpressFileName: PUBLIC PROC [shortName: Rope.ROPE, workingDir: Rope.ROPE, feedback: FeedbackData] RETURNS [fullName: Rope.ROPE _ NIL, success: BOOL _ TRUE] = { [fullName, success, ----] _ GetGenericFileName[shortName, workingDir, "IP", LIST["pic", "gargoyle", "script", "mesa", "tioga"], feedback]; }; GetScriptFileName: PUBLIC PROC [scriptName: Rope.ROPE, currentWDir: Rope.ROPE, feedback: FeedbackData] RETURNS [fullName: Rope.ROPE _ NIL, success: BOOL _ TRUE] = { [fullName, success, ----] _ GetGenericFileName[scriptName, currentWDir, "script", LIST["gargoyle", "IP", "interpress", "mesa", "tioga", "pic"], feedback]; }; GetGenericFileName: PROC [fileName, wDir, defaultExt: Rope.ROPE, illegalExts: LIST OF Rope.ROPE, feedback: FeedbackData, emergency: BOOL _ FALSE] RETURNS [fullName: Rope.ROPE _ NIL, success: BOOL _ TRUE, versionSpecified: BOOL _ FALSE] = { cp: FS.ComponentPositions; extRope: Rope.ROPE; versionSpecified _ Rope.SkipTo[s: fileName, skip: "!"]#Rope.Length[fileName]; IF Rope.Length[fileName]=0 OR Rope.Equal[fileName, ""] THEN { IF NOT emergency THEN { Feedback.PutF[feedback, oneLiner, "No filename specified"]; Feedback.Blink[feedback]; }; RETURN[NIL, FALSE]; }; [fullName, cp, ] _ FS.ExpandName[fileName, wDir ! FS.Error => { success _ FALSE; IF NOT emergency THEN { Feedback.PutF[feedback, oneLiner, "FS Error during name expansion of %g", [rope[fileName]]]; Feedback.Blink[feedback]; }; CONTINUE; } ]; IF NOT success THEN RETURN; extRope _ Rope.Substr[base: fullName, start: cp.ext.start, len: cp.ext.length]; FOR ropeList: LIST OF Rope.ROPE _ illegalExts, ropeList.rest UNTIL ropeList=NIL DO IF Rope.Equal[ropeList.first, extRope, FALSE] THEN { IF NOT emergency THEN { Feedback.PutF[feedback, oneLiner, "%g extension for %g files not allowed", [rope[extRope]], [rope[defaultExt]] ]; Feedback.Blink[feedback]; }; success _ FALSE; RETURN; }; ENDLOOP; IF cp.ext.length=0 THEN fullName _ Rope.Cat[fullName, ".", defaultExt]; }; <> GetSpecialColor: PUBLIC PROC RETURNS [color: Imager.Color] = { zeroByte: Terminal.ColorValue = 0; channel: Terminal.ChannelValue _ 129; mapEntry: REF ImagerColorMap.MapEntry; tool: ViewerClasses.Viewer _ ViewerOps.FindViewer["ColorTool"]; IF tool=NIL THEN RETURN[NIL]; mapEntry _ NEW[ImagerColorMap.MapEntry _ [channel, zeroByte, zeroByte, zeroByte] ]; ImagerColorMap.LoadEntries[vt: Terminal.Current[], mapEntries: LIST[mapEntry^], shared: FALSE]; color _ ImagerDitherContext.MakeSpecialColor[ specialPixel: [value: mapEntry.mapIndex, dstFunc: null], ordinaryColor: ImagerColor.ColorFromRGB[ColorTool.GetRGBValue[tool]]]; ColorTool.RegisterNotifyProc[$GG, TrackPatch, mapEntry, tool]; }; TrackPatch: PROC[rgb: ImagerColor.RGB, clientData: REF] = { -- ColorTool.NotifyProc ToByte: PROC[v: REAL] RETURNS[Terminal.ColorValue] = { RETURN[Real.Round[v*255]] }; mapEntry: REF ImagerColorMap.MapEntry _ NARROW[clientData]; mapEntry.red _ ToByte[rgb.R]; mapEntry.green _ ToByte[rgb.G]; mapEntry.blue _ ToByte[rgb.B]; ImagerColorMap.LoadEntries[vt: Terminal.Current[], mapEntries: LIST[mapEntry^], shared: FALSE]; }; Init: PROC [] = { [] _ CodeTimer.CreateTable[$Solidviews]; }; Init[]; END.