// RSilWrite.bcpl --
get "AltoDefs.d"
get "sil.defs"
external// incoming procedures
[
// OS
Dvec
BitBlt
SetBlock
CharWidth
WriteString
newwrite
writeR270
writeR90
]
manifest
[
BankRegs=#177740
emulator=0
]
structure STRING [ length byte; char↑1,255 byte ]
let WriteString(ptr,x0,y0,type,font,WidthVec,rot,MagFlag) = valof
[
// rot : rotation 0,1,2,3 for 0, 90, 180 270 degree rotation
// type : bold bit ; italic bit
// calculate the bit length of the string
let string = lv(ptr>>item.string)
let Xo = x0+ptr>>item.xmin
let Yo = y0+ptr>>item.ymin
let Xc = x0+ptr>>item.xmax
let Yc = y0+ptr>>item.ymax
if Xo gr 574 % Yo ge 756 then resultis false
let length= getStringWidth(font,string) // init to softcopy width of the string
let charheight=xmload( font -2 ) // charheight=font!(-2)
let width=Xc-Xo
let height=Yc-Yo
let wordstart = DisplayArea + Yo*Nwrds
if rot eq 1 then
[
if Xc gr 574 then
[
ptr>>item.xmax = 574
ptr>>item.xmin = 574 - width
Xo = x0+ptr>>item.xmin
]
if Yc gr 760 then
[ ptr>>item.ymax = 760 - y0; Yc = 760 ]
wordstart = DisplayArea + Yc*Nwrds
]
let Xstart = Xo
if rot eq 2 then Xstart = Xc
// set up BBTable
let BBTable=vec lBBT
BBTable=BBTable+(BBTable&1)
Zero(BBTable,lBBT)
BBTable>>BBT.sBank=1// source is in alternate bank
BBTable>>BBT.dBank=0
BBTable>>BBT.op=1// paint
BBTable>>BBT.dbca=wordstart
BBTable>>BBT.dbmr=Nwrds
BBTable>>BBT.dlx=Xstart
BBTable>>BBT.sbmr=1
let MagArea = 0
if MagFlag then
[
let v = vec 150; MagArea = v; Zero(MagArea, 150)
]
let BoldFlag = (type & #2) eq #2
let ItalicFlag = (type & #1) eq #1
if ItalicFlag do Paint(ptr,toWhite,x0,y0)// italic
// Calculate max width and max height
let maxwidth = 576 - Xo
let maxheight = 756 - Yo
if rot eq 3 then// 270 degree rotation
[
maxwidth = 758 - Yo
maxheight = 576 - Xo
]
if rot eq 1 then// 90 degree rotation
[
maxwidth = 756 - Xo
maxheight = 576 - Yo
]
let WriteRountine = newwrite
let ItalicWrite = WriteItalic
if rot eq 1 then// 90 degree rotation
[
WriteRountine = writeR90
ItalicWrite = WriteItalicR270
]
if rot eq 3 then// 270 degree rotation
[WriteRountine = writeR270
ItalicWrite = WriteItalicR270
]
// now put it out
let ItemWidth = WriteRountine(BBTable, string, font, maxwidth, maxheight, WidthVec, rot, MagFlag, MagArea, Yo, type )
if HardCopy then length = ItemWidth
if BoldFlag & ( rot ne 0 ) do// bold
[
if rot eq 0 then BBTable>>BBT.dlx=Xstart+1
if rot eq 1 then
[
BBTable>>BBT.dbca=DisplayArea + (Yc-1)*Nwrds
BBTable>>BBT.dlx=Xstart
]
if rot eq 2 then BBTable>>BBT.dlx=Xstart-1
if rot eq 3 then BBTable>>BBT.dbca=DisplayArea + (Yo+1)*Nwrds
WriteRountine(BBTable, string, font, maxwidth, maxheight, WidthVec, rot, MagFlag, MagArea, Yo )
]
if ItalicFlag do// italic
[
// range check
let len = length
if len gr maxwidth -2 then len = maxwidth -2
ItalicWrite(BBTable,Xo,Yo,len,charheight, MagFlag)
length = length + 2
]
if rot eq 3 then
[
let rotatedwidth = MaxStringHeight
MaxStringHeight = ItemWidth
resultis rotatedwidth
]
if rot eq 1 % rot eq 2 then length = ItemWidth
resultis length
]
//----------------------------------------------------------------------------
and WriteItalic(BBTable,Xo,Yo,width,charheight, MagFlag) be
//----------------------------------------------------------------------------
[
let MagFactor = 1
if MagFlag then
[
MagFactor = Mag
Xo = (Xo - WindowXmin)*MagFactor
Yo = (Yo - WindowYmin)*MagFactor
width = width*MagFactor
let extent = Xo + 3*MagFactor + width
if extent gr 576 then width = 576 - Xo - 3*MagFactor
]
let segment = (charheight*MagFactor+3)/4
BBTable>>BBT.sBank=0// source is in normal bank
BBTable>>BBT.op= 0 //replace
BBTable>>BBT.sbca=DisplayArea
BBTable>>BBT.sbmr=Nwrds
BBTable>>BBT.slx=Xo
BBTable>>BBT.sty=Yo
BBTable>>BBT.dbca=DisplayArea
BBTable>>BBT.dbmr=Nwrds
BBTable>>BBT.dlx=Xo + 3*MagFactor
BBTable>>BBT.dty=Yo
BBTable>>BBT.dw=width
BBTable>>BBT.dh=segment
BitBlt(BBTable)
BBTable>>BBT.sty=Yo + segment
BBTable>>BBT.dlx=Xo + 2*MagFactor
BBTable>>BBT.dty=Yo + segment
BitBlt(BBTable)
BBTable>>BBT.sty=Yo + segment + segment
BBTable>>BBT.dlx=Xo + 1*MagFactor
BBTable>>BBT.dty=Yo + segment + segment
BitBlt(BBTable)
// Now erase the dirt
BBTable>>BBT.dlx=Xo
BBTable>>BBT.dty=Yo
BBTable>>BBT.sty=Yo
BBTable>>BBT.dw=3*MagFactor
BBTable>>BBT.dh=segment
BBTable>>BBT.op= 2 //invert , therefore erase
BitBlt(BBTable)
BBTable>>BBT.dty=Yo + segment
BBTable>>BBT.sty=Yo + segment
BBTable>>BBT.dw=2*MagFactor
BitBlt(BBTable)
BBTable>>BBT.dty=Yo + segment+ segment
BBTable>>BBT.sty=Yo + segment + segment
BBTable>>BBT.dw=1*MagFactor
BitBlt(BBTable)
]
//----------------------------------------------------------------------------
and WriteItalicR270(BBTable,Xo,Yo,width,charheight, MagFlag) be
//----------------------------------------------------------------------------
[
let segment = (charheight+3)/4
BBTable>>BBT.sBank=0// source is in normal bank
BBTable>>BBT.op= 0 //replace
BBTable>>BBT.sbca=DisplayArea
BBTable>>BBT.sbmr=Nwrds
BBTable>>BBT.slx=Xo + segment
BBTable>>BBT.sty=Yo
BBTable>>BBT.dbca=DisplayArea
BBTable>>BBT.dbmr=Nwrds
BBTable>>BBT.dlx=Xo + segment
BBTable>>BBT.dty=Yo + 1
BBTable>>BBT.dw=segment
BBTable>>BBT.dh=width
BitBlt(BBTable)
BBTable>>BBT.slx=Xo + segment + segment
BBTable>>BBT.dlx=Xo + segment + segment
BBTable>>BBT.dty=Yo + 2
BitBlt(BBTable)
BBTable>>BBT.slx=Xo + segment + segment + segment
BBTable>>BBT.dlx=Xo + segment + segment + segment
BBTable>>BBT.dty=Yo + 3
BitBlt(BBTable)
// Now erase the dirt
BBTable>>BBT.slx=Xo + segment
BBTable>>BBT.sty=Yo
BBTable>>BBT.dlx=Xo + segment
BBTable>>BBT.dty=Yo
BBTable>>BBT.dw=segment
BBTable>>BBT.dh=1
BBTable>>BBT.op= 2 //invert , therefore erase
BitBlt(BBTable)
BBTable>>BBT.slx=Xo + segment+ segment
BBTable>>BBT.dlx=Xo + segment+ segment
BBTable>>BBT.dh=2
BitBlt(BBTable)
BBTable>>BBT.slx=Xo + segment+ segment+ segment
BBTable>>BBT.dlx=Xo + segment+ segment+ segment
BBTable>>BBT.dh=3
BitBlt(BBTable)
]
//----------------------------------------------------------------------------
and getStringWidth(font, char) = valof
//----------------------------------------------------------------------------
[
let w, cw = 0, nil
if (char & 177400b) ne 0 then
[
for i = 1 to char>>STRING.length do
w = w + getStringWidth(font, char>>STRING.char↑i)
resultis w
]
//if font>>DSS.type eq stTypeDisplay then font = font>>DSS.pfont
//if font!-2 ls 0 then font, w = font!-1, 1
let fontminustwo = xmload(font-2)
if fontminustwo ls 0 then
[
w = 1
let fontminusone = xmload(font-1)
font = fontminusone
]
[
// cw = font!(font!char+char)
let charptr = xmload(font+char) + char
cw = xmload(font+charptr)
if (cw & 1) ne 0 then break
w, char = w+16, cw rshift 1
] repeat
resultis w + cw rshift 1
]