XPMReader.st
changeset 1403 94f9ec117aa5
parent 1400 8a7b55b08bf3
child 1495 100e4e782f71
--- a/XPMReader.st	Mon Sep 04 17:36:48 2000 +0200
+++ b/XPMReader.st	Tue Sep 05 14:44:17 2000 +0200
@@ -153,34 +153,34 @@
      dstIndex "{ Class: SmallInteger }"
      colorName monoName greyName grey4Name symbolicName colorMapSize redMap greenMap blueMap
      charsPerPixel xlation s bitsPerPixel lineDone maskPixelValue
-     state key|
+     state key lastKey lastChar1 lastChar2 c1 c2 lastXLation|
 
     inStream := aStream.
 
     line := aStream nextLine.
     (line notNil and:[line startsWith:'/* XPM']) ifFalse:[
-	^ self fileFormatError:'format error (expected XPM)'.
+        ^ self fileFormatError:'format error (expected XPM)'.
     ].
 
     line := aStream nextLine.
     [line notNil and:[(line startsWith:'/*') or:[line isBlank]]] whileTrue:[
-	line := aStream nextLine.
+        line := aStream nextLine.
     ].
     (line notNil and:[line startsWith:'static char']) ifFalse:[
-	^ self fileFormatError:'format error (expected static char)'.
+        ^ self fileFormatError:'format error (expected static char)'.
     ].
     line := aStream nextLine.
     (line notNil and:[line startsWith:'/*']) ifTrue:[
-	[line notNil 
-	 and:[(line startsWith:'/*') or:[line startsWith:' *']]] whileTrue:[
-	    line := aStream nextLine.
-	].
+        [line notNil 
+         and:[(line startsWith:'/*') or:[line startsWith:' *']]] whileTrue:[
+            line := aStream nextLine.
+        ].
     ].
     line notNil ifTrue:[
-	line := line withoutSeparators
+        line := line withoutSeparators
     ].
     (line notNil and:[line startsWith:'"']) ifFalse:[
-	^ self fileFormatError:'format error (expected "ww hh nn mm)'.
+        ^ self fileFormatError:'format error (expected "ww hh nn mm)'.
     ].
     s := ReadStream on:line.
     s next.  "skip quote"
@@ -189,9 +189,9 @@
     colorMapSize := Integer readFrom:s.
     charsPerPixel := Integer readFrom:s.
     charsPerPixel ~~ 1 ifTrue:[
-	xlation := Dictionary new:colorMapSize.
+        xlation := Dictionary new:colorMapSize.
     ] ifFalse:[
-	xlation := Array new:256.
+        xlation := Array new:256.
     ].
 
     redMap := ByteArray new:colorMapSize.
