GGScriptStatsImpl.mesa
Copyright Ó 1986, 1987, 1992 by Xerox Corporation. All rights reserved.
Last edited by Bier on November 8, 1987 11:41:57 pm PST
Contents: Routines for processing one or more SessionLog scripts to determine the frequency of user events. Some of these routines are tailored for Gargoyle scripts in particular. Others are more general.
Pier, November 2, 1992 4:09 pm PST
Bier, July 30, 1992 1:54 pm PDT
Last tweaked by Mike Spreitzer on May 3, 1990 3:45:42 pm PDT
DIRECTORY
Atom, BasicTime, Commander, CommandTool, Feedback, FeedbackOps, FeedbackTypes, File, FileNames, FS, GGFileOps, GGScriptStats, IO, RefTab, Rope, SessionLog, SystemNames, ViewerClasses;
GGScriptStatsImpl: CEDAR PROGRAM
IMPORTS Atom, BasicTime, Commander, CommandTool, Feedback, FeedbackOps, File, FileNames, FS, GGFileOps, IO, RefTab, Rope, SessionLog, SystemNames
EXPORTS GGScriptStats = BEGIN
Script Formats
Normal Gargoyle Script
Version 8710.19
SetSlopes ...
During ...
AllUp
Script Summary
Comment "[Queenfish]<Cedar>Users>Bier.pa>Gargoyle>bier871019-00-06-13.script!2"
Version 1
SetMidpoints 3
AllUp 19
The atomOrder also includes $SectionHeader atoms, used to add extra spacing to the output.
Totals File
Version 1
SetMidpoints 3
AllUp 19
The atomOrder also includes $SectionHeader atoms, used to add headers and section statistics to the output.
ArgumentType: TYPE = {none, rope, rope2, refInt, refReal, refCard};
AtomListt: TYPE = REF AtomListtObj;
AtomListtObj: TYPE = GGScriptStats.AtomListtObj;
Database: TYPE = REF DatabaseObj;
DatabaseObj: TYPE = GGScriptStats.DatabaseObj;
MsgRouter: TYPE = FeedbackTypes.MsgRouter;
Viewer: TYPE = ViewerClasses.Viewer;
AtomSeq: TYPE = REF AtomSeqObj;
AtomSeqObj: TYPE = RECORD [
seq: SEQUENCE len: NAT OF ATOM
];
CardSeq: TYPE = REF CardSeqObj;
CardSeqObj: TYPE = RECORD [
seq: SEQUENCE len: NAT OF CARD
];
RegisteredEvent: TYPE = REF RegisteredEventObj;
RegisteredEventObj: TYPE = RECORD [
argType: ArgumentType,
count: CARD,
fraction: REAL,
addOn: BOOL ¬ FALSE, -- this atom was not registered in the original table
system: BOOL ¬ FALSE,
text: Rope.ROPE ¬ NIL
];
Problem: SIGNAL [msg: Rope.ROPE] = Feedback.Problem;
ProcessOneScript: PUBLIC PROC [scriptName: Rope.ROPE, resultName: Rope.ROPE, workingDirectory: Rope.ROPE] = {
fullName: Rope.ROPE;
success, versionSpecified, alreadyExists: BOOL ¬ FALSE;
resultStream: IO.STREAM;
database: Database;
typescript: Viewer;
router: MsgRouter;
printTime: INT;
BEGIN
[alreadyExists, typescript] ¬ FeedbackOps.CreateNamedTypescript[headerText: "Script Statistics", typescriptName: $ScriptStats, openHeight: 120];
router ¬ Feedback.CreateRouter[];
FeedbackOps.SetTypescript[router, $ScriptStats];
[fullName, success, versionSpecified] ¬ GGFileOps.GetGenericFileName["ScriptStats", resultName, workingDirectory, "statistics", LIST["gargoyle", "ip", "script"], router];
resultStream ¬ FS.StreamOpen[fullName, $create ! FS.Error => GOTO FSError];
database ¬ CreateDatabase[];
printTime ¬ ProcessScript[scriptName, resultStream, database, workingDirectory, router];
resultStream.Close[];
Feedback.PutF[router, oneLiner, $Feedback, "Statistics written to %g in time (%r)", [rope[fullName]], [integer[printTime]]];
EXITS
FSError => Feedback.Append[router, oneLiner, $Complaint, Rope.Concat["FSError while trying ", fullName]];
END;
};
ProcessScript: PUBLIC PROC [scriptName: Rope.ROPE, resultStream: IO.STREAM, database: Database, workingDirectory: Rope.ROPE ¬ NIL, router: MsgRouter ¬ NIL] RETURNS [printTime: INT] = {
fullName, globalName: Rope.ROPE;
success: BOOL ¬ FALSE;
f: IO.STREAM;
endOfStream: BOOL ¬ FALSE;
startTime, endTime: BasicTime.GMT;
totalTime: INT;
InitializeDatabase[database];
BEGIN
[fullName, success] ¬ GGFileOps.GetScriptFileName["ScriptStats", scriptName, workingDirectory, router];
IF NOT success THEN {fullName ¬ scriptName; GOTO OpenFileProblem};
[f, success] ¬ OpenExistingFile[fullName, router];
IF NOT success THEN GOTO OpenFileProblem;
startTime ¬ BasicTime.Now[];
WHILE NOT endOfStream DO
endOfStream ¬ SessionLog.PlayAction[f, database, ProcessAction];
ENDLOOP;
endTime ¬ BasicTime.Now[];
totalTime ¬ BasicTime.Period[startTime, endTime];
Feedback.PutF[router, oneLiner, $Statistics, "Read %g (%r)", [rope[fullName]], [integer[totalTime]]];
startTime ¬ BasicTime.Now[];
globalName ¬ FNameToGName[fullName];
resultStream.PutF["Comment ""%g""\n", [rope[globalName]]];
PrintResults[resultStream, database];
endTime ¬ BasicTime.Now[];
printTime ¬ BasicTime.Period[startTime, endTime];
EXITS
OpenFileProblem => Feedback.Append[router, oneLiner, $Complaint, Rope.Cat["Could not open ", fullName, " for playback"]];
END;
};
ProcessOneSummary: PUBLIC PROC [summaryName: Rope.ROPE, totalsName: Rope.ROPE, workingDirectory: Rope.ROPE] = {
success, versionSpecified, alreadyExists: BOOL ¬ FALSE;
database: Database;
typescript: Viewer;
router: MsgRouter;
Open a typescript
[alreadyExists, typescript] ¬ FeedbackOps.CreateNamedTypescript[headerText: "Script Statistics", typescriptName: $ScriptStats, openHeight: 120];
router ¬ Feedback.CreateRouter[];
FeedbackOps.SetTypescript[router, $ScriptStats];
Initialize the database
database ¬ CreateDatabase[];
InitializeDatabase[database];
Process the summary and write the new totals to the totals files
ReadOneSummary[summaryName, workingDirectory, database, router];
WriteTotals[totalsName, workingDirectory, database, router];
};
ReadOneSummary: PROC [summaryName: Rope.ROPE, workingDirectory: Rope.ROPE, database: Database, router: MsgRouter] = {
endOfStream: BOOL ¬ FALSE;
f: IO.STREAM;
fullSummaryName: Rope.ROPE;
success, versionSpecified, alreadyExists: BOOL ¬ FALSE;
startTime, endTime: BasicTime.GMT;
totalTime: INT;
BEGIN
[fullSummaryName, success, versionSpecified] ¬ GGFileOps.GetGenericFileName["ScriptStats", summaryName, workingDirectory, "stats", LIST["gargoyle", "ip", "script"], router];
IF NOT success THEN {fullSummaryName ¬ summaryName; GOTO OpenFileProblem};
[f, success] ¬ OpenExistingFile[fullSummaryName, router];
IF NOT success THEN GOTO OpenFileProblem;
startTime ¬ BasicTime.Now[];
WHILE NOT endOfStream DO
endOfStream ¬ SessionLog.PlayAction[f, database, ProcessSubtotal];
ENDLOOP;
f.Close[];
endTime ¬ BasicTime.Now[];
totalTime ¬ BasicTime.Period[startTime, endTime];
Feedback.PutF[router, oneLiner, $Feedback, "Read %g (%r)", [rope[fullSummaryName]], [integer[totalTime]]];
EXITS
OpenFileProblem => Feedback.Append[router, oneLiner, $Complaint, Rope.Cat["Could not open ", fullSummaryName, " for input"]];
END;
};
WriteTotals: PUBLIC PROC [totalsName: Rope.ROPE, workingDirectory: Rope.ROPE ¬ NIL, database: Database, router: MsgRouter ¬ NIL] = {
startTime, endTime: BasicTime.GMT;
printTime: INT;
fullTotalsName: Rope.ROPE;
tKeep: CARDINAL ¬ 0;
ofile: FS.OpenFile;
totalsStream: IO.STREAM;
success, versionSpecified, alreadyExists: BOOL ¬ FALSE;
BEGIN
[fullTotalsName, success, versionSpecified] ¬ GGFileOps.GetGenericFileName["ScriptStats", totalsName, workingDirectory, "stats", LIST["gargoyle", "ip", "script"], router];
tKeep ¬ FS.FileInfo[name: fullTotalsName ! FS.Error => CONTINUE].keep;
ofile ¬ FS.Create[name: fullTotalsName, setPages: FALSE, setKeep: TRUE, keep: MAX[tKeep, 2] ! FS.Error => {
GOTO OpenFileProblem;
};];
totalsStream ¬ FS.StreamFromOpenFile[openFile: ofile, accessRights: $write ! FS.Error => GOTO OpenStreamProblem];
Write the totals onto the totalsStream
startTime ¬ BasicTime.Now[];
ComputeTotals[database];
PrintTotals[totalsStream, database];
totalsStream.Close[];
endTime ¬ BasicTime.Now[];
printTime ¬ BasicTime.Period[startTime, endTime];
Feedback.PutF[router, oneLiner, $Feedback, "Totals written to %g in time (%r)", [rope[fullTotalsName]], [integer[printTime]]];
EXITS
OpenFileProblem => Feedback.Append[router, oneLiner, $Complaint, Rope.Cat["Could not open ", fullTotalsName, " for totals"]];
OpenStreamProblem => Feedback.Append[router, oneLiner, $Complaint, Rope.Cat["Could not open stream on ", fullTotalsName]];
END;
};
FNameToGName: PROC [name: Rope.ROPE] RETURNS [Rope.ROPE] = {
gHost, gDir: Rope.ROPE ¬ NIL;
name ¬ FS.FileInfo[name].fullFName; -- put in []<> format
IF Rope.Match["[]*", name] THEN {
IF gHost = NIL THEN gHost ¬ Rope.Cat["[", SystemNames.MachineName[], "]"];
IF gDir = NIL THEN
gDir ¬ Rope.Cat[gHost, "<", File.GetVolumeName[File.SystemVolume[]], ">"];
IF Rope.Match["[]<>*", name]
THEN RETURN [Rope.Replace[base: name, start: 0, len: 4, with: gDir]]
ELSE RETURN [Rope.Replace[base: name, start: 0, len: 2, with: gHost]];
};
RETURN [name];
};
ComputeTotals: PROC [database: Database] = {
Add up all of the actions except those for which system = TRUE; For each of the remaining actions, compute what fraction of the whole it takes up.
AddEmUp: PROC [atom: ATOM] RETURNS [done: BOOL ¬ FALSE] = {
refAny: REF ANY;
regEvent: RegisteredEvent;
found: BOOL;
headerAtom: ATOM;
Zero Section Headers
headerAtom ¬ sectionOrderList.first;
sectionOrderList ¬ sectionOrderList.rest;
IF atom = $SectionHeader THEN {
[found, refAny] ¬ RefTab.Fetch[database.sectionTable, headerAtom];
IF NOT found THEN ERROR;
sectionEvent ¬ NARROW[refAny];
sectionEvent.count ¬ 0;
RETURN;
};
Add Actions to the Totals
[found, refAny] ¬ RefTab.Fetch[table, atom];
IF NOT found THEN ERROR;
regEvent ¬ NARROW[refAny];
IF NOT regEvent.system THEN database.atomCount ¬ database.atomCount + regEvent.count;
sectionEvent.count ¬ sectionEvent.count + regEvent.count;
};
ComputeFraction: PROC [atom: ATOM] RETURNS [done: BOOL ¬ FALSE] = {
refAny: REF ANY;
regEvent: RegisteredEvent;
found: BOOL;
realCount: REAL;
headerAtom: ATOM;
Find Header Fractions
headerAtom ¬ sectionOrderList.first;
sectionOrderList ¬ sectionOrderList.rest;
IF atom = $SectionHeader THEN {
[found, refAny] ¬ RefTab.Fetch[database.sectionTable, headerAtom];
IF NOT found THEN ERROR;
sectionEvent ¬ NARROW[refAny];
realCount ¬ sectionEvent.count;
sectionEvent.fraction ¬ realCount/realAtomCount;
RETURN;
};
Find Action Fractions
[found, refAny] ¬ RefTab.Fetch[table, atom];
IF NOT found THEN ERROR;
regEvent ¬ NARROW[refAny];
realCount ¬ regEvent.count;
regEvent.fraction ¬ realCount/realAtomCount;
};
table: RefTab.Ref ¬ database.table;
sectionEvent: RegisteredEvent;
realAtomCount: REAL;
sectionOrderList: LIST OF ATOM;
sectionOrderList ¬ database.sectionOrder.list;
database.atomCount ¬ 0;
ForEachAtom[database.atomOrder, AddEmUp];
sectionOrderList ¬ database.sectionOrder.list;
realAtomCount ¬ database.atomCount;
ForEachAtom[database.atomOrder, ComputeFraction];
};
printAll: BOOL ¬ FALSE;
PrintTotals: PROC [resultStream: IO.STREAM, database: Database] = {
For each action, print its total and the fraction of the grand total (computed by ComputeTotals) for non-system actions.
For each section header, print its name, its total and the fraction of the grand total.
Finally, print the grand total.
PrintTotalAndFraction: PROC [atom: ATOM] RETURNS [done: BOOL ¬ FALSE] = {
refAny: REF ANY;
regEvent: RegisteredEvent;
found: BOOL;
headerAtom: ATOM;
Deal with Section Headers
headerAtom ¬ sectionOrderList.first;
sectionOrderList ¬ sectionOrderList.rest;
IF atom = $SectionHeader THEN {
headerEvent: RegisteredEvent;
[found, refAny] ¬ RefTab.Fetch[database.sectionTable, headerAtom];
IF NOT found THEN ERROR;
headerEvent ¬ NARROW[refAny];
resultStream.PutF["\nSectionHeader %g %g (%6.3f)\n", [rope[Atom.GetPName[headerAtom]]], [integer[headerEvent.count]], [real[headerEvent.fraction]] ];
RETURN;
};
Deal with Other Atoms
[found, refAny] ¬ RefTab.Fetch[table, atom];
IF NOT found THEN ERROR;
regEvent ¬ NARROW[refAny];
IF regEvent.count > 0 OR printAll THEN {
resultStream.PutF["%g %g (%6.3f)", [rope[Atom.GetPName[atom]]], [integer[regEvent.count]], [real[regEvent.fraction]] ];
IF regEvent.addOn THEN resultStream.PutF[" AddOn"];
resultStream.PutChar[IO.LF];
};
};
table: RefTab.Ref ¬ database.table;
sectionOrderList: LIST OF ATOM ¬ database.sectionOrder.list;
ForEachAtom[database.atomOrder, PrintTotalAndFraction];
resultStream.PutF["\nTotal %g", [integer[database.atomCount]] ];
};
PrintResults: PROC [resultStream: IO.STREAM, database: Database] = {
For each action, print its total.
PrintAtomResults: PROC [atom: ATOM] RETURNS [done: BOOL ¬ FALSE] = {
refAny: REF ANY;
regEvent: RegisteredEvent;
found: BOOL;
IF atom = $SectionHeader THEN {resultStream.PutChar[IO.LF]; RETURN};
[found, refAny] ¬ RefTab.Fetch[table, atom];
IF NOT found THEN ERROR;
regEvent ¬ NARROW[refAny];
IF regEvent.count > 0 THEN {
resultStream.PutF["%g %g", [rope[Atom.GetPName[atom]]], [integer[regEvent.count]] ];
IF regEvent.addOn THEN resultStream.PutF[" AddOn"];
resultStream.PutChar[IO.LF];
};
};
table: RefTab.Ref ¬ database.table;
ForEachAtom[database.atomOrder, PrintAtomResults];
};
InitializeDatabase: PROC [database: Database] = {
InitializeEvent: PROC [key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOL ¬ FALSE] = {
regEvent: RegisteredEvent ¬ NARROW[val];
regEvent.count ¬ 0;
regEvent.fraction ¬ 0.0;
};
[] ¬ RefTab.Pairs[database.table, InitializeEvent];
[] ¬ RefTab.Pairs[database.sectionTable, InitializeEvent];
};
ProcessAction: PUBLIC PROC [clientData: REF ANY, event: LIST OF REF ANY] = {
regEvent: RegisteredEvent;
refAny: REF ANY;
found: BOOL;
database: Database ¬ NARROW[clientData];
atom: ATOM;
table: RefTab.Ref ¬ database.table;
atom ¬ NARROW[event.first];
[found, refAny] ¬ RefTab.Fetch[table, atom];
regEvent ¬ NARROW[refAny];
IF NOT found THEN {
RegisterAction[atom, database, none];
[found, refAny] ¬ RefTab.Fetch[table, event.first];
IF NOT found THEN ERROR;
regEvent ¬ NARROW[refAny];
regEvent.addOn ¬ TRUE;
};
IF atom = $SetScaleUnit THEN {
IF event.rest.rest.first = $Noisy THEN regEvent.count ¬ regEvent.count + 1
}
ELSE regEvent.count ¬ regEvent.count + 1;
};
ProcessSubtotal: PUBLIC PROC [clientData: REF ANY, event: LIST OF REF ANY] = {
regEvent: RegisteredEvent;
refAny: REF ANY;
found: BOOL;
database: Database ¬ NARROW[clientData];
table: RefTab.Ref ¬ database.table;
count: CARD;
atom: ATOM;
atom ¬ NARROW[event.first];
IF atom = $Comment THEN RETURN;
IF atom = $SectionHeader THEN RETURN; -- These are computed from scratch each time
IF atom = $Total THEN RETURN; -- This is computed from scratch each time
[found, refAny] ¬ RefTab.Fetch[table, atom];
regEvent ¬ NARROW[refAny];
Handle AddOns
IF NOT found THEN {
RegisterAction[atom, database, none];
[found, refAny] ¬ RefTab.Fetch[table, event.first];
IF NOT found THEN ERROR;
regEvent ¬ NARROW[refAny];
regEvent.addOn ¬ TRUE;
};
Update the Count
count ¬ NARROW[event.rest.first, REF INT]­;
regEvent.count ¬ regEvent.count + count;
};
OpenExistingFile: PROC [name: Rope.ROPE, router: MsgRouter ¬ NIL] RETURNS [f: IO.STREAM, success: BOOL] = {
success ¬ TRUE;
Two possiblilities
1) File doesn't exist. Print error message.
2) File does exist. File it in. Succeed.
f ¬ FS.StreamOpen[name
! FS.Error => {
success ¬ FALSE;
Feedback.Append[router, oneLiner, $Complaint, error.explanation];
CONTINUE};
];
};
RegisterAction: PROC [atom: ATOM, database: Database, argType: ArgumentType, system: BOOL ¬ FALSE] = {
ensureUnique: BOOL = TRUE;
notAlreadyRegistered: BOOL;
table: RefTab.Ref ¬ database.table;
regEvent: RegisteredEvent ¬ NEW[RegisteredEventObj ¬ [argType, 0, 0.0, FALSE, system]];
notAlreadyRegistered ¬ RefTab.Insert[table, atom, regEvent];
IF NOT notAlreadyRegistered THEN {
IF ensureUnique THEN SIGNAL Problem[msg: IO.PutFR["Event %g was already registered in Gargoyle's event table.", [rope[Atom.GetPName[atom]]]]]
ELSE [] ¬ RefTab.Replace[table, atom, regEvent]; -- register again
}
ELSE {
AppendAtom[atom, database.atomOrder];
AppendAtom[NIL, database.sectionOrder];
};
};
SectionHeader: PROC [sectionName: Rope.ROPE, headerAtom: ATOM, database: Database] = {
notAlreadyRegistered: BOOL;
sectionTable: RefTab.Ref ¬ database.sectionTable;
regEvent: RegisteredEvent ¬ NEW[RegisteredEventObj ¬ [none, 0, 0.0, FALSE, TRUE, sectionName]];
notAlreadyRegistered ¬ RefTab.Insert[sectionTable, headerAtom, regEvent];
IF NOT notAlreadyRegistered THEN {
SIGNAL Problem[msg: IO.PutFR["Section %g was already registered in Gargoyle's event table.", [rope[Atom.GetPName[headerAtom]]]]];
};
AppendAtom[$SectionHeader, database.atomOrder];
AppendAtom[headerAtom, database.sectionOrder];
};
CreateDatabase: PUBLIC PROC [] RETURNS [database: Database] = {
table: RefTab.Ref ¬ RefTab.Create[350];
sectionTable: RefTab.Ref ¬ RefTab.Create[25];
database ¬ NEW[DatabaseObj ¬ [
table: table,
atomOrder: NewAtomListt[],
lastAtom: NIL,
atomCount: 0,
sectionTable: sectionTable,
sectionOrder: NewAtomListt[]
]];
RegisterActions[database];
};
RegisterActions: PROC [database: Database] = {
There were 263 events on September 22, 1987
There were 295 events on September 26, 1987
SectionHeader["Selecting and Graphical Find", $SelectAndFind, database];
RegisterAction[$CycleSelection, database, none];
RegisterAction[$AreaSelectNew, database, none];
RegisterAction[$AreaSelectNewAndDelete, database, none];
RegisterAction[$AreaSelectExtend, database, none];
RegisterAction[$SelectAll, database, none];
RegisterAction[$AreaSelectDegenerate, database, none];
RegisterAction[$SelectCoincident, database, none];
RegisterAction[$SelectUnseeableSegs, database, none];
RegisterAction[$SelectUnseeableObjs, database, none];
RegisterAction[$SelectMatchingWidth, database, refReal];
RegisterAction[$SelectMatchingDashes, database, rope];
RegisterAction[$SelectMatchingAreaRGB, database, rope];
RegisterAction[$SelectMatchingAreaCNS, database, rope];
RegisterAction[$SelectMatchingLineRGB, database, rope];
RegisterAction[$SelectMatchingLineCNS, database, rope];
RegisterAction[$MatchAll, database, none];
RegisterAction[$MatchSelectedName, database, rope];
RegisterAction[$MatchSelectedNameLiteral, database, rope];
RegisterAction[$SelectMatchingCurve, database, rope];
RegisterAction[$StartSelectWithBox, database, none];
RegisterAction[$StartSelectJoint, database, none];
RegisterAction[$StartExtSelectJoint, database, none];
RegisterAction[$StartSelectSegment, database, none];
RegisterAction[$StartExtSelectSegment, database, none];
RegisterAction[$StartSelectTrajectory, database, none];
RegisterAction[$StartExtSelectTrajectory, database, none];
RegisterAction[$StartSelectTopLevel, database, none];
RegisterAction[$StartExtSelectTopLevel, database, none];
RegisterAction[$StartExtendSelection, database, none];
RegisterAction[$StartDeselectJoint, database, none];
RegisterAction[$StartDeselectSegment, database, none];
RegisterAction[$StartDeselectTrajectory, database, none];
RegisterAction[$StartDeselectTopLevel, database, none];
SectionHeader["Adding and Deleting Geometry", $AddGeometry, database];
RegisterAction[$Delete, database, none];
RegisterAction[$DeleteCaretSegment, database, none];
RegisterAction[$AddChar, database, none];
RegisterAction[$AddText, database, rope];
RegisterAction[$NewCircle, database, none];
RegisterAction[$NewBox, database, none];
RegisterAction[$Frame, database, none];
RegisterAction[$UnionCombine, database, none];
RegisterAction[$FitCurves, database, none];
RegisterAction[$FitLines, database, none];
RegisterAction[$FitOutlineEdges, database, none];
RegisterAction[$FitOutlineSplines, database, none];
RegisterAction[$FitCenterLineSplines, database, none];
RegisterAction[$AddHoles, database, none];
RegisterAction[$Close, database, none];
RegisterAction[$Weld, database, none];
RegisterAction[$AddControlPoint, database, none];
RegisterAction[$DeleteControlPoint, database, none];
RegisterAction[$AddJoint, database, none];
RegisterAction[$SplitSegment, database, none];
RegisterAction[$Splice, database, none];
RegisterAction[$PolygonInCircle, database, refInt];
RegisterAction[$KnotchedLine, database, none];
RegisterAction[$NewArrow, database, none];
RegisterAction[$SetStraight, database, none];
RegisterAction[$SetArc, database, none];
RegisterAction[$SetSnowflake, database, none];
RegisterAction[$SetConic, database, refReal];
RegisterAction[$SetBezier, database, none];
RegisterAction[$SetConstrainedBezier, database, none];
RegisterAction[$SetNaturalSpline, database, none];
RegisterAction[$SetBSpline, database, none];
SectionHeader["Interactive Adding Geometry", $InteractiveAddGeometry, database];
RegisterAction[$StartCaretPos, database, none];
RegisterAction[$StartAdd, database, none];
RegisterAction[$StartBezier, database, none];
RegisterAction[$StartBox, database, none];
RegisterAction[$StartCopyAndDrag, database, none];
RegisterAction[$StartAddAndDrag, database, none];
SectionHeader["Interactive Transforming", $InteractiveTransforming, database];
RegisterAction[$StartDrag, database, none];
RegisterAction[$StartRotate, database, none];
RegisterAction[$StartScale, database, none];
RegisterAction[$StartSixPoint, database, none];
SectionHeader["Transforming", $Transforming, database];
RegisterAction[$Rotate, database, rope];
RegisterAction[$UnRotate, database, rope];
RegisterAction[$Scale, database, rope];
RegisterAction[$UnScale, database, rope];
RegisterAction[$ScaleX, database, rope];
RegisterAction[$UnScaleX, database, rope];
RegisterAction[$ScaleY, database, rope];
RegisterAction[$UnScaleY, database, rope];
RegisterAction[$ScaleXY, database, rope];
RegisterAction[$TranslateX, database, rope];
RegisterAction[$TranslateY, database, rope];
RegisterAction[$TranslateXY, database, rope];
RegisterAction[$SixPointTransform, database, none];
RegisterAction[$FourPointTransform, database, none];
RegisterAction[$SetMakeConstrained, database, none];
SectionHeader["Viewing", $Viewing, database];
RegisterAction[$ScalePop, database, rope2];
RegisterAction[$RotatePop, database, rope2];
RegisterAction[$FitPop, database, none];
RegisterAction[$ResetPop, database, none];
RegisterAction[$EdgePop, database, none];
RegisterAction[$PrevTransform, database, none];
RegisterAction[$CenterSel, database, none];
RegisterAction[$FitSel, database, none];
RegisterAction[$SetBiScrollersTransform, database, rope];
RegisterAction[$ShowBiScrollersTransform, database, none];
RegisterAction[$AlignFracs, database, none];
RegisterAction[$Shift, database, none];
SectionHeader["Style", $Style, database];
RegisterAction[$ApplyAllDefaults, database, none];
RegisterAction[$LineWidth, database, refReal];
RegisterAction[$LineEnd, database, rope];
RegisterAction[$TrajJoints, database, rope];
RegisterAction[$DashesFromSelection, database, rope];
RegisterAction[$DashesOff, database, none];
RegisterAction[$Arrows, database, none];
RegisterAction[$AreaColorFromColorTool, database, none];
RegisterAction[$AreaColorFollowColorTool, database, none];
RegisterAction[$AreaColorFromSelectedName, database, rope];
RegisterAction[$AreaColorFromSelectedRGB, database, rope];
RegisterAction[$AreaColorBlack, database, none];
RegisterAction[$AreaColorWhite, database, none];
RegisterAction[$AreaColorGray, database, none];
RegisterAction[$AreaColorNone, database, none];
RegisterAction[$LineColorFromColorTool, database, none];
RegisterAction[$LineColorFollowColorTool, database, none];
RegisterAction[$LineColorFromSelectedName, database, rope];
RegisterAction[$LineColorFromSelectedRGB, database, rope];
RegisterAction[$LineColorBlack, database, none];
RegisterAction[$LineColorWhite, database, none];
RegisterAction[$LineColorGray, database, none];
RegisterAction[$LineColorNone, database, none];
RegisterAction[$SetAmplifySpace, database, refReal];
RegisterAction[$AmplifySpaceFromSelection, database, refReal];
RegisterAction[$SetDropShadow, database, none];
RegisterAction[$DropShadowFromSelection, database, refReal];
RegisterAction[$DropShadowOff, database, none];
RegisterAction[$SetPressFont, database, rope];
RegisterAction[$SetPrintFont, database, rope];
RegisterAction[$SetScreenFont, database, rope];
RegisterAction[$SetFontDetailed, database, rope];
RegisterAction[$SetFontLiteral, database, rope];
RegisterAction[$CopyFont, database, none];
RegisterAction[$CopyAll, database, none];
SectionHeader["Set State", $SetState, database];
RegisterAction[$SetAllDefaults, database, none];
RegisterAction[$StandardDefaults, database, none];
RegisterAction[$SetDefaultStrokeValues, database, none];
RegisterAction[$AreaColorToColorTool, database, none];
RegisterAction[$SetDefaultFillColor, database, none];
RegisterAction[$LineColorToColorTool, database, none];
RegisterAction[$SetDefaultLineColor, database, none];
RegisterAction[$SetDefaultTextLooks, database, none];
RegisterAction[$SetDefaultFontValues, database, none];
RegisterAction[$RadiusUnitFromSegment, database, none];
RegisterAction[$RadiusUnitFromValue, database, none];
RegisterAction[$RadiusUnitFromSelection, database, refReal];
RegisterAction[$InchScaleUnit, database, none];
RegisterAction[$SetScaleUnit, database, none];
RegisterAction[$ToggleShowColors, database, none];
RegisterAction[$ScreenChoiceChange, database, none];
RegisterAction[$SetConstraintType, database, none];
RegisterAction[$SetFitTolerance, database, refReal];
RegisterAction[$SetFitParameters, database, rope];
RegisterAction[$SetFitPolyPenalty, database, refReal];
RegisterAction[$SetFitAngle, database, refReal];
RegisterAction[$SetFitThreshold, database, refReal];
RegisterAction[$SetFitIterations, database, refInt];
RegisterAction[$SetFitMinDistance, database, refReal];
SectionHeader["Set Snap-Dragging State", $SetSnapState, database];
RegisterAction[$GravityChoiceChange, database, none];
RegisterAction[$GravityExtentChange, database, none];
RegisterAction[$ToggleGravity, database, none];
RegisterAction[$ToggleShowAlignments, database, none];
RegisterAction[$MakeHot, database, none];
RegisterAction[$MakeAllHot, database, none];
RegisterAction[$MakeCold, database, none];
RegisterAction[$MakeAllCold, database, none];
RegisterAction[$ShowHot, database, none];
RegisterAction[$HideHot, database, none];
RegisterAction[$DropAnchor, database, none];
RegisterAction[$LiftAnchor, database, none];
RegisterAction[$StandardAlignments, database, none];
RegisterAction[$SlopePrompt, database, none];
RegisterAction[$AddSlope, database, none];
RegisterAction[$GetSlope, database, none];
RegisterAction[$ToggleSlope, database, none];
RegisterAction[$DeleteSlope, database, none];
RegisterAction[$AnglePrompt, database, none];
RegisterAction[$AddAngle, database, none];
RegisterAction[$GetAngle, database, none];
RegisterAction[$ToggleAngle, database, none];
RegisterAction[$DeleteAngle, database, none];
RegisterAction[$RadiusPrompt, database, none];
RegisterAction[$AddRadius, database, none];
RegisterAction[$GetRadius, database, none];
RegisterAction[$ToggleRadius, database, none];
RegisterAction[$DeleteRadius, database, none];
RegisterAction[$DistancePrompt, database, none];
RegisterAction[$AddDistance, database, none];
RegisterAction[$GetDistance, database, none];
RegisterAction[$ToggleDistance, database, none];
RegisterAction[$DeleteDistance, database, none];
RegisterAction[$MeasureSlopeFromSelection, database, refReal];
RegisterAction[$MeasureAngleFromSelection, database, refReal];
RegisterAction[$MeasureRadiusFromSelection, database, refReal];
RegisterAction[$MeasureLineDistFromSelection, database, refReal];
RegisterAction[$MeasureSlopeHit, database, none];
RegisterAction[$MeasureAngleHit, database, none];
RegisterAction[$MeasureRadiusHit, database, none];
RegisterAction[$MeasureLineDistHit, database, none];
RegisterAction[$AllAlignmentsOff, database, none];
RegisterAction[$ToggleMidpoints, database, none];
RegisterAction[$ToggleHeuristics, database, none];
SectionHeader["File Operations", $FileOperations, database];
RegisterAction[$Clear, database, none];
RegisterAction[$Reset, database, none];
RegisterAction[$Get, database, rope];
RegisterAction[$MergeAll, database, rope];
RegisterAction[$MergeShapes, database, rope];
RegisterAction[$MergeOptions, database, rope];
RegisterAction[$MergeAlignments, database, rope];
RegisterAction[$Store, database, rope];
RegisterAction[$Save, database, none];
RegisterAction[$StuffToTioga, database, none];
RegisterAction[$StuffToTiogaAlt, database, none];
RegisterAction[$StuffToTiogaBordered, database, none];
RegisterAction[$StuffToTiogaFit, database, none];
RegisterAction[$StuffToTiogaBorderedAndFit, database, none];
RegisterAction[$StuffToFile, database, rope];
RegisterAction[$GetFromTioga, database, none];
RegisterAction[$GrabFromTioga, database, none];
RegisterAction[$MergeFromTioga, database, none];
RegisterAction[$IPToTioga, database, none];
RegisterAction[$IPToTiogaBordered, database, none];
RegisterAction[$IPToTiogaFit, database, none];
RegisterAction[$IPToTiogaBorderedAndFit, database, none];
RegisterAction[$IPToTiogaAlt, database, none];
RegisterAction[$IPMergeFromTioga, database, none];
RegisterAction[$MergeIPEditable, database, rope];
RegisterAction[$MergeIPSlice, database, rope];
RegisterAction[$ToIP, database, rope];
RegisterAction[$ToIPScreen, database, rope];
RegisterAction[$IncludeIPByReference, database, none];
RegisterAction[$IncludeIPByValue, database, none];
RegisterAction[$ShowIPIncludeMode, database, none];
RegisterAction[$ToIPLit, database, none];
RegisterAction[$IPSnapShot, database, none];
SectionHeader["Overlap Order", $OverlapOrder, database];
RegisterAction[$Top, database, none];
RegisterAction[$ShowPriorityValue, database, none];
RegisterAction[$Bottom, database, none];
RegisterAction[$UpOne, database, none];
RegisterAction[$FindPriorityFromSelection, database, refInt];
RegisterAction[$DownOne, database, none];
RegisterAction[$PutInFront, database, none];
RegisterAction[$Exchange, database, none];
RegisterAction[$PutBehind, database, none];
RegisterAction[$UpFromSelection, database, refInt];
RegisterAction[$PutAtSelection, database, refInt];
RegisterAction[$DownFromSelection, database, refInt];
SectionHeader["Groups", $Groups, database];
RegisterAction[$AddToGroup, database, none];
RegisterAction[$SelectGroup, database, none];
RegisterAction[$RemoveFromGroup, database, none];
RegisterAction[$PrintGroupsOfSelected, database, none];
RegisterAction[$PrintAllGroups, database, none];
SectionHeader["Browse State", $BrowseState, database];
RegisterAction[$Help, database, none];
RegisterAction[$DescribeCurve, database, none];
RegisterAction[$ShowAllDefaults, database, none];
RegisterAction[$Typescript, database, none];
RegisterAction[$PrintStrokeValues, database, none];
RegisterAction[$ShowDefaultStrokeValues, database, none];
RegisterAction[$PrintAreaColor, database, none];
RegisterAction[$ShowDefaultFillColor, database, none];
RegisterAction[$PrintLineColor, database, none];
RegisterAction[$ShowDefaultLineColor, database, none];
RegisterAction[$PrintAmplifySpace, database, none];
RegisterAction[$PrintDropShadow, database, none];
RegisterAction[$ShowDefaultTextLooks, database, none];
RegisterAction[$ShowFontValues, database, none];
RegisterAction[$ShowFontValuesLiteral, database, none];
RegisterAction[$ShowDefaultFontValues, database, none];
RegisterAction[$PrintScaleUnit, database, none];
RegisterAction[$ShowConstraintType, database, none];
RegisterAction[$ShowFitParameters, database, none];
SectionHeader["Special Actions", $SpecialActions, database];
RegisterAction[$Again, database, none];
RegisterAction[$Undelete, database, none];
RegisterAction[$UndeleteAutoConfirm, database, none];
RegisterAction[$ScriptAction, database, none];
RegisterAction[$ShowScripts, database, none];
RegisterAction[$Abort, database, none];
SectionHeader["Internal Actions", $InternalActions, database];
RegisterAction[$Version, database, none, TRUE];
RegisterAction[$PaintActionArea, database, none, TRUE];
RegisterAction[$NoOp, database, none, TRUE];
RegisterAction[$DisableRefresh, database, none, TRUE];
RegisterAction[$EnableRefresh, database, none, TRUE];
RegisterAction[$SetDefaultFillColorFromRope, database, rope, TRUE];
RegisterAction[$SetDefaultLineColorFromRope, database, rope, TRUE];
RegisterAction[$SetDefaultFont, database, none, TRUE];
RegisterAction[$SetGravityChoice, database, none, TRUE];
RegisterAction[$SetShowAlignments, database, none, TRUE];
RegisterAction[$EndOfSessionLogMessage, database, none, TRUE];
RegisterAction[$PrintRope, database, none, TRUE];
RegisterAction[$SetGravityExtent, database, none, TRUE];
RegisterAction[$SetGravity, database, none, TRUE];
RegisterAction[$SetMidpoints, database, none, TRUE];
RegisterAction[$SetHeuristics, database, none, TRUE];
RegisterAction[$SetShowColors, database, none, TRUE];
RegisterAction[$SawTextFinish, database, none, TRUE];
RegisterAction[$SawMouseFinish, database, none, TRUE];
RegisterAction[$SetCaretPosition, database, none, TRUE];
RegisterAction[$SetCaretNormal, database, none, TRUE];
RegisterAction[$SetDisplayStyle, database, none, TRUE];
RegisterAction[$InitializeAlignments, database, none, TRUE]; -- now obsolete
RegisterAction[$SetSlopes, database, none, TRUE];
RegisterAction[$SetAngles, database, none, TRUE];
RegisterAction[$SetRadii, database, none, TRUE];
RegisterAction[$SetDistances, database, none, TRUE];
RegisterAction[$AllUp, database, none, TRUE];
RegisterAction[$GuardUp, database, none, TRUE];
RegisterAction[$MouseUp, database, none, TRUE];
RegisterAction[$During, database, none, TRUE];
SectionHeader["Debugging Actions", $DebuggingActions, database];
RegisterAction[$Refresh, database, none];
RegisterAction[$TestGravity, database, refInt];
RegisterAction[$ToIPTestGravity, database, rope];
RegisterAction[$TestMultiGravity, database, none];
RegisterAction[$Statistics, database, none];
RegisterAction[$PrintSelectedStatistic, database, rope];
RegisterAction[$ResetStatistics, database, none];
RegisterAction[$DrawTightBoxes, database, none];
RegisterAction[$DrawBoundBoxes, database, none];
RegisterAction[$DrawOutlineBoxes, database, none];
RegisterAction[$DrawSelectionBox, database, none];
RegisterAction[$DrawBackgroundBox, database, none];
RegisterAction[$DrawOverlayBox, database, none];
RegisterAction[$DrawRubberBox, database, none];
RegisterAction[$DrawDragBox, database, none];
RegisterAction[$SlackLog, database, none];
RegisterAction[$DescribeCaretObject, database, none];
RegisterAction[$FSMInfo, database, none];
RegisterAction[$PrintAllInput, database, none];
RegisterAction[$ResetAllInput, database, none];
RegisterAction[$CauseAnError, database, none];
RegisterAction[$ReloadTipTable, database, none];
SectionHeader["Other", $OtherHeader, database];
RegisterAction[$MatchFetch, database, none];
RegisterAction[$MatchSearchOpChange, database, none];
RegisterAction[$MatchToggle, database, none];
};
NewAtomListt: PUBLIC PROC [] RETURNS [listt: AtomListt] = {
listt ¬ NEW[AtomListtObj ¬ [NIL, NIL]];
};
AppendAtom: PUBLIC PROC [atom: ATOM, listt: AtomListt] = {
IF listt.tail = NIL THEN {
IF NOT listt.list = NIL THEN ERROR;
listt.tail ¬ listt.list ¬ LIST[atom];
}
ELSE {
listt.tail.rest ¬ LIST[atom];
listt.tail ¬ listt.tail.rest;
};
};
ForEachAtom: PUBLIC PROC [listt: AtomListt, eachAtomProc: EachAtomProc] = {
done: BOOL ¬ FALSE;
FOR list: LIST OF ATOM ¬ listt.list, list.rest UNTIL list = NIL DO
done ¬ eachAtomProc[list.first];
IF done THEN RETURN;
ENDLOOP;
};
EachAtomProc: TYPE = PROC [atom: ATOM] RETURNS [done: BOOL ¬ FALSE];
GGScript: Commander.CommandProc = {
cmd.out.PutF["GGToIP not yet implemented"];
EachFile: FS.NameProc = {
[fullFName: ROPE] RETURNS [continue: BOOL]
printTime: INT;
printTime ¬ ProcessScript[fullFName, resultStream, database, workingDirectory, router];
resultStream.PutChar[IO.LF];
Feedback.PutF[router, oneLiner, $Feedback, "Wrote %g (%r)", [rope[resultFullName]], [integer[printTime]]];
continue ¬ TRUE;
};
TryPattern: PROC [pattern: Rope.ROPE] = {
ENABLE FS.Error => IF error.group # $bug THEN {
IO.PutRope[out, " -- "];
IO.PutRope[out, error.explanation];
GO TO err};
pattern ¬ FileNames.ResolveRelativePath[pattern];
pattern ¬ FS.ExpandName[pattern].fullFName;
IF NOT Rope.Match["*!*", pattern] THEN pattern ¬ Rope.Concat[pattern, "!h"];
FS.EnumerateForNames[pattern, EachFile];
EXITS
err => {IO.PutRope[out, "\n"]; RETURN};
};
out: IO.STREAM ¬ cmd.out;
argv: CommandTool.ArgumentVector;
success, versionSpecified, alreadyExists: BOOL ¬ FALSE;
database: Database;
typescript: Viewer;
router: MsgRouter;
resultShortName, resultFullName, arrow: Rope.ROPE;
workingDirectory: Rope.ROPE ¬ FileNames.CurrentWorkingDirectory[];
resultStream: IO.STREAM;
BEGIN
argv ¬ CommandTool.Parse[cmd: cmd
! CommandTool.Failed => {msg ¬ errorMsg; GO TO failed}];
[alreadyExists, typescript] ¬ FeedbackOps.CreateNamedTypescript[headerText: "Script Statistics", typescriptName: $ScriptStats, openHeight: 120];
router ¬ Feedback.CreateRouter[];
FeedbackOps.SetTypescript[router, $ScriptStats];
resultShortName ¬ argv[1];
arrow ¬ argv[2];
[resultFullName, success, versionSpecified] ¬ GGFileOps.GetGenericFileName["ScriptStats", resultShortName, workingDirectory, "stats", LIST["gargoyle", "ip", "script"], router];
resultStream ¬ FS.StreamOpen[resultFullName, $create ! FS.Error => GOTO FSError];
database ¬ CreateDatabase[];
FOR i: NAT IN [3..argv.argc) DO
arg: Rope.ROPE = argv[i];
IF Rope.Length[arg] = 0 THEN LOOP;
TryPattern[arg];
ENDLOOP;
resultStream.Close[];
EXITS
failed => {result ¬ $Failure};
FSError => Feedback.Append[router, oneLiner, $Complaint, Rope.Concat["FSError while trying ", resultFullName]];
END;
};
GGTotal: Commander.CommandProc = {
EachFile: FS.NameProc = {
[fullFName: ROPE] RETURNS [continue: BOOL]
ReadOneSummary[fullFName, workingDirectory, database, router];
continue ¬ TRUE;
};
TryPattern: PROC [pattern: Rope.ROPE] = {
ENABLE FS.Error => IF error.group # $bug THEN {
IO.PutRope[out, " -- "];
IO.PutRope[out, error.explanation];
GO TO err};
pattern ¬ FileNames.ResolveRelativePath[pattern];
pattern ¬ FS.ExpandName[pattern].fullFName;
IF NOT Rope.Match["*!*", pattern] THEN pattern ¬ Rope.Concat[pattern, "!h"];
FS.EnumerateForNames[pattern, EachFile];
EXITS
err => {IO.PutRope[out, "\n"]; RETURN};
};
out: IO.STREAM ¬ cmd.out;
argv: CommandTool.ArgumentVector;
success, versionSpecified, alreadyExists: BOOL ¬ FALSE;
database: Database;
typescript: Viewer;
router: MsgRouter;
totalsName, arrow: Rope.ROPE;
workingDirectory: Rope.ROPE ¬ FileNames.CurrentWorkingDirectory[];
BEGIN
argv ¬ CommandTool.Parse[cmd: cmd
! CommandTool.Failed => {msg ¬ errorMsg; GO TO failed}];
[alreadyExists, typescript] ¬ FeedbackOps.CreateNamedTypescript[headerText: "Script Statistics", typescriptName: $ScriptStats, openHeight: 120];
router ¬ Feedback.CreateRouter[];
FeedbackOps.SetTypescript[router, $ScriptStats];
totalsName ¬ argv[1];
arrow ¬ argv[2];
database ¬ CreateDatabase[];
InitializeDatabase[database];
FOR i: NAT IN [3..argv.argc) DO
arg: Rope.ROPE = argv[i];
IF Rope.Length[arg] = 0 THEN LOOP;
TryPattern[arg];
ENDLOOP;
WriteTotals[totalsName, workingDirectory, database, router];
EXITS
failed => {result ¬ $Failure};
END;
};
Init: PROC = {
Commander.Register[
key: "GGScript",
proc: GGScript,
doc: "GGScript resultName.stats ← <file pattern>",
clientData: NIL
];
Commander.Register[
key: "GGTotal",
proc: GGTotal,
doc: "GGTotal resultName.stats ← <file pattern>",
clientData: NIL
];
};
Init[];
END.