% ReadOutline.jam -- Jam program to read an outline file and display it.
% Getting started with graphics JaM:
% BringOver /a/p [indigo]<cedar>top>TjamGraphics.df
% Run TjamGraphicsPackage (.bcd)
% (graphics.jam) .run --- to JaM
(loadg) .where {.pop}.cvx {(graphics.jam) .run}.cvx .ifelse
% --- for mesa IO interface and outline reader
(.oOpenIn) .where {.pop}.cvx {(outlineio.bcd) .loadbcd}.cvx .ifelse
(.iobytestream) .where {.pop}.cvx {(jamiostreamimpl.bcd) .loadbcd}.cvx .ifelse
% Since we're about to overflow a dictionary, put all this stuff in a new one.
(FontDict) 600 .dict .def
FontDict .begin
(debugOutline) .false .store
(accentedChar) 0 .store
(pr) {( ).cvis .print}.cvx .def
% (fileName) ROStart -- inits file
(ROStart) { .oOpenIn .not { (Unable to open file.) .print }.cvx .if } .cvx .def
% RORead -- reads entries until eof and does appropriate moveto or drawto
% -- returns -2 on stack if more to come
% -- returns -3 on stack if EOF
(RORead) {
{
.oEntry .dup 0 .gt
{.dup 1 .eq
{.pop .rdrawto}.cvx
{.dup 4 1 .roll .mul 3 1 .roll .mul .exch .rdrawto}.cvx .ifelse
}.cvx
{.dup -2 .eq {.exit} .cvx .if
.dup -3 .eq {.exit} .cvx .if
.dup -1 .eq {.pop .moveto} .cvx .if
} .cvx .ifelse
} .cvx .loop
} .cvx .def
% ROReadBB -- reads and displays bounding box for a single outline
% -- leaves in dictionary <xmin xmax ymin ymax startingfilepos>
% -- returns on stack .true if character read, or .false if eof or error
(ROReadBB) {
.oGetPos (startingfilepos) .exch .store
.oEntry .dup -1 .eq
{ .pop .oBB (ymax) .exch .store (ymin) .exch .store (xmax) .exch .store (xmin) .exch .store
xmin ymin .moveto xmin ymax .drawto xmax ymax .drawto xmax ymin .drawto xmin ymin .drawto
.true }.cvx
{ .dup 0 .gt { .pop .pop (Not at start of character) .print }.cvx .if
.dup -2 .eq { (Not at start of character) .print }.cvx .if
.pop .false }.cvx .ifelse
} .cvx .def
% (file) ROBuildBB -- builds a dictionary called "BBdict" in the main dictionary.
% This dictionary contains, under:
% 'file' the name of the file.
% 'bbcount' the number of bounding boxes in the file.
% [1 .. bbcount] subdictionaries for each bounding box. A subdictionary contains:
% 'startingfilepos' position in input file where outline begins
% 'xmin' 'xmax' 'ymin' 'ymax' the bounding box
(ROBuildBB) {
(BBdict) 500 .dict .store
.dup ROStart
BBdict (file) 3 2 .roll .put
BBdict (bbcount) 0 .put
{ ROReadBB .not {.exit}.cvx .if
BBdict (bbcount) .get 1 .add .dup BBdict (bbcount) 3 2 .roll .put
BBdict .exch 5 .dict .dup 4 1 .roll .put
.dup (startingfilepos) startingfilepos .put
.dup (xmin) xmin .put
.dup (xmax) xmax .put
.dup (ymin) ymin .put
(ymax) ymax .put
}.cvx .loop
}.cvx .def
% Print out dictionary of bounding boxes created by ROBuildBB
(ROPrintBB) {
1 1 BBdict (bbcount) .get
{ (BB #) .print .dup ( ).cvis .print /lp
BBdict .exch .get
{ .exch ( ).cvis .print (=).print ( ).cvis .print ( ).print }.cvx .dictforall
/rp /cr }.cvx .for
}.cvx .def
% i ROGetBB -- defines in global dictionary all properties of BB # i
(ROGetBB) {
BBdict .exch .get { .store }.cvx .dictforall
}.cvx .def
% x y ROFindBB -- puts on stack indices of all BB's surrounding (x,y)
% starts looking with BB# roFindBBStart
(roFindBBStart) 1 .def
(ROFindBB) {
(ytarget) .exch .store (xtarget) .exch .store
roFindBBStart 1 BBdict (bbcount) .get
{ .dup ROGetBB
ytarget ymax .gt {.pop .exit}.cvx .if
xtarget xmin .lt xtarget xmax .gt ytarget ymin .lt .or .or {.pop}.cvx .if
}.cvx .for
}.cvx .def
% rid -- accepts mouse input and prints BB #'s that surround point
(rid) { /clr .touch ROFindBB /stk /clr}.cvx .def
% n RODisplayOutline => ..displays nth outline at full scale
(RODisplayOutline) {
ROGetBB startingfilepos .oSetPos RORead
}.cvx .def
% Routine to help build Page data structure for a font. This routine builds the
% data structure for a row of the strike page. It is called with an array of
% character codes on the stack -- this array contains the character code for each
% character in the row.
(BuildRowDS) {
(buildRowArray) .exch .def
0 1 buildRowArray .length 1 .sub
{ .dup (Character ) .print 1 .add pr CollectBBs /cr
( [ ).print 3 2 .roll buildRowArray .exch .aget pr ( ).print PrintArray (]
) .print
}.cvx .for
}.cvx .def
% Waits for a "touch" and finds surrounding box(es), then another touch, etc.
% Finish by "touch"ing so as to find no bounding boxes.
(CollectBBs) {
(collectCount) 0 .def (collectArray) 10 .array .def
{
.mark (+) .print .touch ROFindBB .cnttomrk .dup 0 .eq {.pop .pop .exit}.cvx .if
1 1 3 2 .roll
{.pop (collectBBcandidate) .exch .def
collectArray collectCount collectBBcandidate .aput
(collectCount) collectCount 1 .add .def
0 1 collectCount 2 .sub
{collectArray .exch .aget collectBBcandidate .eq
{(collectCount) collectCount 1 .sub .def .exit}.cvx .if
}.cvx .for
}.cvx .for
.pop %the mark
}.cvx .loop
collectArray collectCount
}.cvx .def
% array length PrintArray => .. prints [0..length) from array
(PrintArray) {
.exch (printArray) .exch .def
1 .sub 0 1 3 2 .roll
{printArray .exch .aget ( ).cvis .print ( ).print }.cvx .for
}.cvx .def
% Routines to compute deltaX and deltaY for referencing (0,0) point of character
% from a previous "period" character.
% BBofPeriod BBofA ComputeDY => dy
(ComputeDY) {
ROGetBB ymin .exch ROGetBB ymin .sub
}.cvx .def
% BBofPeriod BBofMDash WidthofMDash ComputeDX => dx
(ComputeDX) {
.exch ROGetBB xmax xmin .sub .exch MergWidth .sub 2 .div xmin .add
1 .add % standard width fudge
.exch ROGetBB xmin .sub
}.cvx .def
% Interface to fitter.
% bringover /p [indigo]<fit>top>fit.df
% * (fit.jam) .run
% * startup
% ROFit -- reads outine from file and passes points to fitter
(ROFit) {
{
.oEntry .dup 0 .gt
{.dup 4 1 .roll .mul runy .add (runy) .exch .store
.mul runx .add (runx) .exch .store runx runy .addsa
}.cvx
{.dup -2 .eq {.exit} .cvx .if
.dup -3 .eq {.exit} .cvx .if
.dup -1 .eq {.pop 2 .copy (runy) .exch .store (runx) .exch .store .startsa
(begx) runx .store (begy) runy .store} .cvx .if
} .cvx .ifelse
} .cvx .loop
begx begy .addsa .pop
} .cvx .def
% x y n ROFitOutline => ..fit nth outline at full scale. <x y> is location of char origin.
% writes char to 'char.log' file, with origin at (100,100), full scale.
(ROFitOutline) {
(char.log) 2 .iobytestream .iokillstream
% simulate some curve fitting if debugging
debugOutline
{ .pop .pop .pop
(char.log) 2 .iobytestream .dup
(100 200 .moveto
300 400 500 600 700 800 .curveto
900 100 .lineto
) .iowritebytes .iokillstream
}.cvx
{
2 .setslen
ROGetBB startingfilepos .oSetPos ROFit
.neg 100 .add .exch .neg 100 .add .exch .transa
0 .setslen .homesa .nextsa .thesa .addsa
2 .interpolatesa e ms
1 .dynnodes
55 .squaretangents e ms mn
5 1 2 2 .dynspline
e dc mc
(char.log) .openlogfile
.true .setlog
logcs
.false .setlog
.collectgarbage
}.cvx .ifelse
}.cvx .def
% Routines to process a whole "page" of a font. There are a number of data structures
% involved:
% 1. A width vector for the font, in Mergenthaler units. Index i corresponds to Mergenthaler
% character code (MCC). Index 0 is unused. Stored as "fitWidths".
%
% 2. A vector describing the "page". Each element of the vector describes a "row" in the
% page. Stored as "fitPage".
% GetRowCount => n ..returns count of number of rows on this page.
% i GetRow => ..stores ith row as "fitRow", i in [1..n].
%
% 3. Each row is described by a vector that contains (positional notation):
% BB# for the period that begins the line
% BB# for the period that ends the line (or 0 if none)
% char1
% char2
% . . .
% char n
% GetPeriods => bb1 bb2 ..get period BB numbers.
% GetCharCount => n
% i GetChar => ..stores ith char as "fitChar", i in [1..n]
%
% 4. Each char is described simple as a vector containing:
% MCC (Mergenthaler character code)
% BB# for first outline of char (negative if outline direction should be reversed)
% GetMCC => MCC
% GetOutlineCount => n
% i GetOutline => BB#, i in [i..n]
%
% Widths:
% mcc GetMergWidth => mergenthaler width in units of set
% mcc GetPageWidth => mergenthaler width used to set this
% character on the strike sheet. This is same as GetMergWidth
% except for accent characters.
(GetRowCount) {fitPage .length}.cvx .def
(GetRow) {1 .sub fitPage .exch .aget (fitRow) .exch .store}.cvx .def
(GetPeriods) {fitRow 0 .aget fitRow 1 .aget}.cvx .def
(GetCharCount) {fitRow .length 2 .sub} .cvx .def
(GetChar) {1 .add fitRow .exch .aget (fitChar) .exch .store}.cvx .def
(GetMCC) {fitChar 0 .aget}.cvx .def
(GetOutlineCount) {fitChar .length 1 .sub}.cvx .def
(GetOutline) {fitChar .exch .aget}.cvx .def
(GetMergWidth) {fitWidths .exch .aget}.cvx .def
% If accentedChar#0, character codes [93..101] have page width of accentedChar
(GetPageWidth) {
.dup IsAccentChar {.pop accentedChar}.cvx .if
GetMergWidth
}.cvx .def
% mcc IsAccentChar => boolean ..returns true if character code is an accent
(IsAccentChar) {.dup 92 .gt .exch 102 .lt accentedChar 0 .eq .not .and .and }.cvx .def
% Data structure is set with
% <outFile pointFile fitWidths fitPage xOffset yOffset mergPeriodWidth accentedChar accentXOffset> SetPage
% offsets are added to initial period's xmin,ymin to obtain origin of first char in row.
(SetPage) {
(accentXOffset) .exch .store
(accentedChar) .exch .store
(mergPeriodWidth) .exch .store
(yOffset) .exch .store (xOffset) .exch .store
(fitPage) .exch .store (fitWidths) .exch .store
.pushdc 0.08 0.08 .scale
ROBuildBB
.popdc
(outFile) .exch .store
}.cvx .def
(StartOut) { (outStream) outFile 2 .iobytestream .store }.cvx .def
(StopOut) { outStream .iokillstream }.cvx .def
(DoPage) {
StartOut
1 1 GetRowCount
{ GetRow 1 1 GetCharCount
{ DoChar }.cvx .for
}.cvx .for
StopOut
}.cvx .def
(DoPreview) {
1 1 GetRowCount
{ GetRow 1 1 GetCharCount
{ DoCharPreview .touch .pop .pop }.cvx .for
}.cvx .for
}.cvx .def
% i DoChar -- do ith character on the current row.
(DoChar) {
.erase
DoCharPreamble
{ OutCharBegin
1 1 GetOutlineCount
{ GetOutline .dup 0 .lt {.neg}.cvx .if
xOrg yOrg 3 2 .roll ROFitOutline
OutOutline }.cvx .for
OutCharEnd }.cvx .if
}.cvx .def
% i DoCharPreview -- show ith character on the current row.
(DoCharPreview) {
.erase
DoCharPreamble
{1 1 GetOutlineCount
{ .pushdc
100 100 ShowCross
GetMCC GetMergWidth MergWidth 100 .add 100 ShowCross
xOrg .neg 100 .add yOrg .neg 100 .add .translate
GetOutline RODisplayOutline .pop .popdc }.cvx .for
}.cvx .if
}.cvx .def
% x y ShowCross => puts out small cross
(ShowCross) {
.pushdc .translate
-20 0 .moveto 20 0 .drawto
0 -20 .moveto 0 20 .drawto
.popdc
}.cvx .def
% i DoCharPreamble => boolean ..sets up for fitting a character. return true if should be fit
(DoCharPreamble) {
(curCharIndex) .exch .store
curCharIndex GetChar GetPeriods .pop ROGetBB
xmin xOffset .add curCharIndex CumWidths .add
curCharIndex GetChar GetMCC IsAccentChar {accentXOffset .add}.cvx .if
(xOrg) .exch .store
ymin yOffset .add (yOrg) .exch .store
(Current MCC=) .print GetMCC =
GetOutlineCount .0 .eq .not
}.cvx .def
% OutCharBegin -- start writing out current character on outFile
(OutCharBegin) {
GetMCC OutNum (.charCode
) OutString
fitWidths GetMCC .aget OutNum 54 OutNum
(.width
{) OutString
}.cvx .def
% OutCharEnd -- finish writing out current character on outFile
(OutCharEnd) {
(} .endChar
) OutString OutFlush
}.cvx .def
% OutOutline -- copy outline from 'char.log' to output file.
(.savedmoveto) (.moveto) .load .store
(.savedcurveto) (.curveto) .load .store
(.savedlineto) (.lineto) .load .store
(OutOutline) {
(.moveto) {.exch OutCoord OutCoord (.moveto
) OutString }.cvx .def
(.curveto) {6 5 .roll OutCoord 5 4 .roll OutCoord
4 3 .roll OutCoord 3 2 .roll OutCoord 2 1 .roll OutCoord OutCoord (.curveto
) OutString }.cvx .def
(.lineto) {.exch OutCoord OutCoord (.lineto
) OutString }.cvx .def
(char.log) .run
(.moveto) (.savedmoveto) .load .store
(.curveto) (.savedcurveto) .load .store
(.lineto) (.savedlineto) .load .store
}.cvx .def
(OutNum) {1000 .mul 4000.5 .add .cvi 4000 .sub 1000.0 .div ( ).cvis
outStream .exch .iowritebytes outStream ( ) .iowritebytes}.cvx .def
(OutCoord) {.cvr 100 .sub pointSize 10 .mul .div OutNum}.cvx .def
(OutString) {outStream .exch .iowritebytes}.cvx .def
(OutFlush) {outStream .ioflush}.cvx .def
% i CumWidths => n ..accumulate widths for characters [1..i) on this row
(CumWidths) {
(cumWidth) 0 .store
1 1 3 2 .roll 1 .sub
{ GetChar GetMCC GetPageWidth MergWidth cumWidth .add 1 .add (cumWidth) .exch .store}.cvx .for
cumWidth
}.cvx .def
% Mergenthaler width calculation interface.
(pointSize) 64 .store
% n MergWidth => bits ..convert Merg width at pointsize points to bits (and round)
(MergWidth) { pointSize 10.0 .mul 54 .div .mul 0.5 .add .cvi }.cvx .def
% n1 . . . nn MergSum => bits ..convert each entry on stack and sum
(MergSum) {
(temp) 0 .store
{.cntstk 0 .eq {.exit}.cvx .if
MergWidth temp .add (temp) .exch .store }.cvx .loop
temp
}.cvx .def
% Definitions to help build up row data structures for conventional font
(Row1) [ 27 28 29 30 31 32 33 34 35 36 37 38 39 40 ] .def
(Row2) [ 41 42 43 44 45 46 47 48 49 50 51 52 ] .def
(Row3) [ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ] .def
(Row4) [ 20 21 22 23 24 25 26 64 65 67 66 74 73 85 84 70 71 86 53 78 79 77 69 ] .def
(Row5) [ 63 54 55 56 57 58 59 60 61 62 64 72 76 64 64 75 89 88 87 80 68 ] .def
(Row6) [ 91 116 117 118 119 114 115 107 108 109 110 82 90 120 121 102 103 ] .def
(Row7) [ 104 105 113 111 106 112 83 81 93 94 95 96 97 98 101 99 100 ] .def
% Function to build "Row" array for a 10-char-per-line font
% n Row => array for row n (10n-9, 10n-8, ... 10n)
(Row) {
10 .mul .dup 9 .sub 1 3 2 .roll { }.cvx .for
10 .array .astore
}.cvx .def