From 9aaf29fbbf9eda8d77c40909764d4cb4f650700c Mon Sep 17 00:00:00 2001 From: Gabriel Pariat Date: Tue, 18 Oct 2022 17:23:18 -0400 Subject: [PATCH] first --- Makefile | 0 client/assets/ComicMono.ttf | Bin 0 -> 18724 bytes client/client.asd | 26 +++ client/src/client.lisp | 44 +++++ client/src/game.lisp | 339 ++++++++++++++++++++++++++++++++++ client/src/gui/element.lisp | 115 ++++++++++++ client/src/gui/gui.lisp | 12 ++ client/src/gui/line.lisp | 19 ++ client/src/gui/package.lisp | 38 ++++ client/src/gui/rectangle.lisp | 16 ++ client/src/gui/text.lisp | 64 +++++++ client/src/main-menu.lisp | 183 ++++++++++++++++++ client/src/package.lisp | 5 + client/src/scene.lisp | 15 ++ client/src/utils.lisp | 13 ++ client/system-index.txt | 1 + game/game.asd | 14 ++ game/src/game.lisp | 69 +++++++ game/src/package.lisp | 33 ++++ init.lisp | 10 + server/server.asd | 14 ++ server/src/package.lisp | 3 + server/src/server.lisp | 5 + system-index.txt | 3 + 24 files changed, 1041 insertions(+) create mode 100644 Makefile create mode 100644 client/assets/ComicMono.ttf create mode 100644 client/client.asd create mode 100644 client/src/client.lisp create mode 100644 client/src/game.lisp create mode 100644 client/src/gui/element.lisp create mode 100644 client/src/gui/gui.lisp create mode 100644 client/src/gui/line.lisp create mode 100644 client/src/gui/package.lisp create mode 100644 client/src/gui/rectangle.lisp create mode 100644 client/src/gui/text.lisp create mode 100644 client/src/main-menu.lisp create mode 100644 client/src/package.lisp create mode 100644 client/src/scene.lisp create mode 100644 client/src/utils.lisp create mode 100644 client/system-index.txt create mode 100644 game/game.asd create mode 100644 game/src/game.lisp create mode 100644 game/src/package.lisp create mode 100644 init.lisp create mode 100644 server/server.asd create mode 100644 server/src/package.lisp create mode 100644 server/src/server.lisp create mode 100644 system-index.txt diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..e69de29 diff --git a/client/assets/ComicMono.ttf b/client/assets/ComicMono.ttf new file mode 100644 index 0000000000000000000000000000000000000000..9bc7354e3ad1702a85a08dea067bb2871bce689a GIT binary patch literal 18724 zcma*P2Y6i7wFY|jK4qGw_mQUeqS5pjwNdY~ie<@?EZef>CR?&xk+MTfOg_&%pjeh)%ypLNnwHd}eL{ZaIOz+Gm&72heGQyG7)cF)E?2~sQ z;aIh>4?|{#&~Z4+;KLXsM77PlqD63_V)mMIFTyy_?R0c@G*H!)!{K87!tbPh&6VLT za89^}{(!j(wjC6Lk!>aKAR{DCbQl#;T51vHr5xx*WTL*LV$^9=Nqvb9Q#I5O)lBtL zhp8TF4b?%-r*c#)x)=3QPQ}9f{XJ)8Msu7;e@HYxa z-IN;kVzBiVRZhJLuL)$MhN($v6ux5|)@PF1Of91(V5=FwI0q-z*7y+ zMtH{r`T+L*FopzLingPb)E}rX&?rm`bVzs>&CDCdPYYW`6a%uMr~+ZN7;2|O=dd`e z4j1Sh$i<;`m>fl9Z~DXcJKt}AzwP~|*-wDeGYckJsl91ViCSakL~BPb5?6Og2|qR$ft=ud1%8tpm$x zYHn$5YoF86+0{L_XI^jL{QiN#1w#uLEgoL-!*Bb4-zIYS|M^%tvU1h3i*l^&l$_{7x2)H`C=KmK#AsF7TY4o|;?-{QKdLeN6+LfB~F zj0)s;`LcQ1A4PeT&ZA_;Ky$uyDwE9^^g0gzT+J|I%;v+vG($^inxzrV;?htgwV`cz zw6=M$pZ!?NORu@2ytX)rvk6)lK4f#Qu9;~e)o)DuVdOKak z)l+&Z3}Y~05ey)TvKj36<*_kg!|ab7LtkTwge!LjYgiG(VuR1C)i~`s)Pluu*cGT@ zIfg|BpGT{8ICSjC^Y}f@!4Sr=$STyd+U!wsNTT&wdidQxa+v4~2Fs_IUiNva6Ref; z&JHT;cKOo2Og4|QS{LUAxxh{)seuDV8xqk;?aT%zN+t|O9Vc?r!bTWz=jN3q@6*zm zWG0K+lmmXBSEUM8rqVc`R@JK;)upmz2B*^g?lPom@I|7s?8jMEL!daSFj!5A8XQlw zmCuWL@%#-zje1_d=Tqt(q3eCcmo)ZV81L zut)NsR?7jUsiSygN8lAeTc*j}l{-tg|(}ZesjkV4B(#mh|`@z-wuEBNb1I-n= zO3(wx^es$`eUYjKivVBCadK`Wy&E4}gQ~R|gHf|3xsn|< z5%1k*h07rF)CSzDLg@;Zu}5SpnA(){NAo$$!kS$-Z62~_0wI%2ZlgVB^GQc#UsT&{ zjFm~38^vi;!s68^Ha)Qp?Yqc6&yx$5c|6T+r5<0?rskUU?F~VF)xQEo?J;S_tW)=A zwY$>3pUM-Pm=}`gM-}#1bE3WTY{i3x3HLXGV@pG<;_#lK#{NL!U+A`zPvqBL4j9T`g<)qnpnE{N|NG@_p2o@O@qIeLmRXF!@68`>;@8 z&=^cx*w16K$VP*P?lK&G??P)P9EhzRte46R7Im^=Vak_K6R&n(c`|Gddo#cCC)Hh6uxsA;4ht z&G;DuY!ZKC0Cxk%BT7I-GJ-?#`$V8!U}|ukpF_`x10`Xl#v)c9x~VIkLsEUHaPfov zrB<0kn=4Zpmvo1enWRovh;%ib_qIiAu|(%HH@tM%D7EOSs-%|gVPrK~Xo*DT&pFbeICo5+@FKJN~Fh!2JS3WAp z^EA4dzL$AqCc1JWS0w`HFGLWdA(`^~AhwD)y$~UUY3L02ypVe!c*K%S;CSkIHOnpx zq-oI~!QYEC9!us9aN{u_?*9W$dVCqotlZp>y~)jELATasRbYf75I5E#TiMl<){+b-Nh1EA2y#lc>%>LQx@qd2>ID&u~Hapr(IN(A~q+AL6%= zostQ@;(Pp%o<#{o;*t8Q?|=ZJYNn4dCiX0#GSEG6l;?l|rOiN4C2P(Y)4VS2yjbg8 z?zI=#P~^7OWhR7|VA#mTz*p+Wvl8fo73uBqOz%PE&(jICm=SoRM8M(#+iud_UX8qR-kLU-Np zE!&S}_8u%cjIDS2Jx0ww2XTR7T@2@fr~r`w037)z zID3#MK>!d1iKo)*z;wwW2nujnB9pMuMuP&;FZJ@%&%9h->~BB0x0Ysx1`w(Z)~~Jf?WkxrB;e*soNwLi`W%Q1|GjRyFFgh z7Oq-7yri$o9wdJ2 zK)(T+5Nt;jFPVUeMDaOynDLYFtzZSanw^!%K!P64*!Z)5Z9X>Etuv`yfd)tM(XMUR z1P8Ai3spwKw>?GE2X>glc9+&BQ#$JdE|p1_??1o!v(ISc$js>~p0~L_j4plsAL05g ze{7Cgrw!*9A04k7Y4g>E!kG*AE*y|ZElRJ_P^{Le+Y^DtO7}BQlrO1GS|yrvFE9gu zTYIKo0bO~S3V~Oh(H3xvsZ81<;-VNPq@jq~!@LX{c+T3hUjykvhE>t0%56Ld4r^RJHm49V8jE~;>t*1p`z+C`c`y3A6B zXtZm-FTi+YgCDHxZ}9mOs<}FWLCgIsk;Y?5Uj#e!3`$ z7hm?(b$!0-=0L7NBNa2&!ef7XY1gGB(M&>6jXpk~)zqwq>>9pR)c;><8w)V`1U;eCk;lidc zT772T@ZQFv)pLQQLDYO0uZ6vt@_e81Xuw8&4AC7wNdY}JVXQD}DMFK`PJhI082#ev z3rzR$f#{`1pjPO9QmPM^jTkt)O@ zi8feWoc{+nL(l~9)4A#Am>~G+IF+Zm1c?FW5K;=172FC7f?@$+av~cez)2!5Byw?D zLmtB>?N=bZ4njrHJ$K7P>sS7Kw8`3dpnLp0vB_80w`Wf0-u^nDNi5g8ilT)vN&CjS zkYY-_<9Oe`n$2~?M?b6BJX|jG)l7C?^5D=BbY1P|U^6~YKbm%(mn@xVMTftA19|F3E1l(YYMZS7$H&{Z zSAjmXf_&ZVCm`R95ETVn!+Wbn2m7SAX|`+?3VJ0ynhxXMo>YMJE+f=c2Mjw`3NpkXgsc!sB`d&&SAQuC1 zbl^n5f0KM%E9{e84`s42U^s^G!>nFf@7yi{Ho#gO)M~21EeS zonjDWFPoh+`fW|u%$${iY%ah3w#VwtL^k}h{I@bKJ3DDKes0okK{jiznw3p2|F73( zx2P5>DS8Un%(QHFx0e@I&$5m#hOJt{@6y16#(*uK$P7K&Mb zH1b#px-ir%+THl>pWS6mZ8h=r?Tc5{H7yvx=5(oCIj1(aq_HYjTJK*yY;oqiMdv_8 zsJkov(o5L|HKnChgHtE}4bFnB9Q@Zz4f``{JMpEQAF^aHZ}9xH9t?t>ACMd*Sb3UY z43UB+@>I~^zTg^=Yc^wq?11=N!L>o6tw4b6NV-R$D+BMs9Q}Kl!5?Ypny4Oo^uo^E zio-VzHLM%$stcR+#dC9)XiD~-chFVQwQyNH2E>rwYVzuJmQ>tlCPQhy;` zP++yFO;ScvR2(b~<%)FO$JbPa8ip1oG6Q94n^s()lB;!6wO%fgStI%4m`#h;Jccya z-iLC3xv@u|>fLk4Ur)5|-_&sX(aWyv*uS8X$c_ePkv88AaIB*0+5k7h)OqchnzbZ!3TBKfEnmqxxlWGk`yt3;s} z{d%#}YuAn<5rc;N@+%rMHmxXFGj~q@WK_Z$RuwL~akQd%@N^L^W*J21;=Slk2pwK@ z+LkSq%0=|bC--c*#c%8%FX^~^*C1=L`0n`Caz^Kj#mi!r%s|ekoSKjM2aW)3$mF`` zdo9@{L}U#C^JM%4A!8i}gak-GoytbRBMDk8C@%2|21aow z|I>MwjCK0+tBziE!<@D%aY>Q0K`Ii{sLJV`!_Y3Z-KwlUalu$k^WOH_oy(f-7JpRN zw(r+$>F|!DO(&80{YQ2*sBM0l3x{kKId6iC^wV4-tZKwYnM%}i+0*~rvEY`qg^{pX zqeTkHT#4QUVcgy9LzEM$KEPNB5Po)%2(z8Ai3nMR3>pFCgPEzkz7iBhe)#VufByF? z#s^kBwQ>IJD$ycXq{8lf2d}V%M3>X7*3!0E`JC7WHflPB>94sqaXJ0 zAM$rBjx7|6!0d#1Wvr8^^naS-UL?|Z%}?;#j!I5p))Die`QEA5SAdStA})>f?beV@ zBV*HYTB8!t{rNO9pzKrIyROh>OKG1<0<4$UDMS{9RQKkK$Oid907Z|lTHCBt8kCGm zWziM*^MalcyYj+%fz}bm{f8DM%tn|D=l8IH{WHV?&de=}JR%KZ+2+U(ttV%F9$mf< zB3(4WKfvz>pMb`Y{H^MQ2a6#fR=vl6vOtxHq;M`ih?Ftdm0STsz8b0Qt}CyZ zE9W#aiN~R_1HU3wBKgz@M7Pe_1mQ!0vtq%&gB=S-0lfSMr{!3 zIPf5$x~1!nxBb8}df%``P2x(2d~l)foH-;`^t8t1d%ljjs@Z}CWoXw#GQdjGBJ@>c z!|rWM%aLFrmm&K{kMC~mvPK&%W>}73@72%qd%z^BN48DIIhREnba#ZT4vw}v+O(py zFo!C^k3B?k-dTAA_GH{(&75{d{&|!Fh?N1B0X!A)w4g0|U`il^Nr3|voSkq~0h7WE z%?N9t!!Eva2p1HHw4zk8yZbhcaMb_b58n0@J}TJ6 zhmil?N`VVtqv#wKf_R~U01N4rkGLtoEgp6jLiu$HpqC6-pP0#p!BfAH`SLIPR3e>% zqRjla3^E!a(Jv>2x(t|bXpoT^0+!1EVi3ZNa^TMrNQuEn3}Pe_2V9;c)KAeObf{&2 zZkvQ*P>I`#tWA9l{#sbE%4c+8Ku8`dA>!4B=kpjof~#=kR`)z zIwcVy^w7f}ElqR}56>}b62)#-oD3MNdKya5NHO{gFJk}Km}R1hFQ5HtW}L)EO+R9z zGo?bk4vR9>3`+~>g%UxLm4rYJd=ur@8-8e|VnG?Cs1=3oG#6$3>U5KxKYF|Yb^Kjk zV6-&U>A&UQtw%pF(R~Z=GziNb=kFVDLY|uqg&LWF_l4b;SH*fPA0d5r z&V^H_LQqu7iE&x5xI!dj zX!Gsp*>+RFC`Vphp(z(vq5EGLLZ9lPoSDj&zr_D~Loff(0vyqDN|#UVjllP6r$1xb z!7sM}S}|~b0`dqUMqnE34z!FmL|kRgdkWzp}$v;b;fOATc$293`a{M6wXZmdt}tRL_8X)G z^1y1RQzQ~W_=ovYMpDj&tVNhA%#Z$wFD2EUzU3Ds1)Q9w%R(VX0n5?m;zZ$qF^n!a zC>ATZWYFl)7C<4F*60mI*lrFY6N;cs``_bt^6SGjd5jur12~MXc{EsBB%#|5PKDlk z0{`dcc%4+?EG%+P-8pq2kpLV}DR6tgqKc>_@e1I(NTv7m~LlvSOLKm&ogaQTL#{MEs!6?-y z)~-9{O!5nKI=A=v)#9?1N6!qRW7PD)dvfa@IsX{HYR$Wg%D0Va4CyF+@8lzEhf-UU zO4jOFv9)54?U%^3>%^_6kG~a9+=EGljd|Iu=9UTshX!#gfNS-hEll)lc`T0UwJbBt7N_9mUBW8HNj*(o8`G)_Ow zWT2J{Gt5FLoGsy#yb`pDohjlIt{zN7$f{v}5RnMA28T!yA80vWqeVSarT6UZiLY7F z9T%DW4T}!VBgOjI$l)i~WgqwWT`XM~aA_H_C%mX)(T!tAc5b+PtkF`v{?dCE9skcm z=Zf;Vy25PhvaBspRuc2rB|>SwVef|CxK^RayG=zJf0@VmZ@(ZCX}go8c{4Ze?Q2?sN*$d381f}=Q-T#sLg zM{pvp;@_t00dQm!3+YFX$vIVxze1uF#oU2Bjime{AwEA1`TU*0JwSY(RdSFVlwwsN z6Cq>Q2plD3?*^lWsi8wP{YzFai&t#hJyOT0q^L63E29m?wJWMGen8FvDpJ@B4gMrn zVco)Ow+!b)8b|kePn?G*-p}S&Pqm&XU9qAy`qXpt5&Oa)_0cl3s4~qzF3i_G{TIlG zZ-#mn#5KRm@1saY3~PfmU{{3ThfRpS_~*vH0b4Ksf1DV&sFsGS{HxE_!raxv&>~{$! zo&r;*;cLk^X#vw_ETp_Zl5rS@(V*360XBmCq2L3=1-MuM^yD4b57hDP;!N(lz!j33 zN~I0zkjI4R1`e{MUyNagE18q9B%I#3;=ld7v6IQWbYVS-7 zK})Q5o9S#BFobtL98tSCLhrR5gFPwpyR4EviM-7uCjWiB_Xw)k^-OBw}#_ zi6R!QNTDfdaQi2&a@F$xbn2Db+(HZb-CC?!mQl-1?mm7H-P-T4h?NR|&T8h%2E=qH zUsvYIdDMEf(HpuSS;`jkIYBpK(@!#`5KADEkX{`Kc2Lw5s8a#L!$R3u!TS>YL0G#4 ztQT1w;Xi=%+qGRmosm($=|5m9T+?XMNUSDJC=w_ra2iwcI@FjHIjqN=(xgo83;H#x zLM>LvDpi_EhijzrPLsdTstiEy&&{nLN8l;D&K)viRD>-~)eFx|0~CTNPFO zKmO7F5!$stD0)i3!F2oLmv6#%Uj_UzPI-MbCL~fKTpd=`bemT2`}w0M6i6-$fNs1s z-AX^sy$pS%B*!4!JsDj(BcvD@q6A4WG7K4<(4WBSFb5e1WZc9zz#)27=G5*R(y25j zkwIRHF(UzX@Mj2*#UdC`y7@f*O&PQyil8kttAz9dGS)jqB)xEJb-Ga;g5HJe@7{Bb zT&^}iaskc}#XV||L(Qng5&o*rZ`d|#+(DBh!n^uP14*tzgp?aW8Y*L$|rA|b0 zt~Ws*kIl-1G^Rk_MJh%D#{yCSqy<(l6d>UcNCDPKq!a0FG$#UAp*PTvrqbyfcAd(a zy&4hr#*`?x4WJ5Uq=Zkw#!LA9FKbx@=OrxMb7t3SCR<+F}G6oJ_*R5@;SI*g3u{CZI6}h!V$*e-Obzx6- zeyX4Ki|&*(R3YBBW@Fp(80o4`OsAOW^q(jt z1vnxCu>_Q3wz=ZayGV@cJ*3!LGPUMlKVyff6nh8QeyG&J_>qm(;wf$=MfxQK0-h}B z%*ctqT`n5S_1lbQEYUCUi6)5B_+a%aw{$;GsGt%d7yrB&v6h1LS{nV1@$ zzJswaL5M2^C!fP}Q3lX5RNf3m;@6>3f)LaoDd74*^A$AxY@}LEE15mdH|-j#ce~1a zN4A_-yY|X%k2s}FPE{MjZ6%2%?PXd+w7uHfJ=hrSWSmQ&ueaAKPj(&XIx-=;~W9Z5FkV$X>z~#W$l654~f`O1sB0*Bm zBp4v1zBZunyue38ZkqC?K#Wjn2fzo7iS!%!yvUen87Xhrf8Jmc&?6|Ra%sL-KQFhGmol9TiLc2z-C)fDt}I8!l8bjhKo)?fI}9y}jy9|r+9 zZ<`vwW#es)8BN0#1!|W$YBq^zLr;^#IAol&f@T&T?|blNGXC-D=jbn)FtGgs6G($| zg5(*JHIiGBqB$6-0W=WM1tJpnfF{ykI2zYnz4E0$GI;LM$0n*T-EWc23Hc^3UVV*D zY|qTgWyf10;?B-q;Q5pPIT0G zF>Nn#OIN4M@vWxP?(^H0ELjMU8Bx2Y-=ja|?1VRio);4GL3ZFWj2Van;OamR(mu#_ zNO1?29yl{dDWNH6#{Cl{Eg~7e(0)Pa*J7Ig@6TJaF&xVp2MkyyR?@zzer9kf&ab}s z#)aWr#QESm7}bY}J1~yjT#hvijqaJBil>|m&7qv%pCJ62w?68-3Ng*Nf54evdU{Q> zBNzx~Z#xpQF~GXQg&BTeVu%w(-2SX!Q&TsCoV8F*n+G#d0CNv>5ks#QKmssv!dY-` zA65$r4D%CU0!&8(olrKS*M!7KWuXC2!O$N{o5zn_F}HemfHrb!rU2-@j8j?O>>7P| zn^MHA_~Y{r;+i#=oLMlws6?xxfh@4cPZe@7vA_l?5+n>8&z^}1Lg8>DWV0kUeSMkrIzt(JB z-4VvvlWl48Rv=}g*@zu9HfP!=VeK|gzeaxpexw4h1*8Q8vI|+Lg43r7@d<1o_)md* zhW;<@Ea|Bg)DJ8}Lw{2f_ScF57*yt0He{^Oz=aUY%#hE}*sYYIGT=BFL+$X9x%DGi zGeY{Fs(Os`u`<-Q>gY)nsO)TO2^Y`>S%rUdey&>}I_IIAI#EA*LtvHu#E%9V^Pc>~ zq3-Scp&8%2Z2BGOVY{1>QLuD~z#-!FKzk7B#v|=tNoNYC17_iaoIt=x8B!RBelUa4 z30lbEinifZbEW0!jDvwEE_W2`#8QS6BNTHp%qG!D zeSVM;8uq_kElc}-C5vm)%l2pPEMP@AYWJpy+O7(bIDeOy^UwQgce5C@6X z7!yQHA|gQ}{DJ-q!0FfxsF2hWpaP+o;a_UIT^A?;E=wv! z4Uu3RmK-m=BUq(h_gp-ugcJZ3mWAvtuEtti)u67|yg0G=<*m=2<-ge#%vvN!V$OvcAN%b+oACCf8~J^8 z-ndbWN*ZcW(*lkCip2*P*529t0qFHA=-(+|2s#3me#U$FNg7NtDKcSBXypP8AvkG< z!v%{JKmnN+okqX+AU+67@h!2=Vh@CUiwgH-6_Ve)yT(j-bEv*-9?Foy;Ra+jJ zmtRuhqQyVizjdb!%iI-9vUupyr&e$OkE;iQ3y-|McgHUd)!jj7Rvnu6_Va&urf&6c zbpXC|a_Sm}VwM8#ASpD6fTR`LlmJWta1d=EksBg5=O=U-L`)m0fI~+OS$fohGXABk zM22;$T8FblEMb0nao4uhjX{i@O(RFTp6W%Mfn`zPL|gT6%7~dlA2f9|oG$0Z$qc*V z7xV$d-063^SSD?CmoInBJ@D$$`iu6js>XEDQvMOUuFUCYP-_X>SkGx=OLqlMrAy;%gi384>K@-PQM%>bv)EvgOEPjj^aUxqD^F21Sj z$VihD;hNPauNxY_w^#?o9+idAv3&ofix`=wvB5K^uP(-5V``Y!=PD|4m!n*e#+4(x z4%Qrf_xR#KW7?GT6=)?UzUglM)_1UkOYFjB`T}EV?~%TSJ?qJBTi^$dPrm~9LfU3J zJVC?Ae?bXhtV(D-fHZ&@9|7>d)(~-n_Mvt3>R_B9y}k}a*Or7+wA{Gl$djuLZY3=h zMO>adbPY&Vb$f@qih-{*Mn_m2NQoY)+=m`1tIB2aJNz9D0h;YtzRKbCOT;m+zM)u? zY8z}ZugSIl6UMb3YFKi{Pq>FHFhfLeAU=X4z*`dM;Bg8VZf0yg7#es0xCSsMNg6j; zTdWnOsse?@9(R>pwTr{4m1{50ZSFy9(MnSYPzNru1nUcmH0ArZwXvdCd-m<@3W=0w zzB$=>WbL61URlsrROnPlb4wFNVF%pn;a@QS%p;pdE#{JdL=Fuv4f+6psF2E&sUA#k zx~o65M384M;LQ)&9YW0zRvqwWhSc8Nu51c?E1|K75*UET2D(pyTwVoj(1Y@VD!^fm zzHt4u9T%+1W12={03yo=nf}_KNC_=f-d&))(^)bNt`OSzo5I1pHrTOvGq=W$=DbycpMTVF-=OYVE)9=MMe#Y3&KrNz%>-K zv?#whRe-dG8p1Bglx}Opl+a|@*B9&O`VG(>XX$-OS*S6X(aY!}S6RR!2Jn#Z#aDKZ zS8fb#m7`NAS|3)Ep0c@*@_;)CPkBGnLr)3WtH8>@2nZ7cJcl-80W~BTomAg4WF+9P z0nm}~BT#n0N}iBq3LRzgYiy$8K&VD!o-ePddWNNeQRe|}6K@G#l9W@a$NsK>v-!nB+cla$u zghj+6^n0`tC`750R>k~l`A=>>g6={FcT^=77Y56noA|Z-75rAx`VM0np8kUV2g8t# z(V6=seBc9x;w#7#>gl8&z<7zxLKGAc8jAiJm*iFaTmL%kP0Lbo$G4v(`H@roaIXYf zg}Q($#ElhK?Ry}Pj@@2HZjPAY36<9Rg!9Y4R;bO&mQXqC)!~|ucdY-Gjc2OOW?%@( zSSF@ZkY~J1YAnLNTR?|FHb|;<-@{zkgQFxX1gnJzNP7PO2$NeQpvE%O3230djwY7g zebGF#$89dkwXG>5_Y!3L1^|`?TuAy!u&m8_^crumH$HbkV)81J+hr>4Ul9*gt#g<9 znl`tTuIcSw5D^&*4a)jZD8njD!6H?@VRy?De=4@Qs?T4M*fuy%6KGC(Wv;ag7k1AZ z&AM|gO)+pxAMm^J8SXwx1rvh1gJGEgU48#|1r~rWwHJ=d+M1Yx7f(Xduze}BGM1h~>zy2gp*6O_I zYH!3F?;eUzUTJc1Ij!ty>x+mD|0bt~IR{}5er#p5Och~Mz?DJtBH;@BF02`l5k&ii?id1Y zY+Mpb`j8ptX-2D6iInnPcZFLjqJ>-`+&`e#D^wP<+N@S7=Q|7zY3lA?S2PtW0a~#@ zuhbjlG^bG)X)J|msWlL1jADOj#?3!hSXLdAmM9z&6(hA;^2H^=YB5*mf98Eo>#d5) zOAKzcRs?r6yE6fEA_nv(jQKR;>3i{A6wtp~a_hwR)Z*W-KzCZ9FKWJfBx6$}z)9lUXv9Rk@Mc0vBD9qL6u-d!3Hru? zlLSaIKWoZ}MT{9f3O;K) zeJg$odOp>#gTIq8I6;EO@b8AxmM(`kZg#IS7sL`Kn~NRb|2`aZsWe03$`2ZfOpHuU zmJ6+K!9b{~n`UCw2y_qYAc>=cnk(okK;Qvhij{h}zr^n4d{%^9el?)jB12(z+L+@qoC@@I~{Z2ofLe{1bi(S0{n1H$Ha#5 zCGgrPTsbMcZh+Y?hj%AnrZIRegXfQZ>dcue%rOJc1Y8>@7`hRL);O_Y<#IM)eXJoJ;2oVQho3n zHvQB9HApRh--cNTzk9Qo8iwV(hq{+~fO?R6nz|2u)#jiuHw3>8g9U3Lg+P;VjO^1O fRs^#p{){{XnLNAv!QYUb-|hNM2YDsG74-iAi_5QO literal 0 HcmV?d00001 diff --git a/client/client.asd b/client/client.asd new file mode 100644 index 0000000..4b543d9 --- /dev/null +++ b/client/client.asd @@ -0,0 +1,26 @@ +(require :asdf) + +(asdf:defsystem #:client + :description "Pariatech's Pong game client" + :author "Gabriel Pariat " + :license "AGPLv3" + :version "0.0.1" + :serial t + :depends-on ("game" "cl-raylib" "3d-vectors") + :pathname "src" + :components + ((:file "package") + (:module "gui" + :serial t + :components ((:file "package") + (:file "gui") + (:file "element") + (:file "rectangle") + (:file "text") + (:file "line"))) + (:file "utils") + (:file "scene") + (:file "main-menu") + (:file "game") + (:file "client"))) + diff --git a/client/src/client.lisp b/client/src/client.lisp new file mode 100644 index 0000000..44d71a6 --- /dev/null +++ b/client/src/client.lisp @@ -0,0 +1,44 @@ +(in-package :pong.client) + +(defparameter *scene* nil) + +(defun open-main-menu% () + (setf *scene* (open-main-menu #'start-1-player-game + #'start-2-players-game + #'create-online-game + #'join-online-game))) + +(defun start-1-player-game () + (setf *scene* (open-game (make-instance 'local-game-1p) #'open-main-menu%))) + +(defun start-2-players-game () + (setf *scene* (open-game (make-instance 'local-game-2p) #'open-main-menu%))) + +(defun create-online-game () + (format t "~%Create online game.")) +(defun join-online-game () + (format t "~%Join online game.")) + +(defun main () + (let* ((last-time nil) + (current-time (get-internal-real-time))) + (r:with-window (800 600 "Pariatech's Pong") + (gui:with-gui + (open-main-menu%) + + (r:set-config-flags r:+flag-window-resizable+) + (r:set-target-fps 60) + (r:set-exit-key 0) + (loop + until (or (r:window-should-close) (scene-should-close *scene*)) + do (setf last-time current-time) + (setf current-time (/ (get-internal-real-time) internal-time-units-per-second)) + + (let ((timelapse (- current-time last-time))) + (on-update *scene* timelapse)) + (r:with-drawing + (r:clear-background r:+gray+) + (on-draw *scene*) + (r:draw-fps 20 20))))))) + +(main) diff --git a/client/src/game.lisp b/client/src/game.lisp new file mode 100644 index 0000000..c7e66ac --- /dev/null +++ b/client/src/game.lisp @@ -0,0 +1,339 @@ +(in-package :pong.client) + +(defconstant +score-txt-size+ 32) +(defconstant +score-padding+ 20) +(defconstant +score-font+ "assets/ComicMono.ttf") + +(defclass local-game-1p (g:game) + ((computer-paddle-target :initarg :computer-paddle-target + :initform nil + :accessor local-game-1p-computer-paddle-target))) + +(defclass local-game-2p (g:game) ()) + +(defclass game-scene (scene) + ((game :initarg :game :initform nil :reader game-scene-game) + (left-score :initarg :left-score :initform nil :reader game-scene-left-score) + (right-score :initarg :right-score :initform nil :reader game-scene-right-score) + (left-paddle :initarg :left-paddle :initform nil :reader game-scene-left-paddle) + (right-paddle :initarg :right-paddle :initform nil :reader game-scene-right-paddle) + (left-player :initarg :left-player :initform nil :reader game-scene-left-player) + (right-player :initarg :right-player :initform nil :reader game-scene-right-player) + (ball :initarg :ball :initform nil :reader game-scene-ball) + (line :initarg :line :initform nil :reader game-scene-line) + (move-back :initarg :move-back :initform nil :reader game-scene-move-back) + (quit-menu :initarg :quit-menu :initform nil :reader game-scene-quit-menu) + (quit-menu-text :initarg :quit-menu-text :initform nil :reader game-scene-quit-menu-text) + (quit-menu-yes :initarg :quit-menu-yes :initform nil :reader game-scene-quit-menu-yes) + (quit-menu-no :initarg :quit-menu-no :initform nil :reader game-scene-quit-menu-no))) + +(defun open-game (game move-back) + (let ((root-element (gui:make-rectangle :color r:+darkgray+ + :h-align :center + :v-align :middle)) + (left-score (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :h-align :right + :y +score-padding+)) + (right-score (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :y +score-padding+)) + (left-paddle (gui:make-rectangle :color r:+white+ + :v-align :middle)) + (right-paddle (gui:make-rectangle :color r:+white+ + :h-align :right + :v-align :middle)) + (left-player (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :x +score-padding+ + :y +score-padding+)) + (right-player (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :h-align :right + :y +score-padding+)) + (ball (gui:make-rectangle :color r:+white+ + :h-align :center + :v-align :middle)) + (line (gui:make-line :thickness 4 + :color r:+white+)) + (quit-menu (gui:make-rectangle :color r:+black+ + :h-align :center + :v-align :middle + :visible nil)) + (quit-menu-text (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :y +score-padding+ + :h-align :center + :text "Do you really want to quit the game?")) + (quit-menu-yes (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :h-align :center + :text "Yes")) + (quit-menu-no (gui:make-text :color r:+white+ + :font +score-font+ + :font-size +score-txt-size+ + :h-align :center + :text "No"))) + + (gui:add-children quit-menu + quit-menu-text + quit-menu-yes + quit-menu-no) + + (gui:add-children root-element + quit-menu + left-score + right-score + left-paddle + right-paddle + ball + line + left-player + right-player) + + (g:on-init game) + + (make-instance 'game-scene :game game + :root-element root-element + :left-score left-score + :right-score right-score + :left-paddle left-paddle + :right-paddle right-paddle + :left-player left-player + :right-player right-player + :ball ball + :line line + :move-back move-back + :quit-menu quit-menu + :quit-menu-text quit-menu-text + :quit-menu-yes quit-menu-yes + :quit-menu-no quit-menu-no))) + +(defun position-score (el direction) + (setf (gui:x el) (funcall direction (floor (gui:w (gui:parent el)) 2) +score-padding+))) + +(defun position-paddle (paddle el) + (let ((paddle-y (g:paddle-y paddle)) + (parent (gui:parent el))) + (setf (gui:w el) (* g:+paddle-width+ (gui:w parent))) + (setf (gui:h el) (* g:+paddle-height+ (gui:h parent))) + (setf (gui:y el) (* paddle-y (gui:h parent))))) + +(defun position-right-paddle (paddle el) + (position-paddle paddle el) + (setf (gui:x el) (gui:w (gui:parent el)))) + +(defun position-ball (ball el) + (let ((ball-xy (g:ball-xy ball)) + (parent (gui:parent el))) + (setf (gui:w el) (* g:+ball-radius+ (gui:w parent) 2)) + (setf (gui:h el) (* g:+ball-radius+ (gui:h parent) 2)) + (setf (gui:x el) (* (v:vx ball-xy) (gui:w parent))) + (setf (gui:y el) (* (v:vy ball-xy) (gui:h parent))))) + +(defun position-line (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2)) + (setf (gui:end-x el) (floor (gui:w (gui:parent el)) 2)) + (setf (gui:end-y el) (gui:h (gui:parent el)))) + +(defun position-right-player (el) + (setf (gui:x el) (- (gui:w (gui:parent el)) +score-padding+))) + +(defun position-quit-menu (menu text yes no) + (setf (gui:x menu) (floor (gui:w (gui:parent menu)) 2)) + (setf (gui:y menu) (floor (gui:h (gui:parent menu)) 2)) + (setf (gui:w menu) (+ (gui:w text) (* +score-padding+ 2))) + (setf (gui:x text) (floor (gui:w menu) 2)) + (setf (gui:x yes) (floor (gui:w menu) 3)) + (setf (gui:x no) (floor (gui:w menu) 3/2)) + (setf (gui:y yes) (+ (gui:y text) (gui:h text) +score-padding+)) + (setf (gui:y no) (+ (gui:y text) (gui:h text) +score-padding+)) + (setf (gui:h menu) (+ (gui:y yes) (gui:h yes) +score-padding+))) + +(defmethod on-update ((scene game-scene) timelapse) + (unless (gui:visible (game-scene-quit-menu scene)) + (g:on-update (game-scene-game scene) timelapse)) + (update-text-if-hovered (game-scene-quit-menu-yes scene) "Yes") + (update-text-if-hovered (game-scene-quit-menu-no scene) "No") + (when (gui:clickedp (game-scene-quit-menu-no scene) r:+mouse-button-left+) + (setf (gui:visible (game-scene-quit-menu scene)) nil)) + (when (r:is-key-pressed r:+key-escape+) + (setf (gui:visible (game-scene-quit-menu scene)) t)) + (when (gui:clickedp (game-scene-quit-menu-yes scene) r:+mouse-button-left+) + (funcall (game-scene-move-back scene)))) + +(defmethod on-draw ((scene game-scene)) + (with-slots (game root-element left-score right-score left-paddle right-paddle ball line left-player right-player quit-menu quit-menu-text quit-menu-yes quit-menu-no) + scene + (let ((game-state (g:game-state game))) + (position-root root-element) + (setf (gui:text left-score) (format nil "~a" (g:state-left-score game-state))) + (setf (gui:text right-score) (format nil "~a" (g:state-right-score game-state))) + (position-score left-score #'-) + (position-score right-score #'+) + (position-paddle (g:state-left-paddle game-state) left-paddle) + (position-right-paddle (g:state-right-paddle game-state) right-paddle) + (position-ball (g:state-ball game-state) ball) + (position-line line) + (setf (gui:text left-player) (g:state-left-player game-state)) + (setf (gui:text right-player) (g:state-right-player game-state)) + (position-right-player right-player) + (position-quit-menu quit-menu quit-menu-text quit-menu-yes quit-menu-no)))) + +(defun handle-player-paddle (paddle timelapse upward-keys downward-keys) + (let ((paddle-y (g:paddle-y paddle)) + (paddle-vy (g:paddle-vy paddle))) + (setf (g:paddle-vy paddle) + (cond ((member-if #'r:is-key-down downward-keys) g:+paddle-speed+) + ((member-if #'r:is-key-down upward-keys) (- g:+paddle-speed+)) + (t 0.0))) + (setf (g:paddle-y paddle) + (min (max (+ paddle-y (* paddle-vy timelapse)) (/ g:+paddle-height+ 2)) + (- 1.0 (/ g:+paddle-height+ 2)))))) + +(defun handle-left-player (state timelapse upward-keys downward-keys) + (handle-player-paddle (g:state-left-paddle state) timelapse upward-keys downward-keys)) + +(defun handle-right-player (state timelapse upward-keys downward-keys) + (handle-player-paddle (g:state-right-paddle state) timelapse upward-keys downward-keys)) + +(defun handle-right-computer (state timelapse target) + (let* ((right-paddle (g:state-right-paddle state)) + (paddle-y (g:paddle-y right-paddle)) + (ball (g:state-ball state)) + (ball-xy (g:ball-xy ball)) + (ball-y (v:vy ball-xy)) + (paddle-target (and target (+ paddle-y (- target (/ g:+paddle-height+ 2)))))) + + + (setf (g:paddle-vy right-paddle) + (if paddle-target + (let ((delta (/ (- ball-y paddle-target) timelapse))) + (if (minusp delta) + (max delta (- g:+paddle-speed+)) + (min delta g:+paddle-speed+))) + 0.0)) + + (setf (g:paddle-y right-paddle) + (min (max (+ paddle-y (* (g:paddle-vy right-paddle) timelapse)) + (/ g:+paddle-height+ 2)) + (- 1.0 (/ g:+paddle-height+ 2)))))) + +(defun point-in-rect-p (px py rx ry rw rh) + (and (> px rx) + (< px (+ rx rw)) + (> py ry) + (< py (+ ry rh)))) + +(defun get-ball-paddle-collision (ball paddle paddle-x) + (let* ((ball-xy (g:ball-xy ball)) + (ball-x (v:vx ball-xy)) + (ball-y (v:vy ball-xy)) + (paddle-y (g:paddle-y paddle))) + (when (or (point-in-rect-p (- ball-x g:+ball-radius+) + (- ball-y g:+ball-radius+) + paddle-x + (- paddle-y (/ g:+paddle-height+ 2)) + g:+paddle-width+ + g:+paddle-height+) + (point-in-rect-p (- ball-x g:+ball-radius+) + (+ ball-y g:+ball-radius+) + paddle-x + (- paddle-y (/ g:+paddle-height+ 2)) + g:+paddle-width+ + g:+paddle-height+) + (point-in-rect-p (+ ball-x g:+ball-radius+) + (- ball-y g:+ball-radius+) + paddle-x + (- paddle-y (/ g:+paddle-height+ 2)) + g:+paddle-width+ + g:+paddle-height+) + (point-in-rect-p (+ ball-x g:+ball-radius+) + (+ ball-y g:+ball-radius+) + paddle-x + (- paddle-y (/ g:+paddle-height+ 2)) + g:+paddle-width+ + g:+paddle-height+)) + (- ball-y paddle-y)))) + +(defun handle-ball (state timelapse) + (let* ((ball (g:state-ball state)) + (ball-xy (g:ball-xy ball)) + (ball-x (v:vx ball-xy)) + (ball-y (v:vy ball-xy)) + (ball-vxy (g:ball-vxy ball)) + (ball-vy (v:vy ball-vxy)) + (left-paddle (g:state-left-paddle state)) + (right-paddle (g:state-right-paddle state)) + (ball-left-paddle-collision + (get-ball-paddle-collision ball left-paddle 0.0)) + (ball-right-paddle-collision + (get-ball-paddle-collision ball right-paddle (- 1.0 g:+paddle-width+)))) + (cond + (ball-left-paddle-collision + (g:launch-ball ball + (incf (g:state-bounces state)) + (* (/ ball-left-paddle-collision + (+ (/ g:+paddle-height+ 2) g:+ball-radius+)) + g:+max-launch-angle+) + (+ g:+paddle-width+ g:+ball-radius+) + ball-y)) + (ball-right-paddle-collision + (g:launch-ball ball + (incf (g:state-bounces state)) + (- pi + (* (/ ball-right-paddle-collision + (+ (/ g:+paddle-height+ 2) g:+ball-radius+)) + (/ g:+max-launch-angle+ 2))) + (- 1.0 g:+paddle-width+ g:+ball-radius+) + ball-y)) + ((< (+ ball-x g:+ball-radius+) 0) + (incf (g:state-right-score state)) + (g:random-launch-ball state)) + ((> (- ball-x g:+ball-radius+) 1) + (incf (g:state-left-score state)) + (g:random-launch-ball state)) + ((< (- ball-y g:+ball-radius+) 0) + (setf (v:vy ball-xy) g:+ball-radius+) + (setf (v:vy ball-vxy) (* -1 ball-vy))) + ((> (+ ball-y g:+ball-radius+) 1) + (setf (v:vy ball-xy) (- 1 g:+ball-radius+)) + (setf (v:vy ball-vxy) (* -1 ball-vy))) + (t + (setf (g:ball-xy ball) (v:v+ ball-xy (v:v* ball-vxy timelapse))))))) + +(defun computer-paddle-target (game) + (let* ((game-state (g:game-state game)) + (ball (g:state-ball game-state)) + (ball-vxy (g:ball-vxy ball))) + (if (plusp (v:vx ball-vxy)) + (or (local-game-1p-computer-paddle-target game) + (setf (local-game-1p-computer-paddle-target game) + (random g:+paddle-height+))) + (setf (local-game-1p-computer-paddle-target game) nil)))) + +(defmethod g:on-init ((game local-game-1p)) + (g:random-launch-ball (g:game-state game))) + +(defmethod g:on-update ((game local-game-1p) timelapse) + (let ((game-state (g:game-state game))) + (handle-left-player game-state timelapse + (list r:+key-w+ r:+key-up+) + (list r:+key-s+ r:+key-down+)) + (handle-right-computer game-state timelapse (computer-paddle-target game)) + (handle-ball game-state timelapse))) + +(defmethod g:on-init ((game local-game-2p)) + (g:random-launch-ball (g:game-state game))) + +(defmethod g:on-update ((game local-game-2p) timelapse) + (let ((game-state (g:game-state game))) + (handle-left-player game-state timelapse (list r:+key-w+) (list r:+key-s+)) + (handle-right-player game-state timelapse (list r:+key-up+) (list r:+key-down+)) + (handle-ball game-state timelapse))) diff --git a/client/src/gui/element.lisp b/client/src/gui/element.lisp new file mode 100644 index 0000000..073ca4f --- /dev/null +++ b/client/src/gui/element.lisp @@ -0,0 +1,115 @@ +(in-package #:gui) + +(defclass element () + ((x :initarg :x :initform 0.0 :accessor x) + (y :initarg :y :initform 0.0 :accessor y) + (w :initarg :w :initform 0.0 :accessor w) + (h :initarg :h :initform 0.0 :accessor h) + (h-align :initarg :h-align :initform :left :accessor h-align) + (v-align :initarg :v-align :initform :top :accessor v-align) + (offset-x :initarg :offset-x :initform 0.0 :reader offset-x) + (offset-y :initarg :offset-y :initform 0.0 :reader offset-y) + (screen-x :initarg :screen-x :initform 0.0 :reader screen-x) + (screen-y :initarg :screen-y :initform 0.0 :reader screen-y) + (visible :initarg :visible :initform t :accessor visible) + (parent :initarg :parent :initform nil :reader parent) + (children :initarg :children :initform nil :reader children))) + +(defmethod hoveredp ((el element)) + (let ((mpos (r:get-mouse-position))) + (with-slots (screen-x screen-y w h) el + (and (< (v:vx mpos) (+ screen-x w)) + (>= (v:vx mpos) screen-x) + (< (v:vy mpos) (+ screen-y h)) + (>= (v:vy mpos) screen-y))))) + +(defmethod clickedp ((el element) button) + (and (r:is-mouse-button-pressed button) + (hoveredp el))) + +(defmethod set-screen-x ((el element) x) + (setf (slot-value el 'screen-x) x) + (mapc (lambda (el) (set-screen-x el (+ x (offset-x el)))) + (children el))) + +(defun update-x (el) + (with-slots (x w h-align offset-x screen-x) el + (incf screen-x (- offset-x)) + (setf offset-x (case h-align + (:center (- x (floor w 2))) + (:right (- x w)) + (otherwise x))) + (set-screen-x el (+ screen-x offset-x)))) + +(defmethod (setf x) (value (el element)) + (setf (slot-value el 'x) value) + (update-x el)) + +(defmethod (setf w) (value (el element)) + (setf (slot-value el 'w) value) + (unless (eq (slot-value el 'h-align) :left) + (update-x el))) + +(defmethod (setf h-align) (value (el element)) + (setf (slot-value el 'h-align) value) + (update-x el)) + +(defmethod set-screen-y ((el element) y) + (setf (slot-value el 'screen-y) y) + (mapc (lambda (el) (set-screen-y el (+ y (offset-y el)))) + (children el))) + +(defun update-y (el) + (with-slots (y h v-align offset-y screen-y) el + (incf screen-y (- offset-y)) + (setf offset-y (case v-align + (:middle (- y (floor h 2))) + (:bottom (- y h)) + (otherwise y))) + (set-screen-y el (+ screen-y offset-y)))) + +(defmethod (setf y) (value (el element)) + (setf (slot-value el 'y) value) + (update-y el)) + +(defmethod (setf h) (value (el element)) + (setf (slot-value el 'h) value) + (unless (eq (slot-value el 'v-align) :top) + (update-y el))) + +(defmethod (setf v-align) (value (el element)) + (setf (slot-value el 'v-align) value) + (update-y el)) + +(defmethod remove-child ((parent element) (child element)) + (setf (slot-value parent 'children) + (remove child (children parent)))) + +(defmethod remove-children ((parent element) &rest children) + (mapc #'(lambda (child) (remove-child parent child)) children)) + +(defmethod add-child ((parent element) (child element)) + (when (parent child) + (remove-child (parent child) child)) + (push child (slot-value parent 'children)) + (setf (slot-value child 'parent) parent)) + +(defmethod add-children ((parent element) &rest children) + (mapc #'(lambda (child) (add-child parent child)) children)) + +(defmethod calculate-size ((el element))) + +(defmethod update ((el element)) + (calculate-size el) + (update-y el) + (update-x el) + el) + +(defmethod draw ((el element))) +(defmethod draw :after ((el element)) + (when (visible el) + (mapc #'draw (children el)))) + +(defmacro make-element (&rest args) + `(update (make-instance 'element ,@args))) + diff --git a/client/src/gui/gui.lisp b/client/src/gui/gui.lisp new file mode 100644 index 0000000..e8aeb7a --- /dev/null +++ b/client/src/gui/gui.lisp @@ -0,0 +1,12 @@ +(in-package #:gui) + +(defparameter *fonts* nil) + +(defmacro with-gui (&body body) + `(unwind-protect + (progn + (setf *fonts* (make-hash-table :test #'equal)) + ,@body) + (loop for v being the hash-value in *fonts* + do (loop for v being the hash-value in v + do (r:unload-font v))))) diff --git a/client/src/gui/line.lisp b/client/src/gui/line.lisp new file mode 100644 index 0000000..c705dc1 --- /dev/null +++ b/client/src/gui/line.lisp @@ -0,0 +1,19 @@ +(in-package #:gui) + +(defclass line (element) + ((end-x :initarg :end-x :initform 0.0 :accessor end-x) + (end-y :initarg :end-y :initform 0.0 :accessor end-y) + (thickness :initarg :thickness :initform 0.0 :accessor thickness) + (color :initarg :color :initform r:+black+ :accessor color))) + +(defmethod draw ((line line)) + (with-slots (screen-x screen-y x y end-x end-y thickness color visible) line + (when visible + (r:draw-line-ex (v:vec screen-x screen-y) + (v:vec (+ screen-x (- end-x x)) + (+ screen-y (- end-y y))) + (float thickness) + color)))) + +(defmacro make-line (&rest args) + `(make-instance 'line ,@args)) diff --git a/client/src/gui/package.lisp b/client/src/gui/package.lisp new file mode 100644 index 0000000..9e97305 --- /dev/null +++ b/client/src/gui/package.lisp @@ -0,0 +1,38 @@ +(defpackage #:gui + (:use :cl) + (:local-nicknames (:r :raylib) + (:v :3d-vectors)) + (:export #:element + #:rectangle + #:text + #:line + #:x + #:y + #:w + #:h + #:h-align + #:v-align + #:offset-x + #:offset-y + #:screen-x + #:screen-y + #:end-x + #:end-y + #:thickness + #:color + #:parent + #:children + #:visible + #:draw + #:hoveredp + #:clickedp + #:remove-child + #:remove-children + #:add-child + #:add-children + #:update + #:make-element + #:make-text + #:make-rectangle + #:make-line + #:with-gui)) diff --git a/client/src/gui/rectangle.lisp b/client/src/gui/rectangle.lisp new file mode 100644 index 0000000..a7a1965 --- /dev/null +++ b/client/src/gui/rectangle.lisp @@ -0,0 +1,16 @@ +(in-package #:gui) + +(defclass rectangle (element) + ((color :initarg :color :initform r:+black+ :accessor color))) + +(defmethod draw ((rect rectangle)) + (with-slots (screen-x screen-y w h color visible) rect + (when visible + (r:draw-rectangle (floor screen-x) + (floor screen-y) + (floor w) + (floor h) + color)))) + +(defmacro make-rectangle (&rest args) + `(update (make-instance 'rectangle ,@args))) diff --git a/client/src/gui/text.lisp b/client/src/gui/text.lisp new file mode 100644 index 0000000..b359147 --- /dev/null +++ b/client/src/gui/text.lisp @@ -0,0 +1,64 @@ +(in-package #:gui) + + +(defclass text (element) + ((w :initarg :w :initform 0.0 :reader w) + (h :initarg :h :initform 0.0 :reader h) + (text :initarg :text :initform "" :accessor text) + (color :initarg :color :initform r:+black+ :accessor color) + (font :initarg :font :initform nil :accessor font) + (font-size :initarg :font-size :initform 32 :accessor font-size) + (spacing :initarg :spacing :initform 1.0 :accessor spacing))) + +(defun load-font (font font-size) + (let ((font-family (or (gethash font *fonts*) + (setf (gethash font *fonts*) (make-hash-table))))) + (or (gethash font-size font-family) + (setf (gethash font-size font-family) + (r:load-font-ex font font-size (cffi:null-pointer) 0))))) + +(defmethod draw ((text text)) + (with-slots (font font-size text screen-x screen-y color spacing visible) text + (when visible + (r:draw-text-ex (load-font font font-size) + text + (v:vec (float screen-x) (float screen-y)) + (float font-size) + spacing + color)))) + +(defmethod calculate-size ((txt text)) + (with-slots (w h font font-size text spacing) txt + (when font + (let ((size (r:measure-text-ex (load-font font font-size) + text + (float font-size) + spacing))) + (setf w (v:vx size)) + (setf h (v:vy size)) + (update-x txt) + (update-y txt))))) + +(defmethod (setf text) (value (txt text)) + (setf (slot-value txt 'text) value) + (update txt)) + +(defmethod (setf font) (value (txt text)) + (setf (slot-value txt 'font) value) + (update txt)) + +(defmethod (setf font) (value (txt text)) + (setf (slot-value txt 'font) value) + (update txt)) + +(defmethod (setf font-size) (value (txt text)) + (setf (slot-value txt 'font-size) value) + (update txt)) + +(defmethod (setf spacing) (value (txt text)) + (setf (slot-value txt 'spacing) value) + (update txt)) + +(defmacro make-text (&rest args) + `(update (make-instance 'text ,@args))) + diff --git a/client/src/main-menu.lisp b/client/src/main-menu.lisp new file mode 100644 index 0000000..d736e32 --- /dev/null +++ b/client/src/main-menu.lisp @@ -0,0 +1,183 @@ +(in-package :pong.client) + +(defconstant +title-top-padding+ 30) +(defconstant +menu-padding+ 10) +(defconstant +menu-group-padding+ 20) +(defconstant +menu-font+ "assets/ComicMono.ttf") +(defconstant +menu-font-size+ 32) +(defconstant +menu-title-font-size+ 52) +(defconstant +menu-group-title-font-size+ 42) +(defconstant +menu-text-color+ r:+white+) +(defconstant +menu-local-1-player+ "1 Player") +(defconstant +menu-local-2-players+ "2 Players") +(defconstant +menu-online-create+ "Create Game") +(defconstant +menu-online-join+ "Join Game") + +(defclass main-menu (scene) + ((title :initarg :title :initform nil :reader main-menu-title) + (items-group :initarg :items-group :initform nil :reader main-menu-items-group) + (local-title :initarg :local-title :initform nil :reader main-menu-local-title) + (local-1-player :initarg :local-1-player :initform nil :reader main-menu-local-1-player) + (local-2-players :initarg :local-2-players :initform nil :reader main-menu-local-2-players) + (online-title :initarg :online-title :initform nil :reader main-menu-online-title) + (online-create :initarg :online-create :initform nil :reader main-menu-online-create) + (online-join :initarg :online-join :initform nil :reader main-menu-online-join))) + +(defmacro make-main-menu (&rest args) + `(make-instance 'main-menu ,@args)) + +(defclass menu-item () + ((text :initarg :text :initform nil :reader menu-item-text) + (action :initarg :action :initform nil :reader menu-item-action))) + +(defmacro make-menu-item ((&rest text-args) &key action) + `(make-instance 'menu-item :action ,action + :text (gui:make-text ,@text-args))) + +(defun open-main-menu (start-1-player-game start-2-players-game create-online-game join-online-game) + (let* ((title (gui:make-text :text "Pariatech's Pong Game" + :font +menu-font+ + :font-size +menu-title-font-size+ + :color +menu-text-color+ + :y +title-top-padding+ + :h-align :center)) + (local-title (gui:make-text :text "Local" + :font +menu-font+ + :font-size +menu-group-title-font-size+ + :color +menu-text-color+ + :h-align :center)) + (1-player (make-menu-item (:y (+ (gui:y local-title) + (gui:h local-title) + +menu-group-padding+) + :text +menu-local-1-player+ + :font +menu-font+ + :font-size +menu-font-size+ + :color +menu-text-color+ + :h-align :center) + :action start-1-player-game)) + (2-players (make-menu-item (:y (+ (gui:y (menu-item-text 1-player)) + (gui:h (menu-item-text 1-player)) + +menu-padding+) + :text +menu-local-2-players+ + :font +menu-font+ + :font-size +menu-font-size+ + :color +menu-text-color+ + :h-align :center) + :action start-2-players-game)) + (online-title (gui:make-text :y (+ (gui:y (menu-item-text 2-players)) + (gui:h (menu-item-text 2-players)) + +menu-group-padding+) + :text "Online" + :font +menu-font+ + :font-size +menu-group-title-font-size+ + :color +menu-text-color+ + :h-align :center)) + (online-create (make-menu-item (:y (+ (gui:y online-title) + (gui:h online-title) + +menu-group-padding+) + :text +menu-online-create+ + :font +menu-font+ + :font-size +menu-font-size+ + :color +menu-text-color+ + :h-align :center) + :action create-online-game)) + (online-join (make-menu-item (:y (+ (gui:y (menu-item-text online-create)) + (gui:h (menu-item-text online-create)) + +menu-padding+) + :text +menu-online-join+ + :font +menu-font+ + :font-size +menu-font-size+ + :color +menu-text-color+ + :h-align :center) + :action join-online-game)) + (items-group (gui:make-element :h (+ (gui:y (menu-item-text online-join)) + (gui:h (menu-item-text online-join))) + :h-align :center + :v-align :middle)) + (root-element (gui:make-rectangle :color r:+darkgray+ + :h-align :center + :v-align :middle))) + (gui:add-children items-group + local-title + (menu-item-text 1-player) + (menu-item-text 2-players) + online-title + (menu-item-text online-create) + (menu-item-text online-join)) + (gui:add-children root-element title items-group) + (make-main-menu :title title + :items-group items-group + :local-title local-title + :local-1-player 1-player + :local-2-players 2-players + :online-title online-title + :online-create online-create + :online-join online-join + :items-group items-group + :root-element root-element))) + +(defun position-title (title) + (setf (gui:x title) (floor (gui:w (gui:parent title)) 2))) + +(defun position-items-group (items-group) + (setf (gui:x items-group) (floor (gui:w (gui:parent items-group)) 2)) + (setf (gui:y items-group) (floor (gui:h (gui:parent items-group)) 2)) + (flet ((find-widest (children) + (let ((widest (car children))) + (dolist (child (cdr children) widest) + (when (> (gui:w child) (gui:w widest)) + (setf widest child))) + widest))) + (setf (gui:w items-group) (gui:w (find-widest (gui:children items-group)))))) + +(defun position-local-title (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-local-1-player (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-local-2-players (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-online-title (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-online-create (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun position-online-join (el) + (setf (gui:x el) (floor (gui:w (gui:parent el)) 2))) + +(defun update-text-if-hovered (el txt) + (setf (gui:text el) + (if (gui:hoveredp el) + (concatenate 'string "> " txt " <") + txt))) + +(defun act-on-click (item) + (when (gui:clickedp (menu-item-text item) r:+mouse-button-left+) + (funcall (menu-item-action item)))) + +(defmethod on-update ((scene main-menu) timelapse) + (with-slots (local-1-player local-2-players online-create online-join) scene + (update-text-if-hovered (menu-item-text local-1-player) +menu-local-1-player+) + (update-text-if-hovered (menu-item-text local-2-players) +menu-local-2-players+) + (update-text-if-hovered (menu-item-text online-create) +menu-online-create+) + (update-text-if-hovered (menu-item-text online-join) +menu-online-join+) + (act-on-click local-1-player) + (act-on-click local-2-players) + (act-on-click online-create) + (act-on-click online-join) + (setf (scene-should-close scene) (r:is-key-pressed r:+key-escape+)))) + +(defmethod on-draw ((scene main-menu)) + (with-slots (root-element title items-group local-title local-1-player local-2-players online-title online-create online-join) scene + (position-root root-element) + (position-title title) + (position-items-group items-group) + (position-local-title local-title) + (position-local-1-player (menu-item-text local-1-player)) + (position-local-2-players (menu-item-text local-2-players)) + (position-online-title online-title) + (position-online-create (menu-item-text online-create)) + (position-online-join (menu-item-text online-join)))) diff --git a/client/src/package.lisp b/client/src/package.lisp new file mode 100644 index 0000000..4a18167 --- /dev/null +++ b/client/src/package.lisp @@ -0,0 +1,5 @@ +(defpackage :pong.client + (:use :cl) + (:local-nicknames (:r :raylib) + (:v :3d-vectors) + (:g :pong.game))) diff --git a/client/src/scene.lisp b/client/src/scene.lisp new file mode 100644 index 0000000..d9b26ec --- /dev/null +++ b/client/src/scene.lisp @@ -0,0 +1,15 @@ +(in-package #:pong.client) + +(defclass scene () + ((root-element :initarg :root-element + :initform (make-instance 'gui:element) + :reader scene-root-element) + (should-close :initarg :should-close + :initform nil + :accessor scene-should-close))) + +(defgeneric on-draw (scene)) +(defgeneric on-update (scene timelapse)) + +(defmethod on-draw :after ((scene scene)) + (gui:draw (scene-root-element scene))) diff --git a/client/src/utils.lisp b/client/src/utils.lisp new file mode 100644 index 0000000..7428d63 --- /dev/null +++ b/client/src/utils.lisp @@ -0,0 +1,13 @@ +(in-package :pong.client) + +(defun position-root (root) + (let* ((sw (r:get-screen-width)) + (sh (r:get-screen-height))) + (setf (gui:x root) (floor sw 2)) + (setf (gui:y root) (floor sh 2)) + (cond ((<= sw sh) + (setf (gui:w root) sw) + (setf (gui:h root) sw)) + (t + (setf (gui:w root) sh) + (setf (gui:h root) sh))))) diff --git a/client/system-index.txt b/client/system-index.txt new file mode 100644 index 0000000..7d1e9af --- /dev/null +++ b/client/system-index.txt @@ -0,0 +1 @@ +client.asd diff --git a/game/game.asd b/game/game.asd new file mode 100644 index 0000000..4ab2bff --- /dev/null +++ b/game/game.asd @@ -0,0 +1,14 @@ +(require :asdf) + +(asdf:defsystem #:game + :description "Pariatech's Pong game" + :author "Gabriel Pariat " + :license "AGPLv3" + :version "0.0.1" + :serial t + :depends-on ("3d-vectors") + :pathname "src" + :components + ((:file "package") + (:file "game"))) + diff --git a/game/src/game.lisp b/game/src/game.lisp new file mode 100644 index 0000000..3d5a84c --- /dev/null +++ b/game/src/game.lisp @@ -0,0 +1,69 @@ +(in-package :pong.game) + +(defconstant +paddle-speed+ 0.4) +(defconstant +paddle-height+ 0.1) +(defconstant +paddle-width+ 0.02) +(defconstant +ball-radius+ 0.01) +(defconstant +max-launch-angle+ (/ pi 4)) ; 45° +(defconstant +ball-speed+ 0.5) + +(defstruct paddle + (y 0.0 :type float) + (vy 0.0 :type float)) + +(defstruct ball + (xy (make-instance 'v:vec2) :type v:vec2) + (vxy (make-instance 'v:vec2) :type v:vec2)) + +(defclass state () + ((timestamp :initarg :timestamp + :initform (/ (get-internal-real-time) internal-time-units-per-second) + :reader state-timestamp) + (left-paddle :initarg :left-paddle + :initform (make-paddle :y 0.5) + :accessor state-left-paddle) + (right-paddle :initarg :right-paddle + :initform (make-paddle :y 0.5) + :accessor state-right-paddle) + (ball :initarg :ball + :initform (make-ball :xy (v:vec2 0.5 0.5)) + :accessor state-ball) + (bounces :initarg :bounces + :initform 0 + :accessor state-bounces) + (left-score :initarg :left-score + :initform 0 + :accessor state-left-score) + (right-score :initarg :right-score + :initform 0 + :accessor state-right-score) + (left-player :initarg :left-player + :initform "You" + :accessor state-left-player) + (right-player :initarg :right-player + :initform "Opponent" + :accessor state-right-player))) + + +(defclass game () + ((state :initarg :game-state + :initform (make-instance 'state) + :accessor game-state))) + +(defgeneric on-update (game timelapse)) +(defgeneric on-init (game)) + +(defgeneric handle-action (game action)) + +(defmethod launch-ball ((ball ball) bounces rad x y) + (let* ((v (v:v* (v:vec (cos rad) (sin rad)) (* (log (+ bounces 2)) +ball-speed+)))) + (with-slots (xy vxy) ball + (setf xy (v:vec x y)) + (setf vxy v)))) + +(defmethod random-launch-ball ((state state)) + (launch-ball (state-ball state) + (setf (state-bounces state) 0) + (+ (random +max-launch-angle+) (* (random 2) pi)) + 0.5 + (random 1.0))) diff --git a/game/src/package.lisp b/game/src/package.lisp new file mode 100644 index 0000000..bcab310 --- /dev/null +++ b/game/src/package.lisp @@ -0,0 +1,33 @@ +(defpackage :pong.game + (:use :cl) + (:local-nicknames (:v :3d-vectors)) + (:export #:paddle + #:ball + #:state + #:game + #:on-update + #:on-init + #:handle-action + #:launch-ball + #:random-launch-ball + #:game-state + #:state-timestamp + #:state-left-paddle + #:state-right-paddle + #:state-left-score + #:state-right-score + #:state-ball + #:state-bounces + #:state-left-player + #:state-right-player + #:ball-xy + #:ball-vxy + #:paddle-y + #:paddle-vy + #:+paddle-speed+ + #:+paddle-height+ + #:+paddle-width+ + #:+max-launch-angle+ + #:+ball-radius+)) + + diff --git a/init.lisp b/init.lisp new file mode 100644 index 0000000..d3a0045 --- /dev/null +++ b/init.lisp @@ -0,0 +1,10 @@ +(in-package :cl-user) + +(ql:quickload "cffi") + +(pushnew (car (directory ".")) ql:*local-project-directories*) +(pushnew (car (directory "./client")) ql:*local-project-directories*) + +(ql:register-local-projects) + +(pushnew #P"/usr/local/lib/" cffi:*foreign-library-directories*) diff --git a/server/server.asd b/server/server.asd new file mode 100644 index 0000000..c92a65a --- /dev/null +++ b/server/server.asd @@ -0,0 +1,14 @@ +(require :asdf) + +(asdf:defsystem #:pong.server + :description "Pariatech's Pong game client" + :author "Gabriel Pariat " + :license "AGPLv3" + :version "0.0.1" + :serial t + :depends-on ("pong.game") + :pathname "src" + :components + ((:file "package") + (:file "server"))) + diff --git a/server/src/package.lisp b/server/src/package.lisp new file mode 100644 index 0000000..da8abaa --- /dev/null +++ b/server/src/package.lisp @@ -0,0 +1,3 @@ +(defpackage :pong.server + (:use :cl) + (:local-nicknames (:g :pong.game))) diff --git a/server/src/server.lisp b/server/src/server.lisp new file mode 100644 index 0000000..24d028d --- /dev/null +++ b/server/src/server.lisp @@ -0,0 +1,5 @@ +(in-package :pong.server) + +(defclass online-game (game) + ((actions :initarg :actions + :initform nil))) diff --git a/system-index.txt b/system-index.txt new file mode 100644 index 0000000..b083507 --- /dev/null +++ b/system-index.txt @@ -0,0 +1,3 @@ +game/game.asd +client/client.asd +server/server.asd