#FEATURE by cg
authorClaus Gittinger <cg@exept.de>
Wed, 13 Sep 2017 10:26:09 +0200
changeset 4012 af495a29eafa
parent 4011 0dfddf756e27
child 4013 8e5323ca9c4d
#FEATURE by cg class: WindowsIconReader added: #saveBMP:withFileHeader:onStream: changed: #fromWindowsBMPStream:alreadyRead: #save:onFile: #saveBMP:onFile: #saveICO:onFile: class: WindowsIconReader class changed: #initialize
WindowsIconReader.st
--- a/WindowsIconReader.st	Wed Sep 13 10:15:34 2017 +0200
+++ b/WindowsIconReader.st	Wed Sep 13 10:26:09 2017 +0200
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
  COPYRIGHT (c) 1993 by Claus Gittinger
 	      All Rights Reserved
@@ -261,12 +259,17 @@
     "tell Image-class, that a new fileReader is present
      for the '.bmp' and '.ico' extensions."
 
-    MIMETypes defineImageType:'image/x-MS-bitmap' suffix:'bmp' reader:self.
-    MIMETypes defineImageType:'image/x-ms-bitmap' suffix:'bmp' reader:self.
-    MIMETypes defineImageType:'image/bmp'         suffix:'bmp' reader:self.
-    MIMETypes defineImageType:nil                 suffix:'ico' reader:self.
+    MIMETypes defineImageType:'image/x-MS-bitmap'        suffix:'bmp' reader:self.
+    MIMETypes defineImageType:'image/x-ms-bitmap'        suffix:'bmp' reader:self.
+    MIMETypes defineImageType:'image/bmp'                suffix:'bmp' reader:self.
+    MIMETypes defineImageType:'image/x-icon'             suffix:'ico' reader:self.
+    MIMETypes defineImageType:'image/vnc.microsoft.icon' suffix:'ico' reader:self.
 
-    "Modified: 1.2.1997 / 15:03:59 / cg"
+    "
+     MIMETypes mimeTypeForSuffix:'ico'
+    "
+
+    "Modified (comment): / 13-09-2017 / 09:04:38 / cg"
 ! !
 
 !WindowsIconReader class methodsFor:'testing'!
