]> gitweb.factorcode.org Git - factor.git/commitdiff
tools.deploy.windows: embed icon.ico from deployed vocab dir into deployed exe
authorJoe Groff <arcata@gmail.com>
Mon, 15 Feb 2010 19:49:03 +0000 (11:49 -0800)
committerJoe Groff <arcata@gmail.com>
Mon, 15 Feb 2010 19:49:03 +0000 (11:49 -0800)
basis/tools/deploy/windows/windows.factor

index 4dad8751282bd2481bd70a5ca5fff73bdb9eb46e..9df13a9cdd53de04ade659c79aa16955e255250d 100644 (file)
@@ -1,11 +1,15 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! 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
 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
 
+CONSTANT: app-icon-resource-id "APPICON"
+
 : copy-dll ( bundle-name -- )
     "resource:factor.dll" swap copy-file-into ;
 
@@ -18,12 +22,26 @@ IN: tools.deploy.windows
     dup copy-dll
     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*
     "resource:" [
         dup deploy-config [
             deploy-name get
             {
-                [ create-exe-dir ]
+                [ create-exe-dir dup ]
+                [ drop embed-ico ]
                 [ image-name ]
                 [ drop namespace make-deploy-image ]
                 [ nip "" copy-resources ]