From ed8d8f0e93164a0d9ae6f759fc742c86c054daba Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 3 May 2023 11:19:47 +0100 Subject: [PATCH] Work on terminals --- data/charMaps/charMapVert16Tall.png | Bin 4793 -> 4848 bytes src/Dodge/Render/HUD.hs | 13 ++--- src/Dodge/Terminal.hs | 85 +++++++++++++--------------- src/Dodge/Terminal/LeftButton.hs | 37 ++++-------- src/Dodge/Update/Input/InGame.hs | 6 +- src/Dodge/Update/Input/Text.hs | 5 +- src/Dodge/WorldEffect.hs | 38 ++++++------- src/Picture/Base.hs | 2 - 8 files changed, 79 insertions(+), 107 deletions(-) diff --git a/data/charMaps/charMapVert16Tall.png b/data/charMaps/charMapVert16Tall.png index af00339f859370b2e637043ca23293e35eb25668..2944b681c12d6c1b3b29dc06657f28ddb414f26e 100644 GIT binary patch delta 4748 zcmV;75_9djCGaJXBmqN_B_My2dwv{Sn0VQSf2Pqe$phaIHsBe*_6Xn)83X9*^eIs=d3g zK3uC0rQUCfE{k!|LYC2IzRXI)yz-R|aa&=i*wOz|^mUy+SQ$3)7Lx1q^|n&t73moD z^c;L>F)!#z=*0I*fD9%;a(iOCuU9lb#pVUq_fPsAx1MzP1ozu`=;=)peU}DhKXmzm zUU`j&p1y97eh>G-^v!=F%P+UB+2!oa){17fF4i#mCteI}D8Y|OmbFfvb;L#x1|@dVf;IT|^e zG+9!S1QV$upt5^F80HK~RS2)}geA97D0trP?8n9{70anh6 z{IOh-LtRC)suq7Wt=hB~DLJ9SO0g2xZ8x!OYQ@Z|HS1Msu3AgAT5GGlaTDCe+E9+I zw$^%w&JM}Fqz?WL%HSa*4;^LLsH2TOkv=m|on_jrv(3JE$wD2kvTW7WR^POdN;_{& zyKLKax7{7N=Hl7ai}qjkD#J((Y!+Re3g;ww6RXn;yC2B?5pJpEU*g8Ui(Crm{wHz= zx3u*Qw{K8e@!6gSvAYT*rk9}lz#Dzdx)-hyd^f84Xh9r4M~pKpT-(7Ecad+zsSH0n zuGquHY-@jz_?RHV4D(c#6vtQX=H7AFANI!Q5NZuy5$kNL7wk6(kKJo=?R~Yuu2tZO z?=%)JP-=$(=O?U$$1u#6z(1%VYx#(kwQ*$ZWj;%owJR2-`P$W!Z=bixJCtmE%t90{ z)FW=Hh9cTUT}y}wTx3rzp>lRy_`_jsx@9-iFJgZOo!cNf;$_j(Nf#efeQ%xS%gYLP zMdmKY&5bJsV_M!3O~L;b2Slr!aObNmJ*ZrV%?Ee<;D|#1C3)QfkB}f4OrQsR9{p+$@r9`ED4 zdk*j22l(q{rkWjNfT~$WDiIel*;OI*iXeRG!w9A&X6kdIn1pA2-BT~sU5saW_x)Mj zO3q|}PavLUx?vG-5KnDdI_G`j2rEho@j3CRK^G)`FZP zKL7v#0Pr@Bf3!ZcwFZBEaN90FTcTHqfP`t}Ch|6}@gxGkDr_1h(o!yc6iQ8zT>XEU z`t7-c0RRAA7V6aO;{yWEt>$2f1OGW%^IaTfVbmyzRo^Fv0kCdI$wReO08?Y*<_ui z!D{o~x__x#WN=l0cCcvLG^T8`48EG?%{n;bsZM#>0073JE~zq^HcQyEYYmGzEv!}V zUDCpT@+B?LWlUk4$v-&HLM;_^XC{21RXfOaH){ zu`3Z}l49P&8mYMTfc15bl$~#(E0BH#=6!?!>2=UtK~5J6*Sj$1b=D>#(_Uu)fPSQH z4u90H{x%n`H3~MoOcdTl(l2HTt#n=0T&Uf=);F7;gRde+OdJ5flYNDU#m@8n17-mL z007owv0B~ZICiU_l-k0fy06Do4Wt$E3g{WGJo~k$La$B=*;5BC$z3E?f8TT6t?Y}n6c|U z*tOrZ?oE86fYuwSZWZo&oxKWW0iAdpM{&-`fA~o7WdFcot*h@sDC7x6ES`?7B{JCT zp)`%FS6N~k5s)Ha!9y?sUF?&rook9xdCTi0}Zh!1w_)A~gsJREbb>R7nJ-PL-d%0OJ*>w|Ld;eeL{!)hm z08jN$JcmFQ&){a%W{uqP&UdzWYvJ6wsRpCf#$XL6E8HK+>txAS;LaaNLd01ZvcK{3 z>cS_90s#2~@&}0m^7seK<)s5{K2~U0}g;hz)b~+O(^M~2mnL!2jQqq6|q=+1Jf0J4sv()C2~c;y5Ya; zoG#H@@8&Dx8vs1UKe&3e$1hxCSQ4f&Jq5xvzVks!*9QQAe}G}ZKVTXW007JT2U-I| z{lSX$2ksWpX>Oirm4Amtno$C%KLCI*+SVl;%e$fg_BSGc`~d*;$seq_-l*|fP^t(( zK#~CJ4*=kX`k>}3pwZe>2S0T{RX|G!>k0t3;U4P?UG{X9$Y7NK zskEX*1~=`3X0Xanl+<~+$8?dt)tyJu3MpD!SQ8>X2a*u;8GjV+MVfW@`U1dh{R6^2 z1R&tC0$5)FfPVP{YsGZYe$X7XeGV|ijpyLX75-l)U#+L+eN~1x0&?@gKG;SCtSJBh zR>8Ep@bhzhH^y0_mwqZudlh|h>z1ofdnoRkn3CNOPh-mRK=?sQSzic0$|(yJ^ZWzq z4*+iCA873W=YKa6_95Ul0_cAL0IB%{%j?YfjU2o8^F#kc1SAOn0P+Xq4-jxO0aA_5 z*aeE?IF9PuD7{SL`ApL5ylvYizKxQrPwoJK`~mrc_vH_)xdgFF)O8ctAZZgac7r4U zkUv;Ef3V>B3+CNrktxi74z%t~bK%-5o19w&hO0RZ41yjrankG2ifAE@quyUms6XN)^#JEhT<=5Kw^`PRJN zn|83d)fWKZA7I`Qu%3X>LY3P;u=+^N)xKYg-1=L%5odlYP^*sw0Qd*%1mD%1>RElM zOY5#aXn#83sa0aGDlZ%!_BCyzt9HM2>3ye>owgGN009004o0Gbv1u>0n}ZR4xUh`~ z0DzUa;dyN#4@ETZ+QH_nd1mvj9V`magu`28u*yS`9E&Y7*yN>|-i6R17WeBR$@z@{ z&ol4Z@Hf4vi<1KpfB*!nqmcmMnRxrcgoKpoKYyi6zo8FkV-dcJGW`)R(_gf5zt=G+(cOI0hMmu}t^l!D80R+vz_dIA;s2;jVd@G9 zZO-8G3ZyM4pE(0_^xisRNPQDij*xiE>3;|2WdiTuOFxk{1^|G^>q5NS-?jCxP@iX*aDRRZ5IYp*@+N9L)Rbuqz0T&gcSCP3JOlPGOcbzdW~cR97pn@Z>co}``$d(6Y3e_X zf1q(R#Gk+h2=WI2@LI3s0UAk_KbY5{X~--ffb*RJ08*{gQ~d)e1u#b|cbf$SAmB?t zT1HcoKdZitWcLABUzjRj*UnH)v451vU{QdkCqjt~t_si&R)@akD`>5$hyuPUJQPC2 zX_SPhp2U_A*Dh1{erN0>z%3$I>!}C*qIc@n5r6>SyJG62DfUP5#L(gWOaK7T@X~74 z;k9^L48F~wujZRY%cSkCEC%21@c&-^!5$5^sZRs|c$a@5*$S0^(E6JxkAI}@k7U{3 z#_ji^B1ss`U3y}SlU0Z8kXYG z`Q{c+tt&HGrmN4Wf^T6-ZZ6`wG5dE|UCdoc1IF z008-ewFHb^d++kRaK3Y9k0{G?Ko3a(7?(eATc)sW)GAc-=D=1^x z;5wq(GuV_rSocW;fPZYmqVS=y-DMg_>>>$kB?%U3Joz9kA1Dni5)AgqQa?BW1G a68{5ckMSp1$)MQ)0000N^Fa?g#&LEGQo@?9gIaEZ z4LXCLZ~DCTbkOBZQQP;y_&n&hBCfZAmn*lSM3;fMZbki8l=!xsulIj(TQ05YdkE_l zTD>Xt`URhIQZ7@uwKVK2$E?WPaz~RM`;Vco@8QMD@QHV#6wh2QFO&aL>R9uc z;W$nSdrFE~lAQd;0Lb71G`BmqJ3iU`$jt-S_fPnpubEW>STfT*-V=7G4p1{$~-w8S_Kx3XL8W94>H!& z(n=MDF;OZBR5lB@FLdm-V{cN0LdW>{k@~$Yuw!j(mP^MTY z2^EUUtVBp;1wfr*<&=2<0TST_CpjnFjLK*Nm=2IpI=n1=(Q!)x2}uQQS%FXoSUC&o zM{`9Db#!VLks^O8RhsmYN)G6-QndJW+cjxc(W0tVoA#P&u2M_YT5GGlaZ9+3rJ)^L zZLReVn;n{a2_5_$l))p7JY<8 zM*s!Qj#;dfGdpsQS!{k~3d2cpY!<~%g>y)G6N}M<-4Epc2)9u3FLC4FMJ_mW{}Z`` zTiEi3+c&5!|7_2L*wuxe)0ohGD;egRcbcVHfS@`-cbR~y?nRP^ZTvA>b`8)Mm`~0vcFH3b;MyB;?n@%8qQVG#A?eBfuSHL5JMuCAVIK&prEk2 zDC(eB-N^4TwUI;54Z=DGF1f0uTW=?{0j-E@QTBiE%yR;%i(NNVj)F5}KxgyMi4K{5 zwxcA(POI|>JofC0!_CMjVmsoSyIUJ-Wj6I7vis>FdRAPrA?}LG0KF3Jz;xVnAbgd} zw8KVYC2(n%gV&B_u8T)VR)p`KCvCDkPr+RsN4lYY^zuh{zOu0|_1UA|;+KI#4Y@;K zO^$!rG)E?E7t%fffLR4)nssnZu=;~L931yQApVw3ZPVk*8Hs@7v za&X5Tp55BdR#IwvWZQ>2$=}p_CuVzla{SV+-++{ZuU`XzEH`FnJLOu_?pV2pEf&N>dd(G>uxsTHaAWdB*Z-9eCV6;Hl>pt)9YVYmeGtK^f z06BPakN}UFE0Y2SF$n|%3K2KPQ;U6*JO(I#E=fc|RCwC$oy(G>I1EJ_g5~`G@8)c} zBC=>~T}gfc=PawzN)m%!wxvIR00000;B9>VQv1wS8~p2o+jjZcJ$sc1XfTc3MBc_V zowjGBdi znx9A#1^{ks=Bo(^MLVA}o116wm5@uja87+(r9z5!p_F_r{qJy_vXhYAdlRd(;GKc? z(^wL=ZQFJ=11`(-J?LB5o|%ER##MQ7BrmNbq;wPAFOxZqH6gY4B&<*X0GcU~V%%6# zUuU0T_gn6k|?_-dLr@8FcDI^|^p z02qh7rOIX6JYmnF8Wwk2SXJ-+(!$@DT=QJUY;1G+2j^KRrGhSvtJgxy=H0ay$8>3| zJd!u7vn%r-@{!J$UAhl0FU{-00l<>hdCrDsCCpiP%QX=i0069I-c>I>9kI-RPfVLX z!HP`w$nPE#{;Po%#}j)CP@acASKtY(7k-`9z$5)S13=+z^k(eRI&myPktzn;0>1002++6&@CUJJ0tIm<0d;09cR3_Ue8gvFklJ)Nfk%CO%O>?TwU6g@;~$=cqziKqr1a zpFKDu|KTISll=pawJyF3sgNfXu|z7i?wP@E52b2cqskK7h=3*n7HonE04w+hsfKSJ zg;LEQ)NG`bKk!B?H?z)W*cX|~KF`5WCkykAe*geI^9L_nUwEQ_pv*|>_<_5Fq&3Z3 z^d2A>?2*OU{S#2hB=2bnBjfxM#k-DqvU%2i6w= zo|`|YDHF4EU?kvh9h|Rzftr*(e~z%PXCCSNL34j1buh>u0Kkg=0ripYXcvxXy!g)* z3{%%P@Y3c9VE+LC0C)|l3BHc>n;!jiwh;vrIepfSvOI0MIs= z+OlDtY1-Ts9KC{E2STp|ZR!m!32L7|Xz~-nH!(Gh(Fe(W))xR^Ow^`CZk%8Emv+Yw zqV_;qBB}Ob$oK{>^PXBd51svgk^9R&6aaXthZ1Q5xkmI{vhJBHcugOnf8hMaHKY`o<0QrM;^9MA5M8Hi2m_;b5p9la$@(1at zO^R4NzJcq13cd%0EBg|;B4FL{Kh&qo^wzui%J>EVkMR$#UhVM<*BF)t)7U%(!Zg0~ zL29lK00930!-9XnG$H^1miG@-1H=A<755*6OGGzw^IWSuEYge;!2SaONTZf6p)K!< z0yy7@0P+U_&?kSe=6a*zwV+fHfPh8<*na>3H`E7zC0_xxj)12Lh!!H2))(YD+mWRK zd3}L(1%TUdkM)HvXS(*xU`c?rwPMcO5UzdbhqcoJUfH?5Zs+2{E4o zONhG%MR<{B-Lt*`a9jU?unz$Uc&q@{7XYAN{=mCqdRIT_j@rHlxZ=iha1{#wFO#p{ zu6e(Ic7|61a(81NY$F2J6aWCL;5uFS{kgse<2=zzKb59lMW5Wd=PG0mC43W`WcSn4 z*kpMi{U9}2Ur0a7O%^ET`3LMj0Jx2RpxOcYHxl+C;5GuNe*geY^9P>Snf{Hm-TU*0 z`iTf=Bme-&ACNylz|90$dvwMwP<%e0Pw{Pkv|c8&Ka=%3Z`-z+Z=>bvlRE$)e?b1= zefa}#F2UR-8oG%bkn{-|dq5HZ$RDhoKUlE;g8Ot?W(wOs2daBhUAXoNd6J*lwLX&M zXr^E1%+m+}x6B`;w6YuOD~c#0RF+N)%qUMwyFIG(me=& zm$_1Y#<(uqO$u!(|Lfc5TY0@Vb+EhC7XaWNVBQh1o`BRsRoFl9`bgE)z8{NR`(L^c zXZup1ULOen@DJ7rzKc24v-*;^)?Izj)!?bN#a!B6I6UmD+Q!h{{o1AXokmXDP80wD z_y;%`4IPY4z0__FM*88xHX;B3R^o<#{n}C6__*;k&0`&s9ON_}~MbV0R|hgtUm9{~VB%O5D(S>7e83You4^l;y_Vf~rb z6=2p1qkkg+Ov^J6{*O8oChveya|V}JU>!mE&KbC)_gae~`6f1LA@P>(2kvEp=-^8~ zku?SYfXC$zYHC}`9}Kt7b57oW|CA$Z`^NhRXLmpCA8e6Xz()YMg=JEIY=I;|t-|0c z+<#@g_K4;QCuJp7HoSu4xP58e8bChaCL(~7Gynkoy)=)P(stR{${|$q2TB5h-p0u_ zmT;47Ylhq>Y0ko=^@ZBAkxs&d9MQ|0sCcMNrZM$8yUX4Uy}9rVIKMDaz@f}e?X}*$ zDy*mzYbxvqDG5{6e~N#9pg0=lPv8Iq`2zrWt=IAZjU?p{=2d7KG7AWxzcTnkh&JFGc3f08=bT_$_z;|%}+pqD9(Au!5{&BjnPIIN|>UmG-J0fX%`0o8u34x WD!NVY#Fe1{0000 Configuration -> LWorld -> Picture displayTerminal tid cfig w = fromMaybe mempty $ do tm <- w ^? terminals . ix tid return $ - pictures - [ invHead cfig (_tmTitle tm ++ ":T" ++ show tid) - , drawSelectionList secondColumnParams cfig (thesellist tm) - ] + invHead cfig (_tmTitle tm ++ ":T" ++ show tid) + <> drawSelectionList secondColumnParams cfig (thesellist tm) where toselitm (str, col) = SelectionItem [str] 1 True col 0 () - thesellist tm = - defaultSelectionList & slItems .~ thelist tm + thesellist tm = defaultSelectionList & slItems .~ thelist tm thelist tm = map toselitm . displayTermInput tm . reverse @@ -218,7 +215,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do $ _tmDisplayedLines tm displayTermInput tm = case _tmInput tm of TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)]) - partcommand tm = fromMaybe "" $ tm ^? tmPartialCommand . _Just + partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just displayInputText tm s | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s | otherwise = "" diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index e754df794..0a5f88a4f 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -1,6 +1,5 @@ module Dodge.Terminal ( doTerminalCommandEffect, - guardDisconnected, makeTermLine, commandFutureLines, quitCommand, @@ -46,9 +45,9 @@ basicTerminal = connectionBlurbLines :: [TerminalLine] -> [TerminalLine] connectionBlurbLines tls = [ termSoundLine computerBeepingS - , TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor) + , TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor) , TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor) - , TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor) + , TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor) ] ++ tls ++ [TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)] @@ -56,18 +55,18 @@ connectionBlurbLines tls = quitCommand :: TerminalCommand quitCommand = TerminalCommand - { _tcString = "QUIT" - , _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""] - , _tcHelp = "DISCONNECTS THE TERMINAL." + { _tcString = "quit" + , _tcAlias = ["q", "exit", "x", "shutdown", ""] + , _tcHelp = "Disconnects the terminal." , _tcEffect = TerminalCommandArguments $ NoArguments [TerminalLineEffect 0 TmWdWdDisconnectTerminal] } helpCommand :: TerminalCommand helpCommand = TerminalCommand - { _tcString = "HELP" - , _tcAlias = ["H", "MAN"] - , _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND." + { _tcString = "help" + , _tcAlias = ["h", "man"] + , _tcHelp = "Displays help for a specific command." , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm } @@ -77,9 +76,9 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm f tc = M.insert (_tcString tc) - ( [ makeTermLine "COMMAND:" + ( [ makeTermLine "Command:" , makeColorTermLine commandColor (_tcString tc) - , makeTermLine "ALIASES:" + , makeTermLine "Aliases:" , makeColorTermLine commandColor (unwords (_tcAlias tc)) ] ++ case argumentHelp tc tm w of @@ -92,18 +91,18 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm commandsCommand :: TerminalCommand commandsCommand = TerminalCommand - { _tcString = "COMMANDS" - , _tcAlias = ["COMMAND", "COM"] - , _tcHelp = "DISPLAYS AVAILABLE COMMANDS." + { _tcString = "commands" + , _tcAlias = ["command", "com"] + , _tcHelp = "Displays available commands." , _tcEffect = TerminalCommandEffectCommands } connectionBlurb :: [TerminalLine] connectionBlurb = [ termSoundLine computerBeepingS - , TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor) + , TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor) , TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor) - , TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor) + , TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor) , TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady) ] @@ -173,12 +172,6 @@ argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of -- , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines -- } -guardDisconnected :: Terminal -> World -> World -> World -guardDisconnected tm w w' = case _tmStatus tm of - TerminalOff -> w - TerminalBusy -> w - TerminalReady -> w' - getDamageCoding :: World -> M.Map String [TerminalLine] getDamageCoding = decodedtmap . _sensorCoding . _cwgParams . _cwGen . _cWorld @@ -195,15 +188,15 @@ getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine] getSensor f tm w = maybe [] - (makeTermPara . map toUpper . show . f) + (makeTermPara . map toLower . show . f) (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor) toggleCommand :: TerminalCommand toggleCommand = TerminalCommand - { _tcString = "TOGGLE" - , _tcAlias = ["TOG"] - , _tcHelp = "PERFORMS A REVERSABLE EFFECT." + { _tcString = "toggle" + , _tcAlias = ["tog"] + , _tcHelp = "Performs a reversable effect." , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm) } @@ -213,19 +206,19 @@ decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show) sensorCommand :: TerminalCommand sensorCommand = TerminalCommand - { _tcString = "SENSOR" - , _tcAlias = ["SEN"] - , _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR." + { _tcString = "sensor" + , _tcAlias = ["sen"] + , _tcHelp = "Access information concerning the connected sensor." , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm } disconnectTerminal :: Terminal -> World -> World -disconnectTerminal tm w = - w - & cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff - & exitTerminalSubInv - & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines - .~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines] +disconnectTerminal tm = + (cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff) + . exitTerminalSubInv + . ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines + .~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines] + ) exitTerminalSubInv :: World -> World exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of @@ -235,9 +228,9 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of damageCodeCommand :: TerminalCommand damageCodeCommand = TerminalCommand - { _tcString = "DAMAGECODE" - , _tcAlias = ["DCODE", "DC"] - , _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE." + { _tcString = "damagecode" + , _tcAlias = ["dcode", "dc"] + , _tcHelp = "Displays the shape and color associated with a given damage type." , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding } @@ -253,21 +246,21 @@ togglesToEffects = fmap f . _tmToggles where f tt = [TerminalLineEffect 0 $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)] --- \_ -> triggers . ix (_ttTriggerID tt) %~ not] simpleTermMessage :: [String] -> Terminal simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs commandFutureLines :: String -> Terminal -> World -> [TerminalLine] -commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do +commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do (str, args) <- safeUncons $ words s command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm) case doTerminalCommandEffect (_tcEffect command) tm w of NoArguments tls -> Just tls - OneArgument argtype m -> - let setpartial = TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) - : makeTermPara ("expects " ++ argtype ++ " as an argument") - in Just $ - fromMaybe setpartial $ - safeHead args >>= (m M.!?) + OneArgument argtype m -> + let setpartial = + TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) : + makeTermPara ("expects " ++ argtype ++ " as an argument") + in Just $ + fromMaybe setpartial $ + safeHead args >>= (m M.!?) where errline = makeColorTermLine red diff --git a/src/Dodge/Terminal/LeftButton.hs b/src/Dodge/Terminal/LeftButton.hs index 75f0725b7..e848d084e 100644 --- a/src/Dodge/Terminal/LeftButton.hs +++ b/src/Dodge/Terminal/LeftButton.hs @@ -1,36 +1,23 @@ -module Dodge.Terminal.LeftButton where +module Dodge.Terminal.LeftButton ( + doTerminalEffectLB, + terminalReturnEffect, +) where +import Control.Monad import Data.Maybe import Dodge.Data.World -import Dodge.Terminal--oops +import Dodge.Terminal.ReturnEffect import LensHelp doTerminalEffectLB :: Terminal -> World -> World -doTerminalEffectLB tm w = guardDisconnected tm w $ - fromMaybe w $ do - s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText - if null (words s) - then Just $ defocusTerminalInput w - else return $ terminalReturnEffect tm w - -terminalReturnEffect :: Terminal -> World -> World -terminalReturnEffect tm w = guardDisconnected tm w $ - fromMaybe w $ do - s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText - return $ - runTerminalString s tm $ - w - & cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines .~ [makeTermLine ('>' : s)] +doTerminalEffectLB tm w = fromMaybe w $ do + guard (_tmStatus tm == TerminalReady) + s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText + if null (words s) + then Just $ defocusTerminalInput w + else return $ terminalReturnEffect tm w defocusTerminalInput :: World -> World defocusTerminalInput w = fromMaybe w $ do tmid <- w ^? hud . hudElement . subInventory . termID return $ w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False - -runTerminalString :: String -> Terminal -> World -> World -runTerminalString s tm w = - w & cWorld . lWorld . terminals . ix (_tmID tm) - %~ ( (tmInput .~ TerminalInput mempty True (0, 0)) - . (tmFutureLines ++.~ commandFutureLines s tm w) - . (tmCommandHistory %~ take 10 . (s :)) - ) diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 174c8313e..7fa147a5c 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -90,10 +90,9 @@ updatePressedButtonsCarte' pkeys w updateKeysInTerminal :: Int -> Universe -> Universe updateKeysInTerminal tmid u = - u & doTextInputOver tmpoint + u & doTextInputOver (uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText) & checkEndStatus where - tmpoint = uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiText pkeys = u ^. uvWorld . input . pressedKeys checkEndStatus | pkeys ^. at ScancodeReturn == Just InitialPress = @@ -110,7 +109,6 @@ updateInitialPressInGame :: Universe -> Scancode -> Universe updateInitialPressInGame uv sc = case sc of ScancodeF1 -> useNormalCamera uv ScancodeF2 -> pauseAndFloatCam uv --- ScancodeF3 -> pauseAndPanCam uv ScancodeF5 -> doQuicksave uv ScancodeF9 -> doQuickload uv ScancodeEscape -> pauseGame uv @@ -152,7 +150,7 @@ doRegexInput u i sss any ((== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash] - endmouse = (Just 0 == ) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft + endmouse = (Just 0 ==) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft backspacetonothing = sss ^? sssExtra . sssFilters . ix i . _Just == Just "" && ScancodeBackspace `M.lookup` pkeys == Just InitialPress diff --git a/src/Dodge/Update/Input/Text.hs b/src/Dodge/Update/Input/Text.hs index 7c5b1973b..a81c45ea9 100644 --- a/src/Dodge/Update/Input/Text.hs +++ b/src/Dodge/Update/Input/Text.hs @@ -4,7 +4,7 @@ module Dodge.Update.Input.Text ( ) where import Data.Either -import Data.Char +--import Data.Char import Dodge.Data.Universe import LensHelp import SDL @@ -14,7 +14,8 @@ doTextInputOver p u = doTextInputOver' u p u doTextInputOver' :: Universe -> ASetter' a String -> a -> a doTextInputOver' u p x = - x & p %~ (++ map toUpper (rights str)) + --x & p %~ (++ map toUpper (rights str)) + x & p %~ (++ rights str) & checkBackspace where str = u ^. uvWorld . input . textInput diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 6d0a078a7..bf82d25a2 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -1,9 +1,9 @@ -module Dodge.WorldEffect - ( doWdWd - , accessTerminal - , doTmWdWd - , lineOutputTerminal - ) where +module Dodge.WorldEffect ( + doWdWd, + accessTerminal, + doTmWdWd, + lineOutputTerminal, +) where import Data.Foldable import qualified Data.Map.Strict as M @@ -46,20 +46,20 @@ doItCrWdWd icww = case icww of ItCrWdItemEffect -> flip itemEffect accessTerminal :: Maybe Int -> World -> World -accessTerminal mtmid w = case mtmid of - Nothing -> w - Just tmid -> +accessTerminal mtmid w = fromMaybe w $ do + tmid <- mtmid + return $ w & hud . hudElement . subInventory .~ DisplayTerminal tmid & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus .~ True & cWorld . lWorld . terminals . ix tmid %~ tryToBoot - where - tryToBoot tm = case _tmStatus tm of - TerminalReady -> tm - TerminalBusy -> tm - TerminalOff -> - tm - & tmFutureLines .~ doTerminalBootProgram (_tmBootProgram tm) tm w - & tmStatus .~ TerminalBusy + where + tryToBoot tm = case _tmStatus tm of + TerminalReady -> tm + TerminalBusy -> tm + TerminalOff -> + tm + & tmFutureLines .~ doTerminalBootProgram (_tmBootProgram tm) tm w + & tmStatus .~ TerminalBusy torqueCr :: Float -> Int -> World -> World torqueCr x cid w @@ -82,9 +82,7 @@ lineOutputTerminal tls = } doDeathTriggers :: Terminal -> World -> World -doDeathTriggers tm w = - w - & cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs +doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs where xs = M.elems $ _tmToggles tm diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs index 44a6234a8..fbb81d834 100644 --- a/src/Picture/Base.hs +++ b/src/Picture/Base.hs @@ -201,7 +201,6 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..] text :: String -> Picture {-# INLINE text #-} ---text = translate (-50) (-100) . drawText (10) text = translate (-50) (-100) . drawText (-10) drawText :: Float -> String -> [Verx] @@ -209,7 +208,6 @@ drawText gap = map f . stringToList gap where f (pos, col, V3 a b c) = Verx pos col [a, b, c, 1] BottomLayer textNum - line :: [Point2] -> Picture {-# INLINE line #-} line = thickLine 1