// P L A Y O U T (PREPRESS)
// catalog number ???
// modified by GMcD 1430, 12 March 76: new mmglyphs

get "ix.dfs"

// outgoing procedures
external
[
PlayOut
PlayOutFont
]

// outgoing statics
//external
//[
//]
//static
//[
//]

// incoming procedures
external
[
//WINDOW
WindowSetPosition
WindowGetPosition
WindowReadBlock
WindowWriteBlock
WindowRead
WindowWrite
WindowCopy
WindowClose

//PREPRESS
PrePressWindowInit
IllCommand
ReadIXTempFile
SetPosRelative
GetPosRelative
GetResolution
NoFile
Scream

//UTIL
FSGetX
FSPut
MulDiv
RoundDp

//SCAN
ReadCom
TypeForm

//FLOAT
FLD;FST;FTR;FLDI;FNEG;FAD;FSB;FML;FDV;FCM;FSN
FLDV;FSTV;FLDDP;FSTDP;DPAD;DPSB
DPCop
// OS
MoveBlock; SetBlock; Zero
]

// incoming statics
//external
//[
//]

// internal statics
static
[
Bits//Pointer to scan-converted bits
nBitsWords//Number of words of bits
Height//Real height of font
WordWidth//Number of words wide of max char
disHeight// Even version of Height
disWordWidth// Even version of WordWidth
Strike//Pointer to strike memory
StrikeRaster//# words per scan line in strike
StrikeX//Last x used in Strike
]

// File-wide structure and manifest declarations.

manifest DBptr=#420

structure DB: [
next word
resolution bit 1
background bit 1
indentation bit 6
width bit 8
bitMapAddress word
height word
]
manifest lDB = size DB/16

structure StrikeHeader: [
oneBit bit
index bit
fixed bit
blank bit 13
min word
max word
maxwidth word
]
structure StrikeBody: [
length word
ascent word
descent word
xoffset word
raster word
]

// Procedures
let
//Play out characters.
// Fileflag is:
//0Show chars on screen
//1Make CU file
//2Make AL file
//3Make STRIKE file (use mastermaker switch in PlayOutFont)

PlayOut(fileflag) be [
let sw,wf = 0, 0

[ParamLoop
let switches = vec 10; let str=vec 20
if ReadCom(str, switches) eq 0 then break
test switches!0 eq 0 then sw =
PrePressWindowInit(str, true)
or test switches!1 eq $S then wf =
PrePressWindowInit(str, false)
or if switches!1 eq $O then sw =
PrePressWindowInit(str, true)
]ParamLoop repeat

if (fileflag ne 0) & (sw eq 0) then IllCommand()
if wf eq 0 then wf=PrePressWindowInit(-1,false)//CDtemp

let fn=vec IXLName
let ix=vec IXLMax
ReadIXTempFile(wf,fn,ix)//Read directory
let v = vec 4
//Make up vector (only really needed for fileflag=3)
v!0 = fileflag
v!1 = 0 // ASSUME no rotations. rotations will require a
// a new procedure since filefilag is our only parameter.
// (see mmfonts.c, the use of the switch)
v!4 = 0
PlayOutFont(v,ix,wf,sw)
if fileflag then WindowClose(sw,-1)
WindowClose(wf)
]

and

//PlayOutFont(opvec,ix,wf,sw)
//opvec!0 is file type:
//0Show chars on screen (sw=0)
//1Make CU file
//2Make AL file
//3Make MasterMaker file
//(opvec!1= rotation type
//(opvec!2←
//(opvec!3←
//(opvec!4= trantab
//if trantab=0, nothing special; otherwise,
//trantab is a 256-word table, trantab!i is char#
//to put in that position on output file
//This is for dummy font mapping .. WARNING:
//only bc to ec (from REAL font) will be put out.
//ix is IX entry for the font, in file wf
//sw is file to write goodies on

