-
Notifications
You must be signed in to change notification settings - Fork 26
/
build.rkt
164 lines (141 loc) · 5.81 KB
/
build.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
#lang racket/base
;; build.rkt -- utilities for building the ActivityLog2 application
;; This file is part of ActivityLog2, an fitness activity tracker
;; Copyright (C) 2015, 2018, 2019, 2020 Alex Harsányi <AlexHarsanyi@gmail.com>
;;
;; This program is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; Software Foundation, either version 3 of the License, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
;; more details.
;; NOTE: Gracket instance used to run this might have to have "debugging"
;; disabled in the Language menu
(require compiler/cm
compiler/distribute
compiler/embed
file/ico
images/icons/stickman
launcher/launcher
racket/class
racket/draw
racket/file
racket/math
racket/port
racket/string
racket/system)
;; Create an ICO file from the bitmap BMP. The resulting icon will be square
;; even if BMP is not. The height of BMP will determine the size of the icon.
(define (bitmap->ico bmp)
(let* ((w (send bmp get-width))
(h (send bmp get-height))
(d (send bmp get-depth))
(buf (make-bytes (* w h 4))))
(send bmp get-argb-pixels 0 0 w h buf)
;; Bitmaps generated by the icon tools are not square... make a square one
(let ((nbmp (make-object bitmap% h h #f #t))
(ofs (exact-round (/ (- h w) 2))))
(send nbmp set-argb-pixels ofs 0 w h buf)
(let ((nbuf (make-bytes (* h h 4))))
(send nbmp get-argb-pixels 0 0 h h nbuf)
(argb->ico h h nbuf #:depth d)))))
(define base-color (make-object color% 68 114 196))
;; Create an application icon of SIZE height
(define (make-app-icon size)
(let ((bmp (running-stickman-icon 0.9 #:height size
#:body-color base-color
#:arm-color "white"
#:head-color "white")))
(bitmap->ico bmp)))
;; Create an icon in ICON-FILE by applying MAKE-ICON-FN to each size in
;; ICON-SIZES and writing the result to disk.
(define (create-icon-file icon-file make-icon-fn icon-sizes)
(let ((icons (map make-icon-fn icon-sizes)))
(write-icos icons icon-file #:exists 'replace)))
;; Icon sizes we will generate
(define icon-sizes '(16 20 24 32 40 48 64 96 128 256))
(define app-icon-file "ActivityLog2.ico")
(define app-exe-file "ActivityLog2.exe")
;; Write the application logo to file-name. This function needs to be
;; manually invoked.
(define (write-logo file-name)
(let ((bmp (running-stickman-icon
0.9 #:height 128
#:body-color base-color
#:arm-color "white"
#:head-color "white"
)))
(send bmp save-file file-name 'png)))
(define (app-revision)
(parameterize ((current-error-port (open-output-bytes)))
(let ((rev (string-trim (with-output-to-string
(lambda () (system "git rev-parse HEAD")))))
(status (with-output-to-string
(lambda () (system "git status --porcelain")))))
(if (string=? status "")
rev
(format "~a (modified)" rev)))))
(define (compile-app)
(define revision (app-revision))
;; Write the application revision, version.rkt will read it in and store it
;; in the compiled .zo file.
(with-output-to-file "./build-id.txt"
(lambda () (printf "~a~%" revision))
#:mode 'text #:exists 'truncate/replace)
(managed-compile-zo "./rkt/main.rkt")
(managed-compile-zo "./run.rkt"))
(define (build-app)
(unless (file-exists? app-icon-file)
(create-icon-file app-icon-file make-app-icon icon-sizes))
(parameterize
([use-compiled-file-paths (list "compiled")])
(create-embedding-executable
app-exe-file
#:modules '((#f "run.rkt"))
#:mred? #t
#:configure-via-first-module? #t
#:expand-namespace (make-base-namespace)
#:literal-expression
(parameterize ([current-namespace (make-base-namespace)])
(compile `(namespace-require ''run)))
#:aux (build-aux-from-path app-icon-file))))
(define (mkdist)
(assemble-distribution
"dist"
(list app-exe-file)))
(define issc-program "C:/Program Files (x86)/Inno Setup 6/iscc.exe")
(define (mkinstaller)
(define version (string-trim (file->string "./version.txt" #:mode 'text)))
;; Azure Builds store a unique incrementing build id in the BUILD_BUILDID
;; environment variable. Append it to the version number if we have it.
(define build-id (getenv "BUILD_BUILDID"))
(define v (if (and build-id (string->number build-id))
(string-append version "." build-id)
version))
(system (format "\"~a\" /DMyAppVersion=~a etc/scripts/install.iss" issc-program v)))
(module+ main
(require "rkt/check-missing-modules.rkt")
;; Check and inform the user that these packages need to be installed...
(check-missing-modules
the-application
tzinfo
tzgeolookup
data-frame
plot-container
gui-widget-mixins
map-widget
geoid)
;; If this file is invoked from the command line, the application will be
;; built automatically (including the installer)
(printf "Compiling .zo files...")(flush-output (current-output-port))
(compile-app)
(printf " done.")(newline)(flush-output (current-output-port))
(printf "Building application executable...")(flush-output (current-output-port))
(build-app)
(printf " done.")(newline)(flush-output (current-output-port))
(printf "Assembling distribution...")(flush-output (current-output-port))
(mkdist)
(printf " done.")(newline)(flush-output (current-output-port)))