@@ -1278,7 +1281,8 @@
         "/ 'WinIconReader [info]: Win3.x/Win4.x/Win5.x format' infoPrintCR.
         fileHeader isNil ifTrue:[
             self assert:(bitmapHeader unsignedInt32At:(4 + 1) MSB:false) == width.
-            self assert:(bitmapHeader signedInt32At:(8 + 1) MSB:false) == (height*2).
+            self assert:(((bitmapHeader signedInt32At:(8 + 1) MSB:false) == (height*2))
+                          or:[ (bitmapHeader signedInt32At:(8 + 1) MSB:false) == height ]).
         ] ifFalse:[    
             width := bitmapHeader unsignedInt32At:(4 + 1) MSB:false.
             height := bitmapHeader signedInt32At:(8 + 1) MSB:false.
@@ -1514,7 +1518,7 @@
     ^ self image
 
     "Modified: / 17-09-1995 / 18:48:46 / claus"
-    "Modified: / 29-08-2017 / 23:12:59 / cg"
+    "Modified: / 13-09-2017 / 09:40:01 / cg"
 !
 
 fromWindowsICOFile:aFilename
@@ -1757,40 +1761,85 @@
      Only depth 1,4,8 and 24 images can be represented in this format."
 
     aFileName asFilename suffix asLowercase = 'ico' ifTrue:[
-"/        (image depth == 4
-"/        and:[image width == 32
-"/        and:[image height == 32]]) ifTrue:[
-	    ^ self saveICO:image onFile:aFileName.
-"/        ]
+        self saveICO:image onFile:aFileName.
+        ^ self
     ].
     self saveBMP:image onFile:aFileName.
 
-    "Modified: 17.10.1997 / 20:16:53 / cg"
+    "Modified: / 13-09-2017 / 08:47:33 / cg"
 !
 
 saveBMP:image onFile:fileName
     "save image as BMP file on aFileName.
      Only depth 1,4,8 and 24 images can be represented in this format."
 
-    |depth bhSize biSize biClrUsed biSizeImage bfOffBits rowBytes imgBytesPerRow 
+    outStream := fileName asFilename writeStream.
+    outStream binary.
+
+    self saveBMP:image withFileHeader:true onStream:outStream.
+    
+    outStream close.
+
+    "
+     |i|
+
+     i := Image fromFile:'bitmaps/SBrowser.xbm'.
+     WindowsIconReader save:i onFile:'test.bmp'.
+    "
+
+    "
+     |i i2|
+
+     i := Image fromFile:'../../goodies/bitmaps/gifImages/garfield.gif'.
+     i inspect.
+     WindowsIconReader save:i onFile:'garfield.bmp'.
+     i2 := Image fromFile:'garfield.bmp'.
+     i2 inspect.
+    "
+
+    "Modified: / 13-09-2017 / 09:18:20 / cg"
+!
+
+saveBMP:imageArg withFileHeader:withFileHeaderBoolean onStream:aStream
+    "save image as BMP file on aFileName.
+     If withFileHeaderBoolean is false, no bitmapFileHeader is written (used when saving ICO files).
+     Only depth 1,4,8 and 24 images can be represented in this format."
+
+    |image depth bhSize biSize biClrUsed biSizeImage bfOffBits rowBytes imgBytesPerRow 
      bits srcIndex row|
 
+    image := imageArg.
+    
+    outStream := aStream.
+    outStream binary.
+    
     depth := image depth.
     width := image width.
     height := image height.
 
     (#(1 4 8 24 32) includes:depth) ifFalse:[
-        ^ Image cannotRepresentImageSignal
-            raiseWith:image
-            errorString:('BMP format only supports depths 1,4,8 and 24').
+        |newImage|
+        
+        Image cannotRepresentImageSignal
+            raiseRequestWith:image
+            errorString:('BMP format only supports depths 1,4,8,24 and 32').
+        newImage := ((depth < 8) ifTrue:[Depth8Image] ifFalse:[Depth32Image]) fromImage:image.   
+        image := newImage.
+        depth := image depth.
     ].
     image mask notNil ifTrue:[
-        Image informationLostQuerySignal
-            raiseWith:image
-            errorString:('BMP format does not support an imageMask').
+        |newImage|
+        
+        Image noMaskButAlphaSupportedQuerySignal
+            raiseRequestWith:image
+            errorString:('BMP format does not support an image-mask (but alpha instead)').
+        newImage := Depth32Image fromImage:image.    
+        newImage computeAlphaValuesFromMask:(image mask).
+        image := newImage.
+        depth := image depth.
     ].
 
-    bhSize := 14.  "# bytes in file header"
+    bhSize := withFileHeaderBoolean ifTrue:[14] ifFalse:[0].  "# bytes in file header"     
     biSize := 40.  "info header size in bytes"
     biClrUsed := (depth >= 24) ifTrue:[0] ifFalse:[1 bitShift: depth].  "No. color table entries"
     bfOffBits := biSize + bhSize + (4*biClrUsed).
@@ -1798,16 +1847,16 @@
     rowBytes := (((depth min:32) * width + 31) // 32) * 4.
     biSizeImage := height * rowBytes.
 
-    outStream := fileName asFilename writeStream.
-    outStream binary.
     byteOrder := #lsb.
 
-    "Write the file header"
-    self writeShort:19778.  "bfType = BM"
-    self writeLong:(bfOffBits + biSizeImage).  "Entire file size in bytes"
-    self writeLong:0.  "bfReserved"
-    self writeLong:bfOffBits.  "Offset of bitmap data from start of hdr (and file)"
-
+    withFileHeaderBoolean ifTrue:[
+        "Write the file header"
+        self writeShort:19778.                      "bfType = BM"
+        self writeLong:(bfOffBits + biSizeImage).   "Entire file size in bytes"
+        self writeLong:0.                           "bfReserved"
+        self writeLong:bfOffBits.                   "Offset of bitmap data from start of hdr (and file)"
+    ].
+    
     "Write the bitmap info header"
     outStream position: bhSize.
     self writeLong:biSize.  "info header size in bytes"
@@ -1865,8 +1914,6 @@
         outStream nextPutAll:row.
     ].
 
-    outStream close.
-
     "
      |i|
 
@@ -1884,104 +1931,68 @@
      i2 inspect.
     "
 
-    "Modified: 21.10.1997 / 05:02:02 / cg"
+    "Created: / 13-09-2017 / 09:18:14 / cg"
+    "Modified: / 13-09-2017 / 10:22:56 / cg"
 !
 
 saveICO:image onFile:fileName
-    "save image as ICO file on aFileName.
-     Only depth 4 images of size 32x32 can be represented in this format."
+    "save image as ICO file on aFileName"
 
-    |depth biSizeImage rowBytes imgBytesPerRow data srcIndex row|
+    |depth numColors bmpData savOutStream|
 
     depth := image depth.
+
+    depth > 8 ifTrue:[
+        ^ Image cannotRepresentImageSignal
+            raiseWith:image
+            errorString:('ICO format (currently) only supports depth up to 8').
+    ].
+
     width := image width.
     height := image height.
 
-    depth ~~ 4 ifTrue:[
-        ^ Image cannotRepresentImageSignal
-            raiseWith:image
-            errorString:('ICO format only supports depths 4').
-    ].
-    (width ~~ 32 or:[height ~~ 32]) ifTrue:[
-        ^ Image cannotRepresentImageSignal
-            raiseWith:image
-            errorString:('ICO format (currently) only supports 32x32 bitmaps').
-    ].
-
     "/ align rows on a longword boundary
-    rowBytes := ((depth * width + 31) // 32) * 4.
-    biSizeImage := height * rowBytes.
-
+    numColors := (1 bitShift:depth).
+    
     outStream := fileName asFilename writeStream.
     outStream binary.
     byteOrder := #lsb.
 
     "Write the file header"
-    outStream nextPutAll:#[0 0 1 0].    "/ ICO magic
-    self writeShort:1.             "/ # of images in file
-    outStream nextPut:image width.      "/
-    outStream nextPut:image height.     "/
-    outStream nextPut:(1 bitShift:image depth). "/ # of colors
-    outStream nextPutAll:#[0 0 0 0 0 ]. "/ reserved
-    self writeLong:16rE802.              "/ size pixels
-    self writeLong:16r26.                "/ offset in file
-
-    "/ 40 bytes - unknown format
-    outStream nextPutAll:(ByteArray new:40).
-
-    "/ 16-entry RGB map
-
-    1 to:16 do:[:i |  "Color map"
-        |clr r g b|
-
-        clr := image colorFromValue:i-1.
-        clr isNil ifTrue:[
-            r := g := b := 0.
-        ] ifFalse:[
-            r := clr redByte.
-            g := clr greenByte.
-            b := clr blueByte.
-        ].
-
-        "/ put B,G,R
-        outStream nextPut:b.
-        outStream nextPut:g.
-        outStream nextPut:r.
-        outStream nextPut:0.
-    ].
+    outStream nextPutAll:#[0 0].                "/ 0 magic
+    outStream nextPutAll:#[1 0].                "/ 2 magic for ICO; 2 for CUR 
+    outStream nextPutInt16:1 MSB:false.         "/ 4 # of images in file
+    
+    "Write the ICONDIRECTORY structure"
+    outStream nextPut:width.                    "/ 0
+    outStream nextPut:height.                   "/ 1
+    outStream nextPut:numColors.                "/ 2 # of colors
+    outStream nextPut:0.                        "/ 3 reserved
+    "/ for ICO: color planes (should be 0 or 1)
+    "/ for CUR: hotspot-X
+    outStream nextPutInt16:0 MSB:false.         "/ 4 color planes
+    
+    "/ for ICO: bits per pixel
+    "/ for CUR: hotspot-Y
+    outStream nextPutInt16:depth MSB:false.         "/ 6 bits per pixel
 
-    imgBytesPerRow := image bytesPerRow.
-    data := image bits.
-
-
-    "/ sorry, must extract rows individually
-    "/ (even if alignment is correct),
-    "/ since ICO saves rows bottom-to-top
-
-    row := ByteArray new:rowBytes.
-
-    srcIndex := 1 + (height * imgBytesPerRow).
-    1 to:height do:[:i |
-        srcIndex := srcIndex - imgBytesPerRow.
-        row replaceFrom:1 to:imgBytesPerRow with:data startingAt:srcIndex.
-        outStream nextPutAll:row.
+    savOutStream := outStream.
+    [
+        |bmpStream|
+        
+        bmpStream := WriteStream on:(ByteArray new:100).
+        self saveBMP:image withFileHeader:false onStream:bmpStream. 
+        bmpData := bmpStream contents.
+    ] ensure:[
+        outStream := savOutStream
     ].
+    
+    outStream nextPutInt32:(bmpData size) MSB:false.   "/ 8 size of image data
+    outStream nextPutInt32:(outStream position + 4) MSB:false.       "/ 12 offset in file
 
-    "/ the mask ...
-    image mask isNil ifTrue:[
-        outStream next:128 put:16rFF
-    ] ifFalse:[
-        imgBytesPerRow := image mask bytesPerRow.
-        data := image mask data.
-        row := ByteArray new:4.
+    "/ followed by bmp format image without bitmap-file-header
 
-        srcIndex := 1 + (height * imgBytesPerRow).
-        1 to:height do:[:i |
-            srcIndex := srcIndex - imgBytesPerRow.
-            row replaceFrom:1 to:imgBytesPerRow with:data startingAt:srcIndex.
-            outStream nextPutAll:row.
-        ].
-    ].
+    outStream nextPutAll:bmpData.
 
     outStream close.
 
@@ -1994,7 +2005,7 @@
      WindowsIconReader new saveICO:i onFile:'test.ico'.
     "
 
-    "Modified: 21.10.1997 / 05:02:02 / cg"
+    "Modified: / 13-09-2017 / 10:19:36 / cg"
 ! !
 
 !WindowsIconReader class methodsFor:'documentation'!