// sblooks.sr

// last modified
// RML September 28, 1977  9:30 AM - include Color response to Look ?
// PCL  December 18, 1979  11:56 AM - Make color response compatible to Sil

get "BRAVO1.DF"
get "ST.DF"
get "CHAR.DF"
get "MSG.DF"
get "DISPLAY.DF"


// Outgoing Procedures

external	[
	SbLooks
	SbPar
	]


// Outgoing Statics

// external


// Incoming Procedures

external	[
	stappend
	stnum
	abs
	SbSetSize
	stsize
	RoundRatio
	stput
	]


// Incoming Statics

// external


// Local Statics

// static


// Local Structures

// structure


// Local Manifests

// manifest


// S B   L O O K S

let SbLooks(sb, ch, look1, look2) = valof
[
rv sb = 0
let tsb = vec 5
if look1<<LOOK1.italic then
	stappend(sb, "Italic   ")
if look1<<LOOK1.boldface then
	stappend(sb, "Bold   ")
if look1<<LOOK1.ul then
	stappend(sb, "Underlined   ")
if look1<<LOOK1.visible then
	stappend(sb, "Visible   ")
if look1<<LOOK1.ovstrike then
	stappend(sb, "Overstruck   ")
if look1<<LOOK1.ext then
	stappend(sb, "Graphic   ")
stappend(sb, "Font: ")
stnum(tsb, look2<<LOOK2.fun)
stappend(sb, tsb)
stappend(sb, "   ")
let ofset = look2<<LOOK2.ofset + (look2<<LOOK2.ofsetsgn ? ofsetsgnext, 0)
if ofset ne 0 then
	[
	stappend(sb, (ofset gr 0 ? "Superscript: ", "Subscript: "))
	stnum(tsb, abs(ofset))
	stappend(sb, tsb)
	stappend(sb, "   ")
	]
let tc = look2<<LOOK2.tc
test ch eq chtab ifso
	[
	test tc eq tcPlain ifso
		stappend(sb, "Plain-tab   ")
	ifnot	[
		stappend(sb, "Tab-")
		let tcp = stsize(sb)
		stput(sb, tcp, (tc le 9 ? tc + $0, tc + $A - 10))
		SbSetSize(sb, tcp+1)
		stappend(sb, "   ")
		]
	]
ifnot
	[
	let tsb = "BACDGLMOPRSTUVYW"	//vec ??
//	maybe later will need something more elaborate
//	TcToSb(tsb, tc)
	stappend(sb, "Color: ")
	let tcp = stsize(sb)
	stput(sb, tcp, (tsb>>SB.ch ↑ tc))
	SbSetSize(sb, tcp+1)
	stappend(sb, "   ")
	];
SbSetSize(sb, stsize(sb)-3)
resultis sb
] // end SbLooks


// S B   P A R

let SbPar(sb, par, ttbl) = valof
[
rv sb = 0
let tsb = vec 5
let sbPt = "pt   "
let sbPtCr = "pt*c"

stappend(sb, "Margins:   ")
let xleftmarg = par>>PAR.xleftmarg
let xleftmargf = par>>PAR.xleftmargf
stnum(tsb, RoundRatio(xleftmargf, ptsperinch, xperinch), 10, 0, false, false, false)
test xleftmarg eq xleftmargf ifso
	[
	stappend(sb, "L: ")
	stappend(sb, tsb)
	stappend(sb, sbPt)
	]
ifnot	[
	stappend(sb, "F: ")
	stappend(sb, tsb)
	stappend(sb, sbPt)
	stappend(sb, "P: ")
	stnum(tsb, RoundRatio(xleftmarg, ptsperinch, xperinch), 10, 0, false, false, false)
	stappend(sb, tsb)
	stappend(sb, sbPt)
	]
stappend(sb, "R: ")
stnum(tsb, RoundRatio(par>>PAR.xrightmarg, ptsperinch, xperinch), 10, 0, false, false, false)
stappend(sb, tsb)
stappend(sb, sbPtCr)

stappend(sb, "Lead:   ")
stappend(sb, "X: ")
stnum(tsb, par>>PAR.lead)
stappend(sb, tsb)
stappend(sb, sbPt)
stappend(sb, "Y: ")
stnum(tsb, par>>PAR.parspacing)
stappend(sb, tsb)
let ypos = par>>PAR.ypos
if ypos ne -1 then
	[
	stappend(sb, sbPt)
	stappend(sb, "Vertical-tab: ")
	stnum(tsb, ypos, 10, 0, false, false, false)
	stappend(sb, tsb)
	]
stappend(sb, sbPtCr)

stappend(sb, "Tabs:   ")
test par>>PAR.fOldtab ifso
	[
	stappend(sb, "Plain-tabs: ")
	stnum(tsb, RoundRatio(par>>PAR.dxtb, ptsperinch, xperinch))
	stappend(sb, tsb)
	stappend(sb, sbPtCr)
	]
ifnot	[
	let mpitbxtb = lv ttbl>>TTBL.ampitbxtb
	for itb = 0 to ttbl>>TTBL.cw-2 do
		[
		let xtb = mpitbxtb ! itb
		if xtb eq xtbNil then loop
		let tc = itb + 1
		let tcp = stsize(sb)
		stput(sb, tcp, (tc le 9 ? tc + $0, tc + $A - 10))
		SbSetSize(sb, tcp+1)
		stappend(sb, ": ")
		stnum(tsb, RoundRatio(xtb, ptsperinch, xperinch), 10, 0, false, false, false)
		stappend(sb, tsb)
		stappend(sb, sbPt)
		]
	SbSetSize(sb, stsize(sb)-3)
	stappend(sb, "*c")
	]

let fClip = false
let ykeep = par>>PAR.ykeep
if ykeep ne 0 then
	[
	stappend(sb, "Keep: ")
	stnum(tsb, par>>PAR.ykeep, 10, 0, false, false, false)
	stappend(sb, tsb)
	stappend(sb, sbPt)
	fClip = true
	]
if par>>PAR.rj then
	[
	stappend(sb, "Justified   ")
	fClip = true
	]
if par>>PAR.center then
	[
	stappend(sb, "Centered   ")
	fClip = true
	]
if par>>PAR.control then
	[
	stappend(sb, "Profile   ")
	fClip = true
	]
if fClip then
	SbSetSize(sb, stsize(sb)-3)
resultis sb
] // end SbPar