diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,18 @@ +scroll (1.20250228.1) unstable; urgency=medium + + * Adjust scroll.cabal so hackage will accept it. + + -- Joey Hess Fri, 28 Feb 2025 15:26:57 -0400 + +scroll (1.20250228) unstable; urgency=medium + + * Updates for compatibility with modern base. + Thanks, Xavier Dectot + * Added note to TODO about haskell ncurses library installation issue on + Debian + + -- Joey Hess Fri, 28 Feb 2025 15:25:19 -0400 + scroll (1.20180421) unstable; urgency=medium * Added stack.yaml. diff --git a/Control.hs b/Control.hs --- a/Control.hs +++ b/Control.hs @@ -1,7 +1,7 @@ module Control where +import Control.Monad (when) import Control.Monad.State.Strict -import UI.NCurses (Event(..), Key(..)) import qualified Data.Map as M import Data.Maybe import Control.Applicative @@ -18,20 +18,22 @@ import Poison import Help import View -import Curses +import Term +import Term.Curses mainLoop :: Step -mainLoop (EventCharacter '\t') = forceRedraw -mainLoop (EventCharacter c) = case M.lookup c charMap of - Just (CharControl (Movement d)) -> move d - Just (CharControl Inventory) -> inventory - Just (CharControl Help) -> showHelp - Just (CharControl Quit) -> checkQuit - Just (CharControl Wait) -> wait - Just (IngredientFor _ _) -> invokeSwallowed c - Just (Poison _) -> ignore - Nothing -> invokeSwallowed c -mainLoop e = maybe ignore move (arrowDirection e) +mainLoop i = case inputCharacter i of + Just '\t' -> forceRedraw + Just c -> case M.lookup c charMap of + Just (CharControl (Movement d)) -> move d + Just (CharControl Inventory) -> inventory + Just (CharControl Help) -> showHelp + Just (CharControl Quit) -> checkQuit + Just (CharControl Wait) -> wait + Just (IngredientFor _ _) -> invokeSwallowed c + Just (Poison _) -> ignore + Nothing -> invokeSwallowed c + Nothing -> maybe ignore move (arrowDirection i) -- Does not step time ignore :: M NextStep @@ -99,8 +101,8 @@ next $ \_ -> clearWindows >> ignore checkQuit :: M NextStep -checkQuit = prompt "Are you sure you want to quit? [yn]" $ \i -> case i of - EventCharacter 'y' -> do +checkQuit = prompt "Are you sure you want to quit? [yn]" $ \i -> case inputCharacter i of + Just 'y' -> do showMessage "Bye!" endThread _ -> do @@ -120,14 +122,15 @@ where victorydance 0 _ = endThread victorydance n e = do - let dir = case e of - (EventCharacter c) -> case M.lookup c charMap of + let dir = case inputCharacter e of + (Just c) -> case M.lookup c charMap of Just (CharControl (Movement d)) | d /= DUp && d /= DDive -> d _ -> DDown - (EventSpecialKey KeyLeftArrow) -> DLeft - (EventSpecialKey KeyRightArrow) -> DRight - _ -> DDown + Nothing -> case arrowDirection e of + Just DLeft -> DLeft + Just DRight -> DRight + _ -> DDown moveaway DDown when (dir /= DDown) $ moveaway dir diff --git a/Curses.hs b/Curses.hs deleted file mode 100644 --- a/Curses.hs +++ /dev/null @@ -1,147 +0,0 @@ -module Curses where - -import UI.NCurses hiding (Window) -import Control.Monad.State.Strict -import qualified Data.Vector as V -import Data.Vector ((!)) -import Control.Applicative -import Prelude - -import Types -import View - -inCurses :: (Palette -> Curses a) -> IO a -inCurses a = runCurses $ do - void $ setCursorMode CursorInvisible - setEcho False - palette <- assignColors - a palette - -data Palette = Palette - { swallowedColor :: ColorID - , invokedColor :: ColorID - } - -assignColors :: Curses Palette -assignColors = Palette - <$> newColorID ColorYellow ColorBlack 1 - <*> newColorID ColorGreen ColorBlack 2 - -paint :: Palette -> (Palette -> ColorID) -> Update a -> Update a -paint palette selectcolor a = do - setColor (selectcolor palette) - r <- a - setColor defaultColorID - return r - --- Checks window bounds. -putGlyph :: ViewOffset -> MaxPos -> Pos -> Glyph -> Update () -putGlyph (xoff, yoff) (xmax, ymax) (x,y) g - | x' < xmax && x' > 0 && y' < ymax && y' > 0 = do - moveCursor (fromIntegral y') (fromIntegral x') - drawLineH (Just g) 1 - | otherwise = return () - where - x' = x + xoff - y' = y + yoff - -headGlyph :: Glyph -headGlyph = bodyGlyph '@' - -bodyGlyph :: Char -> Glyph -bodyGlyph c = Glyph c [AttributeStandout] - -swallowedGlyph :: Char -> Glyph -swallowedGlyph c = Glyph c [AttributeStandout] - -stomachColor :: Segment -> (Palette -> ColorID) -stomachColor s - | segmentInvoked s = invokedColor - | otherwise = swallowedColor - -drawPlayer :: ViewOffset -> MaxPos -> Palette -> Player -> Update () -drawPlayer offset maxpos palette p = do - -- draw the body from the last segment to first, since - -- segments sometimes sit on top of other segments. - forM_ (reverse (playerBody p)) $ - drawSegment offset maxpos palette - - -- draw head last so the cursor is over it - putGlyph offset maxpos (playerHead p) headGlyph - -drawSegment :: ViewOffset -> MaxPos -> Palette -> Segment -> Update () -drawSegment offset maxpos palette s - | segmentSide s == CurrentSide = - case segmentSwallowed s of - Nothing -> putGlyph offset maxpos (segmentPos s) $ bodyGlyph $ - bodyChar $ segmentDirection s - Just c -> paint palette (stomachColor s) $ - putGlyph offset maxpos (segmentPos s) $ swallowedGlyph c - | otherwise = return () - -drawWindow :: Integer -> Int -> Window -> Update () -drawWindow ymax xmax (Window (x,y) l) = - when (x < xmax) $ do - let xI = fromIntegral x - let yI = fromIntegral y - forM_ [0..length l - 1] $ \n -> do - let yp = yI+fromIntegral n - when (yp < ymax) $ do - moveCursor yp xI - drawString $ trim (l !! n) - where - trim = take (xmax - x - 1) - -displayView :: View -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe Event, ViewOffset) -displayView view palette timeoutms oldoffset = loop - where - yv = viewVisible view - loop = do - w <- defaultWindow - (ymaxI, xmaxI) <- screenSize - let ymax = fromIntegral ymaxI - let xmax = fromIntegral xmaxI - - let maxpos = (xmax, ymax) - let newoffset@(xdelta, ydelta) = adjustOffset view oldoffset maxpos - - let (ytrimmer, yoff) = viewPort ydelta ymax (V.length yv) - let yvtrimmed = ytrimmer yv - - let xsample = V.head yv - let (xtrimmer, xoff) = viewPort xdelta xmax (V.length xsample) - let xoffI = fromIntegral xoff - - updateWindow w $ do - let clearline = drawLineH (Just (Glyph ' ' [])) xmaxI - forM_ [0..ymax-2] $ \y -> do - let yI = fromIntegral y - let y' = y - yoff - moveCursor yI 0 - void clearline - when (y' < V.length yvtrimmed && y' >= 0) $ do - let cs = V.toList $ xtrimmer $ - yvtrimmed ! y' - unless (null cs) $ do - moveCursor yI xoffI - drawString cs - - drawPlayer newoffset maxpos palette (viewPlayer view) - mapM_ (drawWindow ymaxI xmax) (viewWindows view) - render - - mev <- getEvent w timeoutms - case mev of - Just (EventMouse _ _) -> loop - Just (EventUnknown _) -> loop - Just EventResized -> loop - Just ev -> return (Just ev, newoffset) - Nothing -> return (Nothing, newoffset) - -arrowDirection :: Event -> Maybe Direction -arrowDirection (EventSpecialKey KeyLeftArrow) = Just DLeft -arrowDirection (EventSpecialKey KeyDownArrow) = Just DDown -arrowDirection (EventSpecialKey KeyUpArrow) = Just DUp -arrowDirection (EventSpecialKey KeyRightArrow) = Just DRight -arrowDirection (EventSpecialKey KeyEnter) = Just DDive -arrowDirection _ = Nothing diff --git a/Level.hs b/Level.hs --- a/Level.hs +++ b/Level.hs @@ -19,7 +19,8 @@ import qualified Level.Beowulf import qualified Level.Joyce import View -import Curses +import Term +import Term.Curses import Player import CharMap @@ -96,10 +97,11 @@ } go w off' pl' - input (EventCharacter c) = case M.lookup c charMap of - Just (CharControl (Movement d)) -> Just d - _ -> Nothing - input e = arrowDirection e + input e = case inputCharacter e of + Just c -> case M.lookup c charMap of + Just (CharControl (Movement d)) -> Just d + _ -> Nothing + Nothing -> arrowDirection e levelSelectionWorld :: IO World levelSelectionWorld = diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -2,14 +2,14 @@ import Control.Monad.State.Strict import UI.NCurses (Curses, screenSize, Event(..)) import Options.Applicative -import Data.Monoid ((<>)) import Data.Maybe import Types import WorldSetup import Control import View -import Curses +import Term +import Term.Curses import Rand import Unicode import Level @@ -66,13 +66,13 @@ else do (ymax, _) <- screenSize s <- liftIO $ stToIO $ makeWorld level ymax rand - run s mainLoop EventResized palette timeoutms + run s mainLoop (InputEvent EventResized) palette timeoutms initialViewOffset maybe (return ()) putStrLn finalmsg where timeoutms = (* 1000) . read <$> timeoutOpt opts -run :: S -> Step -> Event -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe String) +run :: S -> Step -> InputEvent -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe String) run s step input palette timeoutms offset = do (NextStep view n, s') <- liftIO $ stToIO $ flip runStateT s $ step input diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,7 +1,6 @@ all: - @find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags 2>/dev/null | sort > tags cabal build - ln -sf dist/build/scroll/scroll + cabal install --installdir=. --overwrite-policy=always hackage: @cabal sdist diff --git a/Peruser.hs b/Peruser.hs --- a/Peruser.hs +++ b/Peruser.hs @@ -1,6 +1,8 @@ module Peruser where import Control.Monad.State.Strict +import Control.Monad (when) +import Data.Foldable (forM_) import qualified Data.Vector.Mutable as MV import qualified Data.Vector as V import Control.Monad.IfElse diff --git a/Player.hs b/Player.hs --- a/Player.hs +++ b/Player.hs @@ -1,6 +1,7 @@ module Player where import Control.Monad.State.Strict +import Control.Monad (forM) import qualified Data.Vector.Mutable as MV import Control.Applicative import Data.Maybe diff --git a/Player/Consume.hs b/Player/Consume.hs --- a/Player/Consume.hs +++ b/Player/Consume.hs @@ -1,6 +1,7 @@ module Player.Consume where import Control.Monad.State.Strict +import Control.Monad (unless, when) import Data.Char import qualified Data.CaseInsensitive as CI import qualified Data.Map as M diff --git a/Player/Move.hs b/Player/Move.hs --- a/Player/Move.hs +++ b/Player/Move.hs @@ -3,6 +3,7 @@ module Player.Move where import Control.Monad.State.Strict +import Control.Monad (when) import Data.Char import Data.Maybe import Control.Applicative diff --git a/Poison.hs b/Poison.hs --- a/Poison.hs +++ b/Poison.hs @@ -1,6 +1,7 @@ module Poison where import Control.Monad.State.Strict +import Control.Monad (when) import qualified Data.CaseInsensitive as CI import qualified Data.Map as M import Data.Char diff --git a/Spell.hs b/Spell.hs --- a/Spell.hs +++ b/Spell.hs @@ -1,6 +1,9 @@ module Spell where import Control.Monad.State.Strict +import Control.Monad (when) +import Control.Monad.Compat ((<=<)) +import Data.Foldable (forM_) import qualified Data.Set as S import qualified Data.Map as M import qualified Data.CaseInsensitive as CI @@ -8,7 +11,6 @@ import Data.Char import Data.Maybe import Control.Monad.IfElse -import UI.NCurses (Event(..)) import Control.Applicative import Prelude @@ -24,6 +26,7 @@ import Rand import DeepCopy import Invert +import Term type SpellAction = M NextStep -> M NextStep @@ -95,8 +98,8 @@ if null swallowed then noingredients cont else prompt ("Pick the new spell's ingredient: [" ++ swallowed ++ "]") $ \i -> - case i of - (EventCharacter c) | (CI.mk c `elem` map CI.mk swallowed) -> do + case inputCharacter i of + Just c | (CI.mk c `elem` map CI.mk swallowed) -> do removeIngredients' (S.singleton (CI.mk c)) possibilities <- checkSpells (const True) <$> gets player case possibilities of @@ -114,8 +117,8 @@ promptknownspell cont ingredient = do let retry = promptknownspell cont ingredient prompt ("What spell should " ++ invokeString [ingredient] ++ " invoke?") $ \i -> - case i of - (EventCharacter c) -> do + case inputCharacter i of + Just c -> do p <- gets player case toggleInvoke c p of (InvokedChar, p') -> do @@ -129,7 +132,7 @@ change p' retry (NoInvoke, _) -> retry - _ -> retry + Nothing -> retry change p' = modifyPlayer (const p') addnewspell ingredient basespell = do @@ -190,13 +193,13 @@ genocide :: SpellAction genocide = promptletter where - promptletter cont = prompt "Genocide which letter?" $ \i -> case i of - (EventCharacter c) + promptletter cont = prompt "Genocide which letter?" $ \i -> case inputCharacter i of + Just c | isBoundry c || isSpace c -> do showMessage "The spell fizzles and dies. Nice try." cont | otherwise -> removeall c cont - _ -> promptletter cont + Nothing -> promptletter cont removeall c cont = do let toremove = CI.mk c @@ -317,8 +320,8 @@ cont wish :: SpellAction -wish cont = prompt ("What letter do you wish for?") $ \ev -> case ev of - (EventCharacter want) -> do +wish cont = prompt ("What letter do you wish for?") $ \ev -> case inputCharacter ev of + Just want -> do result <- if isSpace want then do roll <-randM $ randomR (1,10 :: Int) @@ -338,7 +341,7 @@ then Just result else Nothing cont - _ -> wish cont + Nothing -> wish cont data ToggleInvokeResult = InvokedChar diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,3 +1,24 @@ +scroll fails to build from source on Debian because +https://hackage.haskell.org/package/ncurses fails to +build. The workaround is to patch that library with +this patch: + +--- ncurses-0.2.16.orig/lib/UI/NCurses/Enums.chs 2016-08-28 21:09:37.000000000 -0400 ++++ ncurses-0.2.16/lib/UI/NCurses/Enums.chs 2025-02-28 15:18:09.215809399 -0400 +@@ -195,7 +195,6 @@ + , hsncurses_KEY_UNDO = KEY_UNDO + , hsncurses_KEY_MOUSE = KEY_MOUSE + , hsncurses_KEY_RESIZE = KEY_RESIZE +-, hsncurses_KEY_EVENT = KEY_EVENT + }; + #endc + +I have informed its author about the problem and he did not want to fix it. +So, it would probably be best to migrate away from ncurses. A start has +been made in commit 4b5a597a5de090d1418b96aedd37bf044e3c05e9. Another +reason to do this is to get scroll running compiled to WASM in a web +browser. + Add a bonus level with: Front side, a NanoGenMo generated novel. (It's possible that some of the current levels would qualify, if I'd only written them in November!) diff --git a/Term.hs b/Term.hs new file mode 100644 --- /dev/null +++ b/Term.hs @@ -0,0 +1,9 @@ +module Term where + +import UI.NCurses (Event(..)) + +data InputEvent = InputEvent Event + +inputCharacter :: InputEvent -> Maybe Char +inputCharacter (InputEvent (EventCharacter c)) = Just c +inputCharacter _ = Nothing diff --git a/Term/Curses.hs b/Term/Curses.hs new file mode 100644 --- /dev/null +++ b/Term/Curses.hs @@ -0,0 +1,154 @@ +module Term.Curses ( + Palette, + inCurses, + displayView, + arrowDirection, +) where + +import UI.NCurses hiding (Window) +import Control.Monad (void, unless, when) +import Data.Foldable (forM_) +import qualified Data.Vector as V +import Data.Vector ((!)) +import Control.Applicative +import Prelude + +import Types +import Term +import View + +inCurses :: (Palette -> Curses a) -> IO a +inCurses a = runCurses $ do + void $ setCursorMode CursorInvisible + setEcho False + palette <- assignColors + a palette + +data Palette = Palette + { swallowedColor :: ColorID + , invokedColor :: ColorID + } + +assignColors :: Curses Palette +assignColors = Palette + <$> newColorID ColorYellow ColorBlack 1 + <*> newColorID ColorGreen ColorBlack 2 + +paint :: Palette -> (Palette -> ColorID) -> Update a -> Update a +paint palette selectcolor a = do + setColor (selectcolor palette) + r <- a + setColor defaultColorID + return r + +-- Checks window bounds. +putGlyph :: ViewOffset -> MaxPos -> Pos -> Glyph -> Update () +putGlyph (xoff, yoff) (xmax, ymax) (x,y) g + | x' < xmax && x' > 0 && y' < ymax && y' > 0 = do + moveCursor (fromIntegral y') (fromIntegral x') + drawLineH (Just g) 1 + | otherwise = return () + where + x' = x + xoff + y' = y + yoff + +headGlyph :: Glyph +headGlyph = bodyGlyph '@' + +bodyGlyph :: Char -> Glyph +bodyGlyph c = Glyph c [AttributeStandout] + +swallowedGlyph :: Char -> Glyph +swallowedGlyph c = Glyph c [AttributeStandout] + +stomachColor :: Segment -> (Palette -> ColorID) +stomachColor s + | segmentInvoked s = invokedColor + | otherwise = swallowedColor + +drawPlayer :: ViewOffset -> MaxPos -> Palette -> Player -> Update () +drawPlayer offset maxpos palette p = do + -- draw the body from the last segment to first, since + -- segments sometimes sit on top of other segments. + forM_ (reverse (playerBody p)) $ + drawSegment offset maxpos palette + + -- draw head last so the cursor is over it + putGlyph offset maxpos (playerHead p) headGlyph + +drawSegment :: ViewOffset -> MaxPos -> Palette -> Segment -> Update () +drawSegment offset maxpos palette s + | segmentSide s == CurrentSide = + case segmentSwallowed s of + Nothing -> putGlyph offset maxpos (segmentPos s) $ bodyGlyph $ + bodyChar $ segmentDirection s + Just c -> paint palette (stomachColor s) $ + putGlyph offset maxpos (segmentPos s) $ swallowedGlyph c + | otherwise = return () + +drawWindow :: Integer -> Int -> Window -> Update () +drawWindow ymax xmax (Window (x,y) l) = + when (x < xmax) $ do + let xI = fromIntegral x + let yI = fromIntegral y + forM_ [0..length l - 1] $ \n -> do + let yp = yI+fromIntegral n + when (yp < ymax) $ do + moveCursor yp xI + drawString $ trim (l !! n) + where + trim = take (xmax - x - 1) + +displayView :: View -> Palette -> Maybe Integer -> ViewOffset -> Curses (Maybe InputEvent, ViewOffset) +displayView view palette timeoutms oldoffset = loop + where + yv = viewVisible view + loop = do + w <- defaultWindow + (ymaxI, xmaxI) <- screenSize + let ymax = fromIntegral ymaxI + let xmax = fromIntegral xmaxI + + let maxpos = (xmax, ymax) + let newoffset@(xdelta, ydelta) = adjustOffset view oldoffset maxpos + + let (ytrimmer, yoff) = viewPort ydelta ymax (V.length yv) + let yvtrimmed = ytrimmer yv + + let xsample = V.head yv + let (xtrimmer, xoff) = viewPort xdelta xmax (V.length xsample) + let xoffI = fromIntegral xoff + + updateWindow w $ do + let clearline = drawLineH (Just (Glyph ' ' [])) xmaxI + forM_ [0..ymax-2] $ \y -> do + let yI = fromIntegral y + let y' = y - yoff + moveCursor yI 0 + void clearline + when (y' < V.length yvtrimmed && y' >= 0) $ do + let cs = V.toList $ xtrimmer $ + yvtrimmed ! y' + unless (null cs) $ do + moveCursor yI xoffI + drawString cs + + drawPlayer newoffset maxpos palette (viewPlayer view) + mapM_ (drawWindow ymaxI xmax) (viewWindows view) + render + + mev <- getEvent w timeoutms + case mev of + Just (EventMouse _ _) -> loop + Just (EventUnknown _) -> loop + Just EventResized -> loop + Just ev -> return (Just (InputEvent ev), newoffset) + Nothing -> return (Nothing, newoffset) + +arrowDirection :: InputEvent -> Maybe Direction +arrowDirection (InputEvent (EventSpecialKey KeyLeftArrow)) = Just DLeft +arrowDirection (InputEvent (EventSpecialKey KeyDownArrow)) = Just DDown +arrowDirection (InputEvent (EventSpecialKey KeyUpArrow)) = Just DUp +arrowDirection (InputEvent (EventSpecialKey KeyRightArrow)) = Just DRight +arrowDirection (InputEvent (EventSpecialKey KeyEnter)) = Just DDive +arrowDirection _ = Nothing diff --git a/Types.hs b/Types.hs --- a/Types.hs +++ b/Types.hs @@ -12,9 +12,10 @@ import qualified Data.Set as S import qualified Data.Map as M import Data.CaseInsensitive (CI) -import UI.NCurses (Event) import System.Random (StdGen) +import Term + -- Most code that updates the world runs in this monad stack. type M = StateT S (ST RealWorld) @@ -138,7 +139,7 @@ -- Calculates a new state of the world based on the provided Input. -- Returns new View, and a continuation to handle the next step. -type Step = Event -> M NextStep +type Step = InputEvent -> M NextStep data NextStep = NextStep View (Maybe Step) type Level = [String] diff --git a/Unicode.hs b/Unicode.hs --- a/Unicode.hs +++ b/Unicode.hs @@ -49,6 +49,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.Map as M import Data.Char +import Data.Maybe -- If table is used without being primed, there is a noticible -- delay the first time a character is looked up. @@ -58,11 +59,14 @@ Just _ -> return () unicodeCharDesc :: Char -> String -unicodeCharDesc c - | l1 `elem` vowel = "an " ++ s - | otherwise = "a " ++ s +unicodeCharDesc c = + case listToMaybe s of + Just l1 + | l1 `elem` vowel -> "an " ++ s + | otherwise -> "a " ++ s + Nothing -> "a " ++ s where - s@(l1:_) = unicodeCharString c + s = unicodeCharString c vowel :: String vowel = "AEIOU" diff --git a/World.hs b/World.hs --- a/World.hs +++ b/World.hs @@ -6,6 +6,7 @@ import Control.Monad.State.Strict import qualified Data.Vector.Mutable as MV import Control.Applicative +import Data.Foldable (forM_) import Prelude import Types diff --git a/scroll.cabal b/scroll.cabal --- a/scroll.cabal +++ b/scroll.cabal @@ -1,6 +1,6 @@ Name: scroll -Version: 1.20180421 -Cabal-Version: >= 1.6 +Version: 1.20250228 +Cabal-Version: 1.12 License: GPL-2 Maintainer: Joey Hess Author: Joey Hess @@ -31,9 +31,10 @@ Executable scroll Main-Is: Main.hs GHC-Options: -threaded -Wall -fno-warn-tabs - Build-Depends: base >= 4.5, base < 5, vector, bytestring, mtl, + Build-Depends: base >= 4.5, base < 5, base-compat, vector, bytestring, mtl, containers, ncurses, data-default, random, monad-loops, IfElse, case-insensitive, optparse-applicative, text + Default-Language: Haskell2010 Hs-Source-Dirs: . if flag(Unix) @@ -45,7 +46,6 @@ Other-Modules: CharMap Control - Curses DeepCopy GPL Help @@ -71,6 +71,8 @@ Spell Spell.Enum Status + Term + Term.Curses Time Types Unicode diff --git a/unix/Pager.hs b/unix/Pager.hs --- a/unix/Pager.hs +++ b/unix/Pager.hs @@ -20,7 +20,7 @@ term <- getTerminalName stdOutput oldstdin <- dup stdInput closeFd stdInput - newstdin <- openFd term ReadOnly Nothing defaultFileFlags + newstdin <- openFd term ReadOnly defaultFileFlags _ <- dupTo newstdin stdInput Just <$> (hGetContents =<< fdToHandle oldstdin) else error "stdout is not a terminal"