From bd208ad5206175814d62a892877d3759824046ad Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 17 Feb 2009 21:50:10 +0000 Subject: [PATCH] checkpointing: got thru the first five sections as a first draft; broke out the next two sections svn: r13710 --- .../games/chat-noir/cat-distance-example.png | Bin 0 -> 13329 bytes .../games/chat-noir/chat-noir-literate.ss | 978 +++++++++--------- 2 files changed, 484 insertions(+), 494 deletions(-) create mode 100644 collects/games/chat-noir/cat-distance-example.png diff --git a/collects/games/chat-noir/cat-distance-example.png b/collects/games/chat-noir/cat-distance-example.png new file mode 100644 index 0000000000000000000000000000000000000000..a4c90eb07d627e3e1a1126cd8086fc978d32d1cb GIT binary patch literal 13329 zcmb_?1yohr{`El+kUA(JU6LXt4IUa)KqLfdq@)|^?mU2igwlc{AR%4Sq0&fqgLL=d zTZen^d-uNoyYK(LZ+woyaO}O$UVH7e*P6e%=A5C5Paol8kzqj~5L}tZQpykr%0uvn zi+K&4IcL$rgg~w_nn_A3%1BDmDB9Z?n_0euKwMBh$M#tK6eDb}AC=Zpx!tFXcJt0- zRrQyvRHeETeB;#P@w}GLhNwSU#!R+Yf1&+WQ0B62vz<;1m5@f;dJa3dtV57K8fW%&RFu04ey?vY-9zHu0^3&A%kLM_CqK4zO1_4m=MWXIhE$_Eo0&AD%t*f)rMqeofiPdfvZcJHi^t zG@I2--ryT-SNjYjs2kOtdj5F$A;p&P`w~&qcQp_BR~R&9rQ9&iExH_*`h3~G`?9X~ zO(zXAC=vM_$frLwOl_M#YZ#%MIc5`ML(#mEWT1qjE6MpFOCWXe*RHmp2BJP{d{a5? z)`N%Bbh_`|;Kpq)E*=k}1=nSpHOiZOxHIze2e#j^Wj0GCY3EP0>7ixS#`ua_`VkwZ zEw9V`PbxNn1D}k$hH`AqMZ_!0SzWSAqJPQfB~Nu(s1XOYg|e((WHk6b5kwSqXv(|gzdEn+9r!}$8iSC!$DszBH_)ZxAY|MocahJH z*)}+J0Tbtj?PCoG2n3q|`G*2|n@j?M&_HCQ#8q5SHaxM5CL2bvBkj8+7o z8?zY}_vH-p3r(+_d_Pk6&;a^5_7wc&vr1%muY?qfi`LNiYmTjIm6+Fu5Pa;Yl_|LrJ`zjxG8pVuV2h3*ZBBph;B~@iZ>1Z?MBJn9f|;k zh z4X+!XL?E*5FO8&kN^`PyBG8U1Bx9@%P%$Ay(%TdPq{wy&;e(lnvzd`o74s(!9eXV2 zH-!+}M~a90@(p2NwFv zeuhDxQV$+U5aZ~5Am8I+%+z-?`#R}>|5U=IqeQJR`&(5`aN?1<1Kx?HoR;iE?@!)@ zsGZ#H=T;90u?|X4CJW=g-89Zt#T9rvu_=fNr-k9q;tskkXVNlPRd8d-aw%F#%gkS} zoO$AC+h7cpcvzA&x28jEA%p0t{zXdP{TbQ9wCA;@8VAM4lKi_lwXMO=J!R+&vqGkO zg2ac}D@W4cVlvr@si-$^sWI%zz{6Du!3nnAuyLyEKdBDw2-qWnj?%Et4kxDhyhMow zo38V>g}e1VP0xyYZOSBY5Wl*>oX(rau=%m+l)lY(x#wYF z-^&NLm_HE?;Yqh?mQmh_Q=!E8LKzlOW{x~9^i&AkCLf$fN5K4Pj4OrWdMObD+Zry> zeTF@mFgLi<|J{>6Gq1j)a5XYXpC&OyzJS<#gGY~BFtX3LGXMEdJfjDMq!xot^oq)k z$*;J4W8UJaJz`W;E_*2?h?S%9WYs>6f^^ND3}eZLyzXHF@^)qQf8IjT@u!hkHM+*Y zOIZ;4Bt6Ug$18in-sf>VLu=)3a{7wpvA98w-nRb2~-nJ&tTUQ~hlwyx2sOWog}~2#Ky_d97fs zou6q6KF@2li9_b}&&+1)QN9QJaMUfisWXGX+@Ru%FoqdO?oD9~{r7Pg@|uKIZB-$D zdH$u`7%BRd6QFr7ewXplr*0d2hQ6w}+$7_DkVo&<0e+}sLis9G-PcmWbD7IMA2<{_ zu>WGan{}sRWn*OP!z*!J!e8=hPUQ7@eb@c_-O%x8cBvcxX2pzs$-Qw{*yP0zb<#=_ z^G4TxDq7|092*#hk1M8A@ne@F;FlQHzUwD8ei(6?U76uKhhA6o?^busvcfO&sNAzX zPVQ?fi+(jb-;pQs(zIYN%Et3~6&?@Xi7pyLUI$n3dsU8ap3YdBe>a~LJH-TTx1CiH zHRWMp7&$jJE`D2^bE-e*609^h_?)C%OH-x)G2vOC{w2$UdB!?S-Ri}ZWg46ZNTlvh zR8SXvv)d6-jJ*5%&yZ^X5Fd;6h^yNpQNN>-=v_K36;(kM0~NczX!VLJ+xWzFYu#1B zbxH~^_Cx%>pdEZ&jjyCuv})>-gzqF;$9miOTZl4Kf*E0ic+Us>`eWj8irHdqNTDpr z7}U^QW4V^+2|V`gOHW2Rub8RRBjw(=*SQv-I+K7zt!c;I4rOc1`=k`0Zejs&D zDM`A7__C$?<1fO_+xDW%vo3}caA=krUGdS~8YG)y4$n&M5y=?K;=>NVcA~SgECu^Bo<2DLgcq$xyu*&_G&VSq0X}_EY%JycSse{SYPcZ3&jFt$ zIr!@$t)|SpAnuZ(N%ot^pp1n1x#KlO?Dh7*q_lD{xr<*wb4<@~n0>J)p@F=zZk%IE z^~YHhqY6WCp_e}rB=%L8HU{(Ky=%y`{=}^?{(E6AJ!4V77nsdNd1oqt{!n0yan0^cjW_umNRd>T3QptBqD{{vDfZAm0o?PY{Is#ZQIE? z=-^~Pla7tfIRJMh6-(58YjZ>q5Q|T>yFO@PX3zeMcBu}AF-t$6k>$0Ev!u0s8)eC6 zdE5~jSy{y8t~ceE=AvLIQcgSI^GUe$*77ERCAm~71gf+pCiJE(*_PVq7HrP#K~X9L zH%YT}8g~r%`Q(ZqCV4i@v_G?hw_BP}o3aJm9uSPl06${jt*1wY)TezaRtXGGA@z-s z-4VvPLth}f5KBg!$4urMqq#s-ks@|gWpLA-W(ftKnzx_z#O{B?+O#3BPh%S29GJP* z?&(wVGpj} z{qUbh+t3?lUBi&V<;Ct4@jVsZhz&JXF#F(tJNquIx64aD2yhg7da)Me>Z8wlpiN#A z7&B^j!1n^P`w8D)W;a82PAIq0y7RMY8V;<34~{kP>A@90aWi35OxqJ9hPfYT zzD*8y3vuP>5f}L8LQ*{!c5jzQ)hbDdCnU)o3!apDMi+L=$e>SgkJ+3AA2Dqc?A+4w0sAWF#%RiBp21Mr^B5} z@RVfg|51)|0GEekX_c;n73T{x{bk;v)Gdvxy)g%l-v&4B_O=9ej3jxgHnMorZu;{1 zaF+W30C>2Zk>(omyr0HyHMx7Y>OQJ+3Y`E=&TEw(aZG@A@xd`z8Gd(F)z~)mE_0Pj z$j~vvXJ{hogGRHyJ@dImOn11-jNXMazKIdx@J@R@#geH#22Sww_k zr}{8@Rx`!WuB4(Q>_e1>>e)AVF#Z>O75>5Z+b%X5e6EVZ{tajb1Dtod_#sa`VXMb2 zR*j%ghA(*7x>arW-nwLC7y9UZ7g!=0P?6sbVbdwPjy8nbo*&bXx~Fo#(5khzJO3tP z5sa97xBs5rPbF6wn@Pb)TniQ=`X&1A2+inJ|Ep@k8KzO4A9ErSb#ltOKjwn2ld`40vdp~A zEbiK!;gW{;xg0{q%tqB6h%VZDW?90pgPBhQA1)DTI*t=&Cgb#Dbq{nW%acREj8|JAW1@nvaT{61n)e0QG$up>Tu*+5TZiLN;R z(x_6Xoa5{3OrgU?WLdu)&0*$|-`%^d_mSIVwvRl`)!rlD=w@~VdS$1O|>KfdnDyMew(Qx{pQnywKR|2 zZ)q3nCQ#Ay?Iq&04KjTAago(h2JUi`12Y-S>1-;dt+Xrp+lY$|wmYw(yUP0YyW@rW z?!@aaeHZ78pF6D{5noXV*&9|J8TT}ro10CN?b>ox^PU%I3mUdX6!29lL>e~wU1xT= zKT>WrKIuH|*-q(vzQ82v#W51WMyUdhL&ZsUY6er&n+xU<)+e`$t_!UDPq z_&DnJ`&HF+95>2_H^<7hu+Fieo0d(IYU#Of+#YGw%7VjG|6b)5Nwxm=vuD=1* zhzO)$G0}!(M}UII9Kn|R^w~D*F?ZTY=UZM2p3uw6<;s(#cWQ;Y7oQY7u|!Ksrtr_8-p9=) z#$BgP#9wVE!MX^hc9_PNLufEiapkK^z#VR43x&@ELgz}w6~=OdvX;Y4V1|pVJ`LBu zK*zSYupW?$u+b6Ugi28 zV&a9Q6k1_Wc-ksEZvS;l`g`eqgt9TRwmOd}-#ODTdH=GqL8&4d@RAt2e2O7N6o>9X zJ2C9od04LvlLm9YpiETL`7&y$J0*O&E~WvOe}bl|*xPlT)`XG^W!Wbj$htuf-N(-(to!0YShh`7wi{GJ&u12y;4RzJdXT3&L`r z>^FX;f5ortDX5a%`nT$izFayDcpoDMayH!Sz2`Hf!>4v4owYp=q^vIM&%Ccqmvjr= z3%Bi)CJsGcsCTy?7?ZE5Sa0*jPnUH!7Bdg2gWO>5Ev#C4>-=>uC801m$7mr4=W>Q) zIA7q>vqSI))8F)}`O6f3V7E$=Ld>UGzbj=S49UPW7eYP_=WN9Gcy9$y9Sfzh={Qe1 zR$7!6^uH zf$&}@H%HY%Of1LcP{+Q8kTKK<&_ODC21SqsF7jqR-3TV(wkZf_ruDk)O3H zsO(p?JEui1&-WCB4}LoI2&*xM%|;$wC)Q4#_E^ z!moO#SZRXg?69I9K0c#Ze~dph`yie4VBts6qaQqo3(^@6DU z>=>K+i^DX;{>P8W_E?r)=kwG(TIUa|YS`^8sW9)wYp!ayT+0>!q(K6PFXwBH@i)3l z@3hb&&hZpL%;QYNceSs(&D4nP+P&_Yz3vA+B4?J`O5R{yH}hBFA&R3saq`GkZ+B98 z4%bX&Ytg)qnLX=^@*=deuG!#wLU`E-_1Z2g^t7_;sg6R-KKro^(;M@`_X z?~&N60V7fZTJN(EPi}PtLhZe9$E;{U&H;ge{ZgjzZU-HHs_PQz1bwr`o9G=P+>_X} z^DL5N+ol_LcrK6jE*lb#x(t6|zUdBhiePrflVIFYjGEQY|0udGk-_o()|T3=XM{w! zHKpzSU!+t7>AzOw@l?nYC`C(cPrq)BELTKbw5CLPZV217)v_nyv)t&n(VGx#rqu~2 z=4d10WrXWjDO?c2b0GUV^d0QKrO*#ZGoveUC zkiuboC&6RWrl9KlNXed~{+w$_uw&CWBSQ4@q-Xg>eA^;Fd(rS`tzZ+Sy``=nB7~c< zvt;BLh&vrx1NQZ}&aGS3YwWBp*Jv747iq((<#O!U4a80CU>F&9dL$nzG3d|1nJv`~ z&t|$<2y?CI>NrbYH2aax>|3atnknGfz#JFNh`sS|c!Gi`r9VGZI?*Lzx3s3gb@@xJ zK5S7+blVq-iMr2GJA+LQ`{Z^wYNFJ`slKiC!^v{mZ9mS6*CqY<4@pgzl(Yic@dCj`WucGj@6n`z{hSM|PWNq_A&F}f_50Zz`sgdq6oef+{P=4x3$2@ZdeSa! zyRtvlqBsmI{&Leb$Al8rmya!I|3n8;qd4Z>Io}m5r6YDGmox77NLkKDBK`I|R+Ru# zrmi(YHkF@e6pC_{mTl|BmWZKJqWYtj$k6PNq7TcI-WRLxg*CVK6l}}RfeE#k?9hGx zHp`vN^zRJ()^FxdxTk7bS`W<3 zwn^RPG_}*u9SOo6AEqe{D?{Uz8ur@b?D;7^0jtd20m?X3l$+3>F)Lm0ObRZRU6_$hF;KM< zSr;>I&7R4US=W!s70*x3%STNfJ@U4dIZV-RQMn1_jbG}K46s!48AGgBSR-Co6uj8~ z@J#LNCBX>|u9k#7MCv9Kx36{5A*V%BU^!NHjQ`2aIiw_)ph({4-`yV1H0jaSoINNP zROJ0;<5`(nd6ncgKKS}T%}frCcKbH|>fZZvPs&5M^P(G$n>P;Aqqp4Gx?i#=w& z!XlTKe)GVd?bn8_;|@CD+k-AOG80U`d{a82Z$WMu=U`E(TTZkmRPyjx zmV9l?u+Ey*B5aYS*pe(>Bj&(#dyHR~pw;5#qbKAorH)VBKbXZ}ZVDb(b+jc$VaQAC zvU8a2m?=kVIY$}}B+Ggea&mCh+r%%=EK5Y`QA6LtpWv~rc4oxPB!o*O?9ISdnq-8i zZpD{QcSe`20MWBL^;s0y32#JEED#DoyZzahrXqrm8Q_iiI*mG^Wkd^$AVc+Gke|8i)!Z zkVA}~G;mjyUIp~OwXj})bqj~BWI1kQLNAs>6rM4Z*ICP~a_eLzzMt>$T; z${02=e()pz_~LhejCRbQ%H6t4%jQnXVxj|{k5JJ2|aSKVEUZZMwq!J7c|-wVT}n9XWm zysXa(T-#`HyX~ZhLo96l7@b1QaUSKh|5Jf5ZU12AN}&)SZUVXfO0GN*WF&}#eVe9Fy+uOX0|fygXC!V}heyH|2&m|5^0!_Q-&E4h)ePk{qBF#D?m9F#x#YiE$c zYcZny^&G*wwjGfm{oXQccH8wa1~_;J!E#y**}L(w)X9JPMsn#{Z4$-v_{^WmZSr-& zD46Acw4o2!G6j>1_{AdNS<0RN-N(MTU-T`=ZpQPQ`-^7`J61dMR_;kKf3*y#c(*I~_FooM2# za^JRP{;Dy(G!+G{(t``!aniX~#xt8iWia&vxM!NJ&Amiw+OI`b!6(AQHDJ_Sg&n{j zpi@n7md_sS^zHb5l0Fj+8E$IHcO1 z_m9wsw0sH0rHK&E6ULYwa$PZ@%6!A~SX=00iHCKkkIFeF9;P`xfO-j}8=q&_doX)36Fc0SYR<4j_yfnVIbeQH8!dO=L-megeY~C3Z{RA9o3< zcVHN4IZYXfzB^?9f`kjHmS$qH-@pvFz2Pdx@AK5 z6^Z)LC@&J|4LLFu0|!P+bN@QbA}7~u)Sk_Ru8o`1%bho3Tg_8ql#`nvH&%|mAxKXmBju2b{0^tdVy9MVGz%rmvx~mF93=y#&6af zbquy#HMKQ8KCzDKvbd=o(o-Dveaq`~*UWpJc3lA4E%}@Ye~gprm54M~!hS*V4zEH~ z!MO4co}<#S@CKKX5!R-`@1;lps!zoI&Afm8{yAlsZjV^=m5V0RaXoCArUluOcxW7t z0*l#`ld!XkWM4W~Ka*Tq0P~T^Zof2mwQgc@Mc>pAqVM*}`sS#EE!BPwl4<17J8$DbmTc5^ z%}j9we16dYp&RK;Rfpb>J$i_;5m)eWn!feU3$WSlxM%$Ul#Tykdi@@)004qC<8LE3i8x`9 z{<6Qv&wmL>0AZv5%wJ4qLtX@c-EuEEI$B@{QyG5}z^gNcV7GKi4V#=)2P+QH38xWR z0FUO`ie+$6g~s&n34#}RBQeMa(9$CK^8&~wJjYTU7rJ!pEc z4*KnOKhF((2G#e2C18iW)|&rI8uT0fyhjAf6k~05*xzOjoZt(k*aXNO)NW=V^B;~# z!H5G$Zj|PLHlV1`x#2Yhfl0Jdox@}(*&%MJ{;a1em3YQ9mJ)F2SAfd8@n+XChLN64 zqH%QOd9HOpu4zvV05k=}llBGW8%@Ss>@zj}cOA0UWpI?ZY4#ru9mo3)v?>D7(dZnO z_0L9@XJK8*&!~MMiZ{XX=|nCcC3ryT78|GKd_>o%B*ohiNYe<%m;=6b3dVAV%$tp~ zZY27_78m&ek?RJ~=Y?ds1%&UNmEoT?CmIo|L5>^jz`w?K{xjcZ;f85z))_Ioss7+| z#!Lhd#|RSpz>C}q6U&g331=#Q34#>z z|l^PpixPAkg2WV34K{_U$xz&h9jh}*l$giFTywJ@rW@OExpi)@v~mT80y6E$1i?E}``chR|B)c*3;*{Cg2Z<&9Y$~NHWvE0 z;c>+z2a7D|1K7JD&Q6WEV&O?MP&8ytapI>_G2ABm(wqRxf7cME-lmY(fy*y(8vFhD2 zAg2CI{FLesG86mUP&-*Nf_+XR*uBqL*L*lB*`Tw6m`vT0X?yq|v+m!h{gp>~@)pMu zz+l1>98}E~*A)k88u8zTo- z4=CK4ebVtyvJM#uz+x`64*}kDTGkN;SpV-l0HyB9;K#wl0s$i%E?Pxp_ju69_=6y~ zSi2zbxPR(b$zn2HoiSJd2$WY?1%RrS#6SdG?W|r6TO>7QO~&r_;VzmcMK%vD`cKW< zx16TdiGq8l766HN!>iL5Qw;G?c8|RQx>P~|hHhwWL%y0U@HgW7=TO$ad-Xqz@KSzo z^_Sp&5Q;eME&yak(A5`jAeSN_PYK} z7=7gbXA;IU>W6w%VJDiuf8_AI&9%{C+acqTv}iIF>M=UiUOr9SN+&%ic-Bg?57j!;U}s0mK=@Y+Z-nO5274%i&O8# zi?_JhsgKJH`8C!ox$qMezL~usf1=e6GkMD%#)IUIO$|0w&{GHTO=%fyqkjuR*93ao z{SmB56E!j2H1}?JRWZL31dC2@wzN9yY}WW;hpRmmNW;<^m6n!fT>unIby?Yrh0Ln32@Yzd%be66W41hPB>wq`dEj&Vvx6Vf72n z0ze>#jPqiWRu~La152@_a=M3<7#R3T=9sDe(eogQhGAH#tX3mSb|h*bPnX?um*r0+ z4BXm*ZW7X)8Pn!K_JjskrW$Z>APRtZ9S{Y;rh?~r_?VVTf1=Qsk%UVhQmV}Rdymxx7`_)3x+qA#Q=0w5(B8S14Km6g*PQ|?bh(>)lB?C*JQ z1fhAt(RBohY$!5mw)?)cG@A&ZUU_1@&RYv9R8WC2uBJOk^{(uYvR7ng?Rcqn$Z5`| z<^H?{cKIMY1-Ke`C1H`~MG%ghO2Fw6hzCUC@AlWf@7<)38Pxd;le709R)8h+jAqFY zFdx@5LN>5Ov06NyfF*8|mI>Coyl-L@-~^yo2ROUb9FEukXUKHseg{RY4QN~4H?VX66KcjXr=Pt~wBOhB z?3tnl9k$s8Few~7#Yw{qvQTy3=&?-i$&#%d9R3#oeHDrY!O(#|6+(c`$XM_1-1GM! zD4H)8LS>HAef&?;*`{dp2qN31KS z5u%UOV`-^=2uY5*k$&!^!MR5fa1R*(UwC9=CKr{P!viJJ`&U#0aeHaQvYa|wTVla1 zi}tGxrjAD_&Tq)}Th?+g%v4E+?jYMi=*Kf%FA$Bfj0Aa~c4SolFeG~_W=DQVSn;=X z451h@8}k~(LBAm{)6PG)^b2xvsa%S8sVsH-rnsLQZ?%aJqnGT_-M@jo-8ba1ZRKiZwXFA6`e}zJ(=xuQmA3X*|@7vbvf8`g(DYM zHJ*x@rMrw={7C~OFE?O47uR#Ku6*)4*DZ(kM+28sQ zUtNI8g3{1Rh4n*d*|5=P#{BEP&h0w|ccd0GGf literal 0 HcmV?d00001 diff --git a/collects/games/chat-noir/chat-noir-literate.ss b/collects/games/chat-noir/chat-noir-literate.ss index 39223a036b..441b71e983 100644 --- a/collects/games/chat-noir/chat-noir-literate.ss +++ b/collects/games/chat-noir/chat-noir-literate.ss @@ -3,7 +3,7 @@ @;{ The command to build this: -scribble ++xref-in setup/xref load-collections-xref --htmls chat-noir-doc.ss +mzc chat-noir-doc.ss && scribble ++xref-in setup/xref load-collections-xref --htmls chat-noir-doc.ss } @@ -53,6 +53,8 @@ and some code that builds an initial world and starts the game. graph> + + ] @@ -64,7 +66,8 @@ Each section also comes with a series of test cases that are collected into the graph-tests> - ] + + ] Each test case uses either @scheme[test], a simple form that accepts two arguments and compares them with @scheme[equal?], or @scheme[test/set] @@ -341,6 +344,8 @@ and that @scheme[posn]'s distance. (-> (listof (vector/c (or/c 'boundary posn?) natural-number/c)) hash? hash?) + #:freevar neighbors/w (-> (or/c 'boundary posn?) + (listof (or/c 'boundary posn?))) (cond [(empty? queue) dist-table] [else @@ -623,34 +628,23 @@ For example, in a world of size @scheme[7] with the cat at @scheme[(make-posn 2 2)], the circles with white centers are on the shortest path to the boundary: -@schemeblock[(render-world - (make-world (empty-board 7) - (make-posn 2 2) - 'playing - 7 - false - true))] +@image["cat-distance-example.png"] So we can formulate two test cases using this world, one in the white circles and one not: @chunk[ - (test ((on-cats-path? (make-world (empty-board 7) + (let ([on-the-path? + (on-cats-path? (make-world (empty-board 7) (make-posn 2 2) 'playing 7 false - true)) - (make-posn 1 0)) - true) - (test ((on-cats-path? (make-world (empty-board 7) - (make-posn 2 2) - 'playing - 5 - false - true)) - (make-posn 4 4)) - false)] + true))]) + (test (on-the-path? (make-posn 1 0)) + true) + (test (on-the-path? (make-posn 4 4)) + false))] The computation of the shortest path to the boundary proceeds by computing two distance maps; the distance map to the boundary and the distance map @@ -696,6 +690,475 @@ it returns @scheme['∞] if either argument is @scheme['∞]. [else (+ x y)]))] +@section{Drawing the Cat} + +@chunk[ + ;; cat : symbol -> image + (define (cat mode) + (local [(define face-color + (cond + [(symbol=? mode 'sad) 'pink] + [else 'lightgray])) + + (define left-ear (regular-polygon 3 8 'solid 'black (/ pi -3))) + (define right-ear (regular-polygon 3 8 'solid 'black 0)) + (define ear-x-offset 14) + (define ear-y-offset 9) + + (define eye (overlay (ellipse 12 8 'solid 'black) + (ellipse 6 4 'solid 'limegreen))) + (define eye-x-offset 8) + (define eye-y-offset 3) + + (define nose (regular-polygon 3 5 'solid 'black (/ pi 2))) + + (define mouth-happy + (overlay (ellipse 8 8 'solid face-color) + (ellipse 8 8 'outline 'black) + (move-pinhole + (rectangle 10 5 'solid face-color) + 0 + 4))) + (define mouth-no-expression + (overlay (ellipse 8 8 'solid face-color) + (ellipse 8 8 'outline face-color) + (rectangle 10 5 'solid face-color))) + + (define mouth + (cond + [(symbol=? mode 'happy) mouth-happy] + [else mouth-no-expression])) + (define mouth-x-offset 4) + (define mouth-y-offset -5)] + + (add-line + (add-line + (add-line + (add-line + (add-line + (add-line + (overlay (move-pinhole left-ear (- ear-x-offset) ear-y-offset) + (move-pinhole right-ear (- ear-x-offset 1) ear-y-offset) + (ellipse 40 26 'solid 'black) + (ellipse 36 22 'solid face-color) + (move-pinhole mouth (- mouth-x-offset) mouth-y-offset) + (move-pinhole mouth mouth-x-offset mouth-y-offset) + (move-pinhole eye (- eye-x-offset) eye-y-offset) + (move-pinhole eye eye-x-offset eye-y-offset) + (move-pinhole nose -1 -4)) + 6 4 30 12 'black) + 6 4 30 4 'black) + 6 4 30 -4 'black) + -6 4 -30 12 'black) + -6 4 -30 4 'black) + -6 4 -30 -4 'black))) + + (define happy-cat (cat 'happy)) + (define sad-cat (cat 'sad)) + (define thinking-cat (cat 'thinking))] + + +@section{Drawing a World} + +@chunk[ + (define circle-radius 20) + (define circle-spacing 22) + + (define normal-color 'lightskyblue) + (define on-shortest-path-color 'white) + (define blocked-color 'black) + (define under-mouse-color 'black) + + + image> + image> + + + + ] + +@chunk[ + + + + image-tests> + image-tests> + + ] + +@chunk[ +;; render-world : world -> image +(define (render-world w) + (chop-whiskers + (overlay (board->image (world-board w) + (world-size w) + (on-cats-path? w) + (world-mouse-posn w)) + (move-pinhole + (cond + [(equal? (world-state w) 'cat-won) happy-cat] + [(equal? (world-state w) 'cat-lost) sad-cat] + [else thinking-cat]) + (- (cell-center-x (world-cat w))) + (- (cell-center-y (world-cat w)))))))] + +@chunk[ + + (test + (render-world + (make-world (list (make-cell (make-posn 0 1) false)) + (make-posn 0 1) + 'playing + 2 + (make-posn 0 0) + false)) + (overlay + (board->image (list (make-cell (make-posn 0 1) false)) + 2 + (lambda (x) true) + false) + (move-pinhole thinking-cat + (- (cell-center-x (make-posn 0 1))) + (- (cell-center-y (make-posn 0 1)))))) + + (test + (render-world + (make-world (list (make-cell (make-posn 0 1) false)) + (make-posn 0 1) + 'cat-won + 2 + false + false)) + (overlay + (board->image (list (make-cell (make-posn 0 1) false)) + 2 + (lambda (x) true) + false) + (move-pinhole happy-cat + (- (cell-center-x (make-posn 0 1))) + (- (cell-center-y (make-posn 0 1)))))) + + (test + (render-world + (make-world (list (make-cell (make-posn 0 1) false)) + (make-posn 0 1) + 'cat-lost + 2 + false + false)) + (overlay + (board->image (list (make-cell (make-posn 0 1) false)) + 2 + (lambda (x) true) + false) + (move-pinhole sad-cat + (- (cell-center-x (make-posn 0 1))) + (- (cell-center-y (make-posn 0 1)))))) + + (test + (render-world + (make-world (list + (make-cell (make-posn 0 1) true) + (make-cell (make-posn 1 0) true) + (make-cell (make-posn 1 1) false) + (make-cell (make-posn 1 2) true) + (make-cell (make-posn 2 0) true) + (make-cell (make-posn 2 1) true) + (make-cell (make-posn 2 2) true)) + (make-posn 1 1) + 'cat-lost + 3 + false + false)) + (overlay + (board->image (list + (make-cell (make-posn 0 1) true) + (make-cell (make-posn 1 0) true) + (make-cell (make-posn 1 1) false) + (make-cell (make-posn 1 2) true) + (make-cell (make-posn 2 0) true) + (make-cell (make-posn 2 1) true) + (make-cell (make-posn 2 2) true)) + 3 + (lambda (x) false) + false) + (move-pinhole sad-cat + (- (cell-center-x (make-posn 1 1))) + (- (cell-center-y (make-posn 1 1)))))) + + (test + (render-world + (make-world (list + (make-cell (make-posn 0 1) false) + (make-cell (make-posn 1 0) false) + (make-cell (make-posn 1 1) false) + (make-cell (make-posn 1 2) false) + (make-cell (make-posn 2 0) false) + (make-cell (make-posn 2 1) false) + (make-cell (make-posn 2 2) false)) + (make-posn 1 1) + 'cat-lost + 3 + (make-posn (cell-center-x (make-posn 0 1)) + (cell-center-y (make-posn 0 1))) + true)) + + (overlay + (board->image (list + (make-cell (make-posn 0 1) false) + (make-cell (make-posn 1 0) false) + (make-cell (make-posn 1 1) false) + (make-cell (make-posn 1 2) false) + (make-cell (make-posn 2 0) false) + (make-cell (make-posn 2 1) false) + (make-cell (make-posn 2 2) false)) + 3 + (lambda (x) true) + (make-posn (cell-center-x (make-posn 0 1)) + (cell-center-y (make-posn 0 1)))) + (move-pinhole sad-cat + (- (cell-center-x (make-posn 1 1))) + (- (cell-center-y (make-posn 1 1))))))] + +@chunk[ +;; chop-whiskers : image -> image +;; crops the image so that anything above or to the left of the pinhole is gone +(define (chop-whiskers img) + (shrink img + 0 + 0 + (- (image-width img) (pinhole-x img) 1) + (- (image-height img) (pinhole-y img) 1)))] + +@chunk[ + (test (chop-whiskers (rectangle 5 5 'solid 'black)) + (put-pinhole (rectangle 3 3 'solid 'black) 0 0)) + (test (chop-whiskers (rectangle 6 6 'solid 'black)) + (put-pinhole (rectangle 3 3 'solid 'black) 0 0)) + + (test + (pinhole-x + (render-world + (make-world + (empty-board 3) + (make-posn 0 0) + 'playing + 3 + (make-posn 0 0) + false))) + 0) + (test + (pinhole-x + (render-world + (make-world + (empty-board 3) + (make-posn 0 1) + 'playing + 3 + (make-posn 0 0) + false))) + 0)] + +@chunk[image> +;; board->image : board number (posn -> boolean) posn-or-false -> image + (define (board->image cs world-size on-cat-path? mouse) + (foldl (lambda (x y) (overlay y x)) + (nw:rectangle (world-width world-size) + (world-height world-size) + 'solid + 'white) + (map (lambda (c) + (cell->image c + (on-cat-path? (cell-p c)) + (and (posn? mouse) + (equal? mouse (cell-p c))) + #; + (and (posn? mouse) + (point-in-this-circle? (cell-p c) + (posn-x mouse) + (posn-y mouse))))) + cs)))] + +@chunk[image-tests> + (test (board->image (list (make-cell (make-posn 0 0) false)) + 3 + (lambda (x) false) + false) + (overlay + (nw:rectangle (world-width 3) + (world-height 3) + 'solid + 'white) + (cell->image (make-cell (make-posn 0 0) false) + false + false))) + + (test (board->image (list (make-cell (make-posn 0 0) false)) + 3 + (lambda (x) true) + false) + (overlay + (nw:rectangle (world-width 3) + (world-height 3) + 'solid + 'white) + (cell->image (make-cell (make-posn 0 0) false) + true + false))) + + + (test (board->image (list (make-cell (make-posn 0 0) false)) + 3 + (lambda (x) false) + false) + (overlay + (nw:rectangle (world-width 3) + (world-height 3) + 'solid + 'white) + (cell->image (make-cell (make-posn 0 0) false) + false + false))) + + (test (board->image (list (make-cell (make-posn 0 0) false) + (make-cell (make-posn 0 1) false)) + 3 + (lambda (x) (equal? x (make-posn 0 1))) + false) + (overlay + (nw:rectangle (world-width 3) + (world-height 3) + 'solid + 'white) + (cell->image (make-cell (make-posn 0 0) false) + false + false) + (cell->image (make-cell (make-posn 0 1) false) + true + false))) + + (test (board->image (list (make-cell (make-posn 0 0) false) + (make-cell (make-posn 0 1) false)) + 3 + (lambda (x) (equal? x (make-posn 0 1))) + (make-posn 0 0)) + (overlay + (nw:rectangle (world-width 3) + (world-height 3) + 'solid + 'white) + (cell->image (make-cell (make-posn 0 0) false) + false + true) + (cell->image (make-cell (make-posn 0 1) false) + true + false)))] + +@chunk[image> + ;; cell->image : cell boolean boolean -> image + (define (cell->image c on-short-path? under-mouse?) + (local [(define x (cell-center-x (cell-p c))) + (define y (cell-center-y (cell-p c))) + (define main-circle + (cond + [(cell-blocked? c) + (circle circle-radius 'solid blocked-color)] + [else + (circle circle-radius 'solid normal-color)]))] + (move-pinhole + (cond + [under-mouse? + (overlay main-circle + (circle (quotient circle-radius 2) 'solid under-mouse-color))] + [on-short-path? + (overlay main-circle + (circle (quotient circle-radius 2) 'solid + on-shortest-path-color))] + [else + main-circle]) + (- x) + (- y))))] + +@chunk[image-tests> + (test (cell->image (make-cell (make-posn 0 0) false) false false) + (move-pinhole (circle circle-radius 'solid normal-color) + (- circle-radius) + (- circle-radius))) + (test (cell->image (make-cell (make-posn 0 0) true) false false) + (move-pinhole (circle circle-radius 'solid 'black) + (- circle-radius) + (- circle-radius))) + (test (cell->image (make-cell (make-posn 0 0) false) true false) + (move-pinhole (overlay (circle circle-radius 'solid normal-color) + (circle (quotient circle-radius 2) 'solid + on-shortest-path-color)) + (- circle-radius) + (- circle-radius))) + (test (cell->image (make-cell (make-posn 0 0) false) true true) + (move-pinhole (overlay (circle circle-radius 'solid normal-color) + (circle (quotient circle-radius 2) 'solid + under-mouse-color)) + (- circle-radius) + (- circle-radius)))] + +@chunk[ + + ;; world-width : number -> number + ;; computes the width of the drawn world in terms of its size + (define (world-width board-size) + (local [(define rightmost-posn + (make-posn (- board-size 1) (- board-size 2)))] + (+ (cell-center-x rightmost-posn) circle-radius)))] + +@chunk[ + ;; world-height : number -> number + ;; computes the height of the drawn world in terms of its size + (define (world-height board-size) + (local [(define bottommost-posn + (make-posn (- board-size 1) (- board-size 1)))] + (+ (cell-center-y bottommost-posn) circle-radius)))] + +@chunk[ + (test (world-width 3) 150) + (test (world-height 3) 116.208)] + +@chunk[ + ;; cell-center-x : posn -> number + (define (cell-center-x p) + (local [(define x (posn-x p)) + (define y (posn-y p))] + (+ circle-radius + (* x circle-spacing 2) + (if (odd? y) + circle-spacing + 0))))] + +@chunk[ + (test (cell-center-x (make-posn 0 0)) + circle-radius) + (test (cell-center-x (make-posn 0 1)) + (+ circle-spacing circle-radius)) + (test (cell-center-x (make-posn 1 0)) + (+ (* 2 circle-spacing) circle-radius)) + (test (cell-center-x (make-posn 1 1)) + (+ (* 3 circle-spacing) circle-radius))] + +@chunk[ + ;; cell-center-y : posn -> number + (define (cell-center-y p) + (local [(define y (posn-y p))] + (+ circle-radius + (* y circle-spacing 2 + .866 ;; .866 is an exact approximate to sin(pi/3) + ))))] + +@chunk[ + (test (cell-center-y (make-posn 1 1)) + (+ circle-radius (* 2 circle-spacing .866))) + (test (cell-center-y (make-posn 1 0)) + circle-radius)] + + @section{Tests} @chunk[ @@ -1062,393 +1525,6 @@ it returns @scheme['∞] if either argument is @scheme['∞]. #;'() -;; constants -(define circle-radius 20) -(define circle-spacing 22) - -(define normal-color 'lightskyblue) -(define on-shortest-path-color 'white) -(define blocked-color 'black) -(define under-mouse-color 'black) - - -; -; -; -; -; ;; ;;;; -; ;;;; ;;;;; -; ;;; ; -; ;;; ;;; ; ;;;; ;;;; ;;;;;; ;; ;;;; ;;;;;; ;; ;;;; ;;; -; ;;;;;;;;;;;;;; ;;;; ;;;;;;;;; ;; ;; ; ;;;;; ;;; ;;;; ;;;;;;; -; ;;;;;;;;; ;;; ;;;;;;;;;;;;;;; ;;; ;; ;; ;;; ;;; ;;;; ; ;;;; -; ;;; ;;; ;;; ;;;; ;;; ;;; ;;; ;;; ;;; ;;; ;;;; ;;; ;; ;;; -; ;; ;;;; ;;; ;; ;;;; ;;; ;;;; ;;; ;;; ;;; ;;; ;;;;;;; -; ;;;;;;;; ;;; ;;;;;;;;;; ;;; ;; ;;;;; ;;;; ;;; ;;; ;;; -; ;;;;;;;;;;;;;;;; ;;;;;;;;;;; ;;; ;;; ;;; ;;;;;;;;;; ;;; ;;;; ;;; -; ;;;;; ;;;; ;;;; ;;;;; ;;; -; ;;;;;;; ;;; -; ;;;;;; -; - - -;; render-world : world -> image -(define (render-world w) - (chop-whiskers - (overlay (board->image (world-board w) - (world-size w) - (on-cats-path? w) - (world-mouse-posn w)) - (move-pinhole - (cond - [(equal? (world-state w) 'cat-won) happy-cat] - [(equal? (world-state w) 'cat-lost) sad-cat] - [else thinking-cat]) - (- (cell-center-x (world-cat w))) - (- (cell-center-y (world-cat w))))))) - -(test - (render-world - (make-world (list (make-cell (make-posn 0 1) false)) - (make-posn 0 1) - 'playing - 2 - (make-posn 0 0) - false)) - (overlay - (board->image (list (make-cell (make-posn 0 1) false)) - 2 - (lambda (x) true) - false) - (move-pinhole thinking-cat - (- (cell-center-x (make-posn 0 1))) - (- (cell-center-y (make-posn 0 1)))))) - -(test - (render-world - (make-world (list (make-cell (make-posn 0 1) false)) - (make-posn 0 1) - 'cat-won - 2 - false - false)) - (overlay - (board->image (list (make-cell (make-posn 0 1) false)) - 2 - (lambda (x) true) - false) - (move-pinhole happy-cat - (- (cell-center-x (make-posn 0 1))) - (- (cell-center-y (make-posn 0 1)))))) - -(test - (render-world - (make-world (list (make-cell (make-posn 0 1) false)) - (make-posn 0 1) - 'cat-lost - 2 - false - false)) - (overlay - (board->image (list (make-cell (make-posn 0 1) false)) - 2 - (lambda (x) true) - false) - (move-pinhole sad-cat - (- (cell-center-x (make-posn 0 1))) - (- (cell-center-y (make-posn 0 1)))))) - -(test - (render-world - (make-world (list - (make-cell (make-posn 0 1) true) - (make-cell (make-posn 1 0) true) - (make-cell (make-posn 1 1) false) - (make-cell (make-posn 1 2) true) - (make-cell (make-posn 2 0) true) - (make-cell (make-posn 2 1) true) - (make-cell (make-posn 2 2) true)) - (make-posn 1 1) - 'cat-lost - 3 - false - false)) - (overlay - (board->image (list - (make-cell (make-posn 0 1) true) - (make-cell (make-posn 1 0) true) - (make-cell (make-posn 1 1) false) - (make-cell (make-posn 1 2) true) - (make-cell (make-posn 2 0) true) - (make-cell (make-posn 2 1) true) - (make-cell (make-posn 2 2) true)) - 3 - (lambda (x) false) - false) - (move-pinhole sad-cat - (- (cell-center-x (make-posn 1 1))) - (- (cell-center-y (make-posn 1 1)))))) - -(test - (render-world - (make-world (list - (make-cell (make-posn 0 1) false) - (make-cell (make-posn 1 0) false) - (make-cell (make-posn 1 1) false) - (make-cell (make-posn 1 2) false) - (make-cell (make-posn 2 0) false) - (make-cell (make-posn 2 1) false) - (make-cell (make-posn 2 2) false)) - (make-posn 1 1) - 'cat-lost - 3 - (make-posn (cell-center-x (make-posn 0 1)) - (cell-center-y (make-posn 0 1))) - true)) - - (overlay - (board->image (list - (make-cell (make-posn 0 1) false) - (make-cell (make-posn 1 0) false) - (make-cell (make-posn 1 1) false) - (make-cell (make-posn 1 2) false) - (make-cell (make-posn 2 0) false) - (make-cell (make-posn 2 1) false) - (make-cell (make-posn 2 2) false)) - 3 - (lambda (x) true) - (make-posn (cell-center-x (make-posn 0 1)) - (cell-center-y (make-posn 0 1)))) - (move-pinhole sad-cat - (- (cell-center-x (make-posn 1 1))) - (- (cell-center-y (make-posn 1 1)))))) - -;; chop-whiskers : image -> image -;; crops the image so that anything above or to the left of the pinhole is gone -(define (chop-whiskers img) - (shrink img - 0 - 0 - (- (image-width img) (pinhole-x img) 1) - (- (image-height img) (pinhole-y img) 1))) - -(test (chop-whiskers (rectangle 5 5 'solid 'black)) - (put-pinhole (rectangle 3 3 'solid 'black) 0 0)) -(test (chop-whiskers (rectangle 6 6 'solid 'black)) - (put-pinhole (rectangle 3 3 'solid 'black) 0 0)) - -(test - (pinhole-x - (render-world - (make-world - (empty-board 3) - (make-posn 0 0) - 'playing - 3 - (make-posn 0 0) - false))) - 0) -(test - (pinhole-x - (render-world - (make-world - (empty-board 3) - (make-posn 0 1) - 'playing - 3 - (make-posn 0 0) - false))) - 0) - - -;; board->image : board number (posn -> boolean) posn-or-false -> image -(define (board->image cs world-size on-cat-path? mouse) - (foldl (lambda (x y) (overlay y x)) - (nw:rectangle (world-width world-size) - (world-height world-size) - 'solid - 'white) - (map (lambda (c) - (cell->image c - (on-cat-path? (cell-p c)) - (and (posn? mouse) - (equal? mouse (cell-p c))) - #; - (and (posn? mouse) - (point-in-this-circle? (cell-p c) - (posn-x mouse) - (posn-y mouse))))) - cs))) - -(test (board->image (list (make-cell (make-posn 0 0) false)) - 3 - (lambda (x) false) - false) - (overlay - (nw:rectangle (world-width 3) - (world-height 3) - 'solid - 'white) - (cell->image (make-cell (make-posn 0 0) false) - false - false))) - -(test (board->image (list (make-cell (make-posn 0 0) false)) - 3 - (lambda (x) true) - false) - (overlay - (nw:rectangle (world-width 3) - (world-height 3) - 'solid - 'white) - (cell->image (make-cell (make-posn 0 0) false) - true - false))) - - -(test (board->image (list (make-cell (make-posn 0 0) false)) - 3 - (lambda (x) false) - false) - (overlay - (nw:rectangle (world-width 3) - (world-height 3) - 'solid - 'white) - (cell->image (make-cell (make-posn 0 0) false) - false - false))) - -(test (board->image (list (make-cell (make-posn 0 0) false) - (make-cell (make-posn 0 1) false)) - 3 - (lambda (x) (equal? x (make-posn 0 1))) - false) - (overlay - (nw:rectangle (world-width 3) - (world-height 3) - 'solid - 'white) - (cell->image (make-cell (make-posn 0 0) false) - false - false) - (cell->image (make-cell (make-posn 0 1) false) - true - false))) - -(test (board->image (list (make-cell (make-posn 0 0) false) - (make-cell (make-posn 0 1) false)) - 3 - (lambda (x) (equal? x (make-posn 0 1))) - (make-posn 0 0)) - (overlay - (nw:rectangle (world-width 3) - (world-height 3) - 'solid - 'white) - (cell->image (make-cell (make-posn 0 0) false) - false - true) - (cell->image (make-cell (make-posn 0 1) false) - true - false))) - -;; cell->image : cell boolean boolean -> image -(define (cell->image c on-short-path? under-mouse?) - (local [(define x (cell-center-x (cell-p c))) - (define y (cell-center-y (cell-p c))) - (define main-circle - (cond - [(cell-blocked? c) - (circle circle-radius 'solid blocked-color)] - [else - (circle circle-radius 'solid normal-color)]))] - (move-pinhole - (cond - [under-mouse? - (overlay main-circle - (circle (quotient circle-radius 2) 'solid under-mouse-color))] - [on-short-path? - (overlay main-circle - (circle (quotient circle-radius 2) 'solid - on-shortest-path-color))] - [else - main-circle]) - (- x) - (- y)))) - -(test (cell->image (make-cell (make-posn 0 0) false) false false) - (move-pinhole (circle circle-radius 'solid normal-color) - (- circle-radius) - (- circle-radius))) -(test (cell->image (make-cell (make-posn 0 0) true) false false) - (move-pinhole (circle circle-radius 'solid 'black) - (- circle-radius) - (- circle-radius))) -(test (cell->image (make-cell (make-posn 0 0) false) true false) - (move-pinhole (overlay (circle circle-radius 'solid normal-color) - (circle (quotient circle-radius 2) 'solid - on-shortest-path-color)) - (- circle-radius) - (- circle-radius))) -(test (cell->image (make-cell (make-posn 0 0) false) true true) - (move-pinhole (overlay (circle circle-radius 'solid normal-color) - (circle (quotient circle-radius 2) 'solid - under-mouse-color)) - (- circle-radius) - (- circle-radius))) - -;; world-width : number -> number -;; computes the width of the drawn world in terms of its size -(define (world-width board-size) - (local [(define rightmost-posn - (make-posn (- board-size 1) (- board-size 2)))] - (+ (cell-center-x rightmost-posn) circle-radius))) - -(test (world-width 3) 150) - -;; world-height : number -> number -;; computes the height of the drawn world in terms of its size -(define (world-height board-size) - (local [(define bottommost-posn - (make-posn (- board-size 1) (- board-size 1)))] - (+ (cell-center-y bottommost-posn) circle-radius))) -(test (world-height 3) 116.208) - - -;; cell-center-x : posn -> number -(define (cell-center-x p) - (local [(define x (posn-x p)) - (define y (posn-y p))] - (+ circle-radius - (* x circle-spacing 2) - (if (odd? y) - circle-spacing - 0)))) - -(test (cell-center-x (make-posn 0 0)) - circle-radius) -(test (cell-center-x (make-posn 0 1)) - (+ circle-spacing circle-radius)) -(test (cell-center-x (make-posn 1 0)) - (+ (* 2 circle-spacing) circle-radius)) -(test (cell-center-x (make-posn 1 1)) - (+ (* 3 circle-spacing) circle-radius)) - -;; cell-center-y : posn -> number -(define (cell-center-y p) - (local [(define y (posn-y p))] - (+ circle-radius - (* y circle-spacing 2 - .866 ;; .866 is an exact approximate to sin(pi/3) - )))) - -(test (cell-center-y (make-posn 1 1)) - (+ circle-radius (* 2 circle-spacing .866))) -(test (cell-center-y (make-posn 1 0)) - circle-radius) - ; ; @@ -1944,92 +2020,6 @@ it returns @scheme['∞] if either argument is @scheme['∞]. -; -; -; -; -; -; ;;;; -; ;;; -; ;;; ; -; ;;;;;; ;;;; ;;;;;;;;;;; -; ;;; ;;;; ;;;;;;;;; ;;; ;; -; ;;; ;;;;;;;;;;;;;;; ;;; -; ;;; ;;;;;;; ;;; ;;; ;;;; -; ;;; ;; ;;;; ;;; ;;;;; -; ;;; ; ;;;;;;;;;; ;;; ;;;; -; ;;; ; ;;;;;;;;;;; ;;; ;; -; ;;;; ;;;;; ;;;;; -; -; -; - - -;; cat : symbol -> image -(define (cat mode) - (local [(define face-color - (cond - [(symbol=? mode 'sad) 'pink] - [else 'lightgray])) - - (define left-ear (regular-polygon 3 8 'solid 'black (/ pi -3))) - (define right-ear (regular-polygon 3 8 'solid 'black 0)) - (define ear-x-offset 14) - (define ear-y-offset 9) - - (define eye (overlay (ellipse 12 8 'solid 'black) - (ellipse 6 4 'solid 'limegreen))) - (define eye-x-offset 8) - (define eye-y-offset 3) - - (define nose (regular-polygon 3 5 'solid 'black (/ pi 2))) - - (define mouth-happy - (overlay (ellipse 8 8 'solid face-color) - (ellipse 8 8 'outline 'black) - (move-pinhole - (rectangle 10 5 'solid face-color) - 0 - 4))) - (define mouth-no-expression - (overlay (ellipse 8 8 'solid face-color) - (ellipse 8 8 'outline face-color) - (rectangle 10 5 'solid face-color))) - - (define mouth - (cond - [(symbol=? mode 'happy) mouth-happy] - [else mouth-no-expression])) - (define mouth-x-offset 4) - (define mouth-y-offset -5)] - - (add-line - (add-line - (add-line - (add-line - (add-line - (add-line - (overlay (move-pinhole left-ear (- ear-x-offset) ear-y-offset) - (move-pinhole right-ear (- ear-x-offset 1) ear-y-offset) - (ellipse 40 26 'solid 'black) - (ellipse 36 22 'solid face-color) - (move-pinhole mouth (- mouth-x-offset) mouth-y-offset) - (move-pinhole mouth mouth-x-offset mouth-y-offset) - (move-pinhole eye (- eye-x-offset) eye-y-offset) - (move-pinhole eye eye-x-offset eye-y-offset) - (move-pinhole nose -1 -4)) - 6 4 30 12 'black) - 6 4 30 4 'black) - 6 4 30 -4 'black) - -6 4 -30 12 'black) - -6 4 -30 4 'black) - -6 4 -30 -4 'black))) - -(define happy-cat (cat 'happy)) -(define sad-cat (cat 'sad)) -(define thinking-cat (cat 'thinking)) - - ; ; ;