1 USING: accessors alien alien.data alien.c-types classes.struct
2 combinators io.backend kernel locals
3 math sequences specialized-arrays splitting
4 windows.kernel32 windows.types ;
5 IN: tools.deploy.windows.ico
14 STRUCT: ico-directory-entry
22 { ImageOffset DWORD } ;
23 SPECIALIZED-ARRAY: ico-directory-entry
25 STRUCT: group-directory-entry
33 { ImageResourceID WORD } ;
35 : ico>group-directory-entry ( ico i -- group )
37 [ Width>> ] [ Height>> ] [ Colors>> ] [ Reserved>> ]
38 [ Planes>> ] [ BitsPerPixel>> ] [ ImageSize>> ]
39 } cleave ] [ 1 + ] bi* group-directory-entry boa >c-ptr ; inline
41 : ico-icon ( directory-entry bytes -- subbytes )
42 [ [ ImageOffset>> dup ] [ ImageSize>> + ] bi ] dip subseq ; inline
44 :: ico-group-and-icons ( bytes -- group-bytes icon-bytes )
45 bytes ico-header memory>struct :> header
47 ico-header heap-size bytes <displaced-alien>
48 header ImageCount>> ico-directory-entry <c-direct-array> :> directory
50 directory dup length <iota> [ ico>group-directory-entry ] { } 2map-as
52 directory [ bytes ico-icon ] { } map-as :> icon-bytes
54 header clone >c-ptr group-directory concat append
57 ERROR: unsupported-ico-format bytes format ;
59 : check-ico-type ( bytes -- bytes )
61 "PNG" unsupported-ico-format
64 "UNKNOWN" unsupported-ico-format
69 :: embed-icon-resource ( exe ico-bytes id -- )
70 exe normalize-path 1 BeginUpdateResource :> hUpdate
72 ico-bytes check-ico-type ico-group-and-icons :> ( group icons )
73 hUpdate RT_GROUP_ICON id 0 group dup byte-length
77 hUpdate RT_ICON i 1 + MAKEINTRESOURCE 0 icon dup byte-length
81 hUpdate 0 EndUpdateResource drop