first attempt in saving ICO files.
authorClaus Gittinger <cg@exept.de>
Sun, 09 May 1999 16:38:04 +0200
changeset 1167 78084516ae7c
parent 1166 4892defb2ab6
child 1168 590e5660f69e
first attempt in saving ICO files.
WinIconRdr.st
WindowsIconReader.st
--- a/WinIconRdr.st	Thu May 06 23:17:08 1999 +0200
+++ b/WinIconRdr.st	Sun May 09 16:38:04 1999 +0200
@@ -360,9 +360,9 @@
     (header startsWith:#(16r53 16r5A)) ifTrue:[     "SZ"
         'WinIconReader [warning]: OS/2 SZ format not supported:' infoPrintNL.
         ^ nil.
-        aStream position:1.
-        'WinIconReader [info]: OS/2 SZ format' infoPrintNL.
-        ^ self fromOS2Stream:aStream
+"/        aStream position:1.
+"/        'WinIconReader [info]: OS/2 SZ format' infoPrintNL.
+"/        ^ self fromOS2Stream:aStream
     ].
     (header startsWith:#(0 0 1 0)) ifTrue:[
         aStream position:1.
@@ -807,11 +807,121 @@
     "
 
     "Modified: 21.10.1997 / 05:02:02 / 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."
+
+    |depth bhSize biSize biClrUsed biSizeImage bfOffBits rowBytes imgBytesPerRow data srcIndex row|
+
+    depth := image depth.
+    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.
+
+    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.
+    ].
+
+    imgBytesPerRow := image bytesPerRow.
+    data := image data.
+
+
+    "/ 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.
+    ].
+
+    "/ the mask ...
+    image mask isNil ifTrue:[
+        outStream next:128 put:16rFF
+    ] ifFalse:[
+        imgBytesPerRow := image mask bytesPerRow.
+        data := image mask data.
+        row := ByteArray new:4.
+
+        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 close.
+
+    "
+     |i|
+
+     i := Image fromFile:'bitmaps/xpmBitmaps/SmalltalkX_clr.xpm'.
+     i := Depth4Image fromImage:i.
+     i := i magnifiedTo:32@32.
+     WindowsIconReader new saveICO:i onFile:'test.ico'.
+    "
+
+    "Modified: 21.10.1997 / 05:02:02 / cg"
 ! !
 
 !WindowsIconReader class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/Attic/WinIconRdr.st,v 1.42 1998-09-18 14:00:55 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/Attic/WinIconRdr.st,v 1.43 1999-05-09 14:38:04 cg Exp $'
 ! !
 WindowsIconReader initialize!
--- a/WindowsIconReader.st	Thu May 06 23:17:08 1999 +0200
+++ b/WindowsIconReader.st	Sun May 09 16:38:04 1999 +0200
@@ -360,9 +360,9 @@
     (header startsWith:#(16r53 16r5A)) ifTrue:[     "SZ"
         'WinIconReader [warning]: OS/2 SZ format not supported:' infoPrintNL.
         ^ nil.
-        aStream position:1.
-        'WinIconReader [info]: OS/2 SZ format' infoPrintNL.
-        ^ self fromOS2Stream:aStream
+"/        aStream position:1.
+"/        'WinIconReader [info]: OS/2 SZ format' infoPrintNL.
+"/        ^ self fromOS2Stream:aStream
     ].
     (header startsWith:#(0 0 1 0)) ifTrue:[
         aStream position:1.
@@ -807,11 +807,121 @@
     "
 
     "Modified: 21.10.1997 / 05:02:02 / 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."
+
+    |depth bhSize biSize biClrUsed biSizeImage bfOffBits rowBytes imgBytesPerRow data srcIndex row|
+
+    depth := image depth.
+    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.
+
+    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.
+    ].
+
+    imgBytesPerRow := image bytesPerRow.
+    data := image data.
+
+
+    "/ 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.
+    ].
+
+    "/ the mask ...
+    image mask isNil ifTrue:[
+        outStream next:128 put:16rFF
+    ] ifFalse:[
+        imgBytesPerRow := image mask bytesPerRow.
+        data := image mask data.
+        row := ByteArray new:4.
+
+        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 close.
+
+    "
+     |i|
+
+     i := Image fromFile:'bitmaps/xpmBitmaps/SmalltalkX_clr.xpm'.
+     i := Depth4Image fromImage:i.
+     i := i magnifiedTo:32@32.
+     WindowsIconReader new saveICO:i onFile:'test.ico'.
+    "
+
+    "Modified: 21.10.1997 / 05:02:02 / cg"
 ! !
 
 !WindowsIconReader class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview2/WindowsIconReader.st,v 1.42 1998-09-18 14:00:55 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview2/WindowsIconReader.st,v 1.43 1999-05-09 14:38:04 cg Exp $'
 ! !
 WindowsIconReader initialize!