From cb2ef225591d8f19a343556b822a856166dd4203 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Tue, 6 Mar 2012 10:40:35 -0500 Subject: [PATCH] working on clipart test --- image/private/js-impl.js | 29 ++++++- image/private/main.rkt | 6 +- image/private/racket-impl.rkt | 17 +++- tests/clipart-test/clipart.rkt | 146 +++++++++++++++++++++++++++++++++ tests/clipart-test/dog.jpg | Bin 0 -> 7680 bytes 5 files changed, 189 insertions(+), 9 deletions(-) create mode 100644 tests/clipart-test/clipart.rkt create mode 100644 tests/clipart-test/dog.jpg diff --git a/image/private/js-impl.js b/image/private/js-impl.js index 48eefac..b3bdcf3 100644 --- a/image/private/js-impl.js +++ b/image/private/js-impl.js @@ -4,6 +4,7 @@ var makeClosure = plt.baselib.functions.makeClosure; var finalizeClosureCall = plt.baselib.functions.finalizeClosureCall; var PAUSE = plt.runtime.PAUSE; +var checkSymbolOrString = plt.baselib.check.checkSymbolOrString; var isString = plt.baselib.strings.isString; var isSymbol = plt.baselib.symbols.isSymbol; @@ -1029,6 +1030,22 @@ EXPORTS['color-list->image'] = pinholeY); }); +EXPORTS['color-list->bitmap'] = + makePrimitiveProcedure( + 'color-list->image', + 3, + function(MACHINE) { + var listOfColors = checkListofColor(MACHINE, 'color-list->image', 0); + var width = checkNatural(MACHINE, 'color-list->image', 1); + var height = checkNatural(MACHINE, 'color-list->image', 2); + return colorListToImage(listOfColors, + width, + height, + 0, + 0); + }); + + EXPORTS['image-width'] = makePrimitiveProcedure( 'image-width', @@ -1057,7 +1074,11 @@ EXPORTS['image-baseline'] = }); - - - - +EXPORTS['name->color'] = + makePrimitiveProcedure( + 'name->color', + 1, + function(MACHINE) { + var name = checkSymbolOrString(MACHINE, 'name->color', 0); + return colorDb.get('' + name) || false; + }); \ No newline at end of file diff --git a/image/private/main.rkt b/image/private/main.rkt index 18e168f..6ccc5f8 100644 --- a/image/private/main.rkt +++ b/image/private/main.rkt @@ -54,6 +54,7 @@ rhombus image->color-list color-list->image + color-list->bitmap image-width image-height image-baseline @@ -64,4 +65,7 @@ angle? side-count? step-count? - image?)) + image? + + name->color + )) diff --git a/image/private/racket-impl.rkt b/image/private/racket-impl.rkt index 825a0c2..eb80c33 100644 --- a/image/private/racket-impl.rkt +++ b/image/private/racket-impl.rkt @@ -60,9 +60,17 @@ ;; step-count? bitmap/url + + name->color ) +(provide (rename-out (my-color-list->bitmap color-list->bitmap))) + +(define (my-color-list->bitmap x w h) + (color-list->bitmap x w h)) +(set! my-color-list->bitmap my-color-list->bitmap) + (define-syntax (define-stubs stx) (syntax-case stx () @@ -76,6 +84,7 @@ (define-stubs color-list->image) + (define (my-step-count? x) @@ -83,14 +92,14 @@ (>= x 1))) -(define (png-bytes->image bytes) - (error 'png-bytes->image "not implemented yet")) - - (define image-url (procedure-rename bitmap/url 'image-url)) (define open-image-url (procedure-rename bitmap/url 'open-image-url)) +(define (name->color n) + (error 'name->color "not implemented yet")) + + (provide (rename-out [my-step-count? step-count?] [bitmap/url image-url] [bitmap/url open-image-url])) \ No newline at end of file diff --git a/tests/clipart-test/clipart.rkt b/tests/clipart-test/clipart.rkt new file mode 100644 index 0000000..c677d37 --- /dev/null +++ b/tests/clipart-test/clipart.rkt @@ -0,0 +1,146 @@ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/image) + (planet dyoo/whalesong/resource)) + + +;; color-near? : Color Color Number -> Boolean +;; Is the first color within tolerance of the second? +(define (color-near? a b tolerance) + (and (< (abs (- (color-red a) (color-red b))) tolerance) + (< (abs (- (color-green a) (color-green b))) tolerance) + (< (abs (- (color-blue a) (color-blue b))) tolerance) + (< (abs (- (color-alpha a) (color-alpha b))) tolerance))) + +;; color=? : Color Color -> Boolean +;; Is the first color the same as the second? +(define (color=? a b) + (and a b + (equal? (color-red a) (color-red b)) + (equal? (color-green a) (color-green b)) + (equal? (color-blue a) (color-blue b)) + (equal? (color-alpha a) (color-alpha b)))) + +(define (imgvec-location x y w h) + (+ (* y w) x)) + +(define (imgvec-adjacent-points imgvec loc width height) + (let ((x (remainder loc width)) + (y (floor (/ loc width))) + (vloc (lambda (x y) (imgvec-location x y width height)))) + (append + (if (< 0 x) (list (vloc (- x 1) y )) '()) + (if (< 0 y) (list (vloc x (- y 1))) '()) + (if (< x (- width 1)) (list (vloc (+ x 1) y )) '()) + (if (< y (- height 1)) (list (vloc x (+ y 1))) '())))) + +(define (color-connected-points! imgvec width height start-color destination-color tolerance it) + (let ((mycol (vector-ref imgvec it))) + (when (and (not (color=? mycol destination-color)) + (color-near? mycol start-color tolerance)) + (begin + (vector-set! imgvec it destination-color) + (for-each (lambda (loc) + (color-connected-points! + imgvec width height start-color destination-color tolerance loc)) + (imgvec-adjacent-points imgvec it width height)))))) + +(define (fill-from-point! img start-x start-y source-color destination-color tolerance dust-size) + (let* ((v (list->vector (image->color-list img))) + (width (image-width img)) + (height (image-height img)) + (c (if source-color + (name->color source-color) + (vector-ref v (imgvec-location start-x start-y width height)))) + (d (if (string? destination-color) (name->color destination-color) destination-color))) + (begin + (when (not (color=? c d)) + (color-connected-points! v width height c d tolerance + (imgvec-location start-x start-y width height))) + (color-list->bitmap (vector->list v) width height)))) + +(define (transparent-from-corner img tolerance) + (fill-from-point! img 0 0 #f (make-color 0 0 0 0) tolerance 0)) + +(define (transparent-from-corners img tolerance) + (let ((xprt (make-color 0 0 0 0)) + (start-color #f) + (jaggies 0) + (w-1 (- (image-width img) 1)) + (h-1 (- (image-height img) 1))) + (fill-from-point! + (fill-from-point! + (fill-from-point! + (fill-from-point! img 0 0 start-color xprt tolerance jaggies) + w-1 0 start-color xprt tolerance jaggies) + 0 h-1 start-color xprt tolerance jaggies) + w-1 h-1 start-color xprt tolerance jaggies))) + +;; replace-color : Image Color Color Number -> Image +;; In the given image, replace the source color (with the given tolerance) +;; by the destination color +(define (replace-color img source-color destination-color tolerance) + (let ((src (name->color source-color)) + (dst (name->color destination-color))) + (color-list->bitmap + (map (lambda (c) + (if (color-near? c src tolerance) + dst + c)) + (image->color-list img)) + (image-width img) + (image-height img)))) + +;; color->alpha : Image Color Number -> Image +;; in the given image, transform the given color to transparency. +(define (color->alpha img target-color tolerance) + (replace-color img target-color (make-color 0 0 0 0) tolerance)) + +;; clipart-url : String -> Image +;; try to grab the provided url and turn it into an image assuming a solid white background +(define (clipart/url url) + (transparent-from-corners (bitmap/url url) 30)) + +(define (time name thunk) + (let* ((start (current-seconds)) + (result (thunk)) + (elapsed (- (current-seconds) start))) + (begin + (display "Ran ") (display name) (display " in ") (display elapsed) (display " seconds.") (newline) + result))) + +(define BG (rectangle 300 100 "solid" "green")) +(define-resource dog.jpg) ;; "http://t3.gstatic.com/images?q=tbn:ANd9GcSiCx-eVMoU6wpH2WgfNzOTd_wZunA-S07ZZJsGtHiKNfOUp2chMKmvEVajtg") +(define DOG (scale 1/2 dog.jpg)) + ;(define XDOG (time "(transparent-from-corners DOG 30)" (lambda () (transparent-from-corners DOG 30)))) + ;(define D (overlay XDOG BG)) + ;(define CDOG (overlay (clipart/url DOGURL) BG)) + ;D + +(define (repeat num thunk) + (if (equal? num 0) + (thunk) + (begin + (thunk) + (repeat (- num 1) thunk)))) +(time "(transparent-from-corners DOG 30)" (lambda () (transparent-from-corners DOG 30))) +;; Ran (transparent-from-corners DOG 30) in 7 (sometimes 8) seconds. +(define v (time "just list->vector image->color-list" (lambda () (list->vector (image->color-list DOG))))) +;; Ran just list->vector image->color-list in 0 seconds. +(define DOG-many (vector-length v)) +(time (string-append (number->string DOG-many) " imgvec-adjacent-points") + (lambda () (repeat DOG-many (lambda () (imgvec-adjacent-points v (imgvec-location 41 41 45 45) 45 45))))) +;; Ran 3136 imgvec-adjacent-points in 3 seconds. +(time (string-append (number->string (* 4 DOG-many)) " imgvec-locations") + (lambda () (repeat (* 4 DOG-many) (lambda () (imgvec-location 41 41 45 45))))) +;; Ran 3136 imgvec-locations in 1 seconds. +(time (string-append (number->string (* 4 DOG-many)) " additions") + (lambda () (repeat (* 4 DOG-many) (lambda () (+ 4 5))))) +(time (string-append (number->string (* 4 DOG-many)) " multiplies") + (lambda () (repeat (* 4 DOG-many) (lambda () (* 4 5))))) +(time (string-append (number->string (* 4 DOG-many)) " function calls") + (lambda () (repeat (* 4 DOG-many) (lambda () #t)))) +;; Ran 3136 function calls in 0 seconds. + +;; at least 2 out of 10 seconds are being spent only on adding and multiplying? +;; but that means that 3 seconds are being used in function calls, and I can just inline those... painful, but perhaps effective. + diff --git a/tests/clipart-test/dog.jpg b/tests/clipart-test/dog.jpg new file mode 100644 index 0000000000000000000000000000000000000000..b6f580b18af8e4a8653bf34cb61e23c65d552f17 GIT binary patch literal 7680 zcmZ8`1yCE#@_&L;3L&@!hZc8tw^E8zq%B$?NNBJUXp!Pppt!qBAi>?;-CCSd3dNVFz8CKfgh9uVVRs!0q0Vq#!nVq@XpV&UT7 zF98BDFtNbcBuoN03c9$Y%$9C~0dcuxEQ)%8NF}Q`@p)Z8$XUCm@F;}fwLKe@RKofO z);2-;_j}RaE5X40A5B=;KnzSA+5ZlOe6vdq)28nD_gEF~I;i!2A^0CusD8vOE|JP*w(#S1d--?)svQ$knR$yDTYUraw*7Io_sMCN`+HZiVF&N492YP;xdb$76<0gKDVZ!`kjPlR z^yuhMW~bK1kR{G22eSzqy^>9w^{EE2)JFP^rW-DABxfqbjvy=AcB0d~v?CNjn(L1# zb6~TV-UIoSGV?~xK3k=IYEq3r$;#T=eyPIV{u=3xY!LaTV60I4jj5ZO zgx*4}j_tzfZWUR;03@ROk{WgyW=E4!XDZ>Fp8h-i7HoGax~hWmjtm;r#~7l~QilzH z`Ql`{F}P+jl~Q#3dbO$pROlf;#LQg7)y>R^7v|5*35@lJQZMkD&xX;=%egIh)2{rbs zyc<4n@~0Koi`%3n=~)n@;ScKUugZ(Exbg$(x;w2vC89Q;&J^i9T3vWy?HdKc>F(cb zVRgAv9c(&3^u8@z{w^{Lx)ybMQF1g$?R08-qq-5@9=wNmvwDh~Qxip>4k|v{gj$9B zH}$4FN$VhDc6;=E+zF0Df7q9D)Je(>0!9`$NaPiKmW!8I^D|BzI3g93ViWGDm^8aRt2 zFUX<=&IEQH=)Kr_wp(LUg2G0jRD}L;=-|AdkwU=h*Kf#UvAKDGbPX9I%x2 z)VsjMSpQso-MpTn>QZMB@uo+;?*<7kGq$eG&O}e!=oE9;skX2NPch{wCDRFr3evG9 zFTJ{WdP@CaIBx+$;vU=mf6Cw4?WI+W4lbN--6VOtzmI>Jd}QnWG9)*r*hzp8ji|sZ z@Dh`n82MPUUAx~3_otKultl{7<(#~Ro}*&iVW5KH87nGhT9BGX_txzS*LZnd z`dZHa&inrB^yjCzu2qC~xbT&7tx;q<<)TdU@-0HUJ(=FPHULS}{{6$*&aa6sEx&je zUY@_fFn(#tE8ekNcG+=o?7XOh+W}ywoV~K3$rSBU}C(Y{7 zqz7A-T<;!(PhPtl&F2Cu5q*Lk#JbsJ)TK*D?bOLj%`4EYdg0iga=fs@kN-(Z_in+; z^k=;#)VwgYdVTPH*541O__U$T!RD5E+tplhH~%ud!D?0NJbb${u>nlH7_cZEnQ(0) zf8lq-Q3_qf4DbViLYTQvS5M!qW<7d2z0vW3C;07R1Sa?c;% zPK!Y;a$c9CA6=+@<2jBH*wxh=lDZg{W;qt$@Bg_fe^ccVqwy&9Y*;H}a|=E;ei?R( zF$NK#OV)&5u;)2AXJybupg!e^?$BJwXjW)m@E`Iz-X=|VwV)9(qxP2>$4q`r@fa<& zZh7>5Y_P<$D>#sX}0Bp z5kzjIojUQ_{q)Oo=*NxMs9jto%e@T(8>l>hFeFl+J+5Q>8-MD z>5_dEu#oy@`6P;6vV`Gb<>(M?Vo&xng>3~u(4c=i?AHT4)-?6}hrY+4l*sE<>?#-E z@imRz>PfmGQCc=~1C-u@m6&ytOw3%tTazFc(-_U#k1eo`VoCAxJW4-_5uOGC@qL{H z^LHQ_GB2`#PB7Bg#OPw6@ajdMtgVIMfkk%Hd6oD}260=sBew}X# z=`%D~XNr#)gv!sxYx`rCvUfd&Wc*O?DQ)!>Az7M{LYOT@7a!H{&BnhiIYX{9+*(+d zvoaVzbtXQzA_Q$Xbd;wRV;d)UmC7XtPS96t(wuEGv&~w`tCYHd98EkRJ;fx_?_y}x zj}=`LJHor{sgiG1iPb~G%;MrLbT+JYeyQUl$*}JL-lj9vQ(x1hM?-%p*zvzV|3GV~ z_Yt%laD)0Cy0X13l=rHv$SDd=FC_Av2PQ?lVI_+VxAmmBeK2IdEjFkTJ@8%l;PVFK z?dlr~%pP+??J%YF8I8<_x&R6|NDXxW+8c6gtNQW0yy#Y$5T@Q+&jwD-60QZDuh4P_3MA$av`t#?SF&h>`b&uO!?{0s|eS6{Ji-kWh#e;J2) zQEP`9hUc@dXin6z@V&u1z!`|Ma3u>E!*ayK@_{IB`3m}vvASVe3oTJSO7g;4T`?nA z^Hc`opet#G0W#eq?9>>Zi9MKvRV4j*#bvBt>sZ$gPZ{jr+R-I3J@w0h?N{~eejw=J z^=>VQ?H%!nOP=bJr&3YyRs0zZYPr4PlBPv;C8o~7DpWR^x%4Xj3taz$VIS-T=79RY z1_gI|%UxN;+CTMo$C=YzNV?;8LkCoICpmn#${@^YOjp@Y^f&7RUB@sr<3(V1+~)%$Z( zHNy)ii2{i#04h3+`Ae+Z3xgR!Rf$-8I6Z;+0zoJ)0kImtf`RSS4y_5xtC%HBQ)+9s zPr#&s6g2wTg3B+!UdvBKid9>}QcM_aKHGUi@EWG6XA^CrEUDRtYX?*4<0@w$jGXLC z`Z8tXvZ|vm5o0uf&525kOy9`P8lObi&q=UmfQxVFq!rUu0Ope;fj#?yP~i%C_QDUc z0(b{4KlsVlUC5dy9w4Q$-J-#!9OSP*?2lo z{teH|>)iYNb|}ClyPW!@ZHFjKV zAJP~Tc)rvL>EG+cntN-J5sPk{W5P|B1wf<}x{4cUTKGd(L&4KR4LhOZ~lQ ztrfc*ja+QV#mZQiJ%+JaHRY28Agv6MLQAB>D)p3phcX0VSG*tk1nj1!B^^Gyk@D`D zh)MaQgFIU@b0FqT-63A1H;$}g?$a`#TQ{{^t8X|=!dr~Omb5vuMrM_b`-tz~oBw3? ze^_$K6u58@zwpaeTbV5**iY2Ep*&xswMKs) zVybu{(nE$$MO+81PFQ|PQlD6i`ykW4S*trp2gD-wWO?R?_fk`0ajs)dvgG}b#;C0< z&79>TA3M+IYR8FN?EPunRz2Hiq&kp00DkoR@6GyTal*00sKpB*!c1KP9VIT{HHm*u zeL7{rN?J_D`|m2OM^}<+0v+9Db%9&&&~PmicL_Tf@#_1NEyAcj?2R`S-(}2LsZ%an zJsgM_h}#QOD;?lrQ28d-Mc`~gE#~4TA+YjqnSlU+(+RA3p)F)Gy+=HcBH7gT2bjk{ z?ZmFM$}F<1!O%8vWjX9cOzY?n1+6PaHg=%!k^EM#+=UlrF*oB^UP})gL`&}0)K3Ma z&py%Ai4AovPZ~IM~!6i5L6gEXL+ zWeimiv5IAKg0akZ03&lx1u$7W|3A+AR|(-Cmm2IALx1NyD2XI|)FYU#W8be6cn8>N z9oQCT;Np`*3rKp#FE5$)pB-;YeSNiZb66Wm-doL_v67w!>c0b|Jit-q(InEa&r~(6 za^yMe9f_Sa)SMDNl@nT?$=uoP>uR=ZLvg-wef7zRGAnQE_uw5MIqw5QPe3O{2aKp; zuVl&Qt0ULuNPNBL&I*sRKT#5`+0fgI1hZ40Qa|#P4&)#6pR^tJki?!)J;|c1Jm0P< zl)#d-$`PR`oMtA6ZS_*NTq!rpwDELASEz?D$bw~cQi38>JmAL*D_z66p{%mp(>Np| zvi8r2Cw<_M0)vNs(ydH~K=rjj6tpaJ7;>pH+BuvLS$q7I?Gw8K|%2?jek{_ny4Jx<>ddQ0f}uFChya2kKl#slP|!a5G;{afWS9MO8E zl+Lrn_>Vwn|H)IF=#PHiGq`=KjU_9iBkjN1>Q#QtVrD*gb6;rSmLnO*vJ5hA8e_`W zb28G)gY_p%y^_nJ*jfCHeRWEwnwyM7OFhj2=V#$cw-3rF#WLpFndcH^bEk)DW!$zh ziv^JkZ;_1&s80~2Z9u`rGKy^^4JFsXlXNSo!+$UqJZ)t;ZE@Qi| zRY+}YMV?HQMvvhuJL zzeyojUxUBN7>FG%Hfb?0$Hod1vstw8kg{_&uWcSXrWrqyj%B124($GZTrI149Q%{8 zu&Bp2K1r)GgAeB5O)C8l!yg_ zQc!pS#2Xm;PaE!;jdu3j$wkZ;1l8sS79z;8Z*Eo z-_@lxKMf52s63eOVx&4b4;&OW!KS}t>;65)ROa1^mLhF@CASIVJty2RDBP<;E{U=G zJSaEpQo(+(b&dHon~ld-$hNRo;NfUV%&Q@qo3+$rO9zQG8sEwkxV~P5cYYXq?_PwY z<7?Tpq;`zkk0<51k6IsEBDsO{D=_-64X?cgOIDMFW1&vqD?LSlciO-9VJdI&lpMUfd%Oz$h=+&!J!PJsMCBK z;vGEk;l;RJhui1w%hJXsqJ|mX-X|FzRtFX%%F4#JkN+DIe+#7l4iunQu+`bL)@S_= zmUAM9c?tQSf@0NbE@a4Vi~Jem-v<5)vi;O}64h7uQyWT=yXtA*=_Zd~ya;tWdgj_| zBwO-h2xZ&o#;ePFLTO`Qh}BLz{lo>{m#-nU8|xbUNw@zOrJ4LZ{u&u_h|!vEB$U#H zcZI-tm%i^u46 zGmsMW2+~MLw0o%-@eRRN>A_X9RT-s^D{+E}PePh9*gyE=n~C&ieyn}r?E-GxaE@{- z68+(YKoQJk=NpNZpo3a3c{NlkOZcpzzJ>)Gmvzy{C-a@Ge27j)J3#=Ty=dipd79)p z$qq#+9um;R-suyM;^q7vn3Q!geFyN#*qMwp)39;3T4{cI{d4i%6{WLwxO zgGjL_vgf5%PXP~Q5~wP++W&=W?6RGuOKux^v2Dg9-6!m&WxOPFQc|f1M-4Z`O3m9x z3WE;YVhi_mvRMcycMUk|?S8ZAaQdrbzsfL)LDSNAQp(#F0s7+RdTLxgrOR73BmGC& z$H|_V`Oxiuinae>UUWtE!^wvek~lHNwiSC+JcG-`pVspt!`TQa*}Ic$$@y8|Hcz01Bo_Fzo0`L z?QIxQ?c%FS!C}1iti*3u%jd9C+zhcP^V za7A49i99!NUB1y&x~_Y_KSsvNop6byeh1;${8DFf@5dP(giD+3um$IR`6x0t)v-)l zzN(L;*-z8vd6l*zu+`#r{zyoteYl5#$Cy4TOoA$A$%7sG7Ch92OmeEQzad!##gR*`YhQLwH8SWqEjv>nuwBv=hJ^T`Rk~_ITX&1am4E zZhVXS;a+prWER6PAU-NkFFMPQ&Jk&_#s@f;TC(?OyOei?HXPOVER-KJ>ukM~O8`|B zd{7g7cq`nD?u5s>LlqC@8waB&dKvfqd;R$Lu^_q*@!eA`@DqZ$FL)MdZ zM;((Bl`q#{mNK3Ya=ERN*QxRd0po%S;>@ z6$*8`rnJh`-xxwmnj7(WeW0;p0RHJCjdS9b4&Ia%f8#eMOD7LK#RZclWYZW{boHmm ziUIm1Sl+1SZT`CYfnnZdWxw0B?hvLqL{|zz`@G5eg)r`bUrQJ;U-P=Y+noQ%JHIpHCH+}mNDO+64&Z#a z6(ixvCL+|wl5Z<(oh<5mlhLifV?WG8MGNN`ScS@RkXfEv@$QVn;4jS8y@$;{1#G{^ zGjC?SnVK8sI2}reLoVT&lare`+iLM(R%69_ zL$$QS?RiCU#vO+Ih+d&?|4a%