’From Smalltalk 5.5k XM November 24 on 22 November 1980 at 2:57:08 am.’
"ParagraphScanner"
Class new title: ’ParagraphScanner’
subclassof: Object
fields: ’para "<Paragraph>"
style "<TextStyle>"
press "<PressFile> for output"
runstrm "<Stream> of paragraph runs"
textstrm "<Stream> of paragraph text"
font "<WidthTable> current font"
ascent "<Integer> max ascent"
descent "<Integer> negative max descent"
width "<Integer> total width"
spaces "<Integer> number of spaces"
rect "<Rectangle> for printing"
tabpos "<Stream> (text position, new X position) of tabs"
’
declare: ’’;
asFollows
Scans through a paragraph computing the dimensions of a partial line of text.
Initialization
in: rect
init
[ascent ← descent ← width ← spaces ← 0. tabpos reset]
of: para to: press style: style
[textstrm ← ’’ asStream.
runstrm ← para runs asStream.
tabpos ← (Vector new: 10) asStream]
Access
position [⇑textstrm position]
width [⇑width]
Scanning
backup
[textstrm skip: ¬1]
scan "Scan up to a zero-width character, back up to last blank if width exceeded"
| maxw sp char t
"Save state" spos slim srunpos sasc sdesc swidth ssp sfont stpos
[textstrm end and⦂ self newrun≡false⇒ [⇑false]
maxw ← rect width.
while⦂
[ascent ← ascent max: font ascent.
descent ← descent max: font descent.
sp ← font space.
while⦂ [
t ← font scan: textstrm until: width exceeds: maxw.
[(char ← t◦1) ≡ true⇒ [] width ← t◦2].
char = 040] do⦂
["Save state"
spos ← textstrm position. slim ← textstrm limit.
srunpos ← runstrm position. stpos ← tabpos position.
sasc ← ascent. sdesc ← descent.
swidth ← width. ssp ← spaces. sfont ← font.
spaces ← spaces+1.
width ← width+sp].
char⇒
[(char≡true and⦂ nil≠spos) and⦂ (2*ascent ≤ rect height)⇒ [
"Back up to just past last blank (if another line fits)"
textstrm of: para text from: spos+1 to: slim.
runstrm position ← srunpos. tabpos position ← stpos.
ascent ← sasc. descent ← sdesc.
width ← swidth. spaces ← ssp. font ← sfont.
⇑040]
⇑char]
self newrun]
do⦂ [].
⇑false]
tab
[spaces ← 0.
tabpos next ← textstrm position;
next ← (width ← width + font tab | font tab)]
Printing
printfrom: charpos aligned: align skip: n "Returns false if goes below bottom"
| ybot a b ix iy px xs sp rs len tpos ts ntab rval ifont w ps [
"this code basically writes the EL (entity list) for a line"
"bottom of character -- ascent not really ascent but height"
(ybot ← rect corner y - ascent) < rect origin y ⇒ [
"won’t fit" ⇑false]
a ← charpos + 1.
b ← textstrm position - n.
[a > b ⇒ ["No text"]
ts ← tabpos viewer.
tpos ← ts next.
px ← false.
xs ← rect width - width.
ix ← rect minX + ["left margin offset" align=2⇒ [xs/2]; =4⇒[xs] 0].
"set baseline of character. do setx before showchars"
press sety: (iy ← ybot + descent).
sp ← font space "kludge?".
[align=1⇒ ["do setspacex before showchars"] press setspacex: sp].
rs ← (para run: a to: b) asStream.
while⦂ (len ← rs next) do⦂ [
press selectfont: (press fontindex: (rval ← rs next) style: style) - 1.
b ← a+len.
[(rval land: 4) = 0⇒ ["no underlining"]
"unfortunately, we must rescan this part of line to find out how wide it is"
ifont ← press codefont: rval style: style "a WidthTable".
ps ← (para◦(a to: b-1)) asStream.
w ← true, 0.
while⦂ w◦1 do⦂ [
w ← ifont scan: ps until: w◦2 exceeds: rect width.
w◦1 = 040⇒ [w◦2 ← w◦2 + ifont space];
=011⇒ [w◦2 ← w◦2 + ifont tab | ifont tab]].
[px⇒ ["use current x position"] press setx: ix].
"change y position to show rectangle, then change y back again"
press sety: iy-40; showrectwidth: w◦2 height: 30; sety: iy].
ntab ← 0.
while⦂ (tpos and⦂ tpos<b) do⦂ [ "Put out tabs"
[tpos = a⇒ ["no text between this tab and last"]
"put out accumulated tabs or initial x"
[ntab> 0⇒ [
press skipchars: ntab; setx: px.
ntab ← 0]
px⇒ []
press setx: (px ← ix)].
press showchars: tpos-a].
ntab ← ntab+1.
px ← ix + ts next.
a ← tpos+1.
tpos ← ts next].
[ntab> 0⇒ [
press skipchars: ntab;
setx: px]
px⇒ []
press setx: (px ← ix)].
[align=1 and⦂ tpos≡false ⇒ ["Reset space width"
[spaces=0⇒ [] press setspacex: xs/spaces+sp].
align ← 0]].
rs end⇒ [
"for more compactness, maybe"
press showchars: b-a skip: n.
⇑ybot]
press showchars: b-a.
a ← b]].
[n > 0⇒ [
"skip over ending blank or carriage return"
press skipchars: n]].
⇑ybot]
Private scanning
newrun | len pos [
len ← runstrm next⇒
[pos ← textstrm position.
textstrm of: para text from: pos+1 to: pos+len.
font ← press codefont: (runstrm next) style: style]
⇑false]
SystemOrganization classify: ↪ParagraphScanner under: ’Press File Support’.
"PressFile"
Class new title: ’PressFile’
subclassof: Object
fields: ’DL "<File> stores data list"
EL "<Set> accumulates entity list"
parts "<Set> accumulates part directory"
DLstart "<Integer> position of current entity in DL"
ELstart "<Integer> word position of current entity in EL"
Pstart "<Integer> record position of current page in DL"
eorigin "<Point>"
scale "<Integer> micas per Alto screen dot"
boundbox "<Rectangle> bounding box for current page"
fontcodes "<Vector> of run codes corresponding to current fonts"
fontdefs "<Vector of WidthTables> corresponding to fontcodes"
estate "<Vector> of some entity state"
FL "<Set> accumulates strings for Ext. File part" ’
declare: ’prevstyle SMentity recordsize printers printerMenu ’;
asFollows
There are two levels of code in this class: the low-level Press commands and the high level user commands. At the moment, only text, lines and bitmaps are supported (see Paragraph presson:in: and class ParagraphScanner for the former). ignores bounding box stuff. limited reading.
see <GR-DOCS>PressFormat.Press and PressFormat-figure.Press for more details
Initialization
of: DL [
EL ← Set new string: 200.
FL ← Set new string: 40.
parts ← Set new string: 40.
fontcodes ← Vector new: 0.
fontdefs ← Vector new: 0.
estate ← Vector new: 3 "font, spacex, spacey, ...".
prevstyle← nil.
self scale: PressScale;
startPage]
reset [
DL readwriteshorten; reset.
self of: DL]
scale: scale
Aspects
defaultPrinterName [
⇑[currentProfile ≡ nil⇒ [PrinterName] currentProfile printerName]]
name [⇑DL name]
scale [⇑scale]
Entity/Page/File Commands
box: rect hue: hue sat: sat bright: bright containing⦂ expr | w r
[self entity: (self transrect: (w← rect inset: ¬2)) containing⦂
[for⦂ r from: (w minus: rect) do⦂
[self showrect: r color: 0].
[ColorPrint⇒
[self hue: hue; saturation: sat;
showrect: rect color: bright; brightness: 0]].
expr eval]]
clip: boundingbox
close | p i font [
DL writing≡false⇒ [DL close]
self closePage.
parts≡false or⦂ parts empty⇒ []
"if present, include the external file part --- added Sept 80"
[FL empty⇒[]
self part⦂ [DL append: FL] code: 2.
FL reset.
self padpage].
"put font names and descriptions into font directory (part)"
self part⦂ [
for⦂ i to: fontdefs length do⦂ [
font ← fontdefs ◦ i.
DL nextword← 16; nextword← i-1;
next ← font min; next ← font max.
self Bcpl: font name pad: 20.
DL next ← font face; next ← font min;
nextword ← font pointsize; nextword← 0]]
code: 1.
"write part directory. Pstart is current page position"
DL append: parts asReadStream.
self padpage.
p ← self recordnum.
"document directory"
DL nextword← 27183; "press password"
nextword← p + 1 "number of records";
nextword← parts position / 8 "number of parts";
nextword← Pstart; "part dir and length"
nextword← p - Pstart;
nextword← ¬1; "backpointer to obsolete doc dir"
append: user timewords; "2 time words"
nextword← 1; "first and last copies"
nextword← 1;
nextword← ¬1; "first and last pages"
nextword ← ¬1;
nextword ← ’S’◦1 "solid color (looked at by color printers)";
next: 2*(0177-12) ← 0377.
p ← user now.
self Bcpl: self name pad: 52;
Bcpl: [currentProfile≡nil⇒ [dp0 diskID◦1] currentProfile printedBy] pad: 32;
Bcpl: [((String new: 40) asStream) print: p◦1; space; print: p◦2; contents] pad: 40;
padpage.
DL close.
parts reset]
entity: box containing⦂ expr | v [
self startEntity.
boundbox ← box.
v ← expr eval.
self closeEntity.
⇑v]
entityorigin: eorigin
page [self closePage]
pictureinit [self pictureinit: user screenrect scale: PressScale]
pictureinit: rect scale: scale
[boundbox ← boundbox include: (self transrect: rect).
self somefont]
screenout: rect scale: scale
["puts a bit map image onto the PressFile. The standard
scaling is 32 micas per Alto dot. 22 looks better, Dover only
works with 32"
user displayoffwhile⦂ [
self somefont; setp: (self transrect: rect) origin; bitmap: rect bits: false; close]]
selectPrinter [⇑self selectPrinter: self defaultPrinterName]
selectPrinter: oldName | t [
user cr; show: ’select a printer (currently ’;
show: [oldName≡false or⦂ oldName empty⇒ [’none’] oldName]; show: ’)’.
user cursorloc ← user screenrect center; restoredisplay.
t ← 0.
while⦂ t = 0 do⦂ [t ← printerMenu wbug].
⇑[t ≤ printers length⇒ [printers◦t]
t = (printers length+1)⇒ ["same" oldName] "none" false]]
toPrinter [self toPrinter: self defaultPrinterName]
toPrinter: ndest "a printer name" | psocket dest np t perr [
ndest ≡ false⇒ ["don’t try to print" ⇑false]
E ≡ nil⇒ [
"use O.S. if Smalltalk ethercode not alive"
t ← (String new: 100) asStream.
t append: ’Empress. ’; append: self name.
[ndest length > 0⇒ [t space; append: ndest; append: ’/H’]].
t append: ’; Resume.~ Small.Boot’.
user quitThen: t asReadStream]
dest ← ’’.
perr ← psocket ← false.
np ← printers length+1.
DL readonly.
while⦂ ndest do⦂ [
perr or⦂ ndest empty⇒ [
perr ← false.
ndest ← self selectPrinter: dest]
[dest = ndest⇒ ["to same printer"]
dest ← ndest.
"close previous socket"
psocket⇒ [psocket close. psocket ← false]].
[psocket⇒ []
"create new socket"
psocket ← EFTPSender new hostName: dest⇒ [psocket wakeup]
user cr; show: ’name lookup failure’].
"send file"
psocket and⦂ (user displayoffwhile⦂ [psocket send: DL reset])⇒ [
"success--stop" ndest ← false]
"failure--switch servers?"
perr ← true].
"cleanup after success or abort"
DL close.
psocket⇒ [psocket close]]
Fonts
codefont: code style: style
[⇑fontdefs◦(self fontindex: code style: style)]
fontindex: code style: style | ix font n
["return index if in font dictionary"
code ← code land: 0363. "Remove underline and strikeout"
[style=prevstyle⇒
[(ix ← fontcodes find: code) > 0 ⇒ [⇑ix]]
fontcodes all← nil. "invalid across style change"
prevstyle← style].
n ← code / 16 + 1.
font ← (WidthTable new
named: (style fontfamily: n)
pointsize: (style fontsize: n)
face: (code / 2 land: 1) + (code * 2 land: 2))
lookup.
(ix← fontdefs find: font)>0⇒
[fontcodes◦ix← code. ⇑ix]
"add entry to font dictionary"
fontdefs length=16⇒[user notify: ’too many fonts’. ⇑1]
fontcodes ← fontcodes, code.
fontdefs ← fontdefs, font.
⇑fontcodes length]
selectfont: f [
estate◦1 = f⇒ []
EL next ← 0160 + (estate◦1 ← f)]
somefont "fool self into writing non-empty fontdir"
[self fontindex: 5*16 style: DefaultTextStyle]
Transformations
transpt: p
[⇑ Point new x: (p x * scale) asInteger y: (25400 - (p y * scale)) asInteger]
transrect: rect
[⇑ Rectangle new
origin: (self transpt: rect minX ⌾ rect maxY)
corner: (self transpt: rect maxX ⌾ rect minY)]
EL commands
brightness: b [EL next← 0370; next← b]
hue: b [EL next← 0371; next← b]
onlyoncopy: n [EL next ← 0355; next ← n]
resetspace [EL next ← 0366]
saturation: s [EL next← 0372; next← s]
setp: p [
"self setx: p x; sety: p y"
EL next ← 0356; nextword ← p x;
next ← 0357; nextword ← p y]
setspacex: x [
estate◦2 = x⇒ []
estate◦2 ← x.
x ≥ 0 and⦂ x ≤ 2047⇒ ["short form" EL nextword ← 060000 + x]
EL next ← 0364; nextword ← x]
setspacey: y [
estate◦3 = y⇒ []
estate◦3 ← y.
y ≥ 0 and⦂ y ≤ 2047⇒ ["short form" EL nextword ← 064000 + y]
EL next ← 0365; nextword ← y]
setx: x [EL next ← 0356; nextword ← x]
sety: y [EL next ← 0357; nextword ← y]
showchar: char ["immediate" EL next ← 0363; next ← char]
showchars: n [
n=0⇒ []
n ≥ 1 and⦂ n ≤ 32⇒ ["short form" EL next ← n-1]
EL next ← 0360; next ← n]
showchars: n skip: t [
t=1 and⦂ (n ≥ 1 and⦂ n ≤ 32)⇒ [EL next ← 0100 + n-1]
self showchars: n; skipchars: t]
showdots: nwords [EL next ← 0374; nextNumber: 4 ← nwords]
showdotsopaque: nwords [EL next ← 0375; nextNumber: 4 ← nwords]
showrect: rect [
self setp: rect origin.
EL next ← 0376;
nextword ← rect width;
nextword ← rect height]
showrect: rect color: c [
[ColorPrint⇒ [self brightness: c]].
self showrect: (self transrect: rect)]
showrectwidth: w height: h [EL next ← 0376; nextword ← w; nextword ← h]
skipchars: n [
n=0⇒ []
n ≥ 1 and⦂ n ≤ 32⇒ ["short form" EL next ← 040 + n-1]
EL next ← 0361; next ← n]
skipcontrol: n [
"immediate"
EL next ← 0353; next ← n.
"now put n bytes in EL"]
skipcontrol: n type: t [
"n bytes have been put in DL"
EL next ← 0362; nextword ← n; next ← t]
space [EL next ← 0367]
Bitmaps/Dots
AIS: file width: w height: h croprect: r at: pt scale: s
[self setp: (self transpt: pt); dots⦂
[self setcoding: 8 "byte samples" dots: w lines: h;
setmode: 3 "to right and to bottom of page";
setsizewidth: (s*r width*scale) asInteger height: (s*r height*scale) asInteger;
setwindowwidth: r width height: r height skipdots: r minX skiplines: r minY;
dotsfromAIS: file]]
"
(dp0 pressfile: ’pix.press’) somefont; AIS: ’girl.ais’ width: 512 height: 512 croprect: (50⌾50 rect: 500⌾500) at: 36⌾80 scale: 0.65; close.
"
bitmap: rect bits: bits | w w16 h [
"some pecularities of spruce:
scale must be 32, and multiples of 16 for width (maybe extra stuff prints)"
w ← rect width.
w16 ← w + 15 | 16 "width to next word boundary".
h ← rect height.
"origin should be set earlier"
self dots⦂ [
self setcoding: 0 "bitmap" dots: w16 lines: h;
setmode: 3 "to right and to bottom of page";
setsizewidth: scale * w16 height: scale * h;
setwindowwidth: [ColorPrint⇒ [w] w16] height: h;
dotsfollow.
bits⇒["bits supplied" DL append: bits]
"else from screen"
rect bitsOntoStream: DL]]
dots⦂ exp | dlpos [
dlpos ← self padword.
exp eval.
self showdots: DL wordposition - dlpos]
dotsfollow [DL nextword ← 3]
dotsfromAIS: file | f
[f←file length inString+file+[file length even⇒[’ ’]’’]. "BCPLize"
DL nextword ← 4; nextword ← 4; append: f. FL append: f]
setcoding: c dots: d lines: l [
DL next ← 1; next ← c;
nextword ← d; nextword ← l]
setmode: m [DL next ← 2; next ← m]
setsizewidth: w height: h [
DL nextword ← 2; nextword ← w; nextword ← h]
setwindowwidth: w height: h [
self setwindowwidth: w height: h skipdots: 0 skiplines: 0]
setwindowwidth: w height: h skipdots: sd skiplines: sl
[DL nextword ← 1;
nextword ← sd; nextword ← w;
nextword ← sl; nextword ← h]
Lines/Objects
drawcurve: v [
v length ≠ 12⇒ [user notify: ’illegal drawcurve’]
DL nextword ← 2.
for⦂ v from: v do⦂ [DL nextword ← v]]
drawdiscat: pt radius: radius | dx dy i
[radius ≤ 16 ⇒ []
dx ← ↪(5 4 3 1 ¬1 ¬3 ¬4 ¬5 ¬5 ¬4 ¬3 ¬1 1 3 4 5).
dy ← ↪(1 3 4 5 5 4 3 1 ¬1 ¬3 ¬4 ¬5 ¬5 ¬4 ¬3 ¬1).
self showobject⦂ [
self moveto: pt + ((dx◦16*radius/5) ⌾ (dy◦16*radius/5)).
for⦂ i to: 16 do⦂
[self drawto: pt + ((dx◦i*radius/5) ⌾ (dy◦i*radius/5))]]]
drawlinefrom: p1 to: p2 width: width | d length t1 t2
[[(d ← p2-p1) = (0⌾0) ⇒ []
d x← d x asFloat. d y← d y asFloat. width ← width asFloat.
length ← ((d x*d x)+(d y*d y)) sqrt.
d x← (d x*width/length) asInteger.
d y← (d y*width/length) asInteger.
t1 ← d y ⌾ (0 - d x).
t2 ← 0 - d y ⌾ d x.
self showobject⦂ [
self moveto: p1 + t1.
self drawto: p2 + t1.
self drawto: p2 + t2.
self drawto: p1 + t2.
self drawto: p1 + t1]].
self drawdiscat: p2 radius: width]
drawlinefromscreen: p1 to: p2 width: width
[⇑self drawlinefrom: (self transpt: p1) to: (self transpt: p2) width: (width*scale)]
drawto: p [DL nextword ← 1; nextPoint ← p]
moveto: p [DL nextword ← 0; nextPoint ← p]
object⦂ expr atScreen: p
[self showobject⦂ [self objectGotoScreen: p pen: 0. expr eval]]
objectGotoScreen: p pen: pen [
DL nextword← pen; nextPoint ← (self transpt: p)]
showobject⦂ exp | p [
p ← self padword.
"expression containing moveto, drawto, drawcurve"
exp eval.
EL next ← 0373; nextword ← DL wordposition - p]
Private
append: x
[⇑DL append: x]
Bcpl: s pad: n | slen [
"write a Bcpl string and padding to fill n bytes (used by close)"
slen ← s length min: n-1.
DL next ← slen; append: s◦(1 to: slen); next: n-(slen+1) ← 0]
classInit | a p ["PressFile classInit."
Smalltalk declare: ↪PressScale as: 32.
recordsize ← 512.
SMentity ← 5.
a ← (String new: 250) asStream.
"from [Maxc1]<Altodocs>NetTopology.Press, October 1980. in order of net number"
printers ← ↪(
"net #" "printer names"
" 1" ’Navajo’ "HENRIETTA"
" 3" ’Menlo’ ’Clover’ ’Lilac’ "PARC: BLDG 35, FLOOR 2"
" 5" ’Kanji’ "PARC: BLDG 34"
" 6" ’Wonder’ ’Quake’ "PARC: BLDG 35, FLOOR 1&3"
"10" ’Puff’ "A&E"
"12" ’White’ ’Colorado’ "PASADENA"
"14" ’Niagara’ ’Tioga’ "WEBSTER"
"20" ’Yoda’ "PARC: BLDG 32"
"21" ’Lily’ "SPG"
"23" ’Ranger’ "DALLAS"
"26" ’Windfall’ "DC"
"27" ’Genesee’ "WEBSTER"
"33" ’Amarok’ "TORONTO"
"34" ’Yankee’ "STAMFORD"
"36" ’Cyclops’ "LEESBURG"
"54" ’Rover’ "A&E"
"55" ’SPGEng’ ’Emperor’ "A&E"
"56" ’Thud’ "A&E"
"60" ’Adelie’ ’Daisy’ ’RockHopper’ "BAYHILL"
"62" ’Bud’ "?"
).
for⦂ p from: printers do⦂ [a append: p; cr].
a append: ’same printer’; cr; append: ’no printer’.
printerMenu ← Menu new string: a contents]
closeEntity [self closeEntity: SMentity]
closeEntity: etype [
EL wordposition = ELstart⇒ []
"Put a trailer into the EL"
EL padNext ← 0377; "word-pad EL with <Nop>"
next ← etype;
next← 0; "fontset"
"dlstart relative to DL location in file"
nextNumber: 4 ← DLstart - (Pstart*recordsize);
nextNumber: 4 ← DL position - DLstart;
nextPoint← eorigin; "entity origin"
nextPoint← boundbox origin;
nextPoint← boundbox extent.
EL nextword ← EL wordposition - ELstart + 1.
self startEntity]
closePage [
self closeEntity.
EL empty⇒ []
DL padNext ← 0;
nextword ← 0;
append: EL asReadStream.
self part: 0 start: Pstart]
data ["slightly dangerous" ⇑DL]
padpage ["words of padding to end of page" ⇑(DL pad: recordsize with: 0) / 2]
padword [
"make object (lines or dots) start on word boundary"
[DL padNext ← 0⇒ [self skipchars: 1]].
⇑DL wordposition]
part⦂ exp code: c | fp [
self closePage.
fp ← self recordnum.
exp eval.
self part: c start: fp]
part: type start: start | padding [
padding ← self padpage.
parts nextword ← type;
nextword ← start;
nextword ← self recordnum - start;
nextword ← padding.
self startPage]
recordnum [⇑DL positionSize: recordsize]
skipcode: code data: s | t [
"called by hidePress:complete:. s is a String"
(t ← s length+1) < 256⇒ [
"immediate, in EL"
self skipcontrol: t.
EL next ← code; append: s]
"in DL"
DL next ← code; append: s.
self skipcontrol: t type: SMentity]
startEntity [
DLstart ← DL position.
ELstart ← EL wordposition.
boundbox ← 0 asRectangle.
eorigin ← 0⌾0.
estate all ← ¬1.
estate◦1 ← 0]
startPage [
EL reset.
Pstart ← self recordnum.
self startEntity]
Reading
filin | p [
self open.
while⦂ (p ← self nextParagraph) do⦂ [
FilinSource ← self.
user print: nilⓢ p text; space].
FilinSource ← nil.
self close]
nextControl | command t entity [
"return the next skip-control information"
command ← nil.
while⦂ true do⦂ [
(estate and⦂ command)≡false⇒ [
"either or both false. get next entity"
t ← EL next⇒ [
estate ← EL next viewer. command ← nil.
t◦1 ≠ SMentity⇒ ["ignore this entity" estate ← false]
DLstart ← (t◦(3 to: 6)) asStream nextNumber: 4.
DL position ← Pstart*recordsize + DLstart]
"no more entities on current part (page)"
self readPart⇒ []
"no more pages"
⇑false]
entity ← estate.
while⦂ (command ← entity next) do⦂ [
"some stuff arranged by probable frequency"
command
< 0100⇒ [
"show-characters-short (0-037)
skip-characters-short (040-077)"
DL skip: (command land: 037) +1];
= 0356⇒ ["set-x" entity nextword];
= 0357⇒ ["set-y" entity nextword];
< 0140⇒ [
"show-characters-and-skip (0100-0137)"
DL skip: (command land: 037) +2];
< 0160⇒ [
"set-space-x-short (0140-0147)
set-space-y-short (0150-0157)"
"(command land: 7)*256 +" entity next];
< 0200⇒ ["font" "command land: 017"];
= 0362⇒ [
"skip-control-bytes"
t ← entity nextword.
entity next≠SMentity⇒ ["ignore" DL skip: t]
⇑DL next: t];
= 0360⇒ ["show-characters" DL skip: entity next];
= 0377⇒ ["nop"];
< 0353⇒ [
"available (0200-0237)
spare (0240-0352)"];
= 0353⇒ [
"skip-control-bytes-immediate"
⇑entity next: entity next];
= 0354⇒ ["alternative" entity skipwords: 5];
= 0355⇒ ["only-on-copy" entity next];
= 0361⇒ ["skip characters" DL skip: entity next];
= 0363⇒ ["show-character-immediate" entity next];
< 0366⇒ [
"set-space-x (0364)
set-space-y (0365)" entity nextword];
< 0370⇒ [
"reset-space (0366)
space (0367)" ];
< 0373⇒ [
"set-brightness (0370)
set-hue (0371)
set-saturation (0372)" entity next];
= 0373⇒ ["show-object" DL skipwords: entity nextword];
< 0376⇒ [
"show-dots (0374)
show-dots-opaque (0375)"
DL skipwords: (entity nextNumber: 4)];
= 0376⇒ ["show-rectangle" entity skipwords: 2]
]]]
nextParagraph | s p [
s ← self nextControl⇒ [
s ← s asStream.
p ← Paragraph new.
s next = p pressCode⇒ [⇑p fromPress: self value: s]
⇑false]
⇑false]
open | t [
"read the parts (and font directory?)"
DL readonly; "reopen?" settoend; skip: 0 - recordsize.
DL nextword = 27183 and⦂ DL nextword = (self recordnum + 1)⇒ [
t ← DL nextword.
DL position: DL nextword size: recordsize.
parts ← (DL next: t*8) viewer.
self readPart]
self error: ’not a press file’]
readPart | t [
"read parts until we find a printed page or end"
estate ← false.
while⦂ (t ← parts nextword) do⦂ [
Pstart ← parts nextword.
t ≠ 0⇒ [
"not a printed page"
parts skip: 4.
t> 0⇒ ["font or other part"]
"a non-standard part. let document (estate?) interpret"
"DL position ← Pstart*recordsize.
estate fromPress: self name: t value: DL"]
"go to end of last record of entity list, ignoring padding"
t ← parts nextword "length".
DL position ← Pstart+t * recordsize - ((1 + parts nextword) * 2).
EL ← Set new vector: 50.
"scan backwards for beginning of entity list, reading entities"
while⦂ (t ← DL nextword) > 0 do⦂ [
t < 12⇒ [user notify: ’illegal entity’]
DL skipwords: 0-t.
"read entity and trailer (last 12 words of entity)"
EL next ← DL next: t-12 *2.
EL next ← DL next: 24.
DL skipwords: ¬1 - t].
"now reverse: trailer, entity (1st), ... (last)"
⇑EL ← (EL asArray◦(EL length to: 1 by: ¬1)) asStream]
⇑false]
SystemOrganization classify: ↪PressFile under: ’Press File Support’.
PressFile classInit
"WidthTable"
Class new title: ’WidthTable’
subclassof: Object
fields: ’name "<String> name of font family"
pointsize "<Integer> size in points"
face "<Integer> Press face code"
min "<Integer> min character code in font"
max "<integer> max character code in font"
"Ascent, descent, and width are in micas"
ascent "<Integer> max ascent of characters in font"
descent "<Integer> NEGATIVE max descent of characters in font"
widths "<Vector of Integers> widths of characters"
’
declare: ’tab WidthDict ’;
asFollows
Holds font parameters and width table for a Press font. It knows how to load itself from FONTS.WIDTHS.
Initialization
classInit
[WidthDict ← Dictionary init.
tab ← 500]
lookup | key font i [
key ← name + pointsize asString + (↪(’’ ’I’ ’B’ ’BI’)◦(face+1)).
font ← WidthDict lookup: key⇒ [⇑font]
self fontfrom: (dp0 oldFile: ’Fonts.Widths’) readonly.
for⦂ i from: ↪(011 015 040) do⦂
[i ≥ min and⦂ i ≤ max ⇒ [widths◦(i-min+1) ← 0]].
WidthDict insert: key with: self.
⇑self]
named: name pointsize: pointsize face: face
Access
ascent [⇑ascent]
descent [⇑descent]
face [⇑face]
max [⇑max]
min [⇑min]
name [⇑name]
pointsize [⇑pointsize]
scan: strm until: width exceeds: maxw | char w [
while⦂ (char ← strm next) do⦂
[char < min ⇒
[char=040 or⦂ (char=015 or⦂ char=011) ⇒ [⇑char, width]
user notify: ’char too low’]
char > max ⇒ [user notify: ’char too high’]
(w ← widths◦(char+1-min)) = 0 ⇒ [⇑char, width]
(width ← width + w) > maxw ⇒ [⇑true, width]
].
⇑false, width]
space [⇑150]
tab [⇑tab]
tab ← t [tab ← t]
Reading FONTS.WIDTHS
findfield: n on: file | IXH [
while⦂ [
IXH ← file nextword.
(IXH bits: (0 to: 3)) "type"
= 0 ⇒ [user notify: ’field not found’];
≠ n]
do⦂
[file skipwords: (IXH land: 07777 "length") - 1]]
fontfrom: file | i code fam fmin fmax start len found w scale
["find code for font family"
file reset. fam ← ’’.
until⦂ (fam = name) do⦂
[self findfield: 1 on: file.
code ← file nextword.
fam ← file next: (len ← file next).
file skip: 19 - len].
"now search for proper face"
found ← false.
"Convert from points to micas"
scale ← (pointsize asFloat * 2540 / 72) asInteger.
until⦂ found do⦂
[self findfield: 4 on: file.
found ← [file next = code].
[file next ≠ face ⇒ [found ← false]].
fmin ← file next.
fmax ← file next.
i ← file nextword. [i ≠ scale and: i ≠ 0 ⇒ [found ← false]].
file skip: 4. start ← file nextword. file skip: 4].
scale ← [i ≠ 0 ⇒ [1 "don’t need to scale"] pointsize asFloat * 254 / 7200].
min ← fmin. max ← fmax.
"get bb and x-tables"
file wordposition← start+1.
descent ← 0 - (scale * file nextword) asInteger.
file nextword.
ascent ← (scale * file nextword) asInteger.
file nextword.
widths ← Vector new: (max - min + 1).
for⦂ i to: widths length do⦂
[w ← file nextword.
widths◦i ← [w > 0 ⇒ [(scale * w) asInteger] 0]].
file close]
SystemOrganization classify: ↪WidthTable under: ’Press File Support’.
WidthTable classInit