diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,15 @@ +scroll (1.20150314) unstable; urgency=medium + + * This is a post-7drl release that does not change any gameplay. + * Support use as a pager, with input piped in on stdin, as long + as the unix module is available. + * Rename Setup.hs since cabal uses that name. + Thanks to Sergei Trofimovich of Gentoo, which has packaged scroll! + * Don't crash on exceedingly small input files when being used as a + pager. + + -- Joey Hess Sat, 14 Mar 2015 15:32:28 -0400 + scroll (1.20150313) unstable; urgency=low * First release, at the end of 7DRL 2015! diff --git a/Level/File.hs b/Level/File.hs --- a/Level/File.hs +++ b/Level/File.hs @@ -4,12 +4,8 @@ import Level.Shuffle import qualified Level.Tutorial -import Control.Applicative - -level :: Rand -> FilePath -> IO (Level, Level) -level r f = do - ls <- lines <$> readFile f - return (rand $ ShuffleableSection ls, Level.Tutorial.level) +level :: Rand -> String -> (Level, Level) +level r s = (rand $ ShuffleableSection (lines s), Level.Tutorial.level) where rand = case r of Rand g -> shuffle g diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -5,7 +5,7 @@ import Data.Maybe import Types -import Setup +import WorldSetup import Control import View import Curses @@ -13,6 +13,7 @@ import Unicode import Level import qualified Level.File +import Pager data Opts = Opts { fileOpt :: Maybe FilePath @@ -51,9 +52,14 @@ rand <- initRand (randOpt opts) finalmsg <- inCurses $ \palette -> do level <- case fileOpt opts of - Nothing -> levelFor rand - <$> Level.select palette timeoutms - Just f -> liftIO $ Level.File.level rand f + Nothing -> do + pipedinput <- liftIO stdinPager + case pipedinput of + Nothing -> levelFor rand + <$> Level.select palette timeoutms + Just s -> return $ + Level.File.level rand s + Just f -> liftIO $ Level.File.level rand <$> readFile f if emptyLevel (fst level) then return (Just "Game Over") else do diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -2,3 +2,7 @@ @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 + +hackage: + @cabal sdist + @cabal upload dist/*.tar.gz diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,60 +1,2 @@ -module Setup where - -import Control.Monad.ST -import Control.Monad.State.Strict -import qualified Data.Vector as V -import qualified Data.Set as S -import Data.Vector ((!)) -import Control.Applicative -import Data.Default - -import Types -import Level -import Level.Border -import Player -import Spell -import Poison -import Rand - --- Creates a new game world from the specified level content. -makeWorld :: (Level, Level) -> Integer -> Rand -> ST RealWorld S -makeWorld (frontl, backl) screenheight r = do - (front, frontbuf) <- setup frontv - (back, backbuf) <- setup backv - addCap front - addCap back - let s = S - { world = front - , flipSide = back - , player = def { playerSpells = startingspells } - , bottomBuffer = (frontbuf, backbuf) - , topBuffer = 0 - , peruser = def - , randSource = r - , helpShown = False - , messages = [] - , spells = allSpells - , poisons = allPoisons - , windows = [] - } - execStateT startingPosition s - where - (frontv, backv) = levelVectors (frontl, backl) - - -- 2 for each end of scroll - scrollsize = fromIntegral $ screenheight - 4 - - setup :: V.Vector (V.Vector Char) -> ST RealWorld (World, Vec2 Char) - setup v = do - mv <- V.mapM V.thaw v - let (w, b) = V.splitAt (scrollsize - 1) mv - -- grow for scroll cap - let p = V.singleton (w ! 0) - let w' = V.concat [p,p,w,p,p] - (,) - <$> V.thaw w' - <*> V.thaw b - - startingspells = flip S.insert startingSpells $ - optspells !! fst (randomR (0, length optspells - 1) (randGen r)) - optspells = S.toList maybeStartingSpells +import Distribution.Simple +main = defaultMain diff --git a/Status.hs b/Status.hs --- a/Status.hs +++ b/Status.hs @@ -17,7 +17,7 @@ stringAt (x, y) s = do w <- worldWidth h <- worldHeight - unless (y >= h) $ do + unless (y >= h || y < 0 || x < 0) $ do let maxsz = w - 3 - x let s' = take maxsz s forM_ [0..length s' - 1] $ \n -> do diff --git a/WorldSetup.hs b/WorldSetup.hs new file mode 100644 --- /dev/null +++ b/WorldSetup.hs @@ -0,0 +1,60 @@ +module WorldSetup where + +import Control.Monad.ST +import Control.Monad.State.Strict +import qualified Data.Vector as V +import qualified Data.Set as S +import Data.Vector ((!)) +import Control.Applicative +import Data.Default + +import Types +import Level +import Level.Border +import Player +import Spell +import Poison +import Rand + +-- Creates a new game world from the specified level content. +makeWorld :: (Level, Level) -> Integer -> Rand -> ST RealWorld S +makeWorld (frontl, backl) screenheight r = do + (front, frontbuf) <- setup frontv + (back, backbuf) <- setup backv + addCap front + addCap back + let s = S + { world = front + , flipSide = back + , player = def { playerSpells = startingspells } + , bottomBuffer = (frontbuf, backbuf) + , topBuffer = 0 + , peruser = def + , randSource = r + , helpShown = False + , messages = [] + , spells = allSpells + , poisons = allPoisons + , windows = [] + } + execStateT startingPosition s + where + (frontv, backv) = levelVectors (frontl, backl) + + -- 2 for each end of scroll + scrollsize = fromIntegral $ screenheight - 4 + + setup :: V.Vector (V.Vector Char) -> ST RealWorld (World, Vec2 Char) + setup v = do + mv <- V.mapM V.thaw v + let (w, b) = V.splitAt (scrollsize - 1) mv + -- grow for scroll cap + let p = V.singleton (w ! 0) + let w' = V.concat [p,p,w,p,p] + (,) + <$> V.thaw w' + <*> V.thaw b + + startingspells = flip S.insert startingSpells $ + optspells !! fst (randomR (0, length optspells - 1) (randGen r)) + optspells = S.toList maybeStartingSpells diff --git a/portable/Pager.hs b/portable/Pager.hs new file mode 100644 --- /dev/null +++ b/portable/Pager.hs @@ -0,0 +1,6 @@ +-- This is just a stub for systems building without unix support. + +module Pager where + +stdinPager :: IO (Maybe String) +stdinPager = return Nothing diff --git a/scroll.cabal b/scroll.cabal --- a/scroll.cabal +++ b/scroll.cabal @@ -1,10 +1,10 @@ Name: scroll -Version: 1.20150313 +Version: 1.20150314 Cabal-Version: >= 1.6 License: GPL-2 Maintainer: Joey Hess Author: Joey Hess -Stability: Experimental +Stability: Stable Copyright: 2015 Joey Hess Build-Type: Simple Category: Game @@ -16,13 +16,26 @@ Makefile doc/scroll-roguelike-game-idea .gitignore + unix/Pager.hs + portable/Pager.hs +Flag Unix + Description: Use Unix capabilities to be a better pager + Executable scroll Main-Is: Main.hs GHC-Options: -Wall -threaded -O2 Build-Depends: base >= 4.5, base < 5, vector, bytestring, mtl, containers, ncurses, data-default, random, monad-loops, IfElse, case-insensitive, optparse-applicative, text + + Hs-Source-Dirs: . + if flag(Unix) + Build-Depends: unix + Hs-Source-Dirs: unix + else + Hs-Source-Dirs: portable + Other-Modules: CharMap Control @@ -43,13 +56,13 @@ Level.Tutorial Monster Peruser + Pager Player Player.Consume Player.Move Poison Poison.Enum Rand - Setup Spell Spell.Enum Status @@ -59,3 +72,4 @@ Utility.Percentage View World + WorldSetup diff --git a/unix/Pager.hs b/unix/Pager.hs new file mode 100644 --- /dev/null +++ b/unix/Pager.hs @@ -0,0 +1,25 @@ +module Pager where + +import System.IO +import System.Posix.IO +import System.Posix.Terminal +import Control.Applicative + +-- If stdin is not connected to a tty, we're being used as a pager with +-- output piped in. The content of stdin is sucked in and returned for +-- paging, and stdin is re-opened from the terminal device. +stdinPager :: IO (Maybe String) +stdinPager = go =<< queryTerminal stdInput + where + go True = return Nothing + go False = do + stdoutisterm <- queryTerminal stdOutput + if stdoutisterm + then do + term <- getTerminalName stdOutput + oldstdin <- dup stdInput + closeFd stdInput + newstdin <- openFd term ReadOnly Nothing defaultFileFlags + _ <- dupTo newstdin stdInput + Just <$> (hGetContents =<< fdToHandle oldstdin) + else error "stdout is not a terminal"