PlayOutFont(opvec,ix,wf,sw) be
[
WindowSetPosition(wf,lv ix>>IX.sa)
let bc=ix>>IX.bc
let ec=ix>>IX.ec
let nc=ec-bc+1
let siz=ix>>IX.siz

let WT=FSGetX(nc*CharWidthsize)
WindowReadBlock(wf,WT,nc*CharWidthsize)
let off=vec 1
WindowGetPosition(wf,off)//Offset for CD
let CD=FSGetX(nc*2)//For CD parts
WindowReadBlock(wf,CD,nc*2)

let minx=0; let miny=1000
let maxx=0; let maxy=-1000
let ALextnno=0//Count extensions for AL
let Wtotal=0; let HWtotal=0
let VarPitch=false; let fpch=0
let strikeWidth=0
let nLegalChars=0

for ch=0 to nc-1 do
[
let pch=WT+ch*CharWidthsize
unless pch>>CharWidth.H eq HNonExCode then
[// Find out max size.
nLegalChars=nLegalChars+1
let h=pch>>CharWidth.H
let w=pch>>CharWidth.W
let ox=pch>>CharWidth.XL
let oy=pch>>CharWidth.YB
if ox ls minx then minx=ox
if oy ls miny then miny=oy
if ox+w-1 gr maxx then maxx=ox+w-1
if oy+h-1 gr maxy then maxy=oy+h-1
let wx=RoundDp(lv pch>>CharWidth.WX)
if fpch ne 0 & fpch ne wx then VarPitch=#100000
fpch=wx
//Following computation will assume that the offset (minx) for the entire
// font is 0. We will fix up this assumption below.
strikeWidth=strikeWidth+((w gr wx)? w,wx)
ALextnno=ALextnno+(wx-1)/16
//Calculate the number of words and half-words required if this char
// is stored in full bit-map form (a la Alto)
let hw=(h+15)/16
let hhw=(h+7)/8
hw=hw*w
hhw=hhw*w//* number of scan lines
Wtotal=Wtotal+hw
HWtotal=HWtotal+hhw
]
]

//Now we are in a position to calculate various things.
//
Height=maxy-miny+1//Bounding box.
WordWidth=(maxx-minx+1+15)/16//No of words.
disHeight=(Height+1)𫙰//Even, for display
disWordWidth=(WordWidth+1)𫙰 //Even, for display
nBitsWords=disWordWidth*disHeight

//Type some stuff
TypeForm("Height=",10,Height,". Width=",10,WordWidth," words.*N*L")
TypeForm("SC: words: ",10,Wtotal,", bytes: ",10,HWtotal,".*N*L")
TypeForm("(0,0) point is at ",10,-minx,$,,10,-miny,0)

Bits=FSGetX(nBitsWords, true)
Zero(Bits, nBitsWords)//Zero it out.
let display=FSGetX(lDB, true)
display>>DB.next=0
display>>DB.resolution=1//Low resolution to see it
display>>DB.background=0
display>>DB.indentation=3
display>>DB.width=disWordWidth
display>>DB.bitMapAddress=Bits
display>>DB.height=disHeight//2* for double resolution.
if disWordWidth gr 18 then//Use high resolution.
[
display>>DB.resolution=0
display>>DB.height=disHeight/2
]

//Now link it in!
let olddisplayp=@DBptr
while olddisplayp>>DB.next ne 0 do
olddisplayp=olddisplayp>>DB.next
olddisplayp>>DB.next=display


//Do initial file processing
let fptr=nil
let curALextnno=nil
let trantab=nil
let mpCharPos=vec 500//For files with maps at front...

switchon opvec!0 into [
case 0:endcase
case 1:WindowWrite(sw,Height)//Height first
WindowWrite(sw,WordWidth)
endcase
case 2:[
//First two words are max height,
// then:
// VariablePitch bit 1
// BaseLine bit 7
// MaxWidth bit 8
WindowWrite(sw,maxy-miny+1)
WindowWrite(sw,VarPitch+(maxx-minx+1)+((maxy+1) lshift 8))
// Point everything at the dummy character
for i=0 to 255+ALextnno do
[
mpCharPos!i=256+ALextnno-i //Dummy char ptrs
WindowWrite(sw,0)
]
// Put out dummy character
WindowWrite(sw,1);WindowWrite(sw,0)
fptr=256+ALextnno+2
curALextnno=0
] ; endcase;
case 3:[
//strikeWidth may be too small if minx is <0 because each char will
// be offset in its box. Use nLegalChars+1 because of illegal char.
strikeWidth=strikeWidth+(-minx)*(nLegalChars+1)
let v=vec (size StrikeHeader/16)
Zero(v, size StrikeHeader/16)
v>>StrikeHeader.oneBit = 1
unless VarPitch then v>>StrikeHeader.fixed=1
v>>StrikeHeader.maxwidth=maxx-minx+1
v>>StrikeHeader.min=bc
v>>StrikeHeader.max=ec
WindowWriteBlock(sw, v, size StrikeHeader/16)
let w=vec (size StrikeBody/16)
Zero(w, size StrikeBody/16)
w>>StrikeBody.ascent=maxy+1
w>>StrikeBody.descent=-miny
w>>StrikeBody.xoffset=minx
// 4 is for illegal character
StrikeRaster=(strikeWidth+4+15)/16
let StrikeSize=StrikeRaster*Height
w>>StrikeBody.raster=StrikeRaster
w>>StrikeBody.length=(size StrikeBody/16)+
StrikeSize+nLegalChars+1
WindowWriteBlock(sw, w, size StrikeBody/16)
Strike=FSGetX(StrikeSize)
Zero(Strike, StrikeSize)
StrikeX=0
trantab=opvec!4
] ; endcase
]

//Now cycle through characters again, scan converting.

for ch=bc to ec do
[
let pch=WT+(ch-bc)*CharWidthsize
unless pch>>CharWidth.H eq HNonExCode then
[
SetPosRelative(wf,off,CD+(ch-bc)*2)
ShowChar(wf,ch,pch>>CharWidth.XL-minx,
pch>>CharWidth.YB-miny) //Put on screen.
let wx=RoundDp(lv pch>>CharWidth.WX) //Round width

switchon opvec!0 into [
case 0:[//Wait...
let foo=nil
TypeForm("Widths: ",3,lv pch>>CharWidth.WX,$,,
3,lv pch>>CharWidth.WY," ??",1,lv foo)
] ; endcase
case 1:[//Write stuff on file.
WindowWrite(sw,ch)
WindowWrite(sw,wx) //width
let p=Bits
for i=1 to Height do
[
WindowWriteBlock(sw,p,WordWidth)
p=p+disWordWidth
]
] ; endcase
case 2:[
let exc=(wx-1)/16
let h=pch>>CharWidth.H
let disp=Height+miny-pch>>CharWidth.YB-h
for i=0 to exc do [//Write an FCD
let p=Bits+i+(disp*disWordWidth)
for j=1 to h do
[ WindowWrite(sw,p!0); p=p+disWordWidth ]
fptr=fptr+h
test i eq 0
ifso [ mpCharPos!ch=fptr-ch ]
ifnot [ let t=256+curALextnno
mpCharPos!t=fptr-t
curALextnno=curALextnno+1 ]
test i eq exc
ifso [ WindowWrite(sw,wx*2+1) ]
ifnot [ WindowWrite(sw,(curALextnno+256)*2) ]
WindowWrite(sw,disp*256+h)
fptr=fptr+2
wx=wx-16
]
] ; endcase
case 3:[
let tc=ch-bc
mpCharPos!tc=StrikeX
RecordGlyph(opvec,pch,sw,minx,miny) //Record char
for i=tc+1 to 258 do mpCharPos!i=StrikeX
] ; endcase
] //switchon
]
] //for ch


//Now do post loop processing
switchon opvec!0 into
[
case 2:[
let old=vec 1
WindowGetPosition(sw, old)
WindowSetPosition(sw, table [ 0;2 ] )
WindowWriteBlock(sw, mpCharPos, 256+ALextnno)
if curALextnno ne ALextnno then
Scream("Extension counts do not match!")
WindowSetPosition(sw, old)
endcase
]
case 3:[
Zero(Bits, nBitsWords)//Prepare illchar
let w=vec size CharWidth/16
MoveBlock(lv w>>CharWidth.WX, (table [ 0;4 ] ), 2)
w>>CharWidth.XL=0
w>>CharWidth.YB=0
w>>CharWidth.W=4
w>>CharWidth.H=maxx
ShowLine(0,0,false,4)
ShowLine(0,maxx-1,false,4)
ShowLine(0,0,true,maxx)
ShowLine(3,0,true,maxx)
RecordGlyph(opvec,w,sw,0,0)//And write it out
mpCharPos!(nc+1)=StrikeX
WindowWriteBlock(sw, Strike, StrikeRaster*Height)
WindowWriteBlock(sw, mpCharPos, nc+2)
FSPut(Strike)
endcase
]
default:endcase
]



olddisplayp>>DB.next=0//No more display.

FSPut(Bits); FSPut(display)
FSPut(CD); FSPut(WT)
]

