justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Tweak display, scrolling of item values

Browse Source
This commit is contained in:
justin
2025-01-07 21:10:29 +00:00
parent b3cf10bd26
commit 5fa5bdf21e
18 changed files with 367 additions and 384 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -328,7 +328,7 @@ shineTargetLaser cr itmtree (p, q) w = fromMaybe (w & pointittarg . itTgPos .~ N
. iaLoaded
-~ x
& cWorld . lWorld . lasers
.:~ LaserStart
.:~ Laser
{ _lpPhaseV = 1
, _lpDir = _crDir cr + argV (Q.qToV2 q)
, _lpPos = pos
src/Dodge/Data/CWorld.hs
+1 -2
View File
@@ -19,14 +19,13 @@ import Data.Aeson.TH
import Dodge.GameRoom
import Geometry.ConvexPoly
import Dodge.Data.Camera
import qualified Data.IntSet as IS
import Data.Graph.Inductive
data CWorld = CWorld
{ _lWorld :: LWorld
, _cwGen :: CWGen
, _cClock :: Int
, _seenWalls :: IS.IntSet
-- , _seenWalls :: IS.IntSet
, _cwTiles :: [Tile]
, _pathGraph :: Gr Point2 PathEdge
, _numberFloorVerxs :: Int
src/Dodge/Data/Item/Use.hs
+1 -2
View File
@@ -72,8 +72,7 @@ data TriggerType = AutoTrigger | HammerTrigger
deriving (Eq, Show, Read)
data AttachParams
= APProjectiles
{_apProjectiles :: [Int]}
= APProjectiles {_apProjectiles :: [Int]}
| APInt {_apInt :: Int}
| APNothing
deriving (Eq, Show, Read)
src/Dodge/Data/LWorld.hs
+1 -1
View File
@@ -113,7 +113,7 @@ data LWorld = LWorld
, _flares :: Picture -- picture drawn for one frame
, _teslaArcs :: [TeslaArc]
, _shockwaves :: [Shockwave]
, _lasers :: [LaserStart]
, _lasers :: [Laser]
-- , _lasersToDraw :: [Laser]
, _linearShockwaves :: IM.IntMap LinearShockwave
, _tractorBeams :: [TractorBeam]
src/Dodge/Data/Laser.hs
+3 -12
View File
@@ -18,7 +18,7 @@ data LaserType
| TargetingLaser {_laserEmmiter :: NewInt ItmInt}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
data LaserStart = LaserStart
data Laser = Laser
{ _lpPhaseV :: Float
, _lpPos :: Point2
, _lpDir :: Float
@@ -27,16 +27,7 @@ data LaserStart = LaserStart
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
--data Laser = Laser
-- { _lzColor :: Color
-- , _lzPoints :: [Point2]
-- , _lzType :: LaserType
-- }
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
--makeLenses ''Laser
makeLenses ''LaserStart
makeLenses ''Laser
makeLenses ''LaserType
deriveJSON defaultOptions ''LaserType
deriveJSON defaultOptions ''LaserStart
--deriveJSON defaultOptions ''Laser
deriveJSON defaultOptions ''Laser
src/Dodge/Default/World.hs
+1 -1
View File
@@ -85,7 +85,7 @@ defaultCWorld =
{ _lWorld = defaultLWorld
, _cwGen = defaultCWGen
, _cClock = 0
, _seenWalls = mempty
-- , _seenWalls = mempty
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _cwTiles = mempty
, _numberFloorVerxs = 0
src/Dodge/Equipment/Text.hs
+1
View File
@@ -11,3 +11,4 @@ eqPosText ep = case ep of
OnRightWrist -> "R.WRIST"
OnLegs -> "LEGS"
OnSpecial -> "EQUIPPED"
src/Dodge/HeldUse.hs
+3 -3
View File
@@ -430,7 +430,7 @@ shootLaser itmtree cr mz w =
w
& randGen .~ g
& cWorld . lWorld . lasers
.:~ LaserStart
.:~ Laser
{ _lpType = getLaserDamage itmtree
, _lpPhaseV = getLaserPhaseV itmtree
, _lpPos = pos
@@ -445,9 +445,9 @@ shootLaser itmtree cr mz w =
(a, g) = randomR (- inacc, inacc) $ _randGen w
inacc = _mzInaccuracy mz
lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> LaserStart
lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Laser
lasRayAt col dam phasev pos dir =
LaserStart
Laser
{ _lpType = DamageLaser dam
, _lpPhaseV = phasev
, _lpPos = pos
src/Dodge/Inventory/SelectionList.hs
+74 -40
View File
@@ -47,24 +47,61 @@ itemDisplay w cr ci = f
where
itm = ci ^. _1
NInt itid = itm ^. itID
f (x:xs) (y:_) = itemDisplayPad x y : xs
--f (x:xs) (y:_) = itemDisplayPad x y : xs
f (x:xs) (y:_) = (x ++ ' ': y) : xs
f xs _ = xs
g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs
--g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs
g (x:xs) (y:_) = (x ++ y) : xs
g xs _ = xs
anyextra = maybeToList (anyhotkey <> anyequippos <> anyscroll)
anyextra = maybeToList (anyscroll <> anyhotkey <> anyequippos)
anyhotkey = fmap hotkeyToString
(w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
anyequippos = fmap
(rightPad 8 ' ' . (' ' :) . eqPosText)
(ci ^? _1 . itLocation . ilEquipSite . _Just)
anyscroll = fmap absurround $ itemScrollDisplay =<< (ci ^? _1 . itScroll)
absurround str = '<' : str ++ ">"
anyequippos = do
_ <- ci ^? _1 . itUse . uequipEffect
epText <$> ci ^? _1 . itLocation . ilEquipSite
anyscroll = fmap absurround $ itemScrollDisplay =<< (ci ^? _1)
absurround str = " <" ++ str ++ ">"
itemScrollDisplay :: ItemScroll -> Maybe String
itemScrollDisplay = \case
NoItemScroll -> Nothing
ItemScrollInt i -> Just $ show i
ItemScrollIntRange _ i -> Just $ show i
epText :: Maybe EquipSite -> [Char]
epText (Just ep) = ' ' : rightPad 8 ' ' ('@' : eqPosText ep)
epText Nothing = " @NOT.EQP"
--epText Nothing = " ¬EQUIPED"
itemIntegralValue :: Item -> Maybe (Either Int String)
itemIntegralValue itm
| Just x <- itm ^? itUse . uInt = Just (Left x)
| Just x <- itm ^? itUse . useToggle = Just (Right $ show x)
| isJust $ itm ^? itTargeting . itTgPos . _Just = Just $ Right "!TARGETING"
| Just x <- itm ^? itConsumables . magLoadStatus . iaLoaded = Just $ Left x
| UseAttach (APInt i) <- itm ^. itUse = Just $ Left i
| UseAttach (APProjectiles x) <- itm ^. itUse = Just . Right $ show x
| otherwise = mempty
introScanValue :: Creature -> IntroScanType -> Either Int String
introScanValue cr = \case
HEALTH -> Left $ cr ^. crHP
MAXHEALTH -> Left $ cr ^. crMaxHP
itemExternalValue :: Item -> World -> Creature -> Maybe (Either Int String)
itemExternalValue itm w cr
| EQUIP WRIST_ECG <- itm ^. itType = Just . Right .
displayPulse $ cr ^?! crType . avatarPulse . pulseProgress
| Just t <- itm ^? itType . ibtIntroScanType = Just $ introScanValue cr t
| ITEMSCAN <- itm ^. itType
, Just ExamineInventory <- w ^? hud . hudElement . subInventory
= Just (Right "ON")
| otherwise = mempty
itemScrollDisplay :: Item -> Maybe String
itemScrollDisplay itm
| HELD ALTERIFLE <- itm ^. itType = Just $
case itm ^? itUse . heldAim . aimMuzzles . ix 0 . mzAmmoSlot of
Just 0 -> "L"
_ -> "R"
| UseScope OpticScope{_opticZoom = x} <- itm ^. itUse = Just $ shortShow x
| ItemScrollInt i <- itm ^. itScroll = Just $ show i
| ItemScrollIntRange _ i <- itm ^. itScroll = Just $ show i
| otherwise = Nothing
itemDisplayPad :: [Char] -> String -> [Char]
itemDisplayPad ls rs
@@ -76,19 +113,13 @@ itemNumberDisplay w cr ci
| Just x <- ci ^? _1 . itUse . uInt = [show x]
| Just x <- ci ^? _1 . itUse . useToggle = [show x]
| ITEMSCAN <- ci ^. _1 . itType
, Just ExamineInventory <- w ^? hud . hudElement . subInventory
= ["ACTIVE"]
, Just ExamineInventory <- w ^? hud . hudElement . subInventory = ["ACTIVE"]
| EQUIP WRIST_ECG <- ci ^. _1 . itType =
[displayPulse $ cr ^?! crType . avatarPulse . pulseProgress]
| HELD ALTERIFLE <- ci ^. _1 . itType =
case ci ^? _1 . itUse . heldAim . aimMuzzles . ix 0 . mzAmmoSlot of
Just 0 -> ["/"]
_ -> ["\\"]
| isJust $ ci ^? _1 . itTargeting . itTgPos . _Just = ["!TARG!"]
| Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = [shortShow x]
| UseAttach (APInt i) <- ci ^. _1 . itUse = [show i]
| UseAttach (APProjectiles x) <- ci ^. _1 . itUse = [show x]
| UseScope OpticScope{_opticZoom = x} <- ci ^. _1 . itUse = [shortShow x]
| Just i <- ci ^? _1 . itUse . uaParams . apInt = [show i]
| Just x <- ci ^? _1 . itUse . uaParams . apProjectiles = [show x]
| Just t <- ci ^? _1 . itType . ibtIntroScanType = [introScanDisplay cr t]
| otherwise = mempty
@@ -104,24 +135,27 @@ displayPulse x = take 5 $ drop y "----^-----"
y = min 5 $ x `div` 3
hotkeyToString :: Hotkey -> String
hotkeyToString x = case x of
HotkeyQ -> "[Q]"
HotkeyE -> "[E]"
HotkeyR -> "[R]"
HotkeyZ -> "[Z]"
HotkeyX -> "[X]"
HotkeyC -> "[C]"
HotkeyV -> "[V]"
Hotkey1 -> "[1]"
Hotkey2 -> "[2]"
Hotkey3 -> "[3]"
Hotkey4 -> "[4]"
Hotkey5 -> "[5]"
Hotkey6 -> "[6]"
Hotkey7 -> "[7]"
Hotkey8 -> "[8]"
Hotkey9 -> "[9]"
Hotkey0 -> "[0]"
hotkeyToString x = " [" ++ hotkeyToChar x : "]"
hotkeyToChar :: Hotkey -> Char
hotkeyToChar = \case
HotkeyQ -> 'Q'
HotkeyE -> 'E'
HotkeyR -> 'R'
HotkeyZ -> 'Z'
HotkeyX -> 'X'
HotkeyC -> 'C'
HotkeyV -> 'V'
Hotkey1 -> '1'
Hotkey2 -> '2'
Hotkey3 -> '3'
Hotkey4 -> '4'
Hotkey5 -> '5'
Hotkey6 -> '6'
Hotkey7 -> '7'
Hotkey8 -> '8'
Hotkey9 -> '9'
Hotkey0 -> '0'
closeItemToSelectionItem :: World -> NewInt FloorInt -> Maybe (SelectionItem ())
closeItemToSelectionItem w (NInt i) = do
src/Dodge/Laser/Update.hs
+1 -1
View File
@@ -11,7 +11,7 @@ import Dodge.WorldEvent.Damage
import Geometry
import Picture.Base
updateLaser :: World -> LaserStart -> (World, Picture)
updateLaser :: World -> Laser -> (World, Picture)
updateLaser w pt =
( case _lpType pt of
DamageLaser dam ->
src/Dodge/Render/HUD/Carte.hs
+65 -65
View File
@@ -1,73 +1,73 @@
module Dodge.Render.HUD.Carte (
drawCarte,
-- drawCarte,
) where
import Control.Lens
import Dodge.Base
import Dodge.Data.Config
import Dodge.Data.World
import Dodge.Render.List
import Geometry
import qualified IntMapHelp as IM
import Picture
drawCarte :: Configuration -> World -> Picture
drawCarte cfig w =
fold $
toTopLeft cfig (renderListAt 0 0 locs) :
mapOverlay w
++ [mainListCursor white iPos cfig]
where
iPos = w ^. cWorld . lWorld . selLocation
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
mapOverlay :: World -> [Picture]
mapOverlay w =
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
[foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
where
lw = w ^. cWorld . lWorld
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
drawMapWall :: HUD -> Wall -> Picture
drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y]
where
t = normalizeV (y -.- x)
n2 = 20 *.* vNormal t
(x, y) = _wlLine wl
c = _wlColor wl
--mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
--mapWall cfig thehud wl
-- | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
-- | otherwise = Nothing
----import Control.Lens
--import Dodge.Base
--import Dodge.Data.Config
--import Dodge.Data.World
--import Dodge.Render.List
--import Geometry
--import qualified IntMapHelp as IM
--import Picture
--
----drawCarte :: Configuration -> World -> Picture
----drawCarte cfig w =
---- fold $
---- toTopLeft cfig (renderListAt 0 0 locs) :
---- mapOverlay w
---- ++ [mainListCursor white iPos cfig]
---- where
---- iPos = w ^. cWorld . lWorld . selLocation
---- locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
--
----mapOverlay :: World -> [Picture]
----mapOverlay w =
---- (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
---- [foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
---- where
---- lw = w ^. cWorld . lWorld
--
----(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
--
--drawMapWall :: HUD -> Wall -> Picture
--drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y]
-- where
-- t = normalizeV (y -.- x)
-- n2 = 20 *.* vNormal t
-- (x, y) = _wlLine wl
-- c = _wlColor wl
mainListCursor :: Color -> Int -> Configuration -> Picture
mainListCursor c = openCursorAt 120 c 5 0
openCursorAt ::
-- | Width
Float ->
Color ->
-- | x offset
Float ->
-- | y offset
Float ->
-- | y offset (discrete)
Int ->
Configuration ->
Picture
openCursorAt wth col xoff yoff yint w =
translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20) $
lineCol
[ (V2 wth 12.5, withAlpha 0 col)
, (V2 0 12.5, col)
, (V2 0 (-7.5), col)
, (V2 wth (-7.5), withAlpha 0 col)
]
--
----mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
----mapWall cfig thehud wl
---- | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
---- | otherwise = Nothing
---- where
---- t = normalizeV (y -.- x)
---- n2 = 20 *.* vNormal t
---- (x, y) = _wlLine wl
---- c = _wlColor wl
--
--mainListCursor :: Color -> Int -> Configuration -> Picture
--mainListCursor c = openCursorAt 120 c 5 0
--
--openCursorAt ::
-- -- | Width
-- Float ->
-- Color ->
-- -- | x offset
-- Float ->
-- -- | y offset
-- Float ->
-- -- | y offset (discrete)
-- Int ->
-- Configuration ->
-- Picture
--openCursorAt wth col xoff yoff yint w =
-- translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20) $
-- lineCol
-- [ (V2 wth 12.5, withAlpha 0 col)
-- , (V2 0 12.5, col)
-- , (V2 0 (-7.5), col)
-- , (V2 wth (-7.5), withAlpha 0 col)
-- ]
src/Dodge/Update.hs
+12 -47
View File
@@ -284,7 +284,7 @@ functionalUpdate u =
. over (uvWorld . cWorld . lWorld . creatures) (fmap setOldPos)
. over uvWorld updateCreatureGroups
. over uvWorld updateWallDamages
. over uvWorld updateSeenWalls
-- . over uvWorld updateSeenWalls
. over uvWorld checkTermDist
. over uvWorld updateRBList
. over uvWorld updateCloseObjects
@@ -414,19 +414,17 @@ doWorldEvents w =
(w ^. cWorld . lWorld . worldEvents)
updateLasers :: World -> World
updateLasers w =
w'
& cWorld . lWorld . lasers .~ []
& cWorld . lWorld . flares <>~ concat ls
updateLasers w = w' & cWorld . lWorld . flares <>~ concat ls
where
(w', ls) = mapAccumR updateLaser w (w ^. cWorld . lWorld . lasers)
(w', ls) = mapAccumR updateLaser
(w & cWorld . lWorld . lasers .~ [])
(w ^. cWorld . lWorld . lasers)
zoneClouds :: World -> World
zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
displayTerminalLineString :: TerminalLineString -> World -> (String, Color)
displayTerminalLineString tls = case tls of
TerminalLineConst str col -> const (str, col)
displayTerminalLineString (TerminalLineConst str col) = const (str, col)
tmUpdate :: Terminal -> World -> World
tmUpdate tm w = case w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines . ix 0 of
@@ -523,9 +521,7 @@ updateRadarBlips = updateObjMapMaybe radarBlips updateRadarBlip
-- if changing, make sure that bullets can still spawn new bullets
updateBullets :: World -> World
updateBullets w =
w'
& cWorld . lWorld . bullets %~ (++ catMaybes ps)
updateBullets w = w' & cWorld . lWorld . bullets <>~ catMaybes ps
where
(w', ps) =
mapAccumR updateBullet (w & cWorld . lWorld . bullets .~ []) $
@@ -632,44 +628,15 @@ updateClouds = updateObjCatMaybes clouds updateCloud
-- Just
-- (intersectSegSegss x y ass)
--intersectSegsSegss _ _ = Nothing
--updateInstantBullets :: World -> World
--updateInstantBullets w = case w ^. cWorld . lWorld . instantBullets of
-- [] -> w
-- ps ->
-- let (w', ps') = mapAccumR updateBullet (w & cWorld . lWorld . instantBullets .~ []) ps
-- in updateInstantBullets $ w' & cWorld . lWorld . bullets .++~ catMaybes ps'
--updateInstantParticles :: World -> World
--updateInstantParticles w = case _instantParticles w of
-- [] -> w
-- ps -> let (w',ps') = mapAccumR (\a b -> _ptUpdate b a b) (w {_instantParticles=[]}) ps
-- in updateInstantParticles $ w' & particles .++~ catMaybes ps'
--updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> World
--updateMIM f up = f %~ IM.mapMaybe (dbArg up)
-- Note that this updates the randgen
--updateCreatures :: World -> World
--updateCreatures w = appEndo f $ w
-- & creatures .~ IM.mapMaybe id m
-- & randGen .~ newg
-- where
-- ((f,newg),m) = mapAccumR crUp (Endo id,_randGen w) (_creatures w)
-- crUp (f',g) cr = ((f' <> f'',g'), cr')
-- where
-- (f'',cr') = _crUpdate cr cr (w & randGen .~ g)
-- (_,g') = genWord8 g
ppEvents :: World -> World
ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w ^. cWorld . lWorld . pressPlates
updateSeenWalls :: World -> World
updateSeenWalls w = alaf Endo foldMap (markWallSeen . _wlID . snd) (allVisibleWalls w) w
--updateSeenWalls :: World -> World
--updateSeenWalls w = alaf Endo foldMap (markWallSeen . _wlID . snd) (allVisibleWalls w) w
--updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
markWallSeen :: Int -> World -> World
markWallSeen i = cWorld . seenWalls . at i ?~ ()
--markWallSeen :: Int -> World -> World
--markWallSeen i = cWorld . seenWalls . at i ?~ ()
--markWallSeen :: World -> Int -> World
--markWallSeen w i = w & cWorld . seenWalls . at i ?~ ()
@@ -685,9 +652,7 @@ markWallSeen i = cWorld . seenWalls . at i ?~ ()
checkEndGame :: Universe -> Universe
checkEndGame uv = case w ^? timeFlow . deathDelay of
Just x
| x < 0 ->
uv & uvScreenLayers .~ [gameOverMenu uv]
Just x | x < 0 -> uv & uvScreenLayers .~ [gameOverMenu uv]
Just _ -> uv & uvWorld . timeFlow . deathDelay -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . timeFlow .~ DeathTime 50
_ -> uv
src/Dodge/Update/Scroll.hs
+7 -12
View File
@@ -2,6 +2,7 @@ module Dodge.Update.Scroll (
updateWheelEvent,
) where
import Padding
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -48,24 +49,18 @@ selectedItemScroll yi w = do
itemScroll :: Int -> Int -> Item -> World -> World
itemScroll yi invid itm w
| isJust $ itm ^? itUse . uInt =
w
& cWorld . lWorld . creatures . ix 0 . crInv . ix invid
. itUse
. uInt
+~ yi
| isJust $ itm ^? itUse . uInt = w & itmlens . itUse . uInt +~ yi
| Just xs <- itm ^? itUse . uaParams . apProjectiles = w
& itmlens . itUse . uaParams . apProjectiles .~ rotateList yi xs
| ATTACH ZOOMSCOPE <- itm ^. itType = updateScopeZoom invid w
| HELD ALTERIFLE <- itm ^. itType
, yi /= 0 =
w
& cWorld . lWorld . creatures . ix 0 . crInv . ix invid
. itUse
. heldAim
. aimMuzzles
. ix 0
. mzAmmoSlot
& itmlens . itUse . heldAim . aimMuzzles . ix 0 . mzAmmoSlot
%~ ((`mod` 2) . (+ 1))
| otherwise = w
where
itmlens = cWorld . lWorld . creatures . ix 0 . crInv . ix invid
-- note that your _crInvLock does not apply to this TODO check that this is what
-- is wanted
src/Padding.hs
+15 -8
View File
@@ -7,7 +7,8 @@ module Padding
, midPadL
, rotU
, rotD
, rotListAt
-- , rotListAt
, rotateList
, insertAt
)
where
@@ -45,13 +46,19 @@ rotD :: [a] -> [a]
rotD [] = []
rotD xs = last xs : init xs
rotListAt :: Eq a => a -> [a] -> [a]
rotListAt x' xs = f x' xs []
where
f x (y:ys) zs
| y == x = y:ys ++ zs
| otherwise = f x ys (y:zs)
f _ [] zs = zs
rotateList :: Int -> [a] -> [a]
rotateList i xs
| i >= 0 = let (ys,zs) = splitAt i xs
in zs ++ ys
| otherwise = reverse . rotateList (-i) $ reverse xs
--rotListAt :: Eq a => a -> [a] -> [a]
--rotListAt x' xs = f x' xs []
-- where
-- f x (y:ys) zs
-- | y == x = y:ys ++ zs
-- | otherwise = f x ys (y:zs)
-- f _ [] zs = zs
insertAt :: Int -> a -> [a] -> [a]
insertAt i x xs = let (ys,zs) = splitAt i xs in ys ++ [x] ++ zs