NodeStyleImpl.mesa - Implements JaM commands for style rules and commands to load styles
Written by Bill Paxton, January 1981
Bill Paxton, December 1, 1982 7:38 am
Maxwell, January 6, 1983 8:46 am
Russ Atkinson, July 25, 1983 4:50 pm
Doug Wyatt, May 17, 1984 2:44:24 pm PDT
DIRECTORY
JaMBasic USING [Object],
JaMOps USING [defaultFrame, PopReal, PushBoolean, PushInteger, PushReal],
NodeStyle USING [DataEntry, DataList, FontFace, GetFontSize, GetReal, GetRealOverflow, LineFormatting, LoadStyle, Name, overflow, Real, realArray, RealCode, RealParam, Ref, StyleBody],
NodeStyleExtra USING [AddRealProc, defaultStyleName, Frame, IntegerValue, LoadProc, Param, ParamRec, PercentProc, PopObject, PopReal, PushName, PushObject, PushReal, PushText, SetNameProc, StartApply, StartExtra, StartImpl2, StoreProc, StyleCommand, StyleError, StyleForFrame, TryToPopName],
NodeStyleObject USING [bigger, bold, bolditalic, centered, flushLeft, flushRight, italic, justified, minusbold, minusitalic, percent, plusbold, plusitalic, regular, smaller, the],
NodeStyleSpaces USING [PrintSpaceWidth, ScreenSpaceWidth],
SafeStorage USING [GetSystemZone],
TextNode USING [pZone];
NodeStyleImpl: CEDAR MONITOR
IMPORTS JaMOps, NodeStyle, NodeStyleExtra, NodeStyleObject, NodeStyleSpaces, SafeStorage, TextNode
EXPORTS NodeStyle, NodeStyleExtra, NodeStyleObject
= BEGIN OPEN NodeStyle, NodeStyleExtra, NodeStyleObject;
-- **** General ****
StoreError: PUBLIC StoreProc = {
ob: JaMBasic.Object ← PopObject[frame];
PushName[frame,p.opName];
PushText[frame,"is not legal as value for"];
PushObject[frame,ob];
StyleError[frame,3] };
AddRealError: PUBLIC AddRealProc = {
PushName[frame,p.opName];
PushText[frame,"Numbers are illegal as values for"];
StyleError[frame,2] };
PercentError: PUBLIC PercentProc = {
PushName[frame,p.opName];
PushText[frame,"Numbers are illegal as values for"];
StyleError[frame,2] };
SetNameError: PUBLIC SetNameProc = {
PushName[frame,p.opName];
PushText[frame,"Only numbers are legal as values for"];
StyleError[frame,2] };
qZone: PUBLIC ZONE ← SafeStorage.GetSystemZone[];
-- quantized zone for allocating style records
Create: PUBLIC PROC RETURNS [Ref] = { -- create a body
RETURN [qZone.NEW[StyleBody]] };
Copy: PUBLIC PROC [dest, source: Ref] = { -- copy a body
dest^ ← source^ };
s1, s2, s3: Ref; -- shared
Alloc: PUBLIC ENTRY PROC RETURNS [s: Ref] = { -- get from a small cache
ENABLE UNWIND => NULL;
IF s3 # NIL THEN { s ← s3; s3 ← NIL }
ELSE IF s2 # NIL THEN { s ← s2; s2 ← NIL }
ELSE IF s1 # NIL THEN { s ← s1; s1 ← NIL }
ELSE s ← Create[] };
Free: PUBLIC ENTRY PROC [s: Ref] = { -- don't free more than once or disaster
ENABLE UNWIND => NULL;
IF s3 = NIL THEN s3 ← s
ELSE IF s2 = NIL THEN s2 ← s
ELSE IF s1 = NIL THEN s1 ← s };
DoStyleOperation: PUBLIC PROC [frame: Frame, p: Param] = {
nameflag: BOOLEAN;
name: Name;
style: Ref ← StyleForFrame[frame];
Error: PROC = {
PushName[frame,p.opName];
PushText[frame,"illegal as qualifer for"];
PushName[frame,name];
StyleError[frame,3] };
[name, nameflag] ← TryToPopName[frame];
IF ~nameflag THEN p.ops.Store[frame,p,style] -- e.g., "10 pt leading"
ELSE SELECT name FROM
the => p.ops.Load[frame,p,style]; -- e.g., "the leading"
bigger =>
BEGIN
[name, nameflag] ← TryToPopName[frame];
IF ~nameflag THEN p.ops.AddReal[frame,PopReal[frame],p,style]
-- e.g., "2 pt bigger leading"
ELSE IF name=percent THEN p.ops.Percent[frame,100+PopReal[frame],p,style]
-- e.g., "2 percent bigger leading"
ELSE { Error; RETURN };
END;
smaller =>
BEGIN
[name, nameflag] ← TryToPopName[frame];
IF ~nameflag THEN p.ops.AddReal[frame,-PopReal[frame],p,style]
-- e.g., "2 pt smaller leading"
ELSE IF name=percent THEN p.ops.Percent[frame,100-PopReal[frame],p,style]
-- e.g., "2 percent smaller leading"
ELSE { Error; RETURN };
END;
percent =>
BEGIN
p.ops.Percent[frame,PopReal[frame],p,style];
END;
ENDCASE => p.ops.SetName[frame,name,p,style]; -- e.g., "TimesRoman family"
};
-- **** Name Params ****
LoadNameParam: PUBLIC LoadProc = {
PushName[frame,style.name[NARROW[p, REF ParamRec.name].param]]};
SetNameParam: PUBLIC SetNameProc = {
style.name[NARROW[p, REF ParamRec.name].param] ← name};
-- **** Style Name ****
StyleNameOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,styleParam] };
styleParam: PUBLIC Param;
-- **** Font Family ****
FontFamilyOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,fontFamilyParam] };
fontFamilyParam: PUBLIC Param;
-- **** Line Formatting ****
LineFormattingOp: PUBLIC PROC [frame: Frame] = {
DoStyleOperation[frame,lineFormattingParam] };
lineFormattingParam: PUBLIC Param;
LineFormattingLoad: PUBLIC LoadProc = {
PushName[frame, SELECT style.lineFormatting FROM
Justified => justified,
FlushLeft => flushLeft,
FlushRight => flushRight,
Centered => centered,
ENDCASE => ERROR]
};
LineFormattingSetName: PUBLIC SetNameProc = {
Error: PROC RETURNS [LineFormatting] =
{ NameError[frame,name,p]; RETURN [FlushLeft] };
style.lineFormatting ← SELECT name FROM
justified => Justified,
flushLeft => FlushLeft,
flushRight => FlushRight,
centered => Centered,
ENDCASE => Error[] };
-- **** Font Face ****
FontFaceOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,fontFaceParam] };
fontFaceParam: PUBLIC Param;
FontFaceLoad: PUBLIC LoadProc = {
PushName[frame, SELECT style.fontFace FROM
Regular => regular,
Bold => bold,
Italic => italic,
BoldItalic => bolditalic,
ENDCASE => ERROR]
};
NameError: PUBLIC PROC [frame: Frame, name: Name, p: Param] = {
PushName[frame, p.opName];
PushText[frame, "illegal as value for"];
PushName[frame, name];
StyleError[frame, 3] };
FontFaceSetName: PUBLIC SetNameProc = {
Error: PROC RETURNS [FontFace] = {
NameError[frame,name,p]; RETURN [Regular] };
FontFaceArray: TYPE = ARRAY FontFace OF FontFace;
minusBold: FontFaceArray = [Regular, Regular, Italic, Italic];
minusItalic: FontFaceArray = [Regular, Bold, Regular, Bold];
plusBold: FontFaceArray = [Bold, Bold, BoldItalic, BoldItalic];
plusItalic: FontFaceArray = [Italic, BoldItalic, Italic, BoldItalic];
style.fontFace ← SELECT name FROM
regular => Regular,
bold => Bold,
italic => Italic,
bolditalic => BoldItalic,
plusbold => plusBold[style.fontFace],
plusitalic => plusItalic[style.fontFace],
minusbold => minusBold[style.fontFace],
minusitalic => minusItalic[style.fontFace],
ENDCASE => Error[] };
-- **** Real Parameters ****
RealOpLoad: PUBLIC LoadProc = {
PushReal[frame,GetReal[style, NARROW[p, REF ParamRec.real].param]]};
RealOpSetReal: PUBLIC StoreProc = {
SetReal[style,NARROW[p, REF ParamRec.real].param,PopReal[frame]]};
RealOpAddReal: PUBLIC AddRealProc = {
x: REF ParamRec.real = NARROW[p];
SetReal[style,x.param,GetReal[style,x.param]+inc]};
RealOpPercent: PUBLIC PercentProc = {
val: REAL ← GetReal[style,NARROW[p, REF ParamRec.real].param];
SetReal[style, NARROW[p, REF ParamRec.real].param, (percent/100)*val] };
realArray: PUBLIC REF ARRAY RealCode OF Real; -- array of distances
intArray: PUBLIC REF ARRAY RealCode OF INTEGER;
nextFree: RealCode ← 1; -- next free entry in realArray
-- reserve entry 0 for 0.0
overflowCount: INT ← 0;
realTableOverflow: PUBLIC ERROR = CODE;
EnterReal: PUBLIC ENTRY PROC [value: Real] RETURNS [code: RealCode] = {
ENABLE UNWIND => NULL;
code ← nextFree;
FOR c: RealCode IN [FIRST[RealCode]..nextFree) DO
IF realArray[c]=value THEN { code ← c; EXIT };
ENDLOOP;
SELECT code FROM
< nextFree => NULL; -- already was in realArray
= overflow => { -- realArray is full
overflowCount ← overflowCount+1;
ERROR realTableOverflow };
= nextFree => { -- enter in realArray
nextFree ← nextFree+1;
realArray[code] ← value;
intArray[code] ← IntegerValue[value] };
ENDCASE => ERROR };
SetReal: PUBLIC PROC [ref: Ref, param: RealParam, value: Real] = {
ref.real[param] ← EnterReal[value ! realTableOverflow => {
ref.real[param] ← overflow;
ref.dataList ← qZone.NEW[DataEntry ← [
ref.dataList, real[param, value, IntegerValue[value]]]];
CONTINUE }]; };
GetRealOverflow: PUBLIC PROC [ref: Ref, param: RealParam]
RETURNS [value: Real] = {
code: RealCode ← ref.real[param];
IF code # overflow THEN RETURN [realArray[code]];
FOR x: DataList ← ref.dataList, x.next UNTIL x=NIL DO
xx: REF DataEntry.real = NARROW[x];
IF xx.param = param THEN RETURN [xx.value];
ENDLOOP;
ERROR -- failed to find it on the data list -- };
GetIntOverflow: PUBLIC PROC [ref: Ref, param: RealParam]
RETURNS [value: INTEGER] = {
code: RealCode ← ref.real[param];
IF code # overflow THEN RETURN [intArray[code]];
FOR x: DataList ← ref.dataList, x.next UNTIL x=NIL DO
xx: REF DataEntry.real = NARROW[x];
IF xx.param = param THEN RETURN [xx.valueI];
ENDLOOP;
ERROR -- failed to find it on the data list -- };
-- **** Font Size ****
FontSizeOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,fontSizeParam] };
fontSizeParam: PUBLIC Param;
-- **** Left Indent ****
LeftIndentOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,leftIndentParam] };
leftIndentParam: PUBLIC Param;
-- **** Right Indent ****
RightIndentOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,rightIndentParam] };
rightIndentParam: PUBLIC Param;
-- **** First Indent ****
FirstIndentOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,firstIndentParam] };
firstIndentParam: PUBLIC Param;
-- **** Rest Indent ****
RestIndentOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,restIndentParam] };
restIndentParam: PUBLIC Param;
-- **** Top Indent ****
TopIndentOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,topIndentParam] };
topIndentParam: PUBLIC Param;
-- **** Bottom Indent ****
BottomIndentOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,bottomIndentParam] };
bottomIndentParam: PUBLIC Param;
-- **** LineLeading ****
LineLeadingSizeOp: PUBLIC PROC [frame: Frame] = {
DoStyleOperation[frame,lineLeadingSizeParam] };
lineLeadingSizeParam: PUBLIC Param;
-- **** Top Leading ****
TopLeadingSizeOp: PUBLIC PROC [frame: Frame] = {
DoStyleOperation[frame,topLeadingSizeParam] };
topLeadingSizeParam: PUBLIC Param;
-- **** Bottom Leading ****
BottomLeadingSizeOp: PUBLIC PROC [frame: Frame] = {
DoStyleOperation[frame,bottomLeadingSizeParam] };
bottomLeadingSizeParam: PUBLIC Param;
-- **** VShift ****
VShiftOp: PUBLIC PROC [frame: Frame] = { DoStyleOperation[frame,vshiftParam] };
vshiftParam: PUBLIC Param;
-- **** MinLineGap ****
MinLineGapOp: PUBLIC PROC [frame: Frame] = {
DoStyleOperation[frame,minLineGapParam] };
minLineGapParam: PUBLIC Param;
-- **** TabStops ****
TabStopsOp: PUBLIC PROC [frame: Frame] = {
DoStyleOperation[frame,tabStopsParam] };
tabStopsParam: PUBLIC Param;
-- **** Readonly info ****
IsComment: PUBLIC PROC [frame: Frame] = TRUSTED {
style: Ref ← StyleForFrame[frame];
JaMOps.PushBoolean[frame.opstk, style.isComment] };
IsPrint: PUBLIC PROC [frame: Frame] = TRUSTED {
style: Ref ← StyleForFrame[frame];
JaMOps.PushBoolean[frame.opstk, style.print] };
NestingLevel: PUBLIC PROC [frame: Frame] = TRUSTED {
style: Ref ← StyleForFrame[frame];
JaMOps.PushInteger[frame.opstk, style.nestingLevel] };
-- ***** Dimensions
PointsPerPica: PUBLIC REAL ← 12.0;
PointsPerInch: PUBLIC REAL ← 1.0/0.0138370; -- 72.27
PointsPerCentimeter: PUBLIC REAL ← PointsPerInch/2.540;
PointsPerMillimeter: PUBLIC REAL ← PointsPerCentimeter/10;
PointsPerDidot: PUBLIC REAL ← PointsPerCentimeter/26.60;
PointsPerFil: PUBLIC REAL ← 10000.0;
PointsPerFill: PUBLIC REAL ← PointsPerFil*PointsPerFil;
Points: PROC [frame: Frame] = { }; -- no change needed to convert to points
Picas: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerPica] };
Inches: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerInch] };
Centimeters: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerCentimeter] };
Millimeters: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerMillimeter] };
DidotPoints: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerDidot] };
Ems: PROC [frame: Frame] = {
oneEm: REAL = GetFontSize[StyleForFrame[frame]]; -- should really be width of "M" in current font
PushReal[frame,PopReal[frame]*oneEm] };
Ens: PROC [frame: Frame] = {
oneEn: REAL = GetFontSize[StyleForFrame[frame]]/2; -- should really be width of "N" in current font
PushReal[frame,PopReal[frame]*oneEn] };
ScreenSpaces: PROC [frame: Frame] = {
spaces: REAL ~ PopReal[frame];
width: REAL ~ NodeStyleSpaces.ScreenSpaceWidth[StyleForFrame[frame]];
PushReal[frame, spaces*width];
};
PrintSpaces: PROC [frame: Frame] = {
spaces: REAL ~ PopReal[frame];
width: REAL ~ NodeStyleSpaces.PrintSpaceWidth[StyleForFrame[frame]];
PushReal[frame, spaces*width];
};
Fil: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerFil] };
Fill: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerFill] };
-- ***** Initialization
started: BOOLEANFALSE;
Start: PUBLIC PROCEDURE =
BEGIN
frame: Frame;
IF started THEN RETURN; started ← TRUE;
frame ← JaMOps.defaultFrame;
realArray ← TextNode.pZone.NEW[ARRAY RealCode OF Real];
intArray ← TextNode.pZone.NEW[ARRAY RealCode OF INTEGER];
StartExtra; StartApply; StartImpl2;
[] ← StyleCommand[frame,"pt",Points];
[] ← StyleCommand[frame,"pc",Picas];
[] ← StyleCommand[frame,"in",Inches];
[] ← StyleCommand[frame,"cm",Centimeters];
[] ← StyleCommand[frame,"mm",Millimeters];
[] ← StyleCommand[frame,"dd",DidotPoints];
[] ← StyleCommand[frame,"em",Ems];
[] ← StyleCommand[frame,"en",Ens];
[] ← StyleCommand[frame,"screensp", ScreenSpaces];
[] ← StyleCommand[frame,"printsp", PrintSpaces];
[] ← StyleCommand[frame,"fil",Fil];
[] ← StyleCommand[frame,"fill",Fill];
[] ← LoadStyle[defaultStyleName];
END;
Start;
END...