From 5f5e4d4827a8f937d51252be9a853dc3222483d6 Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 8 Oct 2018 23:36:52 +0200 Subject: [PATCH] more joypad stuff --- assets/icons/controller_blue.png | Bin 0 -> 5466 bytes assets/icons/controller_green.png | Bin 0 -> 5491 bytes src/Init.hs | 3 ++ src/Load.hs | 30 ++++++++++- src/Main.hs | 5 +- src/MainGame/WorldMap.hs | 2 +- src/Menu.hs | 75 ++++++++++++++++++++++++++ src/StateMachine.hs | 20 +++---- src/Types/ImgId.hs | 5 ++ src/Types/StateData.hs | 1 + src/Types/UserData.hs | 84 +++++++++++++++++++++++++++--- tracer-game.cabal | 1 + 12 files changed, 204 insertions(+), 22 deletions(-) create mode 100644 assets/icons/controller_blue.png create mode 100644 assets/icons/controller_green.png create mode 100644 src/Menu.hs diff --git a/assets/icons/controller_blue.png b/assets/icons/controller_blue.png new file mode 100644 index 0000000000000000000000000000000000000000..11911e4b735ba4969433bea059c2c4cb425034b8 GIT binary patch literal 5466 zcmV-g6{YHlP)|oC+KV^auI@J%K~8{S2@Z*ad9G_WR}oWK&Mo zWAA}A*!y6O71I=`GRa|L8xRiZ103B#2DAT$s&`!=un?F9JPynN)9APiB@;3XxEi<3WB1G8d!?L=u(dAXmh0vD!kqg8T}kF@gRs zB)dVL2l-o&;jvpyK}Lf70%TnRH%F=RI7s){Em-}?Sdfns=>{W=%{ZQds1@8Fem-;+meozr{8p@(e~s0dvtuBSrDWWH8UiDm=D> znGKAOYlEUxHSYtX!0d}rc*I8}IS+L%isG9QK(qj75oa*+IyS7Oq9}e@3>+I{787X( zBU4f5q9~yl23#4V;7BtVnFE|0r))*3NfrYmLT9#!FoTgZQRkv4p&1687rM|Gk4QH} zC{t0C2xBksBa-w6mQmZMUKJ%40t^T9VWU>^eKUu4qOPP$(>5M6&q)|5?F=Z zbmz?}dY-|^Xwq~p0Qb35Wj13o3o4bvd%)FhoeKcBP&tdI{eiJQ3-JAjl+E;d$4(9T(ZisKE)ru1M{{&^=1=ryFdL- z`I1lN9@k)`8#c{psJ%9&upP{yZdFPH@S#2+blEXlT`cUj^2BWhVB~@03E6NC! z^LEk8nDymgbp1t1mC!F9D&t8S$(OT8B8BMteg6n!RYKoNtuR#WmVc(XmG7i9gI?I{6)aByvJK{OoMBM zjvb5`!hS<2N~sJ3ImLf5(gV-ud_2(LdL72~3}z(uxl>V6=EnibxCuBcKsheygB`=p zaJ>K(^6_XD@G&+8L#g=K{In5xA>*~ZfgwOQXVxf%XaM;Vm_PVYFN1-<_M_W7X9M$N z8_^2#xaSz6dqM6285O&x?vV~4lR;)B5UaHoWHrbj5B*pVGADuhWtGR=w}}&^4rHCj zihl|+K6Wj`Ab$t4FM*q_+GQ?IBkPL+c`$)`l_P8Muph<&GR9-2cYvH6yM|$r?#r^#k0nqa7jk_0?O}1b$lKshS4(aN^M*(L31WVNhT#ms3BYS0Q?jd& zQNV2AVn;T`#@Sk`O9$iSECa9!xXY97)cNPw2Gj`sfM-CS0U1;LWikll*Vt^JU-V>K z3>sW1a`dbv?XXAFeY^#E2+UVK=&b;xJ+Kz&9@~-{V*xf;)QiB1ob1IOGw2VThTTLr zj&S+iL$U$r?IPoXtJl;g;qMjeLQi@t0J9HdF}8h`aE#2!O|cD$L{H#&;GJ?6x$?d~ z_rGlPsJjxVl=K%$b>U=8SAv77btJX{N=?$>LWu(hBOQP<%GaYPNkMNtx$$0=^B zjz-{B?7o$Sz;gEQ9qJDpg^kNHg?RVUKJ2dS>A<3#jq89Oz<`{MQ?Zf#>m%8ikF)GL zjA@KizBB|l7x5pFDwhbdEP=BrDasCzJ3xxe{Veq$*Mh7JXyZ1JTS0mjX=4|VZ-J~y zpnaQVZ1#J%Y~;2875p$_1tTLP6S%=rlqW$l29}pDAh&}wdA9LkkbW6$JPhQg3AD3- zd^cMioFFd;s^rv&m5hkolfVs@n%s#^2U2d^P6gTQ!M-MtTW}KcKrX}1)MB>xQ{~qq zTjjfe><(1PMIbeH9!JJw18l_}&?(7x9JldlAUhq~_)W()P6XK#vCTJQ&%}jBCI_zQ z3~I*7$QW#Zt=I!PCHa-7w!X@tjX(2b74 z&i&4;C`_ofXvv{uj7gN$!RYY-B?JOI9i}Mr9`JsK3-mV{sDl#}2=}C13I9AeSS>W=rIJ3|;hAyv} zGeAmSV9qjwnUL{1MJbh4fy-N&;hNAkhAyv}&OpiMlCn4oU4KzRu_thOS#p+Ff{m^y zdF-o$QBo%3VZqD{%y3O5*yxIeQZFdc!AKwA3#AsKC>a?LxV-)uuBikYU2!@{$5JjR zbq3Rbvt(_G(k3H8LI#P-68q$Yteem>5;HzaXP~5WNu@d%eLPY^(iu26Oi^+;*|KAF z$G-RofE)>wklNM@CHa6-9gMI1(~8m>p%Thp0AxL^7|OY3m8;fXzpJbVdccfDvGpy0fVzQjd-2n=z7~Gxh*I!0agI z!==n%&dFv^lK9xiqkDt=&>pzWa~U^~-MIjC!oQ7wLwx4~_B8kD#eTSyK~YVQNA)1C zlf@Mod|JuC#UNMsQ7t2YTOBC63gpWU^yERl2>gQ|-I*wQ9i~r?h)fO~Ns z;a++IPhl5o%cTx@0A!Q{T?Zh2u_;+n%AQ*E(@c>LMvegnWi%#LE_J6$>Ik>cSF6+m zPlFUaJui$50G^?|N28V;W_3!Y&;|!1L$HC>j&!5X87F~sE#`y8&S0u-_5yHSZsFPm zR{|p(=~7y!4=@Adn)1}hso2m5Cp)mIB?Ez3AX%du=8y@%9313__CR}VOej~#!wEz- z^As(uw4I50+U8i0jS1AH)?_9~i6L8M5Xf&p8Uxw*JjjV9+Bg*Czwn>8saz>4WyY$Ft<0yrBe=wRBI!ALt`9d7ms zD2h^Dya#4vp%1jRelQkwE{dY$=Q!Hf>d}^iskO%=MNvwlq0k@I!6=GS4h7F86}!$2czpRilUUl zqv|F{~&`vFrePg4uoGFZ0b{CZf(oQIyi?44l^T zm-!rwuD>XXl7)jFlkzzjU4Ky&B?|{F^tM=ok-osHgMY6miqa;HKyNS`n}5-A1~UnD zE{dXLqa85ez+bcsnW^h9h1m(b3e3dD?cD@)1cm}f0Ve^DGy5q4`3RfnY;Nx7rPy!f zdTipsGl4IoeO!o1*bEB5!H-BEVF!!yc{T$-2Yvx&L*b9g0AMmOB_}<68>eJu7w{4` zeeAPfK5Y9EF~Bt7M?k@Fku}QuV2*A6&jAibhGM<8@_AkXz6R!#(l3?vz<6xVn`yvt zPAyZiuo8GWCoh26o=uI^W3z2s=ghL|;Ycvc;PVdV8^FDh3`&*X0e=Z*pBr^D4C`zr zVI5CTH+q!21g?l=P>S4-ZK!m;CSE!> z`7td@i1&eUU^d4##3J?Bna&rmZ>pMQC@>(RVWC)wT^nqc#lQk!e#>(&agp}eM=*U8 zYZ(n@Uh`{e%^qOc23(Yma{(|rfwywf0_lWxHvO=(&)&J8`{jP_jm^#66`QL$l^DzW zumR=QV)IC^%>Dc+_SRc4ZTn{XaZA4^FsRK@qZAC-`_$x3= zV;iDW8)h5u73}%7T4h`vtwaN_5q<_{dTb+SEK^Qp~4TWahDCYK;pNvWkqKvV3;e}0-`yHlnO!mf-Fy9+_;k8 zZ}MlfXF2DvuXa!4V)E6EL<^nGe#v?fNN7%1Aqq=?RRd zQe^>1w_+=KF39c#j4oDIfDH25?}`!(=?d~r0^_P!Sqd_w)JjeT*_nXxZOK-UF+RFk zQQ{#-fGkU3e6=M@K!#?mWJ7KM$F4+cvI9i3QYux79D|*m#~x=soXcmGY)I6}>;yU2 zMK>x+y2x=Ls}mS+EoA|%zm6`sk|*Z8RqRSN%WjbK992$H5=TaXtVv+pHOv3t{)LM4 z0(mZh%57EWqSPKTGJ!AoMv#93$(O6#NhRBX{0O^SHbw=Pft={6a*C2T(ii0ANMmm! z$h1%uy$ED&;0itl(koB}6(v!m9mqctb{okokYS-K+6UwT{Lf|vw2F=ac>?zbB|ikY9vg{WQIx#M$+_A6UdLbR-zBYZCo%-&R**lJQL*(P z{|Pb~JyWD8B_Mr3z76s`**3_oz@CFT7l(_uo~AxB1ULg23yc7U0=F*~&Afa1^zD1k>+aiqj>GT>1Ar005MXy;mmp+1_8$a#{vfd!+~MIKww9FI|FP2HUsPM?Y?H4 zV|C$Jfxicq;_ri{z)~FTiE5KOoVEeU5QYHzbvgE?^M+~;ULw2+%mD5Orr~G{T!xVa zVKi_Fa5gYDa%pYA2f#apV_xCk*Ko{_T(&y(>0rDwIT|=}n`5Y|P4FIYGw=%>8wzgild?77dps`yF9NfGCvmLTHOc6X&xri%hhj<%H@89U9~S^-6I@{@Sb{WXOll6d=&{k zd^dVTXhJv-VY+(rS1)fO?5}-E>lWc0gpKO0T)nJB_&0>zwJ&LXBbNts7R>AzX{~XaXaQLU>rcdE?1Kgpt~pxo!|nM)*X%RpZI~2$QrgbA8~y ziB_vOX?&T5eKS>$un)pA_126pZ3s6a^wz%QwTaLN;TH8~Oe;UrzU(!PpPzeDy%p2S zOoZXum%g?T`XM~3-gN1u4WU*0^4BcFH`QBEN9H2zseSot1ED{{6Y5Q-CyTLfq{fk*5)M&~BOz^0OC7xC(5Nvj{H&Q-MDL z?*q$q%~7K_emDDY-~eDeeoxULO`~$kEjYfRZ3N`S!3ZY-Pe6V=uVK_U7vs1?+X#IJ z?uGK^SE#PPUR z;o1&nCNNIb2E(Xt-U7zr*s4*u-VjMR9dj;*5t}if7vM~<2O~U>4{K={MqK6r2Ws?U zbb2ttWX!o3Mk+=F7iko%(}NLa0Y|BnZ5WNoJYY=f%ogc;Fv5wLb1{t6j0R3mU8u$o z=}Lt%4Z~1)_R5uRqoS{|h_-JOzA&Lq7eh55|5haAx7C)gasF1NUefQ9V9^+FJEc$UVyn zgfC^NS3iUs5ZcviU=l($A^eC+vN;GlB3wmnW|G{5(7)pQK6eO{)GuYvvJ~NfD(iO% z=45JJUPP*R!zt{7aIbnTDwi{>y7$W<#T?9(1Z8AFfb($7txAjIb}So0EprcW5{~yX zYjCUqz6@N4zprYA=+9>Sw@AW!<_{887X)JxFo1^@mx#oOr8!0j*MAA>>*NK zherU<1lIR-V0}hB+JOrSUkqXKy@AW=`AuZrI3uR=Ms+Zs;Pb|WWN~19Mm&Cp8%9nvUMtNpqIT)LNG4e|47Z0`aqT`epN@F>gXtUCWQ6=d@Z1_0TwGz_f z6eRqzmGBP6?@rz$xL(5u!^nhX4W)K^FhhtiZyKWqW4#w6&$K2itJa={*3b&g!5EFk zUnMLndc2juw1!p~*1`BOTx(FBh7p$02uDXR#Ye`Ay3Z#9t)b^(Lib==@Z(Oy$TL4o zP{!53&I!s1$q@WA9E{KtP$`E;i-GqbQ|g5ni=S2jPh>oIFt87>OE7DUQnVs`0mmPs zX!qea|2B&5_?!&P);6Lz!u^qBh;BjnCBj(kss=~c0bwG-j70HR8(o$l>=~gQn-ONI z*Dkx<7yOz8L1;o)9FpQpPtyV#G zuc?K;_%#7B=@(gl-U*xHw*F`Xp2e?Qc@y}M&b33sfqn6DStg-(FKxxI%AN|$E!emm z*bNv_uyHazvVXIZjm0<#p%;!eo#KVo1p6ZXQ>St{L0F)?FD0+C5#dIp%-qj@m-A%^ zixS$n9^pEKfo0m*AK@DaOVzJ#ryN<$?OPqf^$9BYj$Q?o5n9x5uYAgbNXEeO{vo~r zp*^yVcOwkTXyeWZKT*HRUcQ~F4nYu}PE^UsdX-ef$G$Q7tlWeISza+2VNC@4+7YfL zM92f-JbX`0Qy!|i9vLg&AK~Lfm7I$-*nS*g96rF7NvC`(@HIXTVN+lmzaH4eQxHB; zyyj~VjnpeX`dUhvMx!_xA6w@m#hWUR@~cSK`r?2#{xp(}S14cm_(9T(RQg7Riq1ut zlD@Ku5c(o~7h!|)4V5=}9lv5c)^)!%fQ>H@VC8EG8}CxQ{@=@LcJ^_i@Em>>uLkph z$MCQFwq!Ve3yz-zwMf_tGKZDuhtH}v2@CvPj5BZ%=K_S`z}r-}BK;H`PX@B6JHjaZ zYxo_bmC-Yg;8Lbw5e87(^8@Q6T$2>9>>E*L25+n4?RP^JHa?cf#{W=igLP!=L1vwe zKZ)AOxogxmzpa6CZVzTfX;NK_uIxm{m_%6}jBO7vQXs&?NlJ3O0lbyr%&ib9zfyNz zz)uTk(3<6>tPUnqVTMs5Z{U(XP}4G;^JiS5pkNLGo=Q?ycQSPgPwI5zUj zg2d%zab~G)OkG|FCm@wiFlXt(jL&$UVN}ZE#N{o@a87C)Q8ZF!T7E5pR2SG!^p^p#N`do za851Q7>eT&`c!g4r9GHdLM3Z6jP28cBn=XkCHBdoSr?&YL@_=K{h+daNtHSn8y*=c z=?9#aq$FW?vSr8E760NRK7Kn&`KfK=P>~O))WO8cKW!L2kt(75nUHz2Vk#TYMt=lR zkq;=}SYaf3s|Z800T(#dtpyp#i2KFedIE(B)f9~=u3PX{|xC3Eq09~C3L-8qD@{~Qb?9ohl4o27?*fXm& zIpy47ntTxIR1-~+4e6+~Y+jzAbt z&Iilw!PHyt1>o|+#B~TR0>%W=W%SGtU>d@uRcR59#fLsPDuhv87zxZkGDkP`2;+fS z1jr8^f!_F-P=W9{Ug}Y1QsK(PBG=|XgjMP_X*`*ZR2Z^V*c0J52yKaMd>rBM3T+&P z@ZZGG+f=QT6>@g_uc>{0mnGEiB<9n=xi~(m_)OtM;9g*8Xrqj>5MT!I0PrA=`9(f4 z2sjIi;3FuS@VhU*w-PTsg<;eV=i<1p)CbB5++B|oyrt+1?5%BtVblO8 zLum(7x(DMENi8SLIswBl>WepUw3Pb5_T~?c#GH#^7{xh=?JV`!o`Y$$;gMk&mC;)2 zkLF+u!>ERm`;vN|gYhW}RzcE;VuoSV7VqQOr>8%b>cJe3ITyn)O0ze@sGj~<%E4H8 zOv5nBp~v0Tr5sE>1(-4nBOX2aisExHJ{Z$VYGY4?VHmnB$8Q^G@A`+HdN3zp&c!f{ z^4Ogo!b+#tFN--Cn}0D3BMaSzNyQwD&A%9ik%ev(y`PN#0|w(*)$xn2J(vlYb1@7f8@+(>+y0_!$V{7mDa|I}SztOoZtrTK4=@VY7dQd} zXZABv@-9Bn*~^8WKfr%0H{%lzo(OyqYvWQ(z-LeZx(|`wg`RgtHZW^|p8-F|v9jbR zea66vz@);lTXgG;tZW9J!l#dY6vsQ;J;SH*nF9O(N{5SVP~O6EV8?$t9gN>{{jP>Z zIp-PRLLBc`e5OxvG7g{fW(sgnSksIQECL=b98cibkV%WsjL)`lc{tPRhP`ksfX_OZ zuK~AeS(H!Zyb~QOas8KE!A1e5Ua4UyAMW4T|uOz>QJM zs4ecqaS?Pl7=N=b1coabl_#D6PRFq&X{kO!`{BUBz@hjZs{3OrtBbJ}cnf$9pLz5( z;58fzRjd(y0bHR{cK%objKCos4yFZ|t!h$!cndfN#~N)zfR3?#3-CGoo2rgu6fi>3 zvQ#X>&kc4Q^MERPpm|k6~|OJ2(W#>m9GDEqj1xJ#cnzoC|Zl=H!40!0R17nBN0ushXpY0O#SjSKE+i_;1+(bSBel#;3{!=uc;mv7PB$ zBee^~x0LJz?0~;+tGD_6diZo`xv}v7b%oEY1J>1y)5wBw41S$dA8k{Vc?icD{zqXE z((v*_-S#l*2H^_zyIEhBBRGe!7i3uDQD004CIovOZ5YBGz=hgoD6?M^aJ04+%B%z~ zG3R0g<_h3VZ6lO9x(PT++X_Vl_!}G_Xd7bG8IJY9m+|}88kJ+3=ph<-gYZ)vQ?-pS z>J-Q8!1uJxP^85n%%(9nZM_JL!|{o>Ax0hJ7qLDF9dA?`iZ>m?3L0-u%m(0a9CNh| zF&Y42Fn+ahqpg%**@R#J&}dv`&c#TEV;S&O{G4AS(XWZ_L8t1S-{bhTwh=~y;dl(V zN!yIXG&zK|_?4TDz(U|q94oX9F&Yq|5AZyGBWokDvI({mp{;&s$FFxW=VIvKH)mc* z)67hBu@Vd4Y33v&(M%xI(C~ylt4sgBm=O$o= zwiS_C2V7w5U5wn|Lv~(@4^vUkOm_$a@G&@=wXKQ7B{+VoZG>TTLl_VIAN3ira5*rd z3CCLCkJ{Em;x=#O(4YQkOIGMx!A7QvE5)F87yH z!7&J{)J?5iW+R_Q%QuYL#83K8Rezc)mpKT#lv~Nu5I$BnxqMlOuxH$sH;hCG0}x(S zf2zut50FaJ9t)EZHmRGweOZTaSd@k~3@wB`5EiIEUE7!W2&1xAvbFF4=T$Z$mX*?| zQ-uBTz4N@vd@?(i&PwLh$!tP6Elf)qMotk9LRg~yv~`y`^!Pfu@=6|#_f~n4j}cA} zQ#r%PIl@?krRq;zr~D7WU#JL!5FS&nn(s}Sb1@nVp#}Xf`8I@qL5k)o4^qiq2tUBD zmer622#3e1oMGe~zop=5rDtyy!jx1MJsV+J;tJk}Fept04I`)cFZq8a?J|-X2%}S1 zbO^#7#P7|_LpVEaBN;b-$ZzvYzt%;;`c$FM!-qj zI9(sVZ1@D=NMH;w3K#_J3N!(0fVIGfz+B)p;91}$9Bol-GK@w+Xa)`g4#7Wv!{O8U p%ij1n)vJNG@z38Z9P?wC^8dhJoDFlFLs (SubMouse <$> newTVarIO []) <*> (SubKeyboard <$> newTVarIO []) <*> (SubJoypad <$> newTVarIO []) + <*> (SubTranslator <$> newTVarIO []) _ <- glewInit nvg <- createGL3 (S.fromList [NanoVG.Debug, Antialias, StencilStrokes]) return UserData @@ -40,10 +41,12 @@ init = do , assetImages = M.empty , assetAnimations = M.empty , assetFonts = M.empty + , assetIcons = M.empty , nano = nvg , uuid = [] , stateData = None , threadContext = Nothing + , joystick = Nothing } loadPlayerSprite diff --git a/src/Load.hs b/src/Load.hs index b71c1d0..5413828 100644 --- a/src/Load.hs +++ b/src/Load.hs @@ -20,6 +20,7 @@ import NanoVG hiding (V2(..)) -- internal imports +import Menu import Types import MainGame.WorldMap import Util @@ -65,6 +66,16 @@ loadFork ws win glc nvg future progress = do let stateSteps = 37 increment = 1 / stateSteps SDL.glMakeCurrent win glc + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading icon \"conntroller_blue\"" + ))) + mcontrblue <- createImage nvg (FileName "assets/icons/controller_blue.png") 0 + modifyMVar_ progress (return . (\(p, _) -> + ( p + increment + , "Loading icon \"conntroller_green\"" + ))) + mcontrgreen <- createImage nvg (FileName "assets/icons/controller_green.png") 0 modifyMVar_ progress (return . (\(p, _) -> ( p + increment , "Loading asset \"wall_asc\"" @@ -190,6 +201,12 @@ loadFork ws win glc nvg future progress = do , "Loading asset \"watercooler\"" ))) mmiscWatercooler <- createImage nvg (FileName "assets/misc/watercooler.png") 0 + let micons = + [ mcontrblue, mcontrgreen + ] + when (any isNothing micons) $ do + liftIO $logIO Error "Failed to load icon assets" + exitFailure let mimgs = [ mwallasc, mwalldesc , mwallcornern, mwallcornere, mwallcorners, mwallcornerw @@ -215,6 +232,11 @@ loadFork ws win glc nvg future progress = do .. ImgMiscWatercooler ] mimgs + icons = zipWith (\a b -> (a, fromJust b)) + [ IconContrBlue + .. IconContrGreen + ] + micons directions = [E .. N] ++ [NE] standIds var = map (AnimId var "standing") directions walkIds var = map (AnimId var "walking") directions @@ -330,6 +352,7 @@ loadFork ws win glc nvg future progress = do toiletFree ++ toiletOccupied ) + , loadAssetIcons = M.fromList icons } ) @@ -351,9 +374,12 @@ updateLoad _ = do putAffection ud { assetImages = loadAssetImages ld , assetAnimations = loadAssetAnims ld - , state = Main WorldMap + , assetIcons = loadAssetIcons ld + -- , state = Main WorldMap + , state = Menu , stateData = None } - loadMap + -- loadMap + loadMenu Nothing -> return () diff --git a/src/Main.hs b/src/Main.hs index a52fe91..4d6a9e8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -55,7 +55,7 @@ pre = do ud <- getAffection threadCtx <- SDL.glCreateContext (drawWindow ad) SDL.glMakeCurrent (drawWindow ad) (glContext ad) - let Subsystems w m k j = subsystems ud + let Subsystems w m k j t = subsystems ud _ <- partSubscribe w (fitViewport (1280/720)) _ <- partSubscribe w exitOnWindowClose _ <- partSubscribe k toggleFullScreen @@ -74,11 +74,12 @@ quitGame (MsgKeyboardEvent _ _ SDL.Pressed False sym) ad <- A.get ud <- getAffection when (state ud == Main WorldMap || state ud == Main MindMap) $ do - let Subsystems w m k j = subsystems ud + let Subsystems w m k j t = subsystems ud mapM_ (partUnSubscribe w) (uuid ud) mapM_ (partUnSubscribe m) (uuid ud) mapM_ (partUnSubscribe k) (uuid ud) mapM_ (partUnSubscribe j) (uuid ud) + mapM_ (partUnSubscribe t) (uuid ud) SDL.glMakeCurrent (drawWindow ad) (glContext ad) (ws, _) <- yieldSystemT (0, defStorage) (return ()) putAffection ud diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index d381e02..8484751 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -45,7 +45,7 @@ loadMap :: Affection UserData () loadMap = do ud <- getAffection ad <- get - let (Subsystems _ m k _) = subsystems ud + let (Subsystems _ m k _ _) = subsystems ud uu1 <- partSubscribe m movePlayer uu2 <- partSubscribe k changeMaps uu3 <- partSubscribe m playerInteract diff --git a/src/Menu.hs b/src/Menu.hs new file mode 100644 index 0000000..bbca091 --- /dev/null +++ b/src/Menu.hs @@ -0,0 +1,75 @@ +module Menu where + +import Affection as A + +import qualified SDL + +import NanoVG + +import qualified Data.Map.Strict as M +import Data.Maybe (isNothing) + +import Control.Monad (when) + +-- internal imports + +import Types + +loadMenu :: Affection UserData () +loadMenu = do + ud <- getAffection + ad <- get + let (Subsystems _ m _ j _) = subsystems ud + uu1 <- partSubscribe j joystickConnect + uu2 <- partSubscribe j joyDisconnect + putAffection ud + { uuid = [ uu1, uu2 ] + , state = Menu + } + +joystickConnect :: JoystickMessage -> Affection UserData () +joystickConnect msg = do + ud <- getAffection + when (isNothing $ joystick ud) $ do + mjoy <- joystickAutoConnect msg + maybe (return ()) (\joy -> do + ident <- liftIO $ fromIntegral <$> SDL.getJoystickID joy + liftIO $ logIO A.Debug $ "Joystick connected: " ++ show ident + putAffection ud + { joystick = Just joy + , translation = defaultTranslation + } + ) mjoy + +joyDisconnect :: JoystickMessage -> Affection UserData () +joyDisconnect msg = do + ud <- getAffection + maybe (return ()) (\joy -> do + njoys <- joystickAutoDisconnect [joy] msg + when (null njoys) $ do + liftIO $ logIO A.Debug $ "Joystick disconnected" + putAffection ud + { joystick = Nothing + } + ) (joystick ud) + +updateMenu :: Double -> Affection UserData () +updateMenu dt = return () + +drawMenu :: Affection UserData () +drawMenu = do + ud <- getAffection + liftIO $ do + let ctx = nano ud + controller = joystick ud + save ctx + beginPath ctx + paint <- imagePattern ctx 600 620 80 80 0 (assetIcons ud M.! + if isNothing controller + then IconContrBlue + else IconContrGreen + ) 1 + rect ctx 600 620 80 80 + fillPaint ctx paint + fill ctx + restore ctx diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 9f437ea..08a71d8 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -7,26 +7,27 @@ import Affection import Types import Load +import Menu import MainGame.WorldMap import MainGame.MindMap instance StateMachine State UserData where + smLoad Load = loadLoad + smLoad Menu = loadMenu smLoad (Main _) = loadMap - smLoad Load = loadLoad - + smUpdate Load = updateLoad + smUpdate Menu = updateMenu smUpdate (Main WorldMap) = updateMap smUpdate (Main MindMap) = updateMind - smUpdate Load = updateLoad - + smDraw Load = drawLoad + smDraw Menu = drawMenu smDraw (Main WorldMap) = drawMap smDraw (Main MindMap) = drawMind - smDraw Load = drawLoad - smEvent _ evs = do - Subsystems w m k j <- subsystems <$> getAffection + Subsystems w m k j _ <- subsystems <$> getAffection _ <- consumeSDLEvents j =<< consumeSDLEvents k =<< consumeSDLEvents w =<< @@ -35,13 +36,14 @@ instance StateMachine State UserData where smClean _ = do ud <- getAffection - let Subsystems w m k j = subsystems ud - toClean = uuid ud + let Subsystems w m k j t = subsystems ud + toClean = uuid ud mapM_ (\u -> do partUnSubscribe w u partUnSubscribe m u partUnSubscribe k u partUnSubscribe j u + partUnSubscribe t u ) toClean putAffection ud { uuid = [] diff --git a/src/Types/ImgId.hs b/src/Types/ImgId.hs index 4a6fb9d..32092b5 100644 --- a/src/Types/ImgId.hs +++ b/src/Types/ImgId.hs @@ -1,5 +1,10 @@ module Types.ImgId where +data IconId + = IconContrBlue + | IconContrGreen + deriving (Show, Eq, Ord, Enum) + data ImgId = ImgEmpty -- TODO: Find better solution than empty image. | ImgEmptyNoWalk diff --git a/src/Types/StateData.hs b/src/Types/StateData.hs index b104a57..8b59fa4 100644 --- a/src/Types/StateData.hs +++ b/src/Types/StateData.hs @@ -15,6 +15,7 @@ data StateData | LoadData { loadAssetImages :: Map ImgId Image , loadAssetAnims :: Map AnimId Animation + , loadAssetIcons :: Map IconId Image } | MainData { mapMat :: Matrix TileState diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index dd85270..fbfecd2 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -26,9 +26,12 @@ import Types.Entity data UserData = UserData { state :: State , subsystems :: Subsystems + , assetIcons :: M.Map IconId Image , assetImages :: M.Map ImgId Image , assetFonts :: M.Map FontId T.Text , assetAnimations :: M.Map AnimId Animation + , joystick :: Maybe SDL.Joystick + , translation :: M.Map GamepadAction Action , nano :: Context , uuid :: [UUID] , worldState :: SystemState Entity (AffectionState (AffectionData UserData) IO) @@ -44,6 +47,7 @@ data UserData = UserData data State = Load + | Menu | Main SubMain deriving (Eq) @@ -52,17 +56,72 @@ data SubMain | MindMap deriving (Eq) +defaultTranslation :: M.Map GamepadAction Action +defaultTranslation = M.fromList + [ (ButtonAction 0 SDL.JoyButtonPressed, Jump) + , (ButtonAction 1 SDL.JoyButtonPressed, Duck) + , (ButtonAction 2 SDL.JoyButtonPressed, Kick) + , (ButtonAction 3 SDL.JoyButtonPressed, Punch) + , (ButtonAction 4 SDL.JoyButtonPressed, Grab) + , (ButtonAction 5 SDL.JoyButtonPressed, Block) + , (AxisAction 0 AxisNegative, GoLeft) + , (AxisAction 0 AxisPositive, GoRight) + , (AxisAction 0 AxisNeutral, StopLR) + , (AxisAction 1 AxisNegative, GoUp) + , (AxisAction 1 AxisPositive, GoDown) + , (AxisAction 1 AxisNeutral, StopUD) + ] + +data Action + = Jump + | Duck + | Kick + | Punch + | Grab + | Block + | GoLeft + | GoRight + | GoUp + | GoDown + | StopLR + | StopUD + deriving (Show, Eq, Ord, Enum) + +data GamepadAction + = ButtonAction Word SDL.JoyButtonState + | AxisAction Word AxisAlign + | HatAction Word SDL.JoyHatPosition + deriving (Show, Eq, Ord) + +data AxisAlign + = AxisPositive + | AxisNegative + | AxisNeutral + deriving (Show, Eq, Ord) + data Subsystems = Subsystems - { subWindow :: SubWindow - , subMouse :: SubMouse - , subkeyboard :: SubKeyboard - , subJoypad :: SubJoypad + { subWindow :: SubWindow + , subMouse :: SubMouse + , subkeyboard :: SubKeyboard + , subJoypad :: SubJoypad + , subTranslator :: SubTranslator } -newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData())]) -newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection UserData ())]) -newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())]) -newtype SubJoypad = SubJoypad (TVar [(UUID, JoystickMessage -> Affection UserData ())]) +data ActionMessage = ActionMessage + { amAction :: Action + , amJoystick :: Word + , amTime :: Double + } + deriving (Eq, Show) + +instance Message ActionMessage where + msgTime (ActionMessage _ _ t) = t + +newtype SubWindow = SubWindow (TVar [(UUID, WindowMessage -> Affection UserData())]) +newtype SubMouse = SubMouse (TVar [(UUID, MouseMessage -> Affection UserData ())]) +newtype SubKeyboard = SubKeyboard (TVar [(UUID, KeyboardMessage -> Affection UserData ())]) +newtype SubJoypad = SubJoypad (TVar [(UUID, JoystickMessage -> Affection UserData ())]) +newtype SubTranslator = SubTranslator (TVar [(UUID, ActionMessage -> Affection UserData ())]) instance Participant SubWindow UserData where type Mesg SubWindow UserData = WindowMessage @@ -112,6 +171,15 @@ instance Participant SubJoypad UserData where instance SDLSubsystem SubJoypad UserData where consumeSDLEvents = consumeSDLJoystickEvents +instance Participant SubTranslator UserData where + type Mesg SubTranslator UserData = ActionMessage + + partSubscribers (SubTranslator t) = generalSubscribers t + + partSubscribe (SubTranslator t) = generalSubscribe t + + partUnSubscribe (SubTranslator t) = generalUnSubscribe t + generalSubscribers :: TVar [(UUID, msg -> Affection UserData ())] -> Affection UserData [(msg -> Affection UserData ())] diff --git a/tracer-game.cabal b/tracer-game.cabal index bec17cf..f4b38a8 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -40,6 +40,7 @@ executable tracer-game , Interior , Init , Load + , Menu , MainGame.WorldMap , MainGame.MindMap , Navigation