and

//Window w is positioned at the beginning of a CD
// character. Scan-convert it into the "bits"
// array.
// (x0,y0) is the address in the Bits array of the lower left corner
// of the bounding box.

ShowChar(w,c,x0,y0) be [
Zero(Bits, nBitsWords)//Zero it out

let d=WindowRead(w)//FHEAD
let hw=d<<FHEAD.hw
let ns=d<<FHEAD.ns
let wp=(Height-y0-1)*disWordWidth+Bits

let x=x0

for i=0 to ns-1 do
[//Process a scan line x+i
let wx=wp+(x rshift 4)//High bits (word #)
let lbx=x rem 16//Bit position
let NewBit=#100000 rshift lbx
for j=1 to hw do
[
d=WindowRead(w)
for k=0 to 15 do
[
if (d𘚠) ne 0 then @wx=@wx%NewBit
d=d lshift 1
wx=wx-disWordWidth
]
]
x=x+1
]
]

and

ShowBit(x,y,val; numargs n) = valof [
if y ls 0 % y ge Height then resultis 0
if x ls 0 % x ge disWordWidth*16 then resultis 0
let a=(Height-y-1)*disWordWidth+(x rshift 4)+Bits
let m=#100000 rshift (x)
if n eq 2 then resultis (@a &m)
@a=@a%m
]

