// bcpl/f presseditfns.bcpl
// functions for pressedit
// Copyright Xerox Corporation 1979, 1980, 1981

// last edited by Lyle Ramshaw, May 29, 1982  2:40 PM
// last edited by Lyle Ramshaw, January 14, 1981  10:35 AM
// last edited by RML August 1, 1980  2:42 PM
// RML June 25, 1979  11:17 AM rotated fonts

get "presseditdefs.bcpl"
get "streams.d"

// outgoing procedures

external [
	FontFlag
	CopyString
	IsNumber
	IsDigit
	IsPressFile
	EqStr
	EqChar
	CheckFontEntry
	BlankSet
	CompareSets
	DecodeFontName
	GetFileLength
	WFACE
	AppendFace
	SetInFile
	DotsToMicas
	MicasToDots
	WMica
	CheckSwitches
	WritePresseditPrivate
	WriteFontSetCount
	WriteEndMessage
		// copied from pressio
	Error		// (string) does finish, types string
	FileError		// (name) does the same sort of thing
	min
	max
	abs
	nth		// (s,i) returns ith char of string s
	pnth		// (s,i,c) stores c at ith posn in s
	AppendChar	// (s,c) adds c after string s
	AppendString	// (s1,s2) adds s2 after s1
	radixconvert	// (s,n,r) appends n as string, radix r
			// after string s
	utilinit		// starts up scanconvert, muldiv
	FilePage		// (stream) gets position in pages
	PutPressDocDir
	PageNoFlag
	SetPageNo
	]

// outgoing statics

external [
	muldiv
	]

static	[
	muldiv
	]

// incoming procedures

external [
			// in new OS
	OpenFile
	Closes
	WriteBlock
	GetFixed
	FileLength
	PositionPage
	PositionPtr
	Zero
	MoveBlock
	Ws
	Wl
	Wns
	Puts
	FilePos
			// in Pressedit
	FindFamily
	]

// incoming statics

external [
	Debug
	dsp
	DocDirList
	PrivateStamp
	Merge
	OutDocDir
	pageNoStart
	pageNoX
	pageNoY
	pageNoOmit
	OutputFileName
	]

let FontFlag(swv) = valof [

	if swv!0 ne 1 then resultis false
	resultis (swv!1 eq $F % swv!1 eq $f)
	]

and CopyString(s) = valof [

	let lb=nth(s,0)/2+2	// one extra word for .
	let b=GetFixed(lb)
	MoveBlock(b, s, lb)
	resultis b
	]

and IsNumber(s,lvn) = valof [

	let n=0
	for i=1 to nth(s,0) do [
		let c=nth(s,i)-$0
		if c ls 0 % c gr 9 then resultis false
		n=10*n+c
		]
	@lvn=n
	resultis true
	]

and IsDigit(c) = c ge $0 & c le $9

and EqStr(s1,s2) = valof [

	for i=0 to nth(s1,0) do
		unless EqChar(nth(s1,i),nth(s2,i)) then resultis false
	resultis true
	]

and EqChar(c1,c2) = valof [

	if c1 eq c2 then resultis true
	if c1 ge $a & c1 le $z then c1=c1-#40
	if c2 ge $a & c2 le $z then c2=c2-#40
	resultis c1 eq c2
	]

and CheckFontEntry(evec) be [

	let erstr="unusual font entry"
	if evec>>FE.length ne FElen %
	   evec>>FE.set gr 63 % evec>>FE.fno gr 15 %
	   evec>>FE.face ge 255 then Error(erstr)
	]

and BlankSet(p) = valof [

	for i=0 to 15 do if p!i ne 0 then resultis false
	resultis true
	]

// returns -1 if totally different
// 0 if same
// 1 if fp includes tp
// 2 if tp includes fp
// 3 if neither includes other but union can be formed without reordering

and CompareSets(fp,tp) = valof [

	let tot=0
	for i=0 to 15 do if fp!i ne tp!i then [
		if fp!i ne 0 & tp!i ne 0 then resultis -2
		if fp!i eq 0 then tot=tot%2
		if tp!i eq 0 then tot=tot%1
		]
	resultis tot
	]

// decode name, put it at fp

