// ConvertColor.bcpl -- scan conversion color setup // errors 800 // This module is responsible for implementing the color functions. // When a "set color" command is read from a PD file, the // main loop builds a "color leftover" structure (LOCxxx). // // The procedure ColorSet is responsible for establishing a new // color leftover description as the current color. It sets some state // variables (colorType, colorTransparent), and decides whether this // color will be leftover into the next band (colorLeftover=true). // // The leftover machinery is actually responsible for writing into // the leftover file the color leftover. The reason is that not all // potentially leftover colors need to be written. For example, consider // the PD file that contains: // 1. setColor // 2. maskRectangle // 3. setColor // 4. maskTrapezoid // If the rectangle terminates in this band, the color set on line 1 need // not be carried forward in the leftovers. // // The procedure ColorGetLine(s) is then called by the mask-putting // routines to set up the vector colorLine with a full scan-line's worth // of color data. In simple cases, (colorInk and colorClear), this procedure // need not be called at all. get "PDInternals.d" get "PDConvert.d" get "AltoDefs.d" // outgoing procedures external [ ColorInit ColorFinish ColorSet ColorGetLine ] // incoming procedures external [ //ConvertUtils LoadRead LoadReadBlock GetBBT PutBBT //ConvertPut PutNewColor //PDPRINT FSGetX FSPutZ PDError //PDML MulDivT MulMod MulFull BitBLT Zero MoveBlock SetBlock ] // incoming statics external [ SMin FMin FMax FWC LOSizes LOProcs colorLine colorType colorTransparent colorParams colorLeftover ] // internal statics static [ colorBuf //Single scan-line buffer bbc //BitBLT table ] // ColorInit() // Set up buffers, etc. for Color routines let ColorInit() be [ LOSizes!loColorInk=size LOC/16 LOSizes!loColorClear=size LOC/16 LOSizes!loColorTile=size LOCTile/16 LOProcs!loColorInk=ColorSet LOProcs!loColorClear=ColorSet LOProcs!loColorTile=ColorSet colorLine=FSGetX(FWC) colorBuf=FSGetX(FWC) //single scan-line buffer for color // Obtain color leftover block colorParams=FSGetX(loColorSize) // Make up BitBlt control table for filling colorLine bbc=GetBBT() bbc>>BBT.sType=sBM bbc>>BBT.op=fReplace bbc>>BBT.dbca=colorLine bbc>>BBT.dbmr=FWC // bbc>>BBT.dty=0 bbc>>BBT.dh=1 //single scan-line in destination bbc>>BBT.sbca=colorBuf bbc>>BBT.sbmr=FWC // bbc>>BBT.sty=0 ] and ColorFinish() be [ FSPutZ(lv colorLine) FSPutZ(lv colorBuf) FSPutZ(lv colorParams) PutBBT(lv bbc) ] // ColorSet(v, first) is called by PD reader or leftover reader to set new color. // v has a color leftover description in it. If "first" is true (default=false) // initializes color stuff (ink to black, force leftover) and ColorSet(v, first; numargs na) = valof [ let typ=v>>LOC.typ MoveBlock(colorParams, v, LOSizes!typ) // If the color is simple and the same as before, no need for new leftover if na eq 1 & first eq false & typ ne loColorTile & typ eq colorType then resultis false colorType=typ colorTransparent=(typ eq loColorTile)? v>>LOCTile.transparent, false colorLeftover=true // Announce new color to Put routines PutNewColor() resultis false //Never any leftovers done this way ] //ColorGetLine(s) // Fill colorLine with one scan-line of color data for the band-relative // scan-line s. Not called on simple colors (i.e., loColorInk and loColorClear) and ColorGetLine(s) be [ s=s+SMin //now absolute s rather than band-relative let addr=colorParams>>LOCTile.addr compileif offset Tile.phase ne 0 then [ foo=nil ] compileif offset Tile.sMin ne 16 then [ foo=nil ] compileif offset Tile.fMin ne 32 then [ foo=nil ] compileif offset Tile.sSize ne 48 then [ foo=nil ] compileif offset Tile.fSize ne 64 then [ foo=nil ]; let phase,sMin,fMin,sSize,fSize=nil,nil,nil,nil,nil LoadReadBlock(addr, lv phase, 5) addr=addr+5 //Check for simple, inkwell case if fSize eq 16 & sSize eq 16 & phase eq 0 then [ SetBlock(colorLine, LoadRead(addr+(s)), FWC) return ] if fSize eq 0 % sSize eq 0 then PDError(801) // If fMin lies below FMin, bump it up while fMin uls FMin do fMin=fMin+fSize fMin=fMin-FMin // Compute sDiff, distance from sMin to our scan-line let negg=(sMin ugr s) let sDiff=s-sMin; if negg then sDiff=-sDiff // Compute sRem, the scan-line within tile to use. let sRem=MulMod(1, sDiff, sSize) if negg then sRem=sSize-sRem-1 // Compute f, 0 le f ls fSize, to offset (second) tile vertically let f=MulMod(1, fMin, fSize) //Phase of home tile let nTiles=MulDivT(1, sDiff, sSize) //Number of tiles displaced // Note: Must not use MulDiv, which rounds! let df=nil test negg then df=MulMod(nTiles+1, fSize-phase, fSize) or df=MulMod(nTiles, phase, fSize) f=f+df if f ugr fSize then f=f-fSize // Now get sRem'th scan line in colorBuf let d=vec 1 let colWC=(fSize+15) rshift 4 MulFull(sRem, colWC, d) LoadReadBlock(addr+d!1, colorBuf, colWC) // Test for simple optimization test f eq 0 & fSize eq 16 then SetBlock(colorLine, colorBuf!0, FWC) or [ // Put first fragment of 'f' bits into colorLine if f ne 0 then [ bbc>>BBT.dlx=0 bbc>>BBT.dw=f bbc>>BBT.slx=fSize-f BitBLT(bbc) ] // Now loop, copying 'fSize' bits at a time, until the line is full, or // the repeating pattern occupies an integral number of words bbc>>BBT.slx=0 let fcount=FMax-FMin+1 let frag=f // size of first fragment while f ne fcount do [ let w=fSize let fnext=f+fSize if ((fnext-frag)%15) eq 0 then fcount=fnext-frag if f+w ugr fcount then w=fcount-f bbc>>BBT.dlx=f bbc>>BBT.dw=w BitBLT(bbc) f=f+w ] // Replicate the initial pattern to finish the line let wordsDone=fcount rshift 4 // number of words filled let wordsLeft=FWC-wordsDone // number of words to go if wordsLeft ugr 0 then [ MoveBlock(colorLine+wordsDone, colorLine, wordsLeft) ] ] ]