From 03c945d189ef7fed3103f4c547ba959657af9959 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 21 Dec 2022 11:33:11 +0000 Subject: [PATCH] Improve mouse menu controls, tweak charmap --- data/texture/charMap.png | Bin 1496 -> 3339 bytes src/Dodge/Base/Window.hs | 2 ++ src/Dodge/Data/SelectionList.hs | 3 ++- src/Dodge/Data/Universe.hs | 1 + src/Dodge/Menu/Option.hs | 30 ++++++++++++++++-------------- src/Dodge/Render/HUD.hs | 3 --- src/Dodge/Render/List.hs | 2 +- src/Dodge/Render/MenuScreen.hs | 29 ++++++++++++++--------------- src/Dodge/Render/Picture.hs | 14 +++++++++----- src/Dodge/SelectionList.hs | 11 +++++++---- src/Dodge/TestString.hs | 7 +++++-- src/Dodge/Update.hs | 16 +++++++++++----- 12 files changed, 68 insertions(+), 50 deletions(-) diff --git a/data/texture/charMap.png b/data/texture/charMap.png index 7f0d0b1198845664e90fef29d615b1765d0e2090..7700bf053cb90a4aa52247ea0cfddba6fd290986 100644 GIT binary patch delta 3337 zcmV+k4fgWb3yT_%BYy?YdQ@0+Qek%>aB^>EX>4U6ba`-PAZ2)IW&i+q+O1Y=lIAE5 z{Ld-o2%s0zaX>)C-e8YEiNCL^tGat;XCl@Pzc2=onM%3r|NiHcKd?2cRz$m7m{n{N z5;Sn*^|i%wZdIQ1$0qOAZ|&vtJ)wzl<=0~$uWK7<*B>8z%zx45_x9rNH{|buK1O~I z$aiMK&H5T7+UeEapV6=Kd+=$zd+<+K+8ZO> z{PsoD--G`^{C{O){)~vezo_RS_4{(($2rT-*{{_NF(7JhMb+|w&NIeY6Kmt=GpMz8 z9E$t??1A0us0ngb%{sAXi$-AOlqPMp(N5dXHCrM?p-mlEq9lIWoI3?2_-QP6Z-+Vu zFLp4Ov8?)y=!RhmW9Oc%X(w z508j3s0>UrFxEi-ftE>=r%atT`}7%eB;=ElnwC91Bgdk}3pTNA_2nzp*sW|h#g?tx zcHh2Zj{~h8K63Qf>Bmo;@yXho)nE31!CHH>Mt=`ew_pEc4Xvg3k0IK%6TO^)F_H$x z`(*%vrpsCNCPJ6F%UO--AGUSRI-hRW{x^*re#$H)?F|Ca3I}Kx=qI>3I+P17a=dd%GLdCbp$}5tSla7#J1T zW3~c#x3KjAs%FFIeW>+p0|R0C@W%s(Gl0^XaWf-4Vxpr6B@I40O+0JCgjoG{hwyZ1 zjJ@{uH7w5V3?^o4ZF&`gI^gw?!oY+pcYhDigRf+n>qPCJIVZ2I&KoNhZ5|bNjF`PG z!J^xhP&9wd35r+u2_EzSYC3y?T`PL#TxWKJ(x5xq0BoF9&k|%v_q>t|-Rf8=U13Wj zJAhVej!WaNz|_kLKQJ$_h$7WGO@su;9i0&MTsF+NN}sk+D-vZMQ&PIX5XVGjoqvgV zhp%!r{uid?!4HpvoJ!L+0fv^`0oTmCfT@>4_^0U2{*FXm$O%vYNGMahG|rh-Y=r~A z4OOlgd3t5uM}!ZgrwV^P1mJa6_0uQv<&Z>P7PALI*?S1&yXd7Cb3_P@&gRqxLsT`8 z(P0kXI2@HRBsk!cHb77IGp4i*FMm*o+S<91Yc4Z*dN5>t1j?)jZu4G`byQ=d4_pYj z;CoeM6*3n&?AsVsBzd5R)C5*SrV&$5G+5tdd zY+DJiKN5)nYE*fR6@5h<$wk1Mwyte+Ks=0fLTJb-AdK>lSQ0X3)P8iJjDJ`tS9S>H zYC}@!Ry9z3k$=dS8!u*t%e0p|Zt10KpXWLaG^)iQALM;pn?$U;g+3F`2^rwGy9W|# z?HGs^E|9Q;HU%1*X+>ju@2*0&<$^Inln@v@}(}U zZ^1|LPuvwhtg=dAriFzQn19|kuzl=qWa&tDA*lq39;C+yU~?t#Fe`Qhc!Vdx9Q`WIJV zyYS0j{se#V4)vagD)ImT0fcEoLr_UWLm+T+Z)Rz1WdHzpoPCi!NPojX9K~N#r6Lsv zi-KF$!-8NH+xR}YVilJA85kWs@FeWq0n3JR=e8<;4 z0(`xT@htyye~unCXMZsuAQI0q!?cMvh^IGggY!OdgcW6#_?&puqze*1a$WKGjdQ_e zfoDd{bZVYBLM#^ASZQNcG&SNW;;5?WlrLmFRyl8R*2-1ZyeEHQIH#{HbDic85?I6% zB#2N@MG0lth|#K(Vj)HQaUcJn>zBx-kgEhnjs;YpL3aJ%e}C}1TPr^~;U$IRKz1zUWbxTwBfXf|V;K`6p*_DDc zg?t`(KcjET0)4kY_nOyRb04PoPTry00000006+}^H2(1*MD_A9*@WDx>e39)7$yKmw8@) z{;j=-Qr~KSdyi53tap1}pOrm@d!LLlFDw~&-AB=nQTvo@-ui0$tK{Onzp9_B z`X?)YZ{N4&BJH>ANoIT~_n+CbnS7P{GaI>5eiik-^2uJ$^sk~H);y!ie`Xh=b5C~8 zQs&nk_kUFTDf+BvIn{sqRwwiu-hbv_t{B$<0Hwyux^9)T%Cy(6KknDt|6A>wl^?Zl zRL;8AmQniPG?`j5QRM6G|6V`M`ro6U-sea3ZG|i|_x1FjcYLV&k?H?gdn@cyRR6u> z*J}Sr_dT+m{XaUsJ^E2OzGnT9m7nsgt0Ak8-hX#d=cuSXUu}DK`y8Gz_lovc+OKc- zFF)lSqy7y#0st%ct+>fEGCA9UZ2ujVZ~w0B7OC||?X$|vc52!TfRiKI+1+BbzdgG# z)e-KQ{M+`mWqQ}G`V~7o-VBRTn|sev`*l~AgQ8EX$IvUrXGYK4?4q8m-eo84#5P*l zTYsLujmS7VZ;XNp-ZrSuP;8VpgDP`>#pbEDZI*>r)lbn3uU`Foc4g%KBlUZJQM7(U zzE*~hnlZXN1Be}b0Qk57fa>5_j?_Ik;GLXTEFz;0?aX@NI@lz-qV`H!6FQy2dcJG)~1M(f}8a)o}h@10E_ zS3YH18Q{qVR95I%WWjAMz?21?x&TyUtJJsJq{>I}ajF7<>Y~^4iIAth6{N5}vDpz6 z^vuc1{O@^|_Y;t8fD!=U*Z{yR1E3d4jzr*3HH;a@wCcS)=NNbwMCyCp?`=7KBY*uE zIgmXE)#HTq-u+(Rvn#)H{3woxN5&Z)obA|D??z{XER_MDj02bH7j=w9+MeCro&_IP z>qmtRv~1t3U#pz+Q?ocK$Ag*ylGrE9}?li#)G0tn8#!jeoC`Znf=ny?R&u z@Merv2k3X-Cn{Gp2;d1oohs)le__}2pY~xC;IQUL?=MXO0K6LM6M!9&O*MjR9e|aY zBxep}#rsFTE8QWVSxU5WhJS%_XkJuCkwg1NJLFc1-l%=b0Y?=-^At@J_nb~|rEga{ zhEe&9bR)BCm;J_brvG01qoz1l9*S9cMuw8o+I~W_a{PO3Z-u^l$3U-~8bqlco7pkY zvnAFT$lC9o{$$3#SN^l{A3bxz3JR<^BSW>n%KVr8l?BfkA-Ll&%426?3eg9W> zZw^yNqn{-tY?7?+X73n~1PCFyY5RH|#C2WQ(>4%72qA$bU~8KnNj(5JCtc zgpmEbkxtijUGMkX>^s`MeqJB#PyXjVqkTM+GLZ3}{ZfWypMN*E(H`|Zg?UY^Z(ewN zAZ2;u5&52us{9W7A|LBw#eY!$oQdWZ^~sEXdVdi4n$LCW&%`r{*5CV_wf__LKiZ#a zyJnBKf7$b+_08_TB~$jx#--|=h1{=q$VAs^Ro7}iWPeZ37k2Us^Y?r+8~+I*q=P?C z8!&jk|GgZz{(mPE@Z^QNda10A89F@~Ctq~hr8NIO=7@~wM ztE^u1$eD@GM>awA#;>e@rX8^_8lTxiq)So4mw!9#A%y%cEiV8@Q1c33?I)V7 zW{WRxyk(!)CrYg5`JA3eAulQ9vutrCFDzvJk$x!A{%aSiEM}sY9dmoM--thWYY-Jw zvrU>VbX~nQ=>+ko-3ia`^BKj76?rnwXzeG*p23Os$@SIR=AV|Fl|A-!BWP!3B&PdBoDnelU<>Uh*XDNpK`vNG+_=SaVt zo3;ig#yvvF?{dpG0FVS~1W_+>L5id&g6ym_N?xJ_L8GfMi;AjB(S_LP&E30f5&4xh zlF17qKcfpx8m)flT*f?B&(Qo_&Nu5j-RH1#|9`C{y2nynXBNcI#{RF`hw93V*X-)_ z4|%V6{%;{;G!lcX_R8E=Y`>$>hzhc7frb=tp1#aFq2oQ9v^zor$#GWpXV$Ojkg}um z&@tYco3_8vyt{oib0;JBe@2(Kw$=H`{jbO(gpk+krWXJsaLJz|kjab2yKwHjM7pRX zrhoJJ3eoy$2|z|RV&g2^OZqJTnA^1k&1<)0YtQ6(PtF}!y0T}ant*yXq3gd&CZR)Q zMG4=o{q0^C30kOVOFh<`*y4$|&DTP>ni8TzcbSBtY1ITh|+zfZs`E_dkKp=b8fir!uJc`~Cm z?fj$huroP7@$AU8c*4HUyUTjPvtn0rQk?!bd4jcDJwf2OY``_tdPqD6JL&iQxwc~urN-rGlOo}PW$=N(CgrfWq; zW&EHb2ic$1V(mn#{`^S{-^jcyt)Bm^U6ySfzI_KLz66NK*c+Yys{A|TWSRXFEharV zPqAzLynNv<{UbhDFF3sW5y=TY?SD)YLcSa58vu8_*&M+!(xnAx`E143A;Z$&F@LZ4 ztjMp9x7Ku)ul;WIvE;ArQDk4#KHI0Q6=Gl178OLud?O$9xPnUHgNM*JM~A z`aQD#kHjyz7nS)%ROhe7*T|RV_TA?nmEpTl1fc z{g(eCV_z@-ucwV?S%1{dhqO5(&!ap3R@TpxkNS@_pC~3-eKh+rdpgFWK3wq?LJ0Xv zb|ht=z^~5xSK$5 Universe -> [MenuOption] -> Maybe String -> SelectionList -makeOptionsSelectionList mselpos u mos defstr = SelectionList +--makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> Maybe String -> SelectionList +--makeOptionsSelectionList mselpos u mos defstr = SelectionList +makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList +makeOptionsSelectionList mselpos u mos = SelectionList { _slPosX = 50 , _slPosY = 50 , _slOffset = 0 @@ -36,16 +38,16 @@ makeOptionsSelectionList mselpos u mos defstr = SelectionList , _slLength = length $ optionsToSelections u mos , _slSizeRestriction = SelectionSizeRestriction (availableMenuLines cfig) overflowit overflowit (SSRFromScreenBottom 5) - , _slSpecialItem = fromMaybe NoSpecialSelectionItem $ do - str <- defstr - return $ BottomSelectionItem SelectionItem - { _siPictures = [color white $ text str] - , _siHeight = 1 - , _siIsSelectable = True - , _siWidth = length str - , _siColor = white - , _siOffX = 0 - } +-- , _slSpecialItem = fromMaybe NoSpecialSelectionItem $ do +-- str <- defstr +-- return $ BottomSelectionItem SelectionItem +-- { _siPictures = [color white $ text str] +-- , _siHeight = 1 +-- , _siIsSelectable = True +-- , _siWidth = length str +-- , _siColor = white +-- , _siOffX = 0 +-- } } where cfig = u ^. uvConfig diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index a132bc7ad..9ad108aee 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -43,7 +43,6 @@ drawInGameHUD :: SubInventory -> Universe -> Picture drawInGameHUD subinv uv = pictures [ winScale cfig . dShadCol white $ displayHP 0 cfig w - , listPicturesAt (halfWidth cfig) 0 cfig $ map text (_uvTestString uv uv) , inventoryDisplay subinv cfig w ] where @@ -64,7 +63,6 @@ defaultSelectionList = SelectionList , _slWidth = FixedSelectionWidth 15 , _slLength = 0 , _slSizeRestriction = NoSelectionSizeRestriction - , _slSpecialItem = NoSpecialSelectionItem } subInvSelectionList :: SelectionList @@ -81,7 +79,6 @@ subInvSelectionList = SelectionList , _slWidth = FixedSelectionWidth 15 , _slLength = 0 , _slSizeRestriction = NoSelectionSizeRestriction - , _slSpecialItem = NoSpecialSelectionItem } inventorySelectionList :: World -> [SelectionItem] diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 3243d01c6..01933267b 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -23,7 +23,7 @@ drawSelectionList cfig sl = (_slPosX sl) (_slPosY sl) cfig - (_slOffset sl) + 0 --(_slOffset sl) (makeSelectionListPictures sl) <> drawSelectionCursor cfig sl diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index f106bd7e9..021c7fd38 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -1,7 +1,6 @@ {- The menu picture. -} module Dodge.Render.MenuScreen ( - menuScreen, - menuScreen', + drawMenuScreen, ) where --import LensHelp @@ -15,8 +14,8 @@ import Dodge.Data.Universe import Padding import Picture -menuScreen' :: Configuration -> ScreenLayer -> Picture -menuScreen' cfig screen = case screen of +drawMenuScreen :: Configuration -> ScreenLayer -> Picture +drawMenuScreen cfig screen = case screen of OptionScreen{_scTitle = titf, _scSelectionList = selpos} -> drawOptions cfig titf selpos "Use keys to navigate the menu" -- (WaitScreen sf _) -> drawOptions w (sf w) [] 0 "" @@ -24,12 +23,12 @@ menuScreen' cfig screen = case screen of -- (DisplayScreen sd) -> sd w (ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs -menuScreen :: Configuration -> ScreenLayer -> Picture -menuScreen cfig screen = case screen of - OptionScreen{_scTitle = titf, _scSelectionList = selpos} -> - drawOptions cfig titf selpos "Use keys to navigate the menu" - (InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help - (ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs +--menuScreen :: Configuration -> ScreenLayer -> Picture +--menuScreen cfig screen = case screen of +-- OptionScreen{_scTitle = titf, _scSelectionList = selpos} -> +-- drawOptions cfig titf selpos "Use keys to navigate the menu" +-- (InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help +-- (ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs --displayStringList :: World -> [String] -> Picture --displayStringList w ss = pictures @@ -72,8 +71,8 @@ drawInputMenu :: Picture drawInputMenu cfig title footer = pictures - [ --darkenBackground cfig - drawTitle cfig title + [ darkenBackground cfig + , drawTitle cfig title , drawFooterText cfig red footer ] @@ -88,14 +87,14 @@ drawOptions :: Picture drawOptions cfig title sl footer = pictures - [ --darkenBackground cfig - drawTitle cfig title + [ darkenBackground cfig + , drawTitle cfig title , drawFooterText cfig red footer , drawSelectionList cfig sl ] darkenBackground :: Configuration -> Picture -darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox +darkenBackground cfig = winScale cfig . color (withAlpha 0.5 black) . polygon . reverse . screenBox $ cfig drawTitle :: Configuration -> String -> Picture drawTitle cfig = winScale cfig . translate (30 - hw) (hh-50) . scale 0.4 0.4 . text diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index ccaf0d7f3..2a51f033d 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -13,14 +13,18 @@ import Geometry import Picture fixedCoordPictures :: Universe -> Picture -fixedCoordPictures u = - drawConcurrentMessage u <> customMouseCursor cfig (u ^. uvWorld . input) <> case u ^. uvScreenLayers of - [] -> drawHUD u - (lay : _) -> setDepth (-1) (menuScreen' cfig lay) --- <> (setDepth (-1) . winScale cfig $ menuScreen cfig lay) +fixedCoordPictures u = drawMenuOrHUD cfig u + <> drawConcurrentMessage u + <> customMouseCursor cfig (u ^. uvWorld . input) + <> listPicturesAt (halfWidth cfig) 0 cfig (map text (_uvTestString u u)) where cfig = _uvConfig u +drawMenuOrHUD :: Configuration -> Universe -> Picture +drawMenuOrHUD cfig u = case u ^. uvScreenLayers of + [] -> drawHUD u + (lay : _) -> drawMenuScreen cfig lay + drawConcurrentMessage :: Universe -> Picture drawConcurrentMessage u = stackPicturesAt diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index b5f85f39d..32ecc6779 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -1,16 +1,19 @@ module Dodge.SelectionList where +--import Color import Dodge.Data.SelectionList import LensHelp setShownSelectionItems :: SelectionList -> SelectionList setShownSelectionItems sl = case sl ^? slSizeRestriction of - Just (SelectionSizeRestriction maxlines topit botit _) + Just (SelectionSizeRestriction maxlines _ botit _) | length allitems <= maxlines -> sl & slShownItems .~ allitems - | otherwise -> if offset > 0 - then sl & slShownItems .~ ((topit,ScrollUpSelectionItem) : take (maxlines - 2) (drop offset allitems)) - else sl & slShownItems .~ (take (maxlines - 2) allitems ++ [(botit,ScrollDownSelectionItem)]) +-- | offset > length allitems + 3 - maxlines -> sl + | otherwise -> + sl & slShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem)) + ++ [(botit,ScrollDownSelectionItem)] _ -> sl & slShownItems .~ allitems where +-- dummyitem = (SelectionItem [] 1 False 0 white 0, DummySelectionItem) offset = sl ^. slOffset allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. slItems) [0..] diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 6865c1ab7..3b740dc25 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -8,5 +8,8 @@ import qualified Data.Map.Strict as M testStringInit :: Universe -> [String] testStringInit u = - [ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos - ] ++ map show (M.toList (u ^. uvWorld . input . pressedKeys)) + [ show $ u ^? uvScreenLayers . _head . scSelectionList . slOffset + ] + ++ [ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos + ] + ++ map show (M.toList (u ^. uvWorld . input . pressedKeys)) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 0e2237531..6d11062c9 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -92,15 +92,21 @@ gotoTerminal w = case _uvScreenLayers w of (InputScreen{} : _) -> w _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command" -mouseClickOptionsList :: [MenuOption] -> SelectionList -> Maybe MenuOption -> Universe -> Universe -mouseClickOptionsList mos sl mop u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of +mouseClickOptionsList :: [MenuOption] -> SelectionList -> Universe -> Universe +mouseClickOptionsList mos sl u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of Just False -> fromMaybe u $ do i <- sl ^. slSelPos si <- sl ^? slShownItems . ix i . _2 return $ maybe u ($ u) $ case si of ListedSelectionItem j -> mos ^? ix j . moEff - ScrollUpSelectionItem -> Just $ uvScreenLayers . _head . scSelectionList . slOffset %~ (min 0 . subtract 10) - ScrollDownSelectionItem -> Just $ uvScreenLayers . _head . scSelectionList . slOffset +~ 10 + ScrollUpSelectionItem -> Just $ uvScreenLayers . _head . scSelectionList . slOffset %~ (max 0 . subtract 5) + ScrollDownSelectionItem -> do + maxlines <- sl ^? slSizeRestriction . maxSelectionLines + alllines <- sl ^? slLength + Just $ uvScreenLayers . _head . scSelectionList . slOffset %~ + (\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2) + DummySelectionItem -> Just id + SpecialSelectionItem -> Just id _ -> u mouseOverSelectionList :: SelectionList -> Universe -> Universe @@ -146,7 +152,7 @@ optionScreenUpdate :: [MenuOption] -> Maybe MenuOption -> OptionScreenFlag -> Universe -> Universe optionScreenUpdate mos mop _ sl u = optionScreenDefEff mop - . mouseClickOptionsList mos sl mop + . mouseClickOptionsList mos sl . mouseOverSelectionList sl . menuWheelEvents . over (uvScreenLayers . _head . scSelectionList) (setSelectionListRestriction cfig)