and DecodeFontName(s,fp) be [
	manifest [
		scanFamily = 0
		scanSize= scanFamily+1
		scanRotation=scanSize+1
		scanFace=scanRotation+1
	]

	let family=vec 10
	let face=0
	let ptsize=0
	let rotn = 0

	Zero(family, 10)

	AppendChar(s,$.)		// all must contain .
	let state=scanFamily

	for j=1 to nth(s,0) do [
		let c=nth(s,j)	// char
		if c eq $. then break	// done
	switchon state into
		[
	case scanFamily:
		[
		test IsDigit(c)
		ifso	[
			state = scanSize; docase state
			]
		ifnot AppendChar(family,c)
		endcase
		]
	case scanSize:
		[
		test IsDigit(c)
		ifso ptsize=ptsize*10+c-$0
		ifnot test EqChar(c, $R)
		ifso	[
			state=scanRotation
			loop
			]
		ifnot	[
			state=scanFace
			docase state
			]
		endcase
		]
	case scanRotation:
		[
		test IsDigit(c)
		ifso rotn=rotn*10+c-$0
		ifnot	[
			state=scanFace
			docase state
			]
		endcase
		]
	case scanFace:
		[
		test EqChar(c, $R)
		ifso	[
			state=scanRotation
			docase state
			]
		ifnot face=face+selecton c into [
			case $B: case $b: 2
			case $C: case $c: 6
			case $E: case $e: 12
			case $I: case $i: 1
			case $L: case $l: 4
			default: 0
			]
		endcase
		]
		]
	]

	if family!0 eq 0 then
		Error(s," is not a well-formed font name")
	let fn=FindFamily(family)
	fp>>FONT.family=fn
	fp>>FONT.face=face
	fp>>FONT.ptsize=ptsize
	fp>>FONT.earsfont=false
	]

// get file pages, words into vector for POSITIONing

and GetFileLength(s,v) be [

	let x=vec 1
	FileLength(s,x)
	v!0=(x!0 lshift 7) + (x!1 rshift 9)
	v!1=(x!1 rshift 1)&#377
	]

and IsPressFile(fn) = valof [

	let ddv=DocDirList+fn*DDlen
	resultis ddv>>DD.pressfile ? true, false
	]

and WFACE(face) be [

	if face ge 18 then
		[  //funny TEX face
		Ws("F")
		Wns(dsp, face/2)
		if (face&1) ne 0 then Ws(".5")
		return
		]
	let v=vec 2; v!0=0
	AppendFace(v,face)
	Ws(v)
	]

and AppendFace(s,face) be [

	if (face rem 6)/2 ne 0 then
		AppendChar(s,(face rem 6)/2 eq 1 ? $B, $L)
	if (face rem 2) ne 0 then AppendChar(s,$I)
	if face/6 ne 0 then AppendChar(s,face/6 eq 1 ? $C, $E)
	]

// set input file to start of record rn