and

ShowLine(x,y,vert,n) be [
for i=1 to n do
[
ShowBit(x,y,nil)
test vert then y=y+1 or x=x+1
]
]

and


// Master-Maker glyph maker

RecordGlyph(opvec,cw,wind,minx,miny) be [
let rot=opvec!1
let wb=cw>>CharWidth.W
let ws=cw>>CharWidth.H
let ob=cw>>CharWidth.XL
let os=cw>>CharWidth.YB
let wx=RoundDp(lv cw>>CharWidth.WX)
let rightmost=ob+wb
let wide=rightmost-minx
//minx=ob-minx//lower left of char box rel to
//miny=os-miny// screen area
//let rotateit=false
//if (rot&1) ne 0 then
//[
//rotateit=true
//let t=nil
//t=wb; wb=ws; ws=t
//t=ob; ob=os; os=t
//]
//s and b are relative to the bounding box of the character
// (so addr in screen area is b+minx s+miny)
let b,s=nil,nil
//Following line not right for rotations
b=0; s=Height-1

//switchon rot into
//[
//case 0:b=0; s=ws-1; endcase
//case 1:ob=-wb-ob; b=wb-1; s=ws-1; endcase
//case 2:ob=-wb-ob; os=-ws-os; b=wb-1; s=0; endcase
//case 3: os=-ws-os; b=0; s=0; endcase
//]
//
let porg=(StrikeX rshift 4)+Strike
let ts=s
for i=1 to Height do
[
let tb=b
let tx=StrikeX
let tp=porg
for j=1 to wide do
[
let biton=ShowBit(tb,ts)
if biton then @tp=@tp%(#100000 rshift tx)
tx=tx+1
if tx eq 16 then [ tx=0; tp=tp+1 ]
tb=tb+((b ne 0)? -1,1)
]
ts=ts+((s ne 0)? -1,1)
porg=porg+StrikeRaster
]
StrikeX=StrikeX+((wx gr wide)? wx,wide)
if StrikeX/16 gr StrikeRaster then Scream("Strike")
]