@@ -199,139 +199,137 @@
     blueMap := ByteArray new:colorMapSize.
     colorMap := Colormap redVector:redMap greenVector:greenMap blueVector:blueMap.
     1 to:colorMapSize do:[:colorIndex |
-	|index line color t word|
+        |index line color t word|
 
-	line := aStream nextLine.
-	[line notNil and:[line startsWith:'/*']] whileTrue:[
-	    [line notNil and:[(line endsWith:'*/') not]] whileTrue:[
-		line := aStream nextLine.
-	    ].
-	    line := aStream nextLine.
-	].
-	line notNil ifTrue:[
-	    line := line withoutSeparators
-	].
-	(line notNil and:[line startsWith:'"']) ifFalse:[
-	    ^ self fileFormatError:'format error (expected color spec)'.
-	].
+        line := aStream nextLine.
+        [line notNil and:[line startsWith:'/*']] whileTrue:[
+            [line notNil and:[(line endsWith:'*/') not]] whileTrue:[
+                line := aStream nextLine.
+            ].
+            line := aStream nextLine.
+        ].
+        line notNil ifTrue:[
+            line := line withoutSeparators
+        ].
+        (line notNil and:[line startsWith:'"']) ifFalse:[
+            ^ self fileFormatError:'format error (expected color spec)'.
+        ].
 
-	s := ReadStream on:line.
-	s next. "skip quote"
-	charsPerPixel ~~ 1 ifTrue:[
-	    key := s next:charsPerPixel.
-	    xlation at:key put:colorIndex - 1.
-	] ifFalse:[
-	    index := s next asciiValue.
-	    xlation at:index put:colorIndex - 1.
-	].
+        s := ReadStream on:line.
+        s next. "skip quote"
+        charsPerPixel ~~ 1 ifTrue:[
+            key := s next:charsPerPixel.
+            xlation at:key put:colorIndex - 1.
+        ] ifFalse:[
+            index := s next asciiValue.
+            xlation at:index put:colorIndex - 1.
+        ].
 
-	lineDone := false.
-	state := nil.
+        lineDone := false.
+        state := nil.
 
-	[lineDone] whileFalse:[
-	    s skipSeparators.
-	    s peek == $# ifTrue:[
-		word := self colorNameFrom:s
-	    ] ifFalse:[
-		word := s nextAlphaNumericWord.
-	    ].
-	    word isNil ifTrue:[
-		lineDone := true
-	    ] ifFalse:[
-		word = 's' ifTrue:[
-		    "/ symbolic name ...
-		    state := $s. symbolicName := ''.
-		] ifFalse:[
-		    word = 'm' ifTrue:[
-			"/ monochrome data
-			state := $m. monoName := ''.
-		    ] ifFalse:[
-			word = 'g' ifTrue:[
-			    "/ grey data
-			    state := $g. greyName := ''.
-			] ifFalse:[
-			    word = 'g4' ifTrue:[
-				"/ grey data
-				state := $G. grey4Name := ''.
-			    ] ifFalse:[
-				word = 'c' ifTrue:[
-				    "/ color data
-				    state := $c. colorName := ''.
-				] ifFalse:[
-				    "/ append to name
-				    state isNil ifTrue:[
-					^ self fileFormatError:('format error got: ' 
-								, word printString 
-								, ' (expected ''c'',''m'',''g'' or ''s'')').
-				    ].
+        [lineDone] whileFalse:[
+            s skipSeparators.
+            s peek == $# ifTrue:[
+                word := self colorNameFrom:s
+            ] ifFalse:[
+                word := s nextAlphaNumericWord.
+            ].
+            word isNil ifTrue:[
+                lineDone := true
+            ] ifFalse:[
+                word = 's' ifTrue:[
+                    "/ symbolic name ...
+                    state := $s. symbolicName := ''.
+                ] ifFalse:[
+                    word = 'm' ifTrue:[
+                        "/ monochrome data
+                        state := $m. monoName := ''.
+                    ] ifFalse:[
+                        word = 'g' ifTrue:[
+                            "/ grey data
+                            state := $g. greyName := ''.
+                        ] ifFalse:[
+                            word = 'g4' ifTrue:[
+                                "/ grey data
+                                state := $G. grey4Name := ''.
+                            ] ifFalse:[
+                                word = 'c' ifTrue:[
+                                    "/ color data
+                                    state := $c. colorName := ''.
+                                ] ifFalse:[
+                                    "/ append to name
+                                    state isNil ifTrue:[
+                                        ^ self fileFormatError:('format error got: ' 
+                                                                , word printString 
+                                                                , ' (expected ''c'',''m'',''g'' or ''s'')').
+                                    ].
 
-				    state == $m ifTrue:[
-					monoName := monoName , ' ' , word.
-				    ].
-				    state == $g ifTrue:[
-					greyName := greyName , ' ' , word.
-				    ].
-				    state == $G ifTrue:[
-					grey4Name := grey4Name , ' ' , word.
-				    ].
-				    state == $c ifTrue:[
-					colorName := colorName , ' ' , word.
-				    ].
-				    state == $s ifTrue:[
-					symbolicName := symbolicName , ' ' , word.
-				    ].
-				    (word startsWith:'#') ifTrue:[
-					state := nil.
-				    ]
-				]
-			    ]
-			]
-		    ]
-		]
-	    ].
-	].
+                                    state == $m ifTrue:[
+                                        monoName := monoName , ' ' , word.
+                                    ].
+                                    state == $g ifTrue:[
+                                        greyName := greyName , ' ' , word.
+                                    ].
+                                    state == $G ifTrue:[
+                                        grey4Name := grey4Name , ' ' , word.
+                                    ].
+                                    state == $c ifTrue:[
+                                        colorName := colorName , ' ' , word.
+                                    ].
+                                    state == $s ifTrue:[
+                                        symbolicName := symbolicName , ' ' , word.
+                                    ].
+                                    (word startsWith:'#') ifTrue:[
+                                        state := nil.
+                                    ]
+                                ]
+                            ]
+                        ]
+                    ]
+                ]
+            ].
+        ].
 
