// FontPass2.bcpl
// last modified by Butterfield, October 13, 1980 12:04 PM
// - SetSCVTransform, resolutions 1X instead of 10X - 10/13
// - ResolutionB, ResolutionS, 1X instead of 10X - 10/13/80
// errors 700
//
//Routines for preparing the fonts for the 3100 PRESS printer.
get "PressParams.df"
get "PressInternals.df"
get "Ix.dfs"
get "FontPass.df"
// outgoing procedures
external
[
PrintFonts
ConvertFontParts
ConvertFonts
LoopFontParts
LoopFonts
ReleaseFontCore
DPADi
ReadIX
PrintIX
SetPosRelative
]
// outgoing statics
//external
// [
// ]
//static
// [
// ]
// incoming procedures
external
[
//PRESS
PressError
FSGet;FSGetX
FSPut
//PRESSML
DoubleAdd; DoubleSub; DoubleCop
//OS
MoveBlock
//WINDOW
WindowSetPosition
WindowGetPosition
WindowReadBlock
WindowWriteBlock
WindowRead
WindowWrite
WindowCopy
//CONVERT
SetSCVTransform
ConvertAChar
ConvertAWidth
ScaleAChar
//SCAN
// TypeForm
//CURSOR
CursorDigit
CursorToggle
//METER
MeterBlock
MeterTime
]
// incoming statics
external
[
ws //Window on scratch file
wfdir //Window on GOD
SetTable
ResolutionS
ResolutionB
portrait //True if printerMode=3; else printerMode=8
convertThicken //parameters for ConvertAChar
convertOrbitized
]
// internal statics
//static
// [
// ]
// File-wide structure and manifest declarations.
// Procedures
let
//Convert any characters described in the PRESS font part.
ConvertFontParts(wp) be [
SetSCVTransform(1,(portrait? 90*60,0),0,ResolutionS,ResolutionB)
convertThicken=true
convertOrbitized=true
let pFont=vec 3
let con=vec (size Convert/16)
con>>Convert.Monotone=false
con>>Convert.SplineOk=true
con>>Convert.BBGood=false
con>>Convert.PressFontPart=true
@pFont=0
while LoopFontParts(pFont) do
[
let p=pFont!0
if p>>FPREQ.type eq FontPartCharacter then
[
CursorToggle(3)
compileif MeterSw then
[ MeterBlock(METERFontCharConvert) ]
con>>Convert.Len=p>>CREQ.len
WindowSetPosition(wp,lv p>>CREQ.pos)
WindowGetPosition(ws,lv p>>CREQ.pos)
let a=ConvertAChar(wp,ws,lv p>>CREQ.widths,con,FSGet,FSPut)
if a ne 0 then PressError(700, a)
]
]
]
and
//Scan-convert character fonts.
ConvertFonts() be [
let stats=vec (size FPCStat/16)
let con=vec (size Convert/16)
con>>Convert.SplineOk=true
con>>Convert.PressFontPart=false
CursorDigit(0)
[
let ubc=256; let uec=0 //"Used" character code limits
let sn=-1; let fptr=0
let pFont=vec 3
@pFont=0
while LoopFontParts(pFont) do
[
let p=pFont!0
if p>>FPREQ.type eq IXTypeSplines then
[
if sn ls 0 % (sn eq p>>FPREQ.sn &
p>>FPREQ.rrotation eq fptr>>FPREQ.rrotation &
p>>FPREQ.rsiz eq fptr>>FPREQ.rsiz) then
[
sn=p>>FPREQ.sn
p>>FPREQ.sn=0 //No longer needed..
fptr=p
let rbc=p>>FPREQ.rsource
let rec=p>>FPREQ.rn-p>>FPREQ.rm+rbc
if rbc ls ubc then ubc=rbc
if rec gr uec then uec=rec
]
]
]
if sn ls 0 then break //No more to convert
CursorDigit()
compileif MeterSw then
[
MoveBlock(lv stats>>FPCStat.fpreq,fptr,size FPREQ/16)
stats>>FPCStat.TimeIn=MeterTime()
]
let nic=fptr>>FPREQ.ec-fptr>>FPREQ.bc+1 //Number of input descrs
let noc=uec-ubc+1 //Number of used characters
// Set up input description tables:
WindowSetPosition(wfdir,lv fptr>>FPREQ.sa)
let WT=FSGetX(nic*SplineWidthsize)
WindowReadBlock(wfdir,WT,nic*SplineWidthsize)
let off=vec 1
WindowGetPosition(wfdir,off)
let CD=FSGetX(nic*2)
WindowReadBlock(wfdir,CD,nic*2)
// Set up output (converted) description tables
let CWT=FSGetX(noc*CharWidthsize)
let CDT=FSGetX(noc*2)
convertThicken=true
convertOrbitized=true
SetSCVTransform(fptr>>FPREQ.rsiz,fptr>>FPREQ.rrotation,0,
ResolutionS,ResolutionB)
let bbgood=((fptr>>FPREQ.rrotation rem (60*90)) eq 0)
con>>Convert.BBGood=bbgood
con>>Convert.Monotone=bbgood
for c=ubc to uec do
[
// TypeForm($.)
let relic=c-fptr>>FPREQ.bc
let reloc=c-ubc
let ps=WT+relic*SplineWidthsize
let pc=CWT+reloc*CharWidthsize
pc>>CharWidthp.DB=DBNonExCode
CDT!(reloc*2)=-1
if c ge fptr>>FPREQ.bc & c le fptr>>FPREQ.ec then
[
let needSplines=ConvertAWidth(ps,pc,con)
if CD!(relic*2) ne -1 then
[
CursorToggle(3)
SetPosRelative(wfdir,off,CD+relic*2)
WindowGetPosition(ws,CDT+reloc*2)
let a=nil
[ test needSplines then
[ //watch out: ShowObject expects coordinates in MICAS, but
//SCVTransformF puts out DOTS.
//ShowObject wants real rotation (not +90 if portrait)
let realRotation=fptr>>FPREQ.rrotation-(portrait?90*60,0)
SetSCVTransform(fptr>>FPREQ.rsiz, realRotation,
0, 2540, 2540);
a=ScaleAChar(wfdir,ws,pc)
//and reset for next width conversion
SetSCVTransform(fptr>>FPREQ.rsiz,
fptr>>FPREQ.rrotation,0,ResolutionS,ResolutionB)
]
or a=ConvertAChar(wfdir,ws,pc,con,FSGet,FSPut)
if a eq 0 then break //converted ok
unless needSplines do
[ needSplines=true;loop //try for spline fit
]
PressError(701, a)
] repeat //end of test needSplines loop
] //end of if CD!(relic*2) ne -1
] //end of if c ge ...
] //end of for c=ubc to ...
// TypeForm(0)
WindowGetPosition(ws,lv fptr>>FPREQ.sa) //...
WindowWriteBlock(ws,CWT,noc*CharWidthsize)
WindowWriteBlock(ws,CDT,noc*2)
FSPut(CD); FSPut(WT); FSPut(CWT); FSPut(CDT)
//Now find all places that used this font, and plug it in.
@pFont=0
while LoopFontParts(pFont) do
[
let p=pFont!0
if p>>FPREQ.type eq IXTypeSplines &
p>>FPREQ.sn eq 0 then
[
p>>FPREQ.type=Converted
DoubleCop(lv p>>FPREQ.sa,lv fptr>>FPREQ.sa)
p>>FPREQ.bc=ubc
p>>FPREQ.ec=uec
]
]
compileif MeterSw then
[
stats>>FPCStat.TimeOut=MeterTime()
MeterBlock(METERFontConvert,stats,size FPCStat/16)
]
] repeat
]
and
//Print a summary (A good time to see if things are screwed up!)
//PrintFonts() be [
// let pFont=vec 3
// pFont!0=0 //Signal we are starting.
// while LoopFontParts(pFont) do //Loop through all fonts, sets.
// [
// let p=pFont!0 //Pointer to FPREQ
// TypeForm(10,pFont!2,$,,10,pFont!3,$:)
// TypeForm($[,8,p>>FPREQ.rm,$:,8,p>>FPREQ.rn,$])
// test p>>FPREQ.type eq FontPartCharacter
// ifso TypeForm(" Graphical object*N*L")
// ifnot [ TypeForm($*s,lv p>>FPREQ.rfamly,$*s,
// 8,p>>FPREQ.rface,$*s,8,p>>FPREQ.rsource)
// TypeForm($(,10,p>>FPREQ.rsiz,$*s,
// 10,p>>FPREQ.rrotation,") ")
// TypeForm("Type: ",10,p>>FPREQ.type,0)
// TypeForm(" Will use: ")
// PrintIX(lv p>>FPREQ.Type)
// ]
// let foo=vec 10
// TypeForm("??",1,foo)
// ]
//
//]
//
//and
//
//Thing to loop through all FONTs. LoopFonts(p) returns true if there are
// more. LoopFontParts loops through all REQ's of fonts as well.
// Both are initialized by @p=0. Returns:
// p!0=FPREQ pointer
// p!1=FONT pointer for this font
// p!2=set number
// p!3=font number
LoopFontParts(p) = LoopFonts(p,nil)
and
LoopFonts(p;numargs n) = valof [
let set,font=nil,nil
let cp=p!0
test cp eq 0 then
[ //Start afresh
set=0; font=-1 //So index will work.
]
or test cp>>FPREQ.next ne 0 & n eq 1 then
[
p!0=cp>>FPREQ.next
resultis true
]
or [ font=p!3; set=p!2 ]
while true do
[
font=font+1
if font eq 16 then [ set=set+1; font=0 ]
if set eq 65 then resultis false
let ft=SetTable!set
test ft eq 0 then font=15 or
[
let ct=ft>>SET.font↑font
if ct ne 0 then
[
p!3=font; p!2=set
p!1=ct
p!0=ct>>FONT.segments
resultis true
]
]
]
]
//Release all core
and
ReleaseFontCore() be [
for si=0 to 64 do if SetTable!si then
[
let s=SetTable!si
for fi=0 to 15 do if s!fi then
[
let p=(s!fi)>>FONT.segments
while p do
[
let np=p>>REQHeader.next
FSPut(p)
p=np
]
FSPut(s!fi)
]
FSPut(s)
]
]
//Miscellaneous other things
and
DPADi(a,b) = valof [
let c=vec 1
c!0=0; c!1=b
resultis DoubleAdd(a,c)
]
and
ReadIX(w,v) = valof [
//Read an IX entry into vector v. Return length
let a=WindowRead(w)
let l=a<<IXH.Length
v!0=a
WindowReadBlock(w,v+1,l-1)
resultis l
]
and
//PrintIX(ix) be [
////Print out an ix entry
// TypeForm("Family: ",10,ix>>IX.fam,". Face: ")
// let weight,slope,expansion=nil,nil,nil
// DecodeFace(ix>>IX.face,lv weight,lv slope,lv expansion)
// TypeForm(weight,slope,expansion,". Size: ")
// TypeForm(10,ix>>IX.siz,". Rotation: ",10,ix>>IX.rotation)
// TypeForm(". ",8,ix>>IX.bc,$:,8,ix>>IX.ec)
// TypeForm($*s,4,lv ix>>IX.sa,$*s,4,lv ix>>IX.len,0)
// if ix>>IXH.Type eq IXTypeWidths then return
// if ix>>IXH.Type eq IXTypeSplines then return
// TypeForm(" Resolutions: ",10,ix>>IX.resolutionx,$*s)
// TypeForm(10,ix>>IX.resolutiony,0)
//]
//
//and
//
SetPosRelative(w,b,pos) be [
let a=vec 1
DoubleCop(a,b)
DoubleAdd(a,pos)
WindowSetPosition(w,a)
]