<> <> <> <> <<>> DIRECTORY Basics USING [BITOR, BYTE], Atom USING [PutPropOnList, GetPropFromList, PropList], Terminal USING [Virtual, FrameBuffer, GetColorBitmapState, GetColorFrameBufferA, GetColorFrameBufferB, GetBWFrameBuffer, Current, ModifyColorFrame], Imager USING [Context], ImagerRasterPrivate USING [Data], ImagerPixelMap USING [DeviceRectangle], SampleMapOps USING [Create, SampleMap, SubMap, Transfer, GetSample, PutSample, Fill, FromVM, FromSubMap, Get, Put, Function, Buffer, ObtainBuffer, SampleMapRep], ImagerColor USING [RGB], Pixels USING [ErrorDesc, Extent, PixelBuffer, SampleSet, SampleSetSequence, SubMap, SubMapSequence ]; PixelsImpl: CEDAR PROGRAM IMPORTS Basics, Atom, SampleMapOps, Terminal EXPORTS Pixels ~ BEGIN OPEN Pixels; <> BYTE: TYPE ~ Basics.BYTE; RGB: TYPE ~ ImagerColor.RGB; SampleSet: TYPE ~ Pixels.SampleSet; SampleSetSequence: TYPE ~ Pixels.SampleSetSequence; SubMapSequence: TYPE ~ Pixels.SubMapSequence; PixelBuffer: TYPE ~ Pixels.PixelBuffer; Extent: TYPE ~ Pixels.Extent; PixelsError: PUBLIC SIGNAL [reason: Pixels.ErrorDesc] = CODE; SubMap: TYPE ~ Pixels.SubMap; <> <> <> <<];>> SampleMap: TYPE ~ SampleMapOps.SampleMap; <> <> <> <> <> <> <> <> <<];>> <<>> <> XfmMapPlace: PUBLIC PROC [ map: SubMap, x, y: INTEGER ] RETURNS [newX, newY: INTEGER] ~ { x _ map.df * (x + map.subMap.start.f); y _ MAX[0, INTEGER[map.subMap.size.s]-1 - y + map.subMap.start.s]; RETURN [ newX: x, newY: y ]; }; ByteAvrgWgtd: PUBLIC PROC[ b1, b2, wgt: BYTE ] RETURNS[ bOut: BYTE ] ~ { bOut _ ( CARDINAL[b1]*256 + CARDINAL[wgt]*CARDINAL[b2 - b1] ) / 256; bOut _ Basics.BITOR[ bOut, 1 ]; -- Von Neumann rounding }; SumLessProd: PUBLIC PROC[ b1, b2: BYTE ] RETURNS[ bOut: BYTE ] ~ { bOut _ ( CARDINAL[b1]*256 + CARDINAL[b2]*256 - CARDINAL[b2]*CARDINAL[b1] ) / 256; bOut _ Basics.BITOR[ bOut, 1 ]; -- Von Neumann rounding }; GetSampleSet: PUBLIC PROC[size: NAT] RETURNS[SampleSet] ~ { RETURN[ SampleMapOps.ObtainBuffer[size] ]; }; GetTerminalYOffset: PUBLIC PROC[buf: PixelBuffer] RETURNS[NAT] ~ { size: Extent _ NARROW[Atom.GetPropFromList[buf.props, $MaxSize], REF Extent]^; RETURN[size.y]; }; GetExtent: PUBLIC PROC[buf: PixelBuffer] RETURNS[Extent] ~ { bounds: Extent; bounds.x _ buf.pixels[0].subMap.start.f; bounds.y _ buf.pixels[0].subMap.start.s; bounds.w _ buf.pixels[0].subMap.size.f; bounds.h _ buf.pixels[0].subMap.size.s; RETURN[bounds]; }; SubMapFromFrameBuffer: PROC [frameBuffer: Terminal.FrameBuffer] RETURNS [SubMap] ~ { map: SubMap; map.subMap.sampleMap _ SampleMapOps.FromVM[ fSize: frameBuffer.width, sSize: frameBuffer.height, bitsPerSample: frameBuffer.bitsPerPixel, vm: frameBuffer.vm ]; map.subMap.size _ [f: frameBuffer.width, s: frameBuffer.height]; RETURN[map]; }; PositionFromProps: PROCEDURE [props: Atom.PropList] RETURNS [NAT] = { position: REF NAT _ NARROW[ Atom.GetPropFromList[props, $Alpha] ]; IF position = NIL THEN ERROR PixelsError[[$MisMatch, "Expected alpha buffer"]] ELSE RETURN[position^]; }; Swap: PROCEDURE [first, second: INTEGER] RETURNS [INTEGER, INTEGER] = { RETURN [second, first]; }; SGN: PROCEDURE [number: INTEGER] RETURNS [INTEGER] = INLINE { IF number >= 0 THEN RETURN[1] ELSE RETURN[-1]; }; <> Create: PUBLIC PROC [width, height: NAT, pixelSizes: SampleSet] RETURNS[ PixelBuffer ] ~ { <> buf: PixelBuffer; IF pixelSizes = NIL THEN SIGNAL PixelsError[[$Mismatch, "Pixel sizes needed"]]; buf.pixels _ NEW[SubMapSequence[pixelSizes.length] ]; FOR i: NAT IN [0..pixelSizes.length) DO IF pixelSizes[i] > 0 THEN buf.pixels[i].subMap.sampleMap _ SampleMapOps.Create[ fSize: width, sSize: height, bitsPerSample: pixelSizes[i] ]; buf.pixels[i].df _ 1; buf.pixels[i].subMap.start _ [0, 0]; buf.pixels[i].subMap.size _ [f: width, s: height]; ENDLOOP; buf.height _ height; buf.width _ width; buf.samplesPerPixel _ pixelSizes.length; buf.props _ Atom.PutPropOnList[ buf.props, $MaxSize, -- store storage limits NEW[Extent _ [0, 0, buf.width, buf.height]] ]; RETURN [buf]; }; GetFromImagerContext: PUBLIC PROC [imagerCtx: Imager.Context] RETURNS[PixelBuffer] ~ { <> buf: PixelBuffer; renderMode: ATOM; onColor: BOOLEAN _ TRUE; vt: Terminal.Virtual _ Terminal.Current[]; raster: ImagerRasterPrivate.Data _ NARROW[imagerCtx.data]; viewClipBox: ImagerPixelMap.DeviceRectangle _ raster.viewClipBox; SELECT raster.device.class.type FROM $Bitmap => { onColor _ FALSE; renderMode _ $Bitmap; }; $GrayDisplay => { onColor _ TRUE; renderMode _ $Grey; }; $DitheredColorDisplay => { onColor _ TRUE; renderMode _ $Dithered; }; $FullColorDisplay => { onColor _ TRUE; renderMode _ $Dorado24; }; ENDCASE => PixelsError[[$Unimplemented, "Unknown device type"]]; IF onColor THEN buf _ GetFromColorDisplay[vt] ELSE buf _ GetFromLFDisplay[vt]; FOR i: NAT IN [0..buf.samplesPerPixel) DO -- limit sample map to viewer area buf.pixels[i].subMap.size _ [ f: raster.viewClipBox.fSize * buf.pixels[i].df, s: raster.viewClipBox.sSize ]; buf.pixels[i].subMap.sampleMap _ SampleMapOps.FromSubMap[ [ sampleMap: buf.pixels[i].subMap.sampleMap, start: [f: raster.viewClipBox.fMin, s: raster.viewClipBox.sMin], size: buf.pixels[i].subMap.size ] ]; ENDLOOP; buf.props _ Atom.PutPropOnList[ buf.props, $ImagerContext, imagerCtx ]; -- store context buf.props _ Atom.PutPropOnList[ buf.props, $VirtualTerminal, vt ]; -- store terminal buf.props _ Atom.PutPropOnList[ buf.props, $RenderMode, renderMode ]; -- store mode buf.height _ raster.viewClipBox.sSize; buf.width _ raster.viewClipBox.fSize; buf.props _ Atom.PutPropOnList[ -- store storage limits buf.props, $MaxSize, NEW[Extent _ [raster.viewClipBox.fMin, raster.viewClipBox.sMin, buf.width, buf.height]] ]; RETURN [buf]; }; GetFromTerminal: PUBLIC PROC [vt: Terminal.Virtual] RETURNS[PixelBuffer] ~ { IF Terminal.GetColorBitmapState[vt] = none THEN RETURN[GetFromLFDisplay[vt]] ELSE RETURN[GetFromColorDisplay[vt]]; }; Interleave: PUBLIC PROC [pixels: REF SubMapSequence] ~ { <> pixels[0].subMap.sampleMap.bitsPerSample _ 8; -- adjust red map to byte width samples pixels[0].subMap.sampleMap.fSize _ pixels[0].subMap.sampleMap.fSize * 2; pixels[0].df _ 2; pixels[0].subMap.size.f _ pixels[0].subMap.size.f * 2; pixels[1] _ pixels[0]; -- copy to get green map pixels[1].subMap.sampleMap _ SampleMapOps.FromSubMap[ [ sampleMap: pixels[1].subMap.sampleMap, start: [f: 1, s: 0] -- offset green map by one to get lower bytes ] ]; }; GetFromColorDisplay: PROC [vt: Terminal.Virtual] RETURNS[PixelBuffer] ~ { <> fbA: Terminal.FrameBuffer _ vt.GetColorFrameBufferA[]; fbB: Terminal.FrameBuffer _ vt.GetColorFrameBufferB[]; buf: PixelBuffer; IF fbA = NIL THEN SIGNAL PixelsError[[$Mismatch, "No color display"]]; IF fbA.bitsPerPixel > 8 THEN { -- rg interleaved buffer from a-channel, replicate sample map offset by one byte buf.pixels _ NEW[ SubMapSequence[3] ]; buf.samplesPerPixel _ 3; buf.pixels[0] _ SubMapFromFrameBuffer[fbA]; -- get red map buf.pixels[2] _ SubMapFromFrameBuffer[fbB]; -- get Blue map Interleave[buf.pixels]; -- make interleaved RG maps from red map } ELSE { buf.pixels _ NEW[ SubMapSequence[1] ]; -- pseudocolor or grey buf.samplesPerPixel _ 1; buf.pixels[0] _ SubMapFromFrameBuffer[fbA]; -- get map }; buf.height _ fbA.height; buf.width _ fbA.width; buf.props _ Atom.PutPropOnList[ buf.props, $MaxSize, -- store storage limits NEW[Extent _ [0, 0, buf.width, buf.height]] ]; buf.props _ Atom.PutPropOnList[ buf.props, $VirtualTerminal, vt ]; -- store terminal RETURN [buf]; }; GetFromLFDisplay: PROC [vt: Terminal.Virtual] RETURNS[PixelBuffer] ~ { fb: Terminal.FrameBuffer _ vt.GetBWFrameBuffer[]; buf: PixelBuffer; buf.pixels _ NEW[ SubMapSequence[1] ]; buf.samplesPerPixel _ 1; buf.pixels[0] _ SubMapFromFrameBuffer[fb]; buf.height _ fb.height; buf.width _ fb.width; buf.props _ Atom.PutPropOnList[ buf.props, $MaxSize, -- store storage limits NEW[Extent _ [0, 0, buf.width, buf.height]] ]; buf.props _ Atom.PutPropOnList[ buf.props, $VirtualTerminal, vt ]; -- store terminal RETURN [buf]; }; AddToBuffer: PUBLIC PROC [buf: PixelBuffer, pixelSizes: SampleSet] RETURNS[PixelBuffer] ~ { newpixels: REF SubMapSequence; IF pixelSizes = NIL THEN SIGNAL PixelsError[[$Mismatch, "Pixel sizes needed"]]; newpixels _ NEW[SubMapSequence[buf.samplesPerPixel + pixelSizes.length] ]; FOR i: NAT IN [0..buf.samplesPerPixel) DO newpixels[i] _ buf.pixels[i]; ENDLOOP; FOR i: NAT IN [0 .. pixelSizes.length) DO j: NAT _ buf.samplesPerPixel + i; IF pixelSizes[i] > 0 THEN newpixels[j].subMap.sampleMap _ SampleMapOps.Create[ fSize: buf.width, sSize: buf.height, bitsPerSample: pixelSizes[i] ]; newpixels[j].df _ 1; newpixels[j].subMap.start _ [0, 0]; newpixels[j].subMap.size _ [f: buf.width, s: buf.height]; ENDLOOP; buf.pixels _ newpixels; buf.samplesPerPixel _ buf.samplesPerPixel + pixelSizes.length; RETURN [buf]; }; <> TerminalFromBuffer: PUBLIC PROC [buf: PixelBuffer] RETURNS[vt: Terminal.Virtual] ~ { RETURN[ NARROW[Atom.GetPropFromList[buf.props, $VirtualTerminal], Terminal.Virtual] ]; }; ImagerContextFromBuffer: PUBLIC PROC [buf: PixelBuffer, type: ATOM _ NIL] RETURNS[ctx: Imager.Context] ~ { <> <> <> <> <> <<>> <> <<>> <> <<>> <> ref: REF ANY _ Atom.GetPropFromList[buf.props, $ImagerContext]; IF ref # NIL THEN ctx _ NARROW[ref, Imager.Context] ELSE { kind: ATOM; <> ctx _ NIL; IF type # NIL THEN kind _ type ELSE SELECT buf.samplesPerPixel FROM 1, 2 => kind _ $Mapped; ENDCASE => kind _ $Color24; SELECT kind FROM $Gray => SIGNAL PixelsError[[$UnImplemented, "Grey display unsupported"]]; <<$Dithered => ctx _ ImagerDitheredDevice.ContextFromSampleMap[>> <> <> <> <<];>> <<$Mapped => ctx _ ImagerMappedDevice.ContextFromSampleMap[>> <> <> <> <<];>> $Color24 => SIGNAL PixelsError[[$UnImplemented, "no 24-bit color"]]; ENDCASE => SIGNAL PixelsError[[$UnImplemented, "Unknown device type"]]; <> <> <> <> }; RETURN[ctx]; }; Clip: PUBLIC PROC [buf: PixelBuffer, bounds: Extent] ~ { size: Extent _ NARROW[Atom.GetPropFromList[buf.props, $MaxSize], REF Extent]^; bounds.x _ MIN[ size.w, bounds.x ]; -- keep within limits bounds.y _ MIN[ size.h, bounds.y ]; bounds.w _ MIN[ size.w - bounds.x, bounds.w ]; bounds.h _ MIN[ size.h - bounds.y, bounds.h ]; bounds.y _ size.h - (bounds.y + bounds.h); -- invert for upside-down sampleMap FOR i: NAT IN [0..buf.pixels.length) DO buf.pixels[i].subMap.start _ [ f: bounds.x, s: bounds.y ]; -- upper left corner, on display buf.pixels[i].subMap.size _ [f: bounds.w, s: bounds.h]; -- dimensions ENDLOOP; }; Fill: PUBLIC PROC [buf: PixelBuffer, pixel: SampleSet] ~ { <> DoIt: PROC[] ~ { Write[buf, [0, 0, buf.width, buf.height], pixel]; }; vt : Terminal.Virtual _ TerminalFromBuffer[buf]; IF pixel = NIL THEN { pixel _ GetSampleSet[buf.pixels.length]; FOR i: NAT IN [0..pixel.length) DO pixel[i] _ 0; ENDLOOP; }; IF vt # NIL THEN { Terminal.ModifyColorFrame[vt, DoIt, buf.pixels[0].subMap.start.f, buf.pixels[0].subMap.start.s, buf.pixels[0].subMap.start.f + buf.pixels[0].subMap.size.f, buf.pixels[0].subMap.start.s + buf.pixels[0].subMap.size.s ]; } ELSE DoIt[]; }; Transfer: PUBLIC PROC [dstBuf, srcBuf: PixelBuffer] ~ { numMaps: NAT _ MIN[ dstBuf.samplesPerPixel, srcBuf.samplesPerPixel+1 ]; DoIt: PROC[] ~ { FOR i: NAT IN [0 .. numMaps) DO heightDif: NAT _ MAX[ 0, INTEGER[dstBuf.pixels[i].subMap.size.s] - INTEGER[srcBuf.pixels[i].subMap.size.s] ]; IF dstBuf.pixels[i].df = 1 -- write only the first of a set of interleaved maps OR dstBuf.pixels[i].subMap.sampleMap.base.bit = 0 THEN SampleMapOps.Transfer[ dest: dstBuf.pixels[i].subMap.sampleMap, destStart: [ f: dstBuf.pixels[i].subMap.start.f * dstBuf.pixels[i].df, s: dstBuf.pixels[i].subMap.start.s + heightDif ], source: srcBuf.pixels[i].subMap ]; ENDLOOP; }; vt : Terminal.Virtual _ TerminalFromBuffer[dstBuf]; IF vt # NIL THEN { yOffset: NAT _ GetTerminalYOffset[dstBuf]; Terminal.ModifyColorFrame[vt, DoIt, dstBuf.pixels[0].subMap.start.f, dstBuf.pixels[0].subMap.start.s + yOffset, dstBuf.pixels[0].subMap.start.f + dstBuf.pixels[0].subMap.size.f, dstBuf.pixels[0].subMap.start.s + dstBuf.pixels[0].subMap.size.s + yOffset ]; } ELSE DoIt[]; }; Copy: PUBLIC PROC [ destination, source: PixelBuffer, destArea, srcArea: Extent, op: ATOM _ $Write ] ~ { DoIt: PROC[] ~ { func: SampleMapOps.Function; SELECT op FROM $AND => func _ [ and, null]; $OR => func _ [ or, null]; $XOR => func _ [ xor, null]; ENDCASE => func _ [null, null]; IF destination.pixels = NIL OR source.pixels = NIL THEN SIGNAL PixelsError[[$Mismatch, "Buffer is nil"]]; SELECT op FROM $AND, $OR, $XOR, $Write => { << Ensure that result fills the lower left corner of the destination area>> srcArea.w _ MIN[ destArea.w, srcArea.w]; srcArea.h _ MIN[ destArea.h, srcArea.h]; FOR i: NAT IN [0..source.pixels.length) DO srcX, srcY, dstX, dstY: NAT; [srcX, srcY] _ XfmMapPlace[source.pixels[i], srcArea.x, srcArea.y + srcArea.h - 1]; [dstX, dstY] _ XfmMapPlace[destination.pixels[i], destArea.x, destArea.y + srcArea.h - 1]; IF destination.pixels[i].df = 1 -- copy only one from interleaved set OR destination.pixels[i].subMap.sampleMap.base.bit = 0 THEN SampleMapOps.Transfer[ dest: destination.pixels[i].subMap.sampleMap, destStart: [f: dstX, s: dstY], source: [ sampleMap: source.pixels[i].subMap.sampleMap, start: [f: srcX, s: srcY], size: [f: srcArea.w*source.pixels[i].df, s: srcArea.h] ], function: func ]; ENDLOOP; }; $WriteOver, $WriteUnder => { srcSeg: REF SampleSetSequence _ NIL; FOR j: NAT IN [0 .. srcArea.h) DO srcSeg _ GetScanSeg[source, srcArea.x, j + srcArea.y, srcArea.w, srcSeg]; PutScanSeg[destination, destArea.x, j + destArea.y, destArea.w, srcSeg, op]; ENDLOOP; }; ENDCASE => SIGNAL PixelsError[[$UnImplemented, "Unknown operation"]]; }; vt : Terminal.Virtual _ TerminalFromBuffer[destination]; IF vt # NIL THEN { yOffset: NAT _ GetTerminalYOffset[destination]; Terminal.ModifyColorFrame[vt, DoIt, destArea.x, destArea.y+yOffset, destArea.x+destArea.w, destArea.y+destArea.h+yOffset] } ELSE DoIt[]; }; ShowOnImagerContext: PUBLIC PROC [context: Imager.Context, buf: PixelBuffer] ~ { <> SIGNAL PixelsError[[$Unimplemented, "Hasn't been written yet"]]; }; <> GetPixel: PUBLIC PROC [buf: PixelBuffer, x, y: NAT, pixel: SampleSet _ NIL] RETURNS[ SampleSet ] ~ { IF pixel = NIL OR pixel.maxLength < buf.samplesPerPixel THEN pixel _ GetSampleSet[buf.samplesPerPixel]; FOR i: NAT IN [0..buf.pixels.length) DO nx, ny: NAT; [nx, ny] _ XfmMapPlace[buf.pixels[i], x, y]; -- has to be here for interleaved rg pixel[i] _ SampleMapOps.GetSample[ buf.pixels[i].subMap.sampleMap, [f: nx, s: ny] ] ENDLOOP; pixel.length _ buf.pixels.length; -- make sure length field is up to date RETURN [pixel]; }; PutPixel: PUBLIC PROC [ buf: PixelBuffer, x, y: NAT, pixel: SampleSet ] ~ { IF pixel = NIL OR pixel.length > buf.samplesPerPixel THEN SIGNAL PixelsError[[$Mismatch, "Pixel and buffer don't match"]]; FOR i: NAT IN [0..pixel.length) DO nx, ny: NAT; [nx, ny] _ XfmMapPlace[buf.pixels[i], x, y]; -- has to be here for interleaved rg SampleMapOps.PutSample[ buf.pixels[i].subMap.sampleMap, [f: nx, s: ny], pixel[i] ] ENDLOOP; }; GetScanSeg: PUBLIC PROC [ buf: PixelBuffer, x, y, length: NAT, pixels: REF SampleSetSequence _ NIL ] RETURNS[ REF SampleSetSequence ] ~ { IF pixels = NIL OR pixels.length # buf.samplesPerPixel THEN pixels _ NEW[ SampleSetSequence[buf.samplesPerPixel] ]; FOR i: NAT IN [0..buf.samplesPerPixel) DO nx, ny: NAT; IF pixels[i] = NIL OR pixels[i].length < length THEN pixels[i] _ GetSampleSet[length]; [nx, ny] _ XfmMapPlace[buf.pixels[i], x, y]; SampleMapOps.Get[ buffer: pixels[i], count: pixels[i].length, sampleMap: buf.pixels[i].subMap.sampleMap, f: nx, s: ny, df: buf.pixels[i].df ]; ENDLOOP; RETURN[pixels]; }; PutScanSeg: PUBLIC PROC [ buf: PixelBuffer, x, y, length: NAT, pixels: REF SampleSetSequence, op: ATOM _ $Write ] ~ { DoIt: PROC[] ~ { func: SampleMapOps.Function; SELECT op FROM $AND => func _ [ and, null]; $OR => func _ [ or, null]; $XOR => func _ [ xor, null]; ENDCASE => func _ [null, null]; IF pixels = NIL OR pixels.length # buf.samplesPerPixel THEN SIGNAL PixelsError[[$Mismatch, "Pixel and buffer don't match"]]; SELECT op FROM $AND, $OR, $XOR, $Write => { FOR i: NAT IN [0..buf.samplesPerPixel) DO nx, ny: NAT; IF pixels[i] = NIL OR pixels[i].length < length THEN SIGNAL PixelsError[[$Mismatch, "Buffer has insufficient pixels"]]; [nx, ny] _ XfmMapPlace[buf.pixels[i], x, y]; SampleMapOps.Put[ buffer: pixels[i], count: length, sampleMap: buf.pixels[i].subMap.sampleMap, f: nx, s: ny, df: buf.pixels[i].df, function: func ]; ENDLOOP; }; $WriteOver, $WriteUnder => { alpha: NAT _ PositionFromProps[buf.props]; dstSeg: REF SampleSetSequence _ GetScanSeg[buf, x, y, length]; FOR j: NAT IN [0 .. length) DO IF op = $WriteOver THEN { dstSeg[alpha][j] _ SumLessProd[ dstSeg[alpha][j], pixels[alpha][j] ]; FOR k: NAT IN [0..buf.samplesPerPixel) DO IF k # alpha THEN dstSeg[k][j] _ ByteAvrgWgtd[ b1: dstSeg[k][j], b2: pixels[k][j], wgt: pixels[alpha][j] ]; ENDLOOP; } ELSE IF op = $WriteUnder THEN { cvrge: NAT _ MIN[ pixels[alpha][j], 255 - dstSeg[alpha][j] ]; dstSeg[alpha][j] _ dstSeg[alpha][j] + cvrge; FOR k: NAT IN [0..buf.samplesPerPixel) DO IF k # alpha THEN dstSeg[k][j] _ dstSeg[k][j] -- add Von Neumann rounding + Basics.BITOR[ CARDINAL[cvrge * pixels[k][j]] / 256, 1]; ENDLOOP; }; ENDLOOP; PutScanSeg[buf, x, y, length, dstSeg]; }; ENDCASE => SIGNAL PixelsError[[$UnImplemented, "Unknown operation"]]; }; DoIt[]; -- no color display locking, clients are assumed to have done it themselves }; dstPxl: SampleSet _ GetSampleSet[4]; srcPxl: SampleSet _ GetSampleSet[4]; -- for read-mod-write ops Write: PROC[ buf: PixelBuffer, area: Extent, pixel: SampleSet, func: SampleMapOps.Function _ [null, null] ] ~ { FOR i: NAT IN [0..buf.samplesPerPixel) DO x, y, w, h: NAT; [x, y] _ XfmMapPlace[ buf.pixels[i], area.x, area.y + area.h - 1 ]; -- upper left corner w _ MIN[ buf.pixels[i].subMap.sampleMap.fSize - x, area.w]; -- clip to map limits h _ MIN[ buf.pixels[i].subMap.sampleMap.sSize - y, area.h]; IF buf.pixels[i].df = 2 -- kludge for Dorado 24-bit color THEN IF buf.pixels[i].subMap.sampleMap.base.bit = 0 THEN { value: CARDINAL _ pixel[i] * 256 + pixel[i+1]; sampleMap: SampleMapOps.SampleMap _ NEW[SampleMapOps.SampleMapRep]; sampleMap^ _ buf.pixels[i].subMap.sampleMap^; sampleMap.bitsPerSample _ 16; sampleMap.fSize _ sampleMap.fSize / 2; x _ x / buf.pixels[i].df; -- correct for pixel size change SampleMapOps.Fill[ [sampleMap, [f: x, s: y], [f: w, s: h] ], value, func ]; } ELSE {} ELSE SampleMapOps.Fill[ -- case for continuous pixels dest: [ buf.pixels[i].subMap.sampleMap, [f: x, s: y], [f: w, s: h] ], value: pixel[i], function: func ]; ENDLOOP; }; WriteOver: PROC[ buf: PixelBuffer, area: Extent, pixel: SampleSet, alpha: NAT] ~ { scanSeg: REF SampleSetSequence _ NIL; FOR j: NAT IN [area.y..area.y+area.h) DO scanSeg _ GetScanSeg[buf, area.x, j, area.w, scanSeg]; FOR i: NAT IN [area.x..area.x+area.w) DO <> scanSeg[alpha][i] _ SumLessProd[ scanSeg[alpha][i], pixel[alpha] ]; FOR k: NAT IN [0..pixel.length) DO IF k # alpha THEN scanSeg[k][i] _ ByteAvrgWgtd[ b1: scanSeg[k][i], b2: pixel[k], wgt: pixel[alpha] ]; ENDLOOP; ENDLOOP; PutScanSeg[buf, area.x, j, area.w, scanSeg]; ENDLOOP; }; WriteUnder: PROC[ buf: PixelBuffer, area: Extent, pixel: SampleSet, alpha: NAT] ~ { scanSeg: REF SampleSetSequence _ NIL; FOR j: NAT IN [area.y..area.y+area.h) DO scanSeg _ GetScanSeg[buf, area.x, j, area.w, scanSeg]; FOR i: NAT IN [0..area.w) DO IF scanSeg[alpha][i] = 0 THEN { -- untouched pixel scanSeg[alpha][i] _ pixel[alpha]; FOR k: NAT IN [0..pixel.length) DO IF k # alpha THEN scanSeg[k][i] _ CARDINAL[pixel[alpha] * pixel[k]] / 255; -- alpha*new ENDLOOP; } ELSE IF scanSeg[alpha][i] < 255 THEN { -- used but not completely covered pixel cvrge: NAT _ MIN[ pixel[alpha], 255 - scanSeg[alpha][i] ]; -- < unused old alpha scanSeg[alpha][i] _ scanSeg[alpha][i] + cvrge; -- sum alphas (always < 256) FOR k: NAT IN [0..pixel.length) DO IF k # alpha THEN scanSeg[k][i] _ scanSeg[k][i] + CARDINAL[cvrge * pixel[k]] / 255; ENDLOOP; -- old + alpha*new }; ENDLOOP; PutScanSeg[buf, area.x, j, area.w, scanSeg]; ENDLOOP; }; PixelOp: PUBLIC PROC [ buf: PixelBuffer, area: Extent, pixel: SampleSet, op: ATOM _ $Write ] ~ { DoIt: PROC[] ~ { func: SampleMapOps.Function; SELECT op FROM $AND => func _ [ and, null]; $OR => func _ [ or, null]; $XOR => func _ [ xor, null]; ENDCASE => func _ [null, null]; IF pixel = NIL OR pixel.length # buf.samplesPerPixel THEN SIGNAL PixelsError[[$Mismatch, "Pixel and buffer don't match"]]; SELECT op FROM $AND, $OR, $XOR, $Write => Write[buf, area, pixel, func]; $WriteOver => { alpha: NAT _ PositionFromProps[buf.props]; SELECT pixel[alpha] FROM -- pixel[alpha] is coverage (alpha) 255 => Write[buf, area, pixel, func]; -- replacement if alpha saturated 0 => {}; -- no effect if alpha is zero ENDCASE => WriteOver[buf, area, pixel, alpha]; -- blend otherwise }; $WriteUnder => { alpha: NAT _ PositionFromProps[buf.props]; IF pixel[alpha] > 0 THEN WriteUnder[buf, area, pixel, alpha]; -- no-op if alpha zero }; ENDCASE => SIGNAL PixelsError[[$UnImplemented, "Unknown operation"]]; }; vt : Terminal.Virtual _ TerminalFromBuffer[buf]; IF vt # NIL THEN { yOffset: NAT _ GetTerminalYOffset[buf]; Terminal.ModifyColorFrame[vt, DoIt, area.x, area.y+yOffset, area.x+area.w, area.y+area.h+yOffset]; } ELSE DoIt[]; }; <> GetValue: PUBLIC PROC [buf: PixelBuffer, x, y: NAT, map: NAT _ 0] RETURNS[ value: CARDINAL ] ~ { [x, y] _ XfmMapPlace[buf.pixels[map], x, y]; value _ SampleMapOps.GetSample[ buf.pixels[map].subMap.sampleMap, [f: x, s: y] ]; }; PutValue: PUBLIC PROC [ buf: PixelBuffer, x, y: NAT, value: CARDINAL, map: NAT _ 0 ] ~ { [x, y] _ XfmMapPlace[buf.pixels[map], x, y]; SampleMapOps.PutSample[ buf.pixels[map].subMap.sampleMap, [f: x, s: y] , value ]; }; ValueOp: PUBLIC PROC [ buf: PixelBuffer, area: Extent, value: CARDINAL, map: NAT _ 0, op: ATOM _ $Write ] ~ { func: SampleMapOps.Function; SELECT op FROM $AND => func _ [ and, null]; $OR => func _ [ or, null]; $XOR => func _ [ xor, null]; ENDCASE => func _ [null, null]; [area.x, area.y] _ XfmMapPlace[ buf.pixels[map], area.x, area.y + area.h - 1 ]; IF buf.pixels[map].df > 1 THEN area.x _ area.x / buf.pixels[map].df; SELECT op FROM $AND, $OR, $XOR, $Write => IF buf.pixels[map].df > 1 THEN { -- kludge for Dorado 24-bit color scanSeg: SampleSet _ GetSampleSet[area.w]; FOR x: NAT IN [0 .. area.w) DO scanSeg[x] _ value; ENDLOOP; FOR y: NAT IN [area.y.. area.y + area.h) DO SampleMapOps.Put[ buffer: scanSeg, count: area.w, sampleMap: buf.pixels[map].subMap.sampleMap, f: area.x, s: y, df: buf.pixels[map].df, function: func ]; ENDLOOP; } ELSE SampleMapOps.Fill[ dest: [buf.pixels[map].subMap.sampleMap, [f: area.x, s: area.y],[f: area.w, s: area.h]], value: value, function: func ]; ENDCASE => SIGNAL PixelsError[[$UnImplemented, "Operation not for single value"]]; }; END.