// P L A Y O U T (PREPRESS)
// Bcpl/f PlayOut.Bcpl

//Modified August 18, 1980 9:35 PM by Lyle Ramshaw,
// Fixed calculation of Length field in .Strike header.
// The old code used "nLegalChars" where it should have been
// just "nc", since even non-existent characters have pointers
// in the index table.

//Modified June 17, 1980 3:05 PM by Lyle Ramshaw,
// The ALextnno variable isn’t needed by Show at all, but
// is used to determine how much storage to allocate; thus,
// it is important that it not be complete garbage...

//Modified May 23, 1980 11:06 AM by Lyle Ramshaw, PARC
// Made MakeAL pay attention to the "Clipped" flag as well,
// so that rotated AL fonts will get the right rasters at
// least (for HSIL, an XEOS hack).

//Modified April 22, 1980 10:33 AM by Lyle Ramshaw, PARC
// Due to introduction of the new .KS format for Kerned Strikes,
// the Kerned flag is hereby decommissioned. MakeStrike now
// has a "Clipped" flag instead: if Clipped is false (the default)
// the widths of overhanging characters are artificially
// increased just enough to eliminate overhang. If Clipped is
// true, the overhanging bits are ignored, and the width
// is not affected.

//Modified March 1, 1980 9:54 PM by Lyle Ramshaw
// Fixing the width calculations in the MakeStrike code. Whoever
// wrote that code seems to have assumed that the X component of the width
// vector and the X length of the bounding box were measured from the
// same origin: but they aren’t. Hence the need for a fix.

// modified January 15, 1980 6:11 PM by Kerry A. LaPrade, XEOS
// Abort out of show command with DEL key.
//
// modified by Lyle Ramshaw, October 2, 1979 4:04 PM:
//fix bug in VarPitch computation

get "GoodFoo.d"
get "ix.dfs"

// outgoing procedures
external
[
PlayOut
PlayOutFont
]

// outgoing statics
external
[ @Clipped
]
static
[ @Clipped=false//true if overhanging bits should be removed
]

// 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
]

// 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
@StrikeMaxWX// maximum x dimension of block in the Strike
@Strike//Pointer to strike memory
@StrikeRaster//# words per scan line in strike
@StrikeX//Last x used in Strike
@illCharWX// WX of illegal character
]

// 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,wf,sw;numargs na) be
[ switchon na into
[ case 1: sw=0;wf=0;endcase
case 2: wf=PrePressWindowInit(wf,false);sw=0;endcase
default: wf=PrePressWindowInit(wf,false)
sw=PrePressWindowInit(sw,true)
endcase
]

[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)//ACtemp

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
[
if ix>>IX.Type ne IXTypeChars then
Scream("PlayOutFont called with wrong input type")
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 AC
let AC=FSGetX(nc*2)//For AC parts
WindowReadBlock(wf,AC,nc*2)

StrikeMaxWX=0
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=nil; let SeenALegal=false
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.
let h=pch>>CharWidth.H
let w=pch>>CharWidth.W
if (h eq 0)%(w eq 0) then //sanitize empty character
[
pch>>CharWidth.H=0
pch>>CharWidth.W=0
pch>>CharWidth.XL=0
pch>>CharWidth.YB=0
]
let ox=pch>>CharWidth.XL
let oy=pch>>CharWidth.YB
if ox ls minx then minx=ox
if (opvec!0 eq 3)&(ox ls 0) then Scream("Illegal x offset (<0)")
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
]
]

//now, loop through again to handle various width details
for ch=0 to nc-1 do
[
let pch=WT+ch*CharWidthsize
unless pch>>CharWidth.H eq HNonExCode then
[
nLegalChars=nLegalChars+1
let h=pch>>CharWidth.H
let w=pch>>CharWidth.W
let ox=pch>>CharWidth.XL
let oy=pch>>CharWidth.YB
let wx=RoundDp(lv pch>>CharWidth.WX)
let myWidth, effectiveWidth=nil,nil
let extcnt=0
switchon opvec!0 into
[
case 2:effectiveWidth=(Clipped?wx,Max(wx, w+ox-minx))
extcnt=(effectiveWidth-1)/16
myWidth=(Clipped?wx, Max(wx,extcnt*16))
endcase
case 3: myWidth=(Clipped?wx,Max(w+ox, wx))//.Strike
endcase
default: myWidth=wx
endcase
]
strikeWidth=strikeWidth+myWidth
StrikeMaxWX=Max(StrikeMaxWX, myWidth)
if SeenALegal & (fpch ne myWidth) then VarPitch=#100000
unless SeenALegal do [ SeenALegal=true; fpch=myWidth ]
ALextnno=ALextnno+extcnt
//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.
//
if (opvec!0 eq 3) then
[
illCharWX=(VarPitch ? 6,fpch)
minx=0 //Strike spaces by origin and width vec.
if (miny gr 0) then miny=0 //For illchar
if (maxy ls 2) then maxy=2 //For illchar
]
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=FSGetX(259+ALextnno)//For files with maps at front...
Zero(mpCharPos, 259+ALextnno)

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:[
// Use nLegalChars+1 because of illegal char.
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=StrikeMaxWX
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=0//always zero according to new rules
StrikeRaster=(strikeWidth+illCharWX+15)/16
let StrikeSize=StrikeRaster*Height
w>>StrikeBody.raster=StrikeRaster
w>>StrikeBody.length=(size StrikeBody/16)+
StrikeSize+nc+2
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,AC+(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)
TypeForm("Widths: ",3,lv pch>>CharWidth.WX,$,,
3,lv pch>>CharWidth.WY," ??")
Wl("")
if Gets(keys) eq 177b then break
] ; 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 effectiveWidth, exc=nil,nil
effectiveWidth=
(Clipped?wx,Max(wx, pch>>CharWidth.W+pch>>CharWidth.XL-minx))
exc=(effectiveWidth-1)/16
wx=(Clipped?wx, Max(wx,exc*16))
let h=pch>>CharWidth.H
let disp=Height+miny-pch>>CharWidth.YB-h
for i=0 to exc do [//Write an FAC
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
let illx=vec 1
illx!0=illCharWX; illx!1=0;
MoveBlock(lv w>>CharWidth.WX, illx, 2)
MoveBlock(lv w>>CharWidth.WY, (table [ 0;0 ] ), 2)
w>>CharWidth.XL=1
w>>CharWidth.YB=0
w>>CharWidth.W=Min(4,illCharWX-1)
w>>CharWidth.H=maxy+1
ShowLine(1,0,true,maxy+1)
ShowLine(2,0,true,maxy+1)
ShowLine(3,0,true,maxy+1)
ShowLine(4,0,true,maxy+1)
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(AC); FSPut(WT)
]

and

//Window w is positioned at the beginning of a AC
// 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 [
if minx ne 0 then Scream("Problem with x offset in MakeStrike.")
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=(Clipped? Min(rightmost,wx), rightmost)
//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+(Clipped? wx, Max(wx,rightmost))
if StrikeX/16 gr StrikeRaster then Scream("Strike overflow.")
]