-	colorName notNil ifTrue:[
-	    colorName := colorName withoutSeparators
-	].
-	monoName notNil ifTrue:[
-	    monoName := monoName withoutSeparators
-	].
-	greyName notNil ifTrue:[
-	    greyName := greyName withoutSeparators
-	].
-	grey4Name notNil ifTrue:[
-	    grey4Name := grey4Name withoutSeparators
-	].
-	symbolicName notNil ifTrue:[
-	    symbolicName := symbolicName withoutSeparators
-	].
+        colorName notNil ifTrue:[
+            colorName := colorName withoutSeparators
+        ].
+        monoName notNil ifTrue:[
+            monoName := monoName withoutSeparators
+        ].
+        greyName notNil ifTrue:[
+            greyName := greyName withoutSeparators
+        ].
+        grey4Name notNil ifTrue:[
+            grey4Name := grey4Name withoutSeparators
+        ].
+        symbolicName notNil ifTrue:[
+            symbolicName := symbolicName withoutSeparators
+        ].
 
-	"/
-	"/ for now - ignore everything, except
-	"/ colorName (if there is one)
-	"/
-	colorName isNil ifTrue:[
-	    colorName := greyName.
-	    colorName isNil ifTrue:[
-		colorName := monoName.
-	    ]
-	].
+        "/
+        "/ for now - ignore everything, except
+        "/ colorName (if there is one)
+        "/
+        colorName isNil ifTrue:[
+            colorName := greyName.
+            colorName isNil ifTrue:[
+                colorName := monoName.
+            ]
+        ].
 
