// look5.sr
// last modified
// RML add . for color, as opposed to color Tabs: September 21, 1977 4:42 PM
// PCL make color compatible with Sil: December 18, 1979 10:03 AM
get "BRAVO1.DF";
get "CHAR.DF";
get "MSG.DF";
get "NEWMSG.DF";
get "SELECT.DF";
get "COM.DF";
get "LOOK.DF";
// Incoming procedures
external [
SetRegionSys
updatedisplay
uc
bravochar
select
mapcp
SiPut
move
]
// Incoming statics
external [
selarg
vmapstatus
vlook1
vlook2
parsacred
ttblsacred
vofsetstd
vldlnstd
vldhdrstd
vdxtbStd
vfDiablomode
]
// Outgoing procedures
external [
FopLookAux
]
// Outgoing statics
// external
// Local statics
// static
// Local manifests
// manifest
// F O P L O O K A U X
let FopLookAux(pab, pfop, pard, ch) = valof
[
let fop = nil;
[
fop = selecton ch into
[
case $.: valof [
SetRegionSys(risysstate, 242) // "Type color..."
updatedisplay()
// Eventually this must be more sophisticated
let tc = colorInterpret(uc(bravochar()))
unless tc ge 0 do
[
rv pab = abIllParam
resultis fopNil
]
resultis iffTc lshift 8 + tc;
]
case $,: valof [
SetRegionSys(risysstate, 189) // "Type color..." for Tabs
updatedisplay()
let tch = uc(bravochar())
let tc = nil
test tch ge $0 & tch le $9 ifso
tc = tch - $0
ifnot test tch ge $A & tch le $F ifso
tc = tch - $A + 10
ifnot [
rv pab = abIllParam
resultis fopNil
]
resultis iffTc lshift 8 + tc;
]
case $A:
case $S: valof [
SetRegionSys(risyscom, 131)
SetRegionSys(risysstate, 132)
updatedisplay();
selarg>>SEL.type = snone
select(selarg, 0);
if bravochar() ne chesc then
resultis fopNil;
if selarg>>SEL.type eq snone then
resultis fopNil;
vmapstatus = statusblind;
mapcp(selarg>>SEL.doc, selarg>>SEL.cpfirst, true);
if ch eq $S then
[
pfop ! 1 = vlook1
pfop ! 2 = vlook2
resultis iffProcSameLooks lshift 8
]
unless parsacred>>PAR.fOldtab do
parsacred>>PAR.siTtbl = SiPut(siNil, ttblsacred)
let tpl = vec parovhd+1
tpl>>PL.cw = parovhd+1
move(parsacred, tpl+1, parovhd)
pfop ! 1 = SiPut(siNil, tpl)
resultis iffProcSamePar lshift 8
]
case $U: valof [
// if sel>>SEL.type eq sph then
// resultis fopNil
pfop ! 1 = vofsetstd
rv pard = table
[ 135 lshift 8 + 1 lshift 4 + 1;
ardStdY;
]
resultis iffSuper lshift 8
]
case $D: valof [
// if sel>>SEL.type eq sph then
// resultis fopNil
pfop ! 1 = vofsetstd
rv pard = table
[ 135 lshift 8 + 1 lshift 4 + 1;
ardStdY;
]
resultis iffProcSub lshift 8
]
case $Z: valof [
pfop ! 1 = -1
rv pard = table
[ 182 lshift 8 + 1 lshift 4 + 1;
ardStdY;
]
resultis iffProcYpos lshift 8
]
case $K: valof [
pfop ! 1 = 0
rv pard = table
[ 183 lshift 8 + 1 lshift 4 + 1;
ardStdY;
]
resultis iffYkeep lshift 8
]
case $X: valof [
pfop ! 1 = vldlnstd
rv pard = table
[ 139 lshift 8 + 1 lshift 4 + 1;
ardStdY;
]
resultis iffLdln lshift 8
]
// case $E:
case $Y: valof [
pfop ! 1 = vldhdrstd
rv pard = table
[ 140 lshift 8 + 1 lshift 4 + 1;
ardStdY;
]
resultis iffLdhdr lshift 8
]
case chtab: valof [
SetRegionSys(risysstate, 144)
updatedisplay()
let tch = uc(bravochar())
let tc = nil
test tch ge chitbMin & tch ls chitbMin+itbMax ifso
tc = tch - chitbMin + 1
ifnot test tch ge $1 & tch le $9 ifso
tc = tch - $0
ifnot test tch ge $A & tch le $F ifso
tc = tch - $A + 10
ifnot test tch eq $= ifso
[
pfop ! 1 = vdxtbStd
rv pard = table
[ 141 lshift 8 + 1 lshift 4 + 1;
ardStdX;
]
resultis iffProcDxtb lshift 8
]
ifnot [
rv pab = abIllParam
resultis fopNil
]
pfop ! 1 = xtbNil
rv pard = table
[ 142 lshift 8 + 1 lshift 4 + 1;
ardStdX;
]
resultis iffProcXtb lshift 8 + tc - 1
]
// case $\: valof [
// let ho = vec lnho
// augmentomseq("a*140")
// vmapstatus = statusblind
// mapcp(doc, 0, parneeded)
// test parsacred>>PAR.control ifso
// if CpParseDocProf(ho, doc, 0) eq cpnil then
// pfop = 0
// ifnot DefaultHo(ho)
// deactivateomseq("a*140", "a*140")
// if pfop ne 0 then
// [
// let xwEdgemarg = ho>>HO.xwEdgemarg
// let ccol = ho>>HO.ccol
// let tmod = nil
// let xwCol = divmod(xwPage -
// xwEdgemarg lshift 1 -
// mult(ccol-1, ho>>HO.xwMiddlemarg),
// ccol, lv tmod)
// pfop ! 1 = xwCol + xwEdgemarg
// pfop ! 2 = xwEdgemarg
// sel>>SEL.cpfirst = 0
// sel>>SEL.cplast = rgmaccp ! doc - dcpendofdoc - 1
// ]
// resultis iffProcColumn lshift 8
// ]
// case $|: valof [
// fUndo = true
// resultis iffProcColumn lshift 8
// ]
// case $T: valof [
// vmapstatus = statusblind
// mapcp(doc, sel>>SEL.cpfirst, parneeded)
//
// pfop ! 1 = parsacred>>PAR.xleftmarg
// let tard = table
// [ 145 lshift 8 + 1 lshift 4 + 1;
// ardStdX;
// ]
// let tab = AbGetArg(pfop, tard)
// if tab gr 0 then
// [
// ab = tab
// resultis fopNil
// ]
// if tab eq abSameAs then
// [
// unless parsacred>>PAR.fOldtab do
// pfop ! 1 = SiPut(siNil, ttblsacred)
// resultis iffProcTable lshift 8
// ]
// let xtbFirst = pfop ! 1
//
// pfop ! 2 = parsacred>>PAR.xrightmarg
// tard = table
// [ 146 lshift 8 + 2 lshift 4 + 2;
// ardStdX;
// ]
// let tab = AbGetArg(pfop, tard)
// if tab gr 0 then
// [
// ab = tab
// resultis fopNil
// ]
// if tab eq abSameAs then
// [
// unless parsacred>>PAR.fOldtab do
// pfop ! 1 = SiPut(siNil, ttblsacred)
// resultis iffProcTable lshift 8
// ]
//
// let ctb = nil
// augmentomseq("*140")
// let fGetInt = FGetUserInt(lv ctb, 147)
// deactivateomseq("*140", "*140")
// unless fGetInt do
// [
// ab = abIllParam
// resultis fopNil
// ]
// let tmod = nil
// let dxtb = divmod(pfop ! 2 - xtbFirst, ctb, lv tmod)
// let ttbl = vec lnttblMax
// let mpitbxtb = lv ttbl>>TTBL.ampitbxtb
// mpitbxtb ! 0 = xtbNil
// for itb = 0 to ctb-1 do
// mpitbxtb ! itb = xtbFirst + mult(itb, dxtb)
// ttbl>>TTBL.cw = ctb + 2
// pfop ! 1 = SiPut(siNil, ttbl)
// resultis iffProcTable lshift 8 + ufopFIncrement
// ]
case $?: iffQuery lshift 8 + 0
case $h: valof [
SetRegionSys(risyspast, (vfDiablomode ? 129, 130))
updatedisplay();
pfop ! 1 = true
resultis iffMagnify lshift 8
]
case $H: valof [
pfop ! 1 = false
resultis iffMagnify lshift 8
]
case $M: valof [
SetRegionSys(risysstate, 128)
let tch = -1;
[
SetRegionSys(risyspast, (vfDiablomode ? 129, 130))
updatedisplay();
if tch ne -1 then break;
tch = uc(bravochar())
test tch eq $H ifso
vfDiablomode = false
ifnot test tch eq $D ifso
vfDiablomode = true
// ifnot test tch ge $0 & tch le $9 ifso
// [
// vmagLook = mult(10,
// tch - (tch ls $5 ? $0-10, $0))
// if vmagLook eq 100 then
// vmagLook = 101
// break
// ]
ifnot
resultis fopNil
] repeat
pfop ! 1 = true
resultis iffMagnify lshift 8
]
default: valof [
let tch = uc(ch);
if tch ne ch then
[
ch = tch;
loop;
];
resultis fopNil;
]
];
break;
] repeat;
resultis fop;
] // end FopLookAux
and colorInterpret(str) = valof
[ // take the users description and turn it into internal form
// for now, the transformation is trivial
resultis selecton str into
[
case $A: 1 // Aqua
case $B: 0 // Black
case $C: 2 // Cyan
case $D: 3 // DarkBrown
case $G: 4 // Green
case $L: 5 // Lime
case $M: 6 // Magenta
case $O: 7 // Orange
case $P: 8 // Pink
case $R: 9 // Red
case $S: 10 // Smoke
case $T: 11 // Turquoise
case $U: 12 // UltraViolet
case $V: 13 // Violet
case $Y: 14 // Yellow
case $W: 15 // White
default: -1 // Unknown
]
]