tools.deploy.windows: embed icon.ico from deployed vocab dir into deployed exe

db4
Joe Groff 2010-02-15 11:49:03 -08:00
parent f1d6082738
commit b1160f6b36
1 changed files with 21 additions and 3 deletions

View File

@ -1,11 +1,15 @@
! Copyright (C) 2007, 2009 Slava Pestov. ! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io io.files io.pathnames io.directories io.encodings.ascii kernel namespaces USING: io io.encodings.binary io.files io.pathnames io.directories
io.encodings.ascii kernel namespaces
sequences locals system splitting tools.deploy.backend sequences locals system splitting tools.deploy.backend
tools.deploy.config tools.deploy.config.editor assocs hashtables tools.deploy.config tools.deploy.config.editor assocs hashtables
prettyprint combinators windows.shell32 windows.user32 ; prettyprint combinators windows.kernel32 windows.shell32 windows.user32
alien.c-types vocabs.metadata vocabs.loader ;
IN: tools.deploy.windows IN: tools.deploy.windows
CONSTANT: app-icon-resource-id "APPICON"
: copy-dll ( bundle-name -- ) : copy-dll ( bundle-name -- )
"resource:factor.dll" swap copy-file-into ; "resource:factor.dll" swap copy-file-into ;
@ -18,12 +22,26 @@ IN: tools.deploy.windows
dup copy-dll dup copy-dll
deploy-ui? get ".exe" ".com" ? copy-vm ; deploy-ui? get ".exe" ".com" ? copy-vm ;
:: (embed-ico) ( vm ico-bytes -- )
vm 0 BeginUpdateResource :> hUpdate
hUpdate [
hUpdate RT_ICON app-icon-resource-id 0 ico-bytes dup byte-length
UpdateResource drop
hUpdate 0 EndUpdateResource drop
] when ;
: embed-ico ( vm vocab -- )
dup vocab-windows-icon-path vocab-append-path dup exists?
[ binary file-contents (embed-ico) ]
[ 2drop ] if ;
M: winnt deploy* M: winnt deploy*
"resource:" [ "resource:" [
dup deploy-config [ dup deploy-config [
deploy-name get deploy-name get
{ {
[ create-exe-dir ] [ create-exe-dir dup ]
[ drop embed-ico ]
[ image-name ] [ image-name ]
[ drop namespace make-deploy-image ] [ drop namespace make-deploy-image ]
[ nip "" copy-resources ] [ nip "" copy-resources ]