and SetInFile(s,ddv,rn,bn) be [

	test ddv>>DD.pref eq 0 & bn eq 0
	ifso [
		if rn ge ddv>>DD.nrecs then
			Error("trying to read beyond end of file")
		PositionPage(s,rn+1)
		]
	ifnot [
		PositionPage(s,rn+1+((bn+2*ddv>>DD.pref) rshift 9))
		PositionPtr(s,(bn+2*ddv>>DD.pref)&#777)
		]
	]

and DotsToMicas(x) = muldiv(x,127,25)

and MicasToDots(x) = muldiv(x+2,25,127)	// 2 to round

and WMica(m) be [

	let mils=muldiv(m,1000,2540)
	Wns(dsp, mils/1000)
	Puts(dsp, $.)
	if mils rem 1000 ls 100 then Puts(dsp, $0)
	if mils rem 1000 ls 10 then Puts(dsp, $0)
	Wns(dsp, mils rem 1000)
	]

and CheckSwitches(swv) be [

	PrivateStamp = 0
	for i = 1 to swv!0 do [
		let c = swv!i
		if c ge $a & c le $z then c = c - #40	// upper case
		if c eq $T % c eq $B % c eq $P then PrivateStamp = c
		if c eq $M  % c eq $A then Merge = c

		if c eq $D then Debug = c
		]
	if PrivateStamp eq $P & Merge ne 0 then
		Error("please merge first, page number afterwards in separate operations")
	]

and WritePresseditPrivate() be [

	let s=OpenFile("pressedit.private", ksTypeWriteOnly)
	let b=vec 255
	Zero(b,256)
	let t=table [ 16; 0; 127; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 ]
	MoveBlock(lv t>>FE.fam,"TIMESROMAN",6)
	t>>FE.face= PrivateStamp eq $P ? 0, 2	// regular, bold
	t>>FE.siz=10
	MoveBlock(b,t,FElen)
	if PrivateStamp ne $P then
		[
		MoveBlock(lv t>>FE.fam,"KEYHOLE",4)
		t>>FE.face=0
		t>>FE.siz=20
		t>>FE.fno=1
		MoveBlock(b+FElen,t,FElen)
		]
	WriteBlock(s, b, 256)
	Zero(b,256)
	b!0=1; b!1=0; b!2=1
	WriteBlock(s, b, 256)
	b>>DDV.passwd=Presspassword
	b>>DDV.nrecs=3
	b>>DDV.nparts=1
	b>>DDV.pdstart=1
	b>>DDV.pdrecs=1
	WriteBlock(s, b, 256)
	Closes(s)
	]

and WriteFontSetCount(fc) be [

	Wns(dsp,fc+1)
	Ws(" font set")
	if fc gr 0 then Puts(dsp,$s)
	Puts(dsp,$*N)
	]

and Error(s1,s2,s3; numargs na) be [

	Ws("*NError -- ")
	let nullstr=0		// empty string
	switchon na into [
		case 1:	s2=lv nullstr
		case 2:	s3=lv nullstr
		]
	Ws(s1)
	Ws(s2)
	Wl(s3)
	finish
	]

and FileError(n) = Error("cannot open file ",n)

// position in pages

and FilePage(s) = valof [

	let v=vec 2
	FilePos(s,v)
	resultis (v!0 lshift 7)+(v!1 rshift 9)
	]

// The usual

and abs(n) = ((n ls 0) ? -n, n)
and min(a,b) = (a gr b ? b, a)
and max(a,b) = (a gr b ? a, b)

// get nth char (n=i) of string s

and nth(s,i) = (((i&1) eq 1) ?
	s!(i rshift 1), (s!(i rshift 1) rshift 8))&#377

// store c at ith position in string s; enlarge as necessary

and pnth(s,i,c) be [
	let l=s!0 rshift 8
	if i gr l then s!0=(s!0&#377)+(i lshift 8)
	s=s+(i rshift 1)
	test (i&1) eq 1
	ifso s!0=(s!0&#177400)+c
	ifnot s!0=(s!0&#377)+(c lshift 8)
	]

// add char at end of string

and AppendChar(s,c) = pnth(s,nth(s,0)+1,c)

// add string s2 to s1

and AppendString(s1,s2) be [

	for i=1 to nth(s2,0) do AppendChar(s1,nth(s2,i))
	]

// append n to string s, converted to number in radix rad

and radixconvert(s,n,rad) be [
	let dn=n/rad
	if dn ne 0 then radixconvert(s,dn,rad)
	pnth(s,nth(s,0)+1,$0+(n rem rad))
	]

and utilinit() be [

	let t = table [
		#55001
		#155000
		#111000
		#102400
		#61020
		#31403
		#61021
		#101010
		#121000
		#171000
		#35001
		#1401
		]
	muldiv=t
 
	]

// put press doc dir in vector

and PutPressDocDir(ddv,fn,lvec) be [

	let d=DocDirList+fn*DDlen
	d>>DD.pressfile=true
	d>>DD.nrecs=ddv>>DDV.nrecs
	if d>>DD.nrecs ne lvec!0 then Error("bad record count")
	d>>DD.nparts=ddv>>DDV.nparts
	d>>DD.npages=ddv>>DDV.nparts-1	// guess
	d>>DD.pdstart=ddv>>DDV.pdstart
	d>>DD.pdrecs=ddv>>DDV.pdrecs
	if d>>DD.nrecs ne lvec!0 then Error("garbage precedes file")
	d>>DD.pref=0
	]

// check for page number parameter

and PageNoFlag(swv) = swv!0 ne 1 ? false, valof
	[
	let c = swv!1
	resultis EqChar(c, $S) % EqChar(c, $O) % EqChar(c, $X) % EqChar(c, $Y)
	]

and SetPageNo(swv, str) be
	[
	let c = swv!1
	if c ge $A & c le $Z then c = c + #40
	let n = nil
	if IsNumber(str, lv n) eq false then
		Error("page numbering switch should be preceded by a number")
	switchon c into
			[
		case $s: pageNoStart = n; endcase
		case $o: pageNoOmit = n; endcase
		case $x: pageNoX = muldiv(n, 2540, 100); endcase
		case $y: pageNoY = muldiv(n, 2540, 100); endcase
			]
	]

// write final message

and WriteEndMessage() be [

	let npages=OutDocDir>>DDV.nparts-1
	Puts(dsp, $*N)
	Wns(dsp, npages)
	Ws(" page")
	if npages ne 1 then Puts(dsp, $s)
	Ws(" written on ")
	Ws(OutputFileName)
	]