//SilColor.bcpl added to SilToPress for handeling color sil files.
//R. Bates modified on February 15, 1978 to print color
//R. Bates modified on March 16, 1978 to put file name in Sil.Press+colored backgrounds
get "Sil.defs"
external [ PUTB; dsp; MulDiv ]
manifest
[
SetHue = #371
SetSaturation = #372
SetBrightness = #370
]
static
[
@HueTable=0; @SatTable=0; @BrightTable=0
@Color; @Hue; @Saturation; @Brightness
@LastColor; @LastHue; @LastSaturation; @LastBrightness
]
let SetEntityColor(S,item,macroitem) be
[
if macroitem then test macroitem>>item.color ne Black
ifso Color = macroitem>>item.color
ifnot Color = item>>item.color
if item>>item.font eq 15 then Color = Color + 16
if Color eq LastColor then return//no change - nothing to do
Hue = HueTable!Color
Saturation = SatTable!Color
Brightness = BrightTable!Color
if Hue ne LastHue then [ PUTB(S,SetHue); PUTB(S,Hue) ]
if Saturation ne LastSaturation then [ PUTB(S,SetSaturation); PUTB(S,Saturation) ]
if Brightness ne LastBrightness then [ PUTB(S,SetBrightness); PUTB(S,Brightness) ]
LastColor = Color
LastHue = Hue
LastSaturation = Saturation
LastBrightness = Brightness
]
and CheckColorCmmd(comcm,fn,Host,File) be
[
let InitedTable = false
let bgnd = 0
let clr = true
[
let ln = fn>>str.length
if fn>>str.char↑(ln-1) ne $/ then return
let num = -1
if fn>>str.char↑1 le $9 then num = GetNum(fn,-1)
//specify a Magnification for press conversion (num = "X.Y")
if fn>>str.char↑ln eq $z then if num ge 1 then
[ //be prepaired to handle a decimal fraction i.e. 1.37/z
let scalor = 1; let fraction = false
for c = 1 to fn>>str.length do
[
let chr = fn>>str.char↑c
if chr eq $. then fraction = true
if (fraction eq true) & (chr ge $0) & (chr le $9) then scalor = scalor*10
]
C50 = MulDiv(C50dflt,scalor,num)
]
if num gr 255 then num = 255 //guard against unreasonable values
//specify a host destination for empress
if fn>>str.char↑ln eq $h then if num eq -1 do MoveBlock(Host,fn,50)
//specify a file name for output
if fn>>str.char↑ln eq $f then test PressS eq 0 //must be before Sil.press is open
ifnot
[
Ws("*nOutput in Sil.Press: ")
Ws(fn);Ws(" must come before any printing files")
@#420 = Dcb
]
ifso //place just the name (no /f) into File
[
File!0=0
for i = 1 to fn>>str.length do
[ let c = fn>>str.char↑i; if c eq $/ then break; AppendC(c,File) ]
]
//specify a copies count for empress
if fn>>str.char↑ln eq $c then if num ge 0 then ncopies = num
//specify an X-offset for press conversion
if fn>>str.char↑ln eq $x then if num ne -1 then Xmargin = Lmargin+num
//specify a Y-offset for press conversion
if fn>>str.char↑ln eq $y then if num ne -1 then Ymargin = num
//default all color values of objects and backgrounds
if fn>>str.char↑ln eq $i then InitColorTable(0)
//about to specify parameters for Objects (lines & text) with color clr
if fn>>str.char↑ln eq $o then
[ clr=GetColor(fn>>str.char↑1); bgnd = 0 ]
//about to specify parameters for backgrounds with color clr
if (fn>>str.char↑ln eq $b) & (num eq -1) then
[ clr=GetColor(fn>>str.char↑1); bgnd = 16 ]
if num ge 0 then //process the value
[
if not InitedTable then [ InitColorTable(0); InitedTable = true ]
test clr eq true //were talking about all backgrounds
ifso
[
if num eq 0 then BackGndEn = 0//disable backgrounds
if fn>>str.char↑ln eq $s then for i = 16 to 31 do SatTable!i = num
if fn>>str.char↑ln eq $b then for i=16 to 31 do BrightTable!i=num
//patch the Black and White entries to make them what we expect
SatTable!(White+16) = 0
SatTable!(Black+16) = 0
BrightTable!(Black+16) = 255-num
]
ifnot //were talking about a specific color or background
[
test clr ge 16
ifso [ Ws("*n’ "); Puts(dsp,clr); Ws("’ is an invalid color") ]
ifnot
[
if fn>>str.char↑ln eq $h then HueTable!(clr+bgnd) = num
if fn>>str.char↑ln eq $s then SatTable!(clr+bgnd) = num
if fn>>str.char↑ln eq $b then BrightTable!(clr+bgnd) = num
]
]
]
if not ReadCmEntry(comcm,fn) then [ fn>>str.length = 0; return ] //no more files
if fn>>str.length eq 0 then return
] repeat
]
and InitColorTable(level) be
[
if level ne 0 then
[ LastColor = Black; LastHue = 0; LastSaturation = 0; LastBrightness = 0; return ]
if HueTable eq 0 then
[
HueTable = GetSomeMem(32)
SatTable = GetSomeMem(32)
BrightTable = GetSomeMem(32)
]
BackGndEn = true//this is a flag to enable backgrounds
//first set tables to their most common value
for i = 0 to 15 do [ HueTable!i = 0; SatTable!i = 255; BrightTable!i = 255 ]
//now specifically set the variations to the above default values
SatTable!Black = 0; BrightTable!Black = 0
HueTable!Red = 0
HueTable!Yellow = 40
HueTable!Green = 80
HueTable!Cyan = 120
HueTable!Violet = 160
HueTable!Magenta = 200
SatTable!White = 0
HueTable!Brown = 5; BrightTable!Brown = 90
HueTable!Orange = 20
HueTable!Lime = 60
HueTable!Turquoise = 100
HueTable!Aqua = 140
HueTable!UltraViolet = 180
HueTable!Pink = 220; SatTable!Pink = 128
SatTable!Smoke = 0; BrightTable!Smoke = 192
//now make backgrounds identical to objects
MoveBlock(HueTable+16, HueTable, 16)
MoveBlock(SatTable+16, SatTable, 16)
MoveBlock(BrightTable+16, BrightTable, 16)
]