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).
(cherry picked from commit b5618b7d13)
This commit is contained in:
Eli Barzilay
Ryan Culpepper
parent
269549b59a
commit
baa0e1268d
|
|
@ -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