Bit-frobbing in Curl, a programming language: http://www.curl.com/

icon.curl

|| See http://msdn2.microsoft.com/en-us/library/ms997538.aspx

|| A .ico file is an IconDir followed by 0 or more IconDirEntry
|| objects, one for each icon pixmap in the file.  Each IconDirEntry
|| describes an IconImage object.  All the IconImage objects are in a
|| last section following all the IconDirEntry objects.

|| Note: Encode every icon with 32-bit pixels because that's where the
|| world is headed anyway, and it is much simpler.

||""((

|| Write value as an unaligned little-endian integer to bos.
||
{define-proc package {write-le-byte     || Win32 BYTE
                        bos:ByteOutputStream,
                        value:byte
                    }:int
   {bos.write-one value}
   {return 1}
}
{define-proc package {write-le-int16    || Win32 WORD
                        bos:ByteOutputStream,
                        value:int16
                    }:int
   {return
       ({write-le-byte bos, {bit-sra value, 0} asa byte} +
        {write-le-byte bos, {bit-sra value, 8} asa byte})
   }
}
{define-proc package {write-le-int32    || Win32 DWORD
                        bos:ByteOutputStream,
                        value:int32
                    }:int
   {return
       ({write-le-byte bos, {bit-sra value, 0}  asa byte}  +
        {write-le-byte bos, {bit-sra value, 8}  asa byte}  +
        {write-le-byte bos, {bit-sra value, 16} asa byte}  +
        {write-le-byte bos, {bit-sra value, 24} asa byte})
   }
}
{define-proc package {write-le-long     || Win32 LONG
                        bos:ByteOutputStream,
                        value:int
                    }:int
   {return {write-le-int32 bos, value}}
}


|| The fields in the  following classes follow the C classes.
|| Consequently some fields are defined only for documentation.
|| Some field values are ignored while writing out the objects.
|| Array fields are actually struct {int a[1]; ...} hacks in C.
||
|| The RGBQUAD struct from WINGDI.H.  This is used for encoding color
|| maps, but this implemenation doesn't use color maps.  It's defined
|| here because it is also handy for encoding XOR maps in IconImage
|| objects.  Win32 names RgbQuad.alpha 'rgbReserved' and states it
|| must always be 0, but here it suits to use it for alpha.
||
{define-class package RgbQuad
 field private constant blue:byte
 field private constant green:byte
 field private constant red:byte
 field private constant alpha:byte

 let private constant size:int = 1 + 1 + 1 + 1

 {method package {write bos:ByteOutputStream}:int
   def size =
       ({write-le-byte bos, self.blue}   +
        {write-le-byte bos, self.green}  +
        {write-le-byte bos, self.red}    +
        {write-le-byte bos, self.alpha})
   {assert size == RgbQuad.size}
   {return size}
 }

 {constructor package {default color:Pixel}
   set self.blue  = color.blue-as-uint8
   set self.green = color.green-as-uint8
   set self.red   = color.red-as-uint8
   set self.alpha = color.alpha-as-uint8
 }
}


|| The BITMAPINFOHEADER struct from WINGDI.H.
||
{define-class package BitMapInfoHeader
 field package constant size:int32 = 4 + 4 + 4 + 2 + 2 + 4 + 4 + 4 + 4 + 4 + 4
 field private constant width:int
 field private constant height:int
 field private constant planes:int16           =  1
 field private constant bit-count:int16        = 32
 field private constant compression:int32      =  0
 field private constant size-image:int32
 field private constant x-pixels-per-meter:int =  0
 field private constant y-pixels-per-meter:int =  0
 field private constant colors-used:int32      =  0
 field private constant colors-important:int32 =  0

 {method package {write bos:ByteOutputStream}:int
   def size =
       ({write-le-int32 bos, self.size}               +
        {write-le-long  bos, self.width}              +
        {write-le-long  bos, self.height}             +
        {write-le-int16 bos, self.planes}             +
        {write-le-int16 bos, self.bit-count}          +
        {write-le-int32 bos, self.compression}        +
        {write-le-int32 bos, self.size-image}         +
        {write-le-long  bos, self.x-pixels-per-meter} +
        {write-le-long  bos, self.y-pixels-per-meter} +
        {write-le-int32 bos, self.colors-used}        +
        {write-le-int32 bos, self.colors-important})
   {assert size == self.size}
   {return size}
 }

 {constructor package {default
                          icon-image:IconImage,
                          pixmap:Pixmap
                      }
   set self.width = pixmap.width
   set self.height = 2 * pixmap.height
   set self.planes = 1
   set self.size-image = icon-image.image-size
 }
}


|| The pixel data for an icon, named ICONIMAGE in WINGDI.H
|| Encode using 32-bit pixels, so self.colors is always empty.
||
{define-class package IconImage
 field private header:BitMapInfoHeader   || DIB header
 field private colors:{Array-of RgbQuad} || Color table
 field private xor-mask:{Array-of byte}  || DIB bits for XOR mask
 field private and-mask:{Array-of byte}  || DIB bits for AND mask

 || The size of the image data.
 ||
 {getter package {image-size}:int
   {assert self.colors.empty?}
   {return self.colors.size + self.xor-mask.size + self.and-mask.size}
 }

 || The total size of this including the header.
 ||
 {getter package {size}:int
   {assert self.colors.empty?}
   {return self.header.size + self.image-size}
 }

 {method package {write bos:ByteOutputStream}:int
   {assert self.colors.empty?}
   let size:int = {self.header.write bos}
   {for color in self.colors do
       set size = size + {color.write bos}
   }
   set size = size + {bos.write self.xor-mask}
   set size = size + {bos.write self.and-mask}
   {assert size == self.size}
   {return size}
 }

 || Surprise: The and-mask is word-aligned on width.
 ||
 {constructor package {default pixmap:Pixmap}
   set self.xor-mask = {{Array-of byte}}
   def and-mask-width-bytes = pixmap.width div 8
   def and-mask-width-bytes-mod = pixmap.width mod 8
   def and-mask-byte-count =
       and-mask-width-bytes + {if pixmap.width mod 8 == 0 then 0 else 1}
   def and-mask-width-words = and-mask-byte-count div 4
   def and-mask-word-count =
       and-mask-width-words + {if and-mask-byte-count mod 4 == 0 then 0 else 1}
   def and-mask-width-size = 4 * and-mask-word-count
   def and-mask-size = and-mask-width-size * pixmap.height
   set self.and-mask = {{Array-of byte}.from-size and-mask-size, 0 asa byte}
   {with-open-streams
       bos = {{ByteOutputStream-into {Array-of byte}} self.xor-mask}
    do
       || Scan bottom up.
       ||
       {for y = pixmap.height - 1 downto 0 do
           {for x = 0 below pixmap.width do
               def rgb = {RgbQuad pixmap[x, y]}
               {rgb.write bos}
           }
       }
   }
   set self.colors = {{Array-of RgbQuad}}
   set self.header = {BitMapInfoHeader self, pixmap}
 }
}


|| One entry in an IconDir, named ICONDIRENTRY in WINGDI.H.
|| Encode using 32-bit pixels and no color map.
||
{define-class package IconDirEntry
 field private constant width:byte
 field private constant height:byte
 field private constant color-count:byte =  0
 field private constant reserved:byte    =  0
 field private constant planes:int16     =  1
 field private constant bit-count:int16  = 32
 field private bytes-in-resource:int32
 field private image-offset:int32

 let package constant size:int = 1 + 1 + 1 + 1 + 2 + 2 + 4 + 4

 {method package {write bos:ByteOutputStream}:int
   def size =
       ({write-le-byte  bos, self.width}             +
        {write-le-byte  bos, self.height}            +
        {write-le-byte  bos, self.color-count}       +
        {write-le-byte  bos, self.reserved}          +
        {write-le-int16 bos, self.planes}            +
        {write-le-int16 bos, self.bit-count}         +
        {write-le-int32 bos, self.bytes-in-resource} +
        {write-le-int32 bos, self.image-offset})
   {assert size == IconDirEntry.size}
   {return size}
 }

 {constructor package {default
                          image-offset:int32,
                          icon-image:IconImage,
                          pixmap:Pixmap
                      }
   set self.width = pixmap.width asa byte
   set self.height = pixmap.height asa byte
   set self.bytes-in-resource = icon-image.size
   set self.image-offset = image-offset
 }
}


|| The .ico file header named ICONDIR in WINGDI.H.
|| It is followed by self.count IconDirEntry objects.
|| The IconImage objects follow the IconDirEntry objects.
||
{define-class package IconDir
 field private constant reserved:int16 = 0
 field private constant type:int16     = 1
 field private constant count:int16
 ||
 || IconDir.count entries: an entry for each image.
 ||
 field private entries:{Array-of IconDirEntry}

 let private constant size:int = 2 + 2 + 2

 {method package {write bos:ByteOutputStream}:int
   let size:int =
       ({write-le-int16 bos, self.reserved} +
        {write-le-int16 bos, self.type}     +
        {write-le-int16 bos, self.count})
   {assert size == IconDir.size}
   {for e in self.entries do
       set size = size + {e.write bos}
   }
   {return size}
 }

 {constructor package {default
                          icon-images:{Array-of IconImage},
                          pixmaps:{Array-of Pixmap}
                      }
   set self.count = icon-images.size asa int16
   set self.entries = {{Array-of IconDirEntry} efficient-size = self.count}
   let image-offset:int32 = IconDir.size + self.count * IconDirEntry.size
   {for n = 0 below self.count do
       def icon-image = icon-images[n]
       def pixmap = pixmaps[n]
       {self.entries.append {IconDirEntry image-offset, icon-image, pixmap}}
       set image-offset = image-offset + icon-image.size
   }
 }
}


|| Combine install-icons into win32-icon-file and return it.
|| Return something usable on error, currently "curl.ico".
|| Otherwise, return win32-icon-file.
||
{define-proc package {make-icon-file
                        win32-icon-file:Url,
                        install-icons:#{Array-of Url}
                    }:Url
   let result:Url = {host-localize-url "images/curl.ico"}
   {if install-icons != null and not install-icons.empty? then
       def icons = {non-null install-icons}
       {try
           {with-open-streams
               bos = {write-open-byte win32-icon-file}
            do
               def count = icons.size
               def pixmaps = {{Array-of Pixmap} efficient-size = count}
               def icon-images = {{Array-of IconImage} efficient-size = count}
               {for icon in icons do
                   def pixmap = {Pixmap.from-url icon}
                   def ok? =
                       ((pixmap.width == pixmap.height) and
                        ((pixmap.width == 256) or
                         (pixmap.width == 128) or
                         (pixmap.width ==  64) or
                         (pixmap.width ==  48) or
                         (pixmap.width ==  32) or
                         (pixmap.width ==  16)))
                   {if ok? then
                       {pixmaps.append pixmap}
                       {icon-images.append {IconImage pixmap}}
                   }
               }
               def icon-dir = {IconDir icon-images, pixmaps}
               let size:int = {icon-dir.write bos}
               {for icon-image in icon-images do
                   set size = size + {icon-image.write bos}
               }
           }
           set result = win32-icon-file
        catch ignore:Exception do
       }
   }
   {return result}
}

||""))