Copyright (C) 1994, Digital Equipment Corp.Lectern: a user interface for viewing documents stored as images The object class for paintable images.
UNSAFE MODULEImages EXPORTSImages ; IMPORT Fmt, PaintPrivate, Point, Rect, ScrnPixmap, Thread, VBT, Word, Wr; PROCEDURERawGetLine (c: RawContents; v: INTEGER; VAR line: ARRAY OF INTEGER) = VAR raw := c.raw; rowStart := (v-raw.bounds.north)*raw.wordsPerRow + raw.offset; bitsPerPixel := raw.bitsPerPixel; pixelsPerWord := BITSIZE(Word.T) DIV bitsPerPixel; sourceBitDelta, sourceBitOrigin: INTEGER; BEGIN IF raw.pixelOrder = PaintPrivate.ByteOrder.LSBFirst THEN sourceBitDelta := raw.bitsPerPixel; sourceBitOrigin := 0; ELSE sourceBitDelta := - raw.bitsPerPixel; sourceBitOrigin := (pixelsPerWord-1) * raw.bitsPerPixel; END; VAR pixels := LOOPHOLE(ADR(raw.pixels[rowStart]), UNTRACED REF ARRAY [0..999999] OF Word.T); sourceWord := 0; sourceBit := sourceBitOrigin; sourceCount := pixelsPerWord; source := pixels[0]; BEGIN FOR destH := 0 TO Rect.HorSize(raw.bounds)-1 DO line[destH] := Word.Extract(source, sourceBit, bitsPerPixel); INC(sourceBit, sourceBitDelta); DEC(sourceCount); IF sourceCount = 0 THEN INC(sourceWord); source := pixels[sourceWord]; sourceBit := sourceBitOrigin; sourceCount := pixelsPerWord; END; END; END; END RawGetLine; PROCEDUREBitFromGray (g: Gray): Bit = BEGIN RETURN ORD(g < 128) END BitFromGray; PROCEDUREGrayFromBit (b: Bit): Gray = BEGIN RETURN (1-b) * 255 END GrayFromBit; PROCEDUREGrayFromRGB (rgb: RGB): Gray = BEGIN RETURN ROUND(0.239*FLOAT(rgb.r) + 0.686*FLOAT(rgb.g) + 0.075*FLOAT(rgb.b)) END GrayFromRGB; PROCEDURERGBFromGray (g: Gray): RGB = BEGIN RETURN RGB{ r := g, g := g, b := g } END RGBFromGray; PROCEDUREGrayMapFromRGBMap (map: RGBMap): GrayMap = VAR toGray := NEW(GrayMap, NUMBER(map^)); BEGIN FOR i := 0 TO LAST(toGray^) DO toGray[i] := GrayFromRGB(map[i]); END; RETURN toGray; END GrayMapFromRGBMap; PROCEDURELasso (contents: RawContents): Rect.T = VAR raw := contents.raw; bounds := Rect.Inset(raw.bounds, 1); seed := raw.get(Rect.NorthWest(bounds)); res := Rect.T{ west := bounds.east, east := bounds.west, north := bounds.south, south := bounds.north }; (* an improper rectangle, so far *) h: INTEGER; BEGIN FOR v := bounds.north TO bounds.south-1 DO h := bounds.west; WHILE h < bounds.east DO IF h < res.west OR v < res.north OR v >= res.south THEN IF raw.get(Point.T{h := h, v := v}) # seed THEN res.west := MIN(res.west, h); res.north := MIN(res.north, v); res.east := MAX(res.east, h+1); res.south := MAX(res.south, v+1); EXIT (* this row is now boring, except for .east *) END; ELSE EXIT END; INC(h); END; h := bounds.east; WHILE h > res.east DO DEC(h); IF raw.get(Point.T{h := h, v := v}) # seed THEN res.east := MAX(res.east, h+1); END; END; END; IF res.west >= res.east OR res.north >= res.south THEN RETURN Rect.Empty (* so that we don't return an improper rectangle *) ELSE RETURN res END; END Lasso; PROCEDUREToPNM (contents: Contents; wr: Wr.T) RAISES { Wr.Failure, Thread.Alerted } = VAR map := contents.map; toGray := GrayMapFromRGBMap(map); line := NEW(REF ARRAY OF INTEGER, contents.width); chars := NEW(REF ARRAY OF CHAR, contents.width*3); BEGIN Wr.PutChar(wr, 'P'); IF contents.isBW THEN Wr.PutChar(wr, '4'); ELSIF contents.isGray THEN Wr.PutChar(wr, '5'); ELSE Wr.PutChar(wr, '6'); END; Wr.PutText(wr, "\n" & Fmt.Int(contents.width) & "\n" & Fmt.Int(contents.height) & "\n"); IF NOT contents.isBW THEN Wr.PutText(wr, "255\n") END; FOR v := 0 TO contents.height-1 DO contents.getLine(v, line^); IF contents.isBW THEN <*ASSERT FALSE*> (* not yet implemented *) ELSIF contents.isGray THEN FOR h := 0 TO contents.width-1 DO chars[h] := VAL(toGray[line[h]], CHAR); END; Wr.PutString(wr, SUBARRAY(chars^, 0, contents.width)); ELSE FOR h := 0 TO contents.width-1 DO VAR rgb := map[line[h]]; BEGIN chars[h*3] := VAL(rgb.r, CHAR); chars[h*3+1] := VAL(rgb.g, CHAR); chars[h*3+2] := VAL(rgb.b, CHAR); END; END; Wr.PutString(wr, SUBARRAY(chars^, 0, 3*contents.width)); END; END; END ToPNM; REVEAL EmptyImage = T BRANDED OBJECT OVERRIDES domain := EmptyDomain; paint := EmptyPaint; render := EmptyRender; contents := EmptyContents; END; PROCEDUREEmptyDomain (<*UNUSED*>i: T; <*UNUSED*>v: VBT.Leaf): Rect.T = BEGIN RETURN Rect.Empty END EmptyDomain; PROCEDUREEmptyPaint (<*UNUSED*>i: T; <*UNUSED*>v: VBT.Leaf; <*UNUSED*>READONLY clip: Rect.T := Rect.Full; <*UNUSED*>READONLY delta: Point.T) = BEGIN END EmptyPaint; PROCEDUREEmptyRender (<*UNUSED*>i: T; <*UNUSED*>v: VBT.Leaf): ScrnPixmap.Raw RAISES { Error } = BEGIN RETURN ScrnPixmap.NewRaw(1, Rect.Empty); END EmptyRender; PROCEDUREEmptyContents (<*UNUSED*>i: T): Contents RAISES { Error } = BEGIN RETURN NEW(RawContents, width := 0, height := 0, map := NEW(RGBMap, 0), isBW := TRUE, isGray := TRUE, isGrayRamp := FALSE, raw := ScrnPixmap.NewRaw(1, Rect.Empty)) END EmptyContents; BEGIN Empty := NEW(EmptyImage); END Images.