~
BEGIN
InvalidFormat:
ERROR [code:
ATOM, byteOffset:
INT];
RawFetch:
UNSAFE
PROC [base:
ROPE, byteOffset:
INT, destination:
LONG
POINTER, nWords:
NAT] ~
UNCHECKED {
len: NAT ~ Basics.bytesPerWord*nWords;
buf: REF TEXT ~ RefText.ObtainScratch[len];
IF (byteOffset + len) > Rope.Size[base] THEN ERROR InvalidFormat[$AttemptToReadPastEnd, byteOffset];
[] ← Rope.AppendChars[buffer: buf, rope: base, start: byteOffset, len: len];
PrincOpsUtils.LongCopy[from: LOOPHOLE[buf, LONG POINTER]+SIZE[TEXT[0]], nwords: nWords, to: destination];
RefText.ReleaseScratch[buf];
};
IKFontData: TYPE ~ IKOps.IKFontData;
IKFontDataRep: TYPE ~ IKOps.IKFontDataRep;
Open:
PUBLIC
PROC [fileName:
ROPE]
RETURNS [IKFontData] ~ {
RETURN [OpenOnContents[RopeFile.Create[name: fileName]]]
};
OpenFromOpenFile:
PUBLIC
PROC [file:
FS.OpenFile]
RETURNS [IKFontData] ~ {
RETURN [OpenOnContents[RopeFile.FromStream[FS.StreamFromOpenFile[file]]]]
};
bytesPerFileWord: INT ~ 2;
ByteCountFromWord:
PROC [word: IKFontFormat.Word]
RETURNS [
INT] ~ {
RETURN [bytesPerFileWord*IKFontFormat.CardFromWord[word]]
};
OpenOnContents:
PROC [fileContents:
ROPE]
RETURNS [IKFontData] ~ {
ik: IKFontData ~ NEW[IKFontDataRep];
header: IKFontFormat.Header;
nameSection: IKFontFormat.NameSection;
fontInfoSection: IKFontFormat.FontInfoSection;
hierarchySection: IKFontFormat.HierarchySection;
characterIndexSection: IKFontFormat.CharacterIndexSection;
pos: INT ← 0;
ik.base ← fileContents;
TRUSTED { RawFetch[ik.base, pos, @header, SIZE[IKFontFormat.Header]] };
pos ← pos + 2;
ik.nameSectionOffset ← pos;
TRUSTED { RawFetch[ik.base, pos, @nameSection, SIZE[IKFontFormat.NameSection]] };
IF nameSection.dataFormat # ['I, 'K] THEN InvalidFormat[$WrongFileType, pos];
pos ← pos + ByteCountFromWord[nameSection.length];
ik.fontInfoSectionOffset ← pos;
TRUSTED { RawFetch[ik.base, pos, @fontInfoSection, SIZE[IKFontFormat.FontInfoSection]] };
pos ← pos + ByteCountFromWord[fontInfoSection.length];
TRUSTED { RawFetch[ik.base, pos, @hierarchySection, SIZE[IKFontFormat.HierarchySection]] };
pos ← pos + ByteCountFromWord[hierarchySection.length];
ik.characterIndexSectionOffset ← pos;
TRUSTED { RawFetch[ik.base, pos, @characterIndexSection, SIZE[IKFontFormat.CharacterIndexSection]] };
pos ← pos + ByteCountFromWord[characterIndexSection.length];
ik.characterIndexSectionEnd ← pos;
IF pos # bytesPerFileWord*IKFontFormat.CardFromWord[header.length] THEN ERROR InvalidFormat[$HeaderLength, pos];
ik.bodySize ← IKFontFormat.CardFromWord[fontInfoSection.bodySize];
InitCharIndex[ik];
RETURN [ik];
};
EnumerateCharacters:
PUBLIC
PROC [ik: IKFontData, action:
PROC [characterCode:
CARDINAL, byteOffsetOfCharacterData:
INT]] ~ {
entryBytes: INT ~ 6; -- length of each CharacterIndexEntry, in bytes
FOR pos:
INT ← ik.characterIndexSectionOffset + 6, pos + entryBytes
WHILE pos < ik.characterIndexSectionEnd
DO
characterIndexEntry: IKFontFormat.CharacterIndexEntry;
TRUSTED { RawFetch[ik.base, pos, @characterIndexEntry, SIZE[IKFontFormat.CharacterIndexEntry]] };
action[characterCode: IKFontFormat.CardFromWord[characterIndexEntry.characterCode], byteOffsetOfCharacterData: IKFontFormat.ByteOffsetFromFilePosition[characterIndexEntry.filePositionOfCharacterData]];
ENDLOOP;
};
InitCharIndex:
PROC [ik: IKFontData] ~ {
min: CARDINAL ← LAST[CARDINAL];
max: CARDINAL ← FIRST[CARDINAL];
MinMaxAction:
PROC [characterCode:
CARDINAL, byteOffsetOfCharacterData:
INT] ~ {
min ← MIN[min, characterCode];
max ← MAX[max, characterCode];
};
StoreAction:
PROC [characterCode:
CARDINAL, byteOffsetOfCharacterData:
INT] ~ {
IF ik.charIndex[characterCode-min] # -1 THEN ERROR InvalidFormat[$DuplicateCharacterEntry, byteOffsetOfCharacterData];
ik.charIndex[characterCode-min] ← byteOffsetOfCharacterData;
};
EnumerateCharacters[ik, MinMaxAction];
IF max < min THEN min ← max ← 0;
ik.minCharCode ← min;
ik.charIndex ← NEW[IKOps.CharIndexRep[max-min+1]];
FOR i:
NAT
IN [0..ik.charIndex.size)
DO
ik.charIndex[i] ← -1;
ENDLOOP;
EnumerateCharacters[ik, StoreAction];
};
GetFileName:
PUBLIC
PROC [ik: IKFontData]
RETURNS [
ROPE] ~ {
nameSection: IKFontFormat.NameSection;
len: NAT ← 14;
i: NAT ← 0;
p: PROC RETURNS [CHAR] ~ {i ← i + 1; RETURN [nameSection.fileName[i-1]]};
TRUSTED { RawFetch[ik.base, ik.nameSectionOffset, @nameSection, SIZE[IKFontFormat.NameSection]] };
WHILE len > 0 AND nameSection.fileName[len-1] = ' DO len ← len-1 ENDLOOP;
RETURN [Rope.FromProc[len: len, p: p]];
};
GetFontName:
PUBLIC
PROC [ik: IKFontData]
RETURNS [
ROPE] ~ {
nameSection: IKFontFormat.NameSection;
len: NAT ← 14;
i: NAT ← 0;
p: PROC RETURNS [CHAR] ~ {i ← i + 1; RETURN [nameSection.fontName[i-1]]};
TRUSTED { RawFetch[ik.base, ik.nameSectionOffset, @nameSection, SIZE[IKFontFormat.NameSection]] };
WHILE len > 0 AND nameSection.fontName[len-1] = ' DO len ← len-1 ENDLOOP;
RETURN [Rope.FromProc[len: len, p: p]];
};
CharacterInfo:
TYPE ~ IKOps.CharacterInfo;
Contains:
PUBLIC
PROC [ik: IKFontData, code:
CARDINAL]
RETURNS [
BOOL] ~ {
RETURN [
code IN [ik.minCharCode..ik.minCharCode+ik.charIndex.size) AND
(ik.charIndex[code-ik.minCharCode] >= 0)
]
};
GetCharacterInfo:
PUBLIC
PROC [ik: IKFontData, code:
CARDINAL]
RETURNS [CharacterInfo] ~ {
IF
NOT Contains[ik, code]
THEN
RETURN [[]]
ELSE
TRUSTED {
pos: INT ← ik.charIndex[code - ik.minCharCode];
characterData: IKFontFormat.CharacterData;
charNameSection: IKFontFormat.CharNameSection;
charSettingInfo: IKFontFormat.CharSettingInfo;
charContourIndex: IKFontFormat.CharContourIndex;
RawFetch[ik.base, pos, @characterData, SIZE[IKFontFormat.CharacterData]];
pos ← pos + 2;
RawFetch[ik.base, pos, @charNameSection, SIZE[IKFontFormat.CharNameSection]];
IF IKFontFormat.CardFromWord[charNameSection.characterCode] # code THEN ERROR InvalidFormat[$InconsistentCharacterCodeInformation, pos];
pos ← pos + ByteCountFromWord[charNameSection.length];
RawFetch[ik.base, pos, @charSettingInfo, SIZE[IKFontFormat.CharSettingInfo]];
pos ← pos + ByteCountFromWord[charSettingInfo.length];
RawFetch[ik.base, pos, @charContourIndex, SIZE[IKFontFormat.CharContourIndex]];
RETURN [[
characterCode: code,
characterTypeCode: IKFontFormat.CardFromWord[charSettingInfo.characterTypeCode],
numberOfDigitizations: IKFontFormat.CardFromWord[charSettingInfo.numberOfDigitizations],
totalSetWidth: IKFontFormat.IntFromWord[charSettingInfo.totalSetWidth],
leftSideBearing: IKFontFormat.IntFromWord[charSettingInfo.leftSideBearing],
width: IKFontFormat.IntFromWord[charSettingInfo.width],
rightSideBearing: IKFontFormat.IntFromWord[charSettingInfo.rightSideBearing],
xMin: IKFontFormat.IntFromWord[charSettingInfo.xMin],
xMax: IKFontFormat.IntFromWord[charSettingInfo.xMax],
yMin: IKFontFormat.IntFromWord[charSettingInfo.yMin],
yMax: IKFontFormat.IntFromWord[charSettingInfo.yMax],
unit: IKFontFormat.CardFromWord[charSettingInfo.unit],
byteOffsetOfContourIndex: pos,
numberOfContours: (IKFontFormat.ByteCountFromDataLength[charContourIndex.dataLength]-4)/12
]];
};
};
Direction: TYPE ~ IKOps.Direction;
ContourInfo:
TYPE ~ IKOps.ContourInfo;
firstRecordNumber: NAT ← 0;
firstWordNumber: NAT ← 1;
ByteOffsetFromFP:
PROC [f: IKFontFormat.FilePosition]
RETURNS [
INT] ~
INLINE {
RETURN [ (IKFontFormat.CardFromWord[f.physicalRecordNumber]-firstRecordNumber)*IKFontFormat.bytesPerPhysicalRecord + (IKFontFormat.CardFromWord[f.wordNumber]-firstWordNumber)*IKFontFormat.bytesPerWord ]
};
GetContourInfo:
PUBLIC
PROC [ik: IKFontData, byteOffsetOfContourIndex:
INT, contourNumber:
NAT]
RETURNS [ContourInfo] ~
TRUSTED {
pos: INT ← byteOffsetOfContourIndex;
imageInfoStartByte: INT;
charContourIndex: IKFontFormat.CharContourIndex;
charContourIndexEntry: IKFontFormat.CharContourIndexEntry;
RawFetch[ik.base, pos, @charContourIndex, SIZE[IKFontFormat.CharContourIndex]];
imageInfoStartByte ← byteOffsetOfContourIndex + IKFontFormat.ByteCountFromDataLength[charContourIndex.dataLength];
IF byteOffsetOfContourIndex + (contourNumber+1)*12+4 > imageInfoStartByte THEN ERROR; -- caller bug
pos ← pos + 4 + contourNumber*12;
RawFetch[ik.base, pos, @charContourIndexEntry, SIZE[IKFontFormat.CharContourIndexEntry]];
RETURN [[
byteOffsetOfImageInformation: imageInfoStartByte + ByteOffsetFromFP[charContourIndexEntry.filePositionOfContour],
direction: IF IKFontFormat.IntFromWord[charContourIndexEntry.directionOfTurn] < 0 THEN clockwise ELSE counterclockwise,
nesting: IKFontFormat.CardFromWord[charContourIndexEntry.nesting],
colorInside: IKFontFormat.CardFromWord[charContourIndexEntry.colorInside],
numberOfDigitizations: IKFontFormat.CardFromWord[charContourIndexEntry.numberOfDigitizations]
]]
};
RealSeq: TYPE ~ IKOps.RealSeq;
RealSeqRep: TYPE ~ IKOps.RealSeqRep;
TypeSeq: TYPE ~ IKOps.TypeSeq;
TypeSeqRep:
TYPE ~ IKOps.TypeSeqRep;
ContourDigitizations:
TYPE ~
RECORD [
x, y: RealSeq,
type: TypeSeq
];
GetContourDigitizations:
PUBLIC
PROC [ik: IKFontData, contourInfo: ContourInfo, x, y: RealSeq, type: TypeSeq] ~ {
pos: INT ← contourInfo.byteOffsetOfImageInformation;
x.length ← y.length ← type.length ← contourInfo.numberOfDigitizations;
FOR i:
NAT
IN [0..contourInfo.numberOfDigitizations)
DO
digitization: IKFontFormat.Digitization;
point: IKFontFormat.Point;
TRUSTED {RawFetch[ik.base, pos, @digitization, SIZE[IKFontFormat.Digitization]]};
point ← IKFontFormat.PointFromDigitization[digitization];
x[i] ← point.x;
y[i] ← point.y;
type[i] ← point.type;
pos ← pos + 4;
ENDLOOP;
};
ObtainRealSeq:
PROC [n:
NAT]
RETURNS [RealSeq] ~ {
RETURN [NEW[RealSeqRep[n] ← [length: n, v: NULL]]]
};
ReleaseRealSeq: PROC [s: RealSeq] ~ {};
ObtainTypeSeq:
PROC [n:
NAT]
RETURNS [TypeSeq] ~ {
RETURN [NEW[TypeSeqRep[n] ← [length: n, v: NULL]]]
};
ReleaseTypeSeq:
PROC [s: TypeSeq] ~ {};
PointType:
TYPE ~ IKFontFormat.PointType;
{none, start, corner, curve, tangent};
ShowPts:
PUBLIC
PROC [ik: IKFontData, code:
CARDINAL, context: Imager.Context] ~ {
characterInfo: CharacterInfo ~ GetCharacterInfo[ik, code];
FOR i:
NAT
IN [0..characterInfo.numberOfContours)
DO
contourInfo: ContourInfo ~ GetContourInfo[ik, characterInfo.byteOffsetOfContourIndex, i];
n: NAT ~ contourInfo.numberOfDigitizations;
x: RealSeq ~ ObtainRealSeq[n];
y: RealSeq ~ ObtainRealSeq[n];
type: TypeSeq ~ ObtainTypeSeq[n];
GetContourDigitizations[ik: ik, contourInfo: contourInfo, x: x, y: y, type: type];
FOR i:
NAT
IN [0..n)
DO
proc:
PROC ~ {
Imager.TranslateT[context, [x[i], y[i]]];
Imager.ScaleT[context, 2540/72.0];
SELECT type[i]
FROM
start => {
Imager.SetStrokeEnd[context, round];
Imager.SetStrokeWidth[context, 4];
Imager.MaskVector[context, [-4, -4], [4, 4]];
Imager.MaskVector[context, [4, -4], [-4, 4]];
Imager.SetStrokeWidth[context, 2];
Imager.SetGray[context, 0];
Imager.MaskVector[context, [-4, -4], [4, 4]];
Imager.MaskVector[context, [4, -4], [-4, 4]];
};
corner => {
Imager.MaskBox[context, [-3, -3, 3, 3]];
Imager.SetGray[context, 0];
Imager.MaskBox[context, [-1, -1, 1, 1]];
};
curve => {
Imager.SetStrokeEnd[context, round];
Imager.SetStrokeWidth[context, 6];
Imager.MaskVector[context, [0, 0], [0, 0]];
Imager.SetStrokeWidth[context, 4];
Imager.SetGray[context, 0];
Imager.MaskVector[context, [0, 0], [0, 0]];
};
tangent => {
Imager.SetStrokeEnd[context, square];
Imager.SetStrokeWidth[context, 4];
Imager.MaskVector[context, [-2, 0], [2, 0]];
Imager.MaskVector[context, [0, 0], [0, -3]];
Imager.SetStrokeWidth[context, 2];
Imager.SetGray[context, 0];
Imager.MaskVector[context, [-2, 0], [2, 0]];
Imager.MaskVector[context, [0, 0], [0, -3]];
};
ENDCASE => ERROR;
};
Imager.DoSave[context, proc];
ENDLOOP;
ReleaseRealSeq[x];
ReleaseRealSeq[y];
ReleaseTypeSeq[type];
ENDLOOP;
};
try: NAT ← 2;
GetPath:
PUBLIC
PROC [ik: IKFontData, code:
CARDINAL, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc, curveTo: ImagerPath.CurveToProc] ~ {
characterInfo: CharacterInfo ~ GetCharacterInfo[ik, code];
FOR i:
NAT
IN [0..characterInfo.numberOfContours)
DO
contourInfo: ContourInfo ~ GetContourInfo[ik, characterInfo.byteOffsetOfContourIndex, i];
n: NAT ~ contourInfo.numberOfDigitizations;
x: RealSeq ~ ObtainRealSeq[n+1];
y: RealSeq ~ ObtainRealSeq[n+1];
c: RealSeq ~ ObtainRealSeq[n+1];
s: RealSeq ~ ObtainRealSeq[n+1];
g: RealSeq ~ ObtainRealSeq[n+1];
type: TypeSeq ~ ObtainTypeSeq[n+1];
GetContourDigitizations[ik: ik, contourInfo: contourInfo, x: x, y: y, type: type];
IF x[n-1] = x[0]
AND y[n-1] = y[0]
AND type[0] = start
THEN {
x[n] ← x[1];
y[n] ← y[1];
type[n] ← type[1];
}
ELSE {
ERROR InvalidFormat[$StartPointImproperlyDigitized, contourInfo.byteOffsetOfImageInformation];
};
Splin[m: 0, n: n, ke: type, x: x, y: y, c: c, s: s, g: g, n12: 0];
c[0] ← c[n-1];
s[0] ← s[n-1];
type[0] ← type[n-1];
moveTo[[x[0], y[0]]];
FOR i:
NAT
IN (0..n)
DO
SELECT
TRUE
FROM
type[i-1] = corner
OR type[i] = corner => {
lineTo[[x[i], y[i]]];
};
ENDCASE => {
delta: VEC ~ [x[i]-x[i-1], y[i]-y[i-1]];
lenSqr: REAL ~ delta.x*delta.x + delta.y*delta.y;
SELECT try
FROM
0 => {
length: REAL ~ RealFns.SqRt[lenSqr];
curveTo[
p1: [x[i-1] + c[i-1]*length/3.0, y[i-1] + s[i-1]*length/3.0],
p2: [x[i] - c[i]*length/3.0, y[i] - s[i]*length/3.0],
p3: [x[i], y[i]]
]
};
1 => {
delta: VEC ~ [x[i]-x[i-1], y[i]-y[i-1]];
dot1: REAL ~ delta.x*c[i-1] + delta.y*s[i-1];
scale1: REAL ~ lenSqr/(3.0*dot1);
dot2: REAL ~ delta.x*c[i] + delta.y*s[i];
scale2: REAL ~ lenSqr/(3.0*dot2);
curveTo[
p1: [x[i-1] + c[i-1]*scale1, y[i-1] + s[i-1]*scale1],
p2: [x[i] - c[i]*scale2, y[i] - s[i]*scale2],
p3: [x[i], y[i]]
]
};
2 => {
length: REAL ~ RealFns.SqRt[lenSqr];
delta: VEC ~ [x[i]-x[i-1], y[i]-y[i-1]];
baseAngle: REAL ~ RealFns.ArcTanDeg[delta.y, delta.x];
theta: REAL ~ RealFns.ArcTanDeg[s[i-1], c[i-1]]-baseAngle;
phi: REAL ~ baseAngle-RealFns.ArcTanDeg[s[i], c[i]];
psi: REAL ~ (theta+phi)/2.0;
denom: REAL ~ (1.0 + ABS[RealFns.CosDeg[psi]])*RealFns.SinDeg[psi]*3.0;
scale1: REAL ~ ABS[2*RealFns.SinDeg[phi]/denom]*length;
scale2: REAL ~ ABS[2*RealFns.SinDeg[theta]/denom]*length;
curveTo[
p1: [x[i-1] + c[i-1]*scale1, y[i-1] + s[i-1]*scale1],
p2: [x[i] - c[i]*scale2, y[i] - s[i]*scale2],
p3: [x[i], y[i]]
]
};
ENDCASE => lineTo[[x[i], y[i]]];
};
ENDLOOP;
ReleaseRealSeq[x];
ReleaseRealSeq[y];
ReleaseRealSeq[c];
ReleaseRealSeq[s];
ReleaseRealSeq[g];
ReleaseTypeSeq[type];
ENDLOOP;
};
GetOutline:
PUBLIC
PROC [ik: IKFontData, code:
CARDINAL]
RETURNS [ImagerPath.Outline] ~ {
path: ImagerPath.PathProc ~ { GetPath[ik, code, moveTo, lineTo, curveTo] };
outline: ImagerPath.Outline ~ ImagerPath.OutlineFromPath[path];
RETURN [outline]
};
Splin:
PROC [
m: NAT, -- first index for curve pt on segment
n: NAT, -- last index for curve pt on segment
ke: TypeSeq, -- array for kind of points
x: RealSeq, -- x values
y: RealSeq, -- y values
c: RealSeq, -- cosine value of directions
s: RealSeq, -- sine value of directions
g: RealSeq, -- aux array
n12: NAT -- index of starting point of contour -- ] ~ {
mn: INTEGER ~ n-m;
IF mn < 2 THEN RETURN;
c[n] ← c[m] ← s[n] ← s[m] ← 0.0;
Cubik[m, n, x, y, c, s, g];
Tangt[m, n, x, y, c, s];
IF ke[n] = curve
THEN {
dx: REAL ~ x[n]-x[m];
dy: REAL ~ y[n]-y[m];
d2: REAL ~ dx*dx + dy*dy;
IF d2 <= 100
THEN {
dx: REAL ~ c[m]+c[n];
dy: REAL ~ s[m]+s[n];
ab: REAL ~ RealFns.SqRt[dx*dx + dy*dy];
c[n] ← c[m] ← dx/ab;
c[m] ← s[m] ← dy/ab;
g[n-2] ← c[n];
g[n-1] ← s[n];
RETURN
};
};
IF ke[m] = tangent
THEN {
ab, c0, s0, c1, s1, win: REAL;
[ab, c0, s0] ← Vekto[x[m-1], y[m-1], x[m], y[m]];
[ab, c1, s1] ← Vekto[x[m], y[m], x[m+1], y[m+1]];
c[m] ← c0;
s[m] ← s0;
win ← c0*s1 - c1*s0;
IF
ABS[win] >= 0.05
THEN {
dr: REAL ~ win*0.5;
s5: REAL ~ 0.0366438*dr;
c5: REAL ~ RealFns.SqRt[1-s5*s5];
cm1: REAL ~ c[m+1];
sm1: REAL ~ s[m+1];
c[m+1] ← cm1*c5 - sm1*s5;
s[m+1] ← cm1*s5 + sm1*c5;
};
IF ke[n] = tangent
THEN {
n1: NAT ~ IF ke[n+1] > start THEN n+1 ELSE n12+1;
[ab, c0, s0] ← Vekto[x[n-1], y[n-1], x[n], y[n]];
[ab, c1, s1] ← Vekto[x[n], y[n], x[n1], y[n1]];
c[n] ← c1;
s[n] ← s1;
win ← c0*s1 - c1*s0;
IF
ABS[win] >= 0.05
THEN {
dr: REAL ~ -win*0.5;
s5: REAL ~ 0.0366438*dr;
c5: REAL ~ RealFns.SqRt[1-s5*s5];
cm1: REAL ~ c[n-1];
sm1: REAL ~ s[n-1];
c[n-1] ← cm1*c5 - sm1*s5;
s[n-1] ← cm1*s5 + sm1*c5;
};
};
};
g[n-2] ← c[n];
g[n-1] ← s[n];
};
Vekto:
PROC [x1, y1, x2, y2:
REAL]
RETURNS [distance, cosine, sine:
REAL] ~ {
dx: REAL ~ x2-x1;
dy: REAL ~ y2-y1;
distance ← RealFns.SqRt[dx*dx + dy*dy];
IF distance >= 0.1
THEN {
cosine ← dx/distance;
sine ← dy/distance;
}
ELSE {
distance ← 0;
cosine ← 1;
sine ← 0;
};
};
Cubik:
PROC [
m: NAT, -- first index for curve pt on segment
n: NAT, -- last index for curve pt on segment
x: RealSeq, -- x values
y: RealSeq, -- y values
x2: RealSeq, -- x value of second derivative
y2: RealSeq, -- y value of second derivative
g: RealSeq -- aux array-- ] ~ {
mn: INTEGER ← n-m;
n1: INTEGER ← n-1;
n2: INTEGER ← n-2;
m1: INTEGER ← m+1;
h1: REAL ← Real.TrappingNaN;
r1: REAL ← Real.TrappingNaN;
s1: REAL ← Real.TrappingNaN;
g[m] ← 0.0;
FOR k:
NAT
IN [m..n1]
DO
k2: NAT ~ k+1;
dx: REAL ~ x[k2] - x[k];
dy: REAL ~ y[k2] - y[k];
h2: REAL ~ RealFns.SqRt[dx*dx + dy*dy];
r2: REAL ~ IF h2=0.0 THEN 1.0 ELSE dx/h2;
s2: REAL ~ IF h2=0.0 THEN 1.0 ELSE dy/h2;
IF k # m
THEN {
qu: REAL ~ (2.0*(h1+h2) - h1*g[k-1]);
z: REAL ~ IF qu = 0.0 THEN 1.0 ELSE 1.0/qu;
g[k] ← z*h2;
x2[k] ← z*(6.0*(r2-r1)-h1*x2[k-1]);
y2[k] ← z*(6.0*(s2-s1)-h1*y2[k-1]);
};
h1 ← h2;
r1 ← r2;
s1 ← s2;
ENDLOOP;
IF mn <= 2 THEN RETURN;
FOR j:
NAT
IN [m1..n2]
DO
k: NAT ~ n2+m1-j;
x2[k] ← x2[k]-g[k]*x2[k+1];
y2[k] ← y2[k]-g[k]*y2[k+1];
ENDLOOP;
};
Tangt:
PROC [
m: NAT, -- first index for curve pt on segment
n: NAT, -- last index for curve pt on segment
x: RealSeq, -- x values
y: RealSeq, -- y values
x2: RealSeq, -- x value of second derivative
y2: RealSeq -- y value of second derivative
] ~ {
xsn, ysn, abn: REAL ← 0.0;
FOR k:
NAT
IN [m..n)
DO
dx: REAL ~ x[k+1] - x[k];
dy: REAL ~ y[k+1] - y[k];
dt: REAL ~ (dx*dx + dy*dy)/6.0;
xs: REAL ~ dx - dt*(x2[k+1] + x2[k]*2.0);
ys: REAL ~ dy - dt*(y2[k+1] + y2[k]*2.0);
ab: REAL ~ RealFns.SqRt[xs*xs + ys*ys];
IF k = n-1
THEN {
Need to use the values at n-1 before they get stored into.
xsn ← x[n] - x[n-1] + dt*(x2[n-1] + x2[n]*2.0);
ysn ← y[n] - y[n-1] + dt*(y2[n-1] + y2[n]*2.0);
abn ← RealFns.SqRt[xsn*xsn + ysn*ysn];
};
IF ab # 0.0 THEN {x2[k] ← xs/ab; y2[k] ← ys/ab};
ENDLOOP;
IF abn # 0
THEN {
x2[n] ← xsn/abn;
y2[n] ← ysn/abn;
};
};