
<<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>>

DIRECTORY
NodeStyle,
NodeStyleExtra,
NodeStyleObject,
TextNode,
TextLooks,
NameSymbolTable,
Real,
SafeStorage,
JaMOps,
JaMBasic;

NodeStyleImpl: CEDAR MONITOR
IMPORTS SafeStorage, Real, NodeStyle, NodeStyleExtra, NodeStyleObject, JaMOps, TextNode
EXPORTS NodeStyle, NodeStyleExtra, NodeStyleObject
= BEGIN OPEN R:Real, NodeStyle, NodeStyleExtra, NodeStyleObject;

<<-- **** General ****>>

StoreError: PUBLIC StoreProc = {
ob: 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] };

Spaces: PROC [frame: Frame] = {
oneSp: REAL = GetFontSize[StyleForFrame[frame]]/2; -- should really be width of a standard space in current font
--PushReal[frame,PopReal[frame]*oneSp]-- --for now, just leave the number of spaces on the stack-- };

Fil: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerFil] };

Fill: PROC [frame: Frame] = { PushReal[frame,PopReal[frame]*PointsPerFill] };


<<-- ***** Initialization>>

started: BOOLEAN _ FALSE;
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,"sp",Spaces];
[] _ StyleCommand[frame,"fil",Fil];
[] _ StyleCommand[frame,"fill",Fill];
<<>>
[] _ LoadStyle[defaultStyleName];

END;

Start;

END...