-	((colorName = 'none') 
-	or:[colorName = 'None'
-	or:[colorName = 'NONE']]) ifTrue:[
-	    color := Color noColor. "/ white
-	    redMap at:colorIndex put:0.
-	    greenMap at:colorIndex put:0.
-	    blueMap at:colorIndex put:0.
-	    maskPixelValue := colorIndex-1.
-	] ifFalse:[
-	    color := Color name:colorName ifIllegal:Color black.
-	    redMap at:colorIndex put:(color red asFloat * 255.0 // 100).
-	    greenMap at:colorIndex put:(color green asFloat * 255.0 // 100).
-	    blueMap at:colorIndex put:(color blue asFloat * 255.0 // 100).
-	].
+        (colorName sameAs: 'none') ifTrue:[
+            color := Color noColor. "/ white
+            redMap at:colorIndex put:0.
+            greenMap at:colorIndex put:0.
+            blueMap at:colorIndex put:0.
+            maskPixelValue := colorIndex-1.
+        ] ifFalse:[
+            color := Color name:colorName ifIllegal:Color black.
+            redMap at:colorIndex put:(color red asFloat * 255.0 // 100).
+            greenMap at:colorIndex put:(color green asFloat * 255.0 // 100).
+            blueMap at:colorIndex put:(color blue asFloat * 255.0 // 100).
+        ].
     ].
 
     "actually, could make it an image with less depth most of the time ..."
@@ -344,37 +342,64 @@
 
     dstIndex := 1.
     1 to:height do:[:row |
-	line := aStream nextLine withoutSpaces.
-	[line notNil and:[line startsWith:'/*']] whileTrue:[
-	    line := aStream nextLine withoutSpaces.
-	].
-	line notNil ifTrue:[
-	    line := line withoutSeparators
-	].
-	(line notNil and:[line startsWith:'"']) ifFalse:[
-	    ^ self fileFormatError:'format error (expected pixels)'.
-	].
-	charsPerPixel ~~ 1 ifTrue:[
-	    s := line readStream.
-	    s next. "/ skip dquote
-	    1 to: width do:[:col |
-		|key|
-
-		key := s next:charsPerPixel.
-		data at:dstIndex put:(xlation at:key).
-		dstIndex := dstIndex + 1
-	    ]
-	] ifFalse:[
-	    srcIndex := 2.
-	    1 to: width do:[:col |
-		|char|
-
-		char := line at:srcIndex.
-		data at:dstIndex put:(xlation at:char asciiValue).
-		srcIndex := srcIndex + 1.
-		dstIndex := dstIndex + 1
-	    ]
-	]
+        line := aStream nextLine withoutSpaces.
+        [line notNil and:[line startsWith:'/*']] whileTrue:[
+            line := aStream nextLine withoutSpaces.
+        ].
+        line notNil ifTrue:[
+            line := line withoutSeparators
+        ].
+        (line notNil and:[line startsWith:'"']) ifFalse:[
+            ^ self fileFormatError:'format error (expected pixels)'.
+        ].
+        charsPerPixel == 1 ifTrue:[
+            srcIndex := 2. "skip dquote"
+            1 to:width do:[:col |
+                key := line at:srcIndex.
+                key ~~ lastKey ifTrue:[
+                    lastXLation := xlation at:key asciiValue.
+                    lastKey := key
+                ].
+                data at:dstIndex put:lastXLation.
+                srcIndex := srcIndex + 1.
+                dstIndex := dstIndex + 1
+            ]
+        ] ifFalse:[
+            charsPerPixel == 2 ifTrue:[
+                "/ sorry, but this ugly code does a lot for speed,
+                "/ when reading big Xpm files (factor=5 for banner8.xpm)  ...
+                srcIndex := 2."skip dquote"
+                lastChar1 := lastChar2 := nil.
+                key := String new:2.
+                1 to:width do:[:col |
+                    c1 := line at:srcIndex.
+                    c2 := line at:srcIndex+1.
+                    (c1 ~~ lastChar1 or:[c2 ~~ lastChar2]) ifTrue:[
+                        key at:1 put:c1.
+                        key at:2 put:c2.
+                        lastXLation := xlation at:key.
+                        lastChar1 := c1.
+                        lastChar2 := c2.
+                    ].
+                    data at:dstIndex put:lastXLation.
+                    srcIndex := srcIndex + 2.
+                    dstIndex := dstIndex + 1
+                ]
+            ] ifFalse:[
+                s := line readStream.
+                s next. "/ skip dquote
+                1 to:width do:[:col |
+                    key := s next:charsPerPixel.
+"/                data at:dstIndex put:(xlation at:key).
+                    key ~= lastKey ifTrue:[
+                        lastXLation := xlation at:key.
+                        lastKey := key
+                    ].
+                    data at:dstIndex put:lastXLation.
+                    dstIndex := dstIndex + 1
+                ]
+            ]
+        ]
     ].
 
     photometric := #palette.
@@ -382,7 +407,7 @@
     bitsPerSample := Array with:bitsPerPixel.
 
     maskPixelValue notNil ifTrue:[
-	self buildMaskFromColor:maskPixelValue
+        self buildMaskFromColor:maskPixelValue
     ].
 
     "
@@ -521,6 +546,6 @@
 !XPMReader class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/XPMReader.st,v 1.42 2000-08-31 10:04:08 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/XPMReader.st,v 1.43 2000-09-05 12:44:17 cg Exp $'
 ! !
 XPMReader initialize!