Do the conventional DMG layout.
Note that this requires a running Finder. Note also that the process involves attaching the created DMG which means that it might be problematic with a machine that might have a volume by the same name already attached (since the applescript uses the volume name, which is not required to be unique).
This commit is contained in:
Eli Barzilay
parent
a3a47128de
commit
b5618b7d13
|
|
@ -166,6 +166,8 @@ sitemapdir="$scriptdir/sitemap"
|
|||
|
||||
# platform-installer stuff, all relative to the racket tree
|
||||
nsisdir="$scriptdir/nsis"
|
||||
dmgdir="$scriptdir/dmg"
|
||||
dmgbackground="$dmgdir/racket-rising.png"
|
||||
unixinstallerdir="$scriptdir/unix-installer"
|
||||
unixpathcheckscript="$unixinstallerdir/check-install-paths"
|
||||
unixinstallerscript="$unixinstallerdir/installer-header"
|
||||
|
|
@ -1713,12 +1715,13 @@ tgz_to_zip() {
|
|||
_rm "$tmpdir/tgz-to-zip-$$"
|
||||
}
|
||||
#----------------------------------------
|
||||
make_dmg() { # inputs: dir, dmg
|
||||
local srcdir="$1" tgtdmg="$2"; shift 2
|
||||
make_dmg() { # inputs: dir, dmg, bg-image
|
||||
local srcdir="$1" tgtdmg="$2" tmpbg="$3"; shift 3
|
||||
local tmpdmg="${tgtdmg%.dmg}-tmp.dmg"
|
||||
local src="$(basename "$srcdir")"
|
||||
local myself="$(id -nu):$(id -ng)"
|
||||
show "Making \"$tgtdmg\" from \"$srcdir\""
|
||||
_cp "$tmpbg" "$srcdir"
|
||||
_cd "$(dirname "$srcdir")"
|
||||
_run sudo rm -f "$tgtdmg" "$tmpdmg"
|
||||
# It should be possible to create dmgs normally, but they'd be created with
|
||||
|
|
@ -1732,21 +1735,59 @@ make_dmg() { # inputs: dir, dmg
|
|||
# -mode 555 -volname "$src" -srcfolder "$src" "$tgtdmg"
|
||||
# so: [1] create an uncompressed image
|
||||
_run sudo hdiutil create -format UDRW -ov \
|
||||
-mode 555 -volname "$src" -srcfolder "$src" "$tmpdmg"
|
||||
-mode 755 -volname "$src" -srcfolder "$src" "$tmpdmg"
|
||||
# [2] remove the source tree
|
||||
_run sudo rm -rf "$src"
|
||||
# [3] create the compressed image from the uncompressed image
|
||||
# [3] do the expected dmg layout (see below)
|
||||
easy_dmg_layout "$tmpdmg" "$src" "$(basename "$tmpbg")"
|
||||
# [4] create the compressed image from the uncompressed image
|
||||
_run sudo hdiutil convert -format UDZO -imagekey zlib-level=9 -ov \
|
||||
"$tmpdmg" -o "$tgtdmg"
|
||||
# [4] remove the uncompressed image
|
||||
# [5] remove the uncompressed image
|
||||
_run sudo chown "$myself" "$tgtdmg" "$tmpdmg"
|
||||
_rm "$tmpdmg"
|
||||
}
|
||||
easy_dmg_layout() {
|
||||
local tmpdmg="$1" volname="$2" bg="$3"; shift 3
|
||||
show "Mounting image for layout"
|
||||
local vol_dev="$(
|
||||
sudo hdiutil attach -readwrite -noverify -noautoopen "$tmpdmg" \
|
||||
| grep '/dev/' | head -1 | awk '{print $1}')"
|
||||
show "Creating layout via Finder"
|
||||
sudo /usr/bin/osascript <<-EOF
|
||||
tell application "Finder"
|
||||
tell disk "$volname"
|
||||
open
|
||||
set current view of container window to icon view
|
||||
set toolbar visible of container window to false
|
||||
set statusbar visible of container window to false
|
||||
set bounds of container window to {320, 160, 1000, 540}
|
||||
set theViewOptions to the icon view options of container window
|
||||
set arrangement of theViewOptions to not arranged
|
||||
set icon size of theViewOptions to 128
|
||||
set text size of theViewOptions to 16
|
||||
set background picture of theViewOptions to file "$bg"
|
||||
make new alias file at container window to POSIX file "/Applications" with properties {name:"Applications"}
|
||||
set position of item "$volname" of container window to {170, 180}
|
||||
set position of item "$bg" of container window to {900, 180}
|
||||
set position of item "Applications" of container window to {500, 180}
|
||||
set name of file "$bg" to ".$bg"
|
||||
close
|
||||
open
|
||||
update without registering applications
|
||||
delay 5
|
||||
close
|
||||
end tell
|
||||
end tell
|
||||
EOF
|
||||
sync; sync
|
||||
_run sudo hdiutil detach "$vol_dev"
|
||||
}
|
||||
#----------------------------------------
|
||||
do_tgz_to_dmg() {
|
||||
local tmptgz="$1" tmpdmg="$2" version="$3"
|
||||
local pname="$4" ptype="$5" srcplatform="$6"
|
||||
shift 6
|
||||
local tmptgz="$1" tmpdmg="$2" tmpbg="$3"
|
||||
local version="$4" pname="$5" ptype="$6" srcplatform="$7"
|
||||
shift 7
|
||||
local distname="$(name_of_dist_package "$pname")"
|
||||
distname="$distname v$version"
|
||||
if [[ "$ptype" != "bin" ]]; then
|
||||
|
|
@ -1760,7 +1801,7 @@ do_tgz_to_dmg() {
|
|||
_rm "$tmptgz"
|
||||
_mv "$installdir" "$distname"
|
||||
_cd "$tmpdir/tgz-to-dmg-$$"
|
||||
make_dmg "$distname" "$tmpdmg"
|
||||
make_dmg "$distname" "$tmpdmg" "$tmpbg"
|
||||
_cd "$savedpwd"
|
||||
_rm "$tmpdir/tgz-to-dmg-$$"
|
||||
}
|
||||
|
|
@ -1768,9 +1809,12 @@ tgz_to_dmg() {
|
|||
local srctgz="$1" tgt="$2" pname="$3" ptype="$4" srcplatform="$5"; shift 5
|
||||
local tmptgz="$tmpdir/tgz2dmg.tgz"
|
||||
local tmpdmg="$tmpdir/tgz2dmg.dmg"
|
||||
local tmpbg="$tmpdir/bg.png"
|
||||
_scp "$srctgz" "${dmgmachine}:$tmptgz"
|
||||
_scp "$PLTHOME/$dmgbackground" "${dmgmachine}:$tmpbg"
|
||||
run_part "$dmgmachine" "do_tgz_to_dmg" \
|
||||
"$tmptgz" "$tmpdmg" "$version" "$pname" "$ptype" "$srcplatform"
|
||||
"$tmptgz" "$tmpdmg" "$tmpbg" \
|
||||
"$version" "$pname" "$ptype" "$srcplatform"
|
||||
_scp "${dmgmachine}:$tmpdmg" "$tgt.dmg"
|
||||
}
|
||||
#----------------------------------------
|
||||
|
|
|
|||
BIN
collects/meta/build/dmg/128x128-arrow.png
Normal file
BIN
collects/meta/build/dmg/128x128-arrow.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 4.9 KiB |
194
collects/meta/build/dmg/disk-image-background.rkt
Normal file
194
collects/meta/build/dmg/disk-image-background.rkt
Normal file
|
|
@ -0,0 +1,194 @@
|
|||
#lang racket/base
|
||||
|
||||
(require slideshow racket/gui/base racket/runtime-path)
|
||||
|
||||
(provide plt-title-background
|
||||
make-plt-title-background
|
||||
plt-red-color
|
||||
plt-blue-color
|
||||
plt-background-color
|
||||
plt-lambda-color
|
||||
plt-pen-color
|
||||
plt-pen-style)
|
||||
|
||||
(define plt-red-color (make-object color% 242 183 183))
|
||||
(define plt-blue-color (make-object color% 183 202 242))
|
||||
(define plt-background-color (make-object color% 209 220 248))
|
||||
(define plt-lambda-color (send the-color-database find-color "white"))
|
||||
(define plt-pen-color "black")
|
||||
(define plt-pen-style 'transparent)
|
||||
|
||||
(define (with-dc-settings dc thunk)
|
||||
(define alpha (send dc get-alpha))
|
||||
(define smoothing (send dc get-smoothing))
|
||||
(define pen (send dc get-pen))
|
||||
(define brush (send dc get-brush))
|
||||
(thunk)
|
||||
(send* dc (set-alpha alpha)
|
||||
(set-smoothing smoothing)
|
||||
(set-pen pen)
|
||||
(set-brush brush)))
|
||||
|
||||
(define (make-plt-title-background
|
||||
red-color blue-color background-color lambda-color pen-color pen-style
|
||||
#:clip? [clip? #t] #:edge-cleanup-pen [edge-cleanup-pen #f])
|
||||
(define-syntax-rule (make-path cmd ...)
|
||||
(let ([p (new dc-path%)]) (send* p cmd ...) p))
|
||||
(define left-lambda-path
|
||||
(make-path (move-to 153 44)
|
||||
(line-to 161.5 60)
|
||||
(curve-to 202.5 49 230 42 245 61)
|
||||
(curve-to 280.06 105.41 287.5 141 296.5 186)
|
||||
(curve-to 301.12 209.08 299.11 223.38 293.96 244)
|
||||
(curve-to 281.34 294.54 259.18 331.61 233.5 375)
|
||||
(curve-to 198.21 434.63 164.68 505.6 125.5 564)
|
||||
(line-to 135 572)))
|
||||
(define left-logo-path
|
||||
(make-path (append left-lambda-path)
|
||||
(arc 0 0 630 630 (* 235/360 2 pi) (* 121/360 2 pi) #f)))
|
||||
(define bottom-lambda-path
|
||||
(make-path (move-to 135 572)
|
||||
(line-to 188.5 564)
|
||||
(curve-to 208.5 517 230.91 465.21 251 420)
|
||||
(curve-to 267 384 278.5 348 296.5 312)
|
||||
(curve-to 301.01 302.98 318 258 329 274)
|
||||
(curve-to 338.89 288.39 351 314 358 332)
|
||||
(curve-to 377.28 381.58 395.57 429.61 414 477)
|
||||
(curve-to 428 513 436.5 540 449.5 573)
|
||||
(line-to 465 580)
|
||||
(line-to 529 545)))
|
||||
(define bottom-logo-path
|
||||
(make-path (append bottom-lambda-path)
|
||||
(arc 0 0 630 630 (* 314/360 2 pi) (* 235/360 2 pi) #f)))
|
||||
(define right-lambda-path
|
||||
(make-path (move-to 153 44)
|
||||
(curve-to 192.21 30.69 233.21 14.23 275 20)
|
||||
(curve-to 328.6 27.4 350.23 103.08 364 151)
|
||||
(curve-to 378.75 202.32 400.5 244 418 294)
|
||||
(curve-to 446.56 375.6 494.5 456 530.5 537)
|
||||
(line-to 529 545)))
|
||||
(define right-logo-path
|
||||
(make-path (append right-lambda-path)
|
||||
(arc 0 0 630 630 (* 314/360 2 pi) (* 121/360 2 pi) #t)))
|
||||
(define lambda-path ;; the lambda by itself (no circle)
|
||||
(let ([p (new dc-path%)])
|
||||
(send p append left-lambda-path)
|
||||
(send p append bottom-lambda-path)
|
||||
(let ([t (make-object dc-path%)])
|
||||
(send t append right-lambda-path)
|
||||
(send t reverse)
|
||||
(send p append t))
|
||||
(send p close)
|
||||
p))
|
||||
|
||||
;; (define lambda-path
|
||||
;; (make-path (append left-lambda-path)
|
||||
;; (append bottom-lambda-path)
|
||||
;; (append right-lambda-path)))
|
||||
|
||||
;; This function draws the paths with suitable colors:
|
||||
(define (paint-plt dc dx dy)
|
||||
(send dc set-smoothing 'aligned)
|
||||
(define old-pen (send dc get-pen))
|
||||
(define old-brush (send dc get-brush))
|
||||
(define old-clip (send dc get-clipping-region))
|
||||
(send dc set-pen pen-color 0 pen-style)
|
||||
(cond [(procedure? lambda-color)
|
||||
(with-dc-settings dc
|
||||
(λ () (lambda-color dc)
|
||||
(send dc draw-path lambda-path dx dy)))]
|
||||
[lambda-color
|
||||
(send* dc (set-brush lambda-color 'solid)
|
||||
(draw-path lambda-path dx dy))]
|
||||
[else (void)])
|
||||
;; Draw red regions
|
||||
(cond [(is-a? red-color bitmap%)
|
||||
(define rgn1 (new region% [dc dc]))
|
||||
(define rgn2 (new region% [dc dc]))
|
||||
(send rgn1 set-path left-logo-path dx dy #;(- dx 150) #;(- dy 20))
|
||||
(send rgn2 set-path bottom-logo-path dx dy #;(- dx 150) #;(- dy 20))
|
||||
(send rgn2 union rgn1)
|
||||
(send dc set-clipping-region rgn2)
|
||||
;; the left and top values of the bounding box seem to change over
|
||||
;; time, so I've just put reasonable numbers below.
|
||||
(let-values ([(sw sh) (send dc get-scale)])
|
||||
(send* dc (set-scale 1 1)
|
||||
(draw-bitmap red-color 220 100)
|
||||
(set-scale sw sh)))
|
||||
(send dc set-clipping-region old-clip)
|
||||
(cleanup-edges left-logo-path dc dx dy)
|
||||
(cleanup-edges bottom-logo-path dc dx dy)]
|
||||
[(procedure? red-color)
|
||||
(with-dc-settings dc
|
||||
(λ () (red-color dc)
|
||||
(send* dc (draw-path left-logo-path dx dy)
|
||||
(draw-path bottom-logo-path dx dy))))]
|
||||
[else (send* dc (set-brush red-color 'solid)
|
||||
(draw-path left-logo-path dx dy)
|
||||
(draw-path bottom-logo-path dx dy))])
|
||||
;; Draw blue region
|
||||
(cond [(is-a? blue-color bitmap%)
|
||||
(define rgn (new region% [dc dc]))
|
||||
(send rgn set-path right-logo-path dx dy #;(- dx 150) #;(- dy 20))
|
||||
(send dc set-clipping-region rgn)
|
||||
;; the left and top values of the bounding box seem to change over
|
||||
;; time, so I've just put reasonable numbers below.
|
||||
(let-values ([(sw sh) (send dc get-scale)])
|
||||
(send* dc (set-scale 1 1)
|
||||
(draw-bitmap blue-color 430 50)
|
||||
(set-scale sw sh)))
|
||||
(send dc set-clipping-region old-clip)
|
||||
(cleanup-edges right-logo-path dc dx dy)]
|
||||
[(procedure? blue-color)
|
||||
(with-dc-settings dc
|
||||
(λ () (blue-color dc)
|
||||
(send dc draw-path right-logo-path dx dy)))]
|
||||
[else (send* dc (set-brush blue-color 'solid)
|
||||
(draw-path right-logo-path dx dy))])
|
||||
(send* dc (set-pen old-pen)
|
||||
(set-brush old-brush)
|
||||
(set-clipping-region old-clip)))
|
||||
(define (cleanup-edges path dc dx dy)
|
||||
(when edge-cleanup-pen
|
||||
(define pen (send dc get-pen))
|
||||
(define brush (send dc get-brush))
|
||||
(define alpha (send dc get-alpha))
|
||||
(send* dc (set-pen edge-cleanup-pen)
|
||||
(set-brush "black" 'transparent)
|
||||
(set-alpha .8)
|
||||
(draw-path path dx dy)
|
||||
(set-pen pen)
|
||||
(set-brush brush)
|
||||
(set-alpha alpha))))
|
||||
(define image (pin-over
|
||||
(if background-color
|
||||
(colorize (filled-rectangle client-w client-h)
|
||||
background-color)
|
||||
(blank client-w client-h))
|
||||
320 50
|
||||
(scale (dc paint-plt 630 630 0 0) 12/10)))
|
||||
(if clip? (clip image) image))
|
||||
|
||||
(define plt-title-background
|
||||
(make-plt-title-background plt-red-color
|
||||
plt-blue-color
|
||||
plt-background-color
|
||||
plt-lambda-color
|
||||
plt-pen-color
|
||||
plt-pen-style))
|
||||
|
||||
(define-runtime-path arrow.png "128x128-arrow.png")
|
||||
(define blue-arrow (read-bitmap arrow.png))
|
||||
|
||||
(define result.png "racket-rising.png")
|
||||
|
||||
(define size 1)
|
||||
(define bmp (make-bitmap (round (* 1024 size 2/3)) (* 768 size 1/2)))
|
||||
(define bdc (make-object bitmap-dc% bmp))
|
||||
(draw-pict (scale plt-title-background size) bdc -100 0)
|
||||
(void (send bdc draw-bitmap
|
||||
blue-arrow
|
||||
(/ (- (send bmp get-width) (send blue-arrow get-width)) 2)
|
||||
(/ (- (send bmp get-height) (send blue-arrow get-height)) 2)))
|
||||
(when (send bmp save-file result.png 'png)
|
||||
(printf "wrote ~a\n" result.png))
|
||||
BIN
collects/meta/build/dmg/racket-rising.png
Normal file
BIN
collects/meta/build/dmg/racket-rising.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 16 KiB |
Loading…
Reference in New Issue
Block a user