From b1acdfba8655803f96a2e2567df150491c0a6ff3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 5 Jan 2014 16:31:26 -0700 Subject: [PATCH] mrlib/close-icon: revise, especially for @2x Modernize by using alpha instead of constructing masks, etc. --- pkgs/gui-pkgs/gui-lib/mrlib/close-icon.rkt | 77 ++++++--------------- pkgs/icons/close@2x.png | Bin 0 -> 2220 bytes 2 files changed, 23 insertions(+), 54 deletions(-) create mode 100644 pkgs/icons/close@2x.png diff --git a/pkgs/gui-pkgs/gui-lib/mrlib/close-icon.rkt b/pkgs/gui-pkgs/gui-lib/mrlib/close-icon.rkt index 039bd253b8..b0a4bdabc2 100644 --- a/pkgs/gui-pkgs/gui-lib/mrlib/close-icon.rkt +++ b/pkgs/gui-pkgs/gui-lib/mrlib/close-icon.rkt @@ -8,48 +8,10 @@ (define-runtime-path icon-path '(lib "close.png" "icons")) (define icon 'icon-not-yet-init) -(define mask1 'mask-not-yet-init) -(define mask2 'mask-not-yet-init) -(define mask3 'mask-not-yet-init) -(define (init-masks) - (define (for-each/b bytes r g b) - (let loop ([i 0]) - (when (< i (bytes-length bytes)) - (bytes-set! bytes (+ i 1) (r (bytes-ref bytes (+ i 1)))) - (bytes-set! bytes (+ i 2) (g (bytes-ref bytes (+ i 2)))) - (bytes-set! bytes (+ i 3) (b (bytes-ref bytes (+ i 3)))) - (loop (+ i 4))))) - - (define stupid-internal-define-syntax1 - (set! icon (make-object bitmap% icon-path 'png/mask))) - (define stupid-internal-define-syntax2 - (set! mask1 (send icon get-loaded-mask))) - - (define bytes (make-bytes (* (send icon get-width) (send icon get-width) 4))) - (define bdc (make-object bitmap-dc% mask1)) - - (set! mask2 (make-object bitmap% (send mask1 get-width) (send mask1 get-height))) - (set! mask3 (make-object bitmap% (send mask1 get-width) (send mask1 get-height))) - - (send bdc get-argb-pixels 0 0 (send mask1 get-width) (send mask1 get-height) bytes) - (send bdc set-bitmap mask2) - (for-each/b bytes - (λ (x) (- 255 (floor (* (- 255 x) 2/3)))) - values - values) - (send bdc set-argb-pixels 0 0 (send mask1 get-width) (send mask1 get-height) bytes) - - (send bdc set-bitmap mask1) - (send bdc get-argb-pixels 0 0 (send mask1 get-width) (send mask1 get-height) bytes) - (send bdc set-bitmap mask3) - (for-each/b bytes - (λ (x) (- 255 (floor (* (- 255 x) 1/4)))) - values - values) - (send bdc set-argb-pixels 0 0 (send mask1 get-width) (send mask1 get-height) bytes) - - (send bdc set-bitmap #f)) +(define (init-icon) + (when (symbol? icon) + (set! icon (read-bitmap icon-path #:try-@2x? #t)))) (define close-icon% (class canvas% @@ -59,7 +21,7 @@ [bg-color #f]) (init [horizontal-pad 4] [vertical-pad 4]) - (init-masks) + (init-icon) (define mouse-in? #f) (define mouse-down? #f) @@ -82,9 +44,11 @@ (callback))] [(send evt moving?) (let ([new-mouse-in? - (and (<= (send evt get-x) + (and (<= 0 + (send evt get-x) (send icon get-width)) - (<= (send evt get-y) + (<= 0 + (send evt get-y) (send icon get-height)))]) (unless (equal? new-mouse-in? mouse-in?) (set! mouse-in? new-mouse-in?) @@ -98,20 +62,25 @@ (send dc set-pen bg-color 1 'transparent) (let-values ([(w h) (get-client-size)]) (send dc draw-rectangle 0 0 w h))) + (send dc set-alpha (cond + [(and mouse-in? + mouse-down?) + 0.5] + [(and mouse-in? + (not mouse-down?)) + 0.75] + [else + 1])) (send dc draw-bitmap icon (- (/ cw 2) (/ (send icon get-width) 2)) (- (/ ch 2) (/ (send icon get-height) 2)) 'solid - (send the-color-database find-color "black") - (cond - [(and mouse-in? - mouse-down?) - mask3] - [(and mouse-in? - (not mouse-down?)) - mask2] - [else - mask1]))))) + (send the-color-database find-color "black"))))) + + (define/override (on-superwindow-show on?) + (unless on? + (set! mouse-in? #f) + (set! mouse-down? #f))) (super-new [style '(transparent no-focus)]) (min-width (+ horizontal-pad horizontal-pad (send icon get-width))) diff --git a/pkgs/icons/close@2x.png b/pkgs/icons/close@2x.png new file mode 100644 index 0000000000000000000000000000000000000000..3289ea6d213cadd699ade40a2b1c10ee3445b10d GIT binary patch literal 2220 zcmV;d2vhfoP)XmQA*JMQL_~jvHBHk19LI5_l-Gb^;BUZ3Qp)+e@_Q!$ zLWmmRmqLgqbX|8sp-}080|&Tz^(re?tN>taY>bA623~#jRZP=NT9&0rDc=M3Nh#<4 zF91S_BH%S4#7~Ngivusb@Pf8x%^Dtl_+f&pD>2#X@{(gprhIsq! zx9wCa>-_>$=R& z&T{0)5#D|GUB|ZV1n{Voa`3hQgb;PWh_379`}gk`?d|P^LZMt{fk1#@FqotMR`EQK zOeT}l6+&Q|Cd0$Sy#D&@(z2`@z$z)_?Ee4|LKFkTilQuk=9y>Ij*bpWN=mRSi`m&( z!r?HhSFdL2(xsG^mZB(1jtMCxp68KFCYhR=;*;~|xqt0iYHDiGbsfVn=ylNg49 zVHhNnNg|O5;c%EU0|PX#T*=APrx_m~CmxUEx-M;PZFF~ct3U&=zkmTD#4_MQFc=K& z+qaL3iV8f>Z6;4|Dka_o-O4h?Of>q9_WnSd2H{e3MKjV*+27QeN>HctZ%Gc6N5=_AMHX zG8>7|wQCno?$`mq#s?qd={!|~(Ckw7pMV)ygU)45?of$l@=*E19jqX&aHj)UiUG&MD$X_{`^_AVjB9u;^D z_^zgD!S?p{T$xqZ)KFGZ!o^FMsBLPZJQT_~zOT6%y}X>ka2TN|{OGyo*tvOgLGa0V zoWFkX0gFpYC@U>xetw>GI!!vA=G?h+xUQQ5E(+jJLWrljySqgw6e1W5qU$;p6%{O9 zx|EyABzj2++q=4GuC6W!@_8(VA_Pk-DhmF;JU7SR4n4(b0jFG6z7{b?WQuX=-Z1@jUd>Qnu~fNnLF%ML>W;v4J#j zZDxj#KKu|nnM6|*CMG7Bo}R|CtQ-J<{{DVE&$}dmq^hbVjg5_jLLoFwLseB&RYlV@ zs;a7JYik2Vp{l-~M>{)NQeFL}ec<}s9LIZlh)hp|=P@!eLL?HwaU5LN#dTdA$H6pB zu3Wi->$*t|C<3r;8%0rY90yfZQ4|G5Q7}!DSS-e>RjZhtoka@-*w)oWFc>UgAd|`P zuj9u#9}c6bDx)JK7>0r8dAa3-ux;BnE7JT7d;q?(pP>+fR4T>C$Bxm^*vPjwZ$?oR zZk-{DqEJ>=#@N^xSFc8u4e4gC1$Q&%lYvG`^&N{(&;pSp#nbyDiuY^O*}uiZQEFuMdPw% zJiB)5BXA{*T-J<5MBTp*Q7;kqsWj^i*iI7lj;Mo|>L`M?7V zhr^ud>mz*jEQv${+qTJMGJf?~*_il!AS#6TE$~w*WwB*h0K{T3{@veCCY|Q9%a<7( z7~u1XiGtuh0LO9o^!#~D!(eh^f~n6wV|Z|o8#iv`swo@X0Ddi{ya9z*vH)-rSnVH3 zRaFTD0+f}NQCU^R^|?7r)6A7tz6c>u6opVI#FFZ2qLD~0bHDzx)DHn0q?AqpfUJ`` z;5@K+;it&W1|_cqze@b>nP2x=8wtdLwlBSu<~djk{1Yeviu}xc$G5wZ`y%riRUT6r zAOUQWQVtcwyUoL-E(>BgP@JFH-MkBKVJZcT16!n&Gj}w~GcE$&$Rambpilx*2q6_k zDOf@XnXi+zNdUh9g13!xyAOFlYJlGZCU6t*ZV8mXJYYVndl0C;lm9!uj`Oyq82BF0 u33LFpESwWqXsa{8DWHdi=XvUG{Qehcvp)nzV1a-D0000