Browse code
moving stuff around
Ed L authored on 27/04/2013 02:54:38
Showing 1 changed files
Showing 1 changed files
1 | 1 |
deleted file mode 100644 |
... | ... |
@@ -1,140 +0,0 @@ |
1 |
-{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} |
|
2 |
- |
|
3 |
-import System.IO |
|
4 |
-import System.Process |
|
5 |
-import System.Environment |
|
6 |
-import System.Console.CmdArgs |
|
7 |
- |
|
8 |
-import Control.Concurrent |
|
9 |
- |
|
10 |
-import qualified Control.Exception as Exception |
|
11 |
-import Control.Monad |
|
12 |
-import Control.Monad.ST |
|
13 |
-import Control.Monad.Trans |
|
14 |
-import Control.Monad.IO.Class |
|
15 |
-import Data.STRef |
|
16 |
- |
|
17 |
-import qualified UI.HSCurses.Curses as HSCurses |
|
18 |
-import qualified UI.HSCurses.CursesHelper as HSCursesHelper |
|
19 |
- |
|
20 |
-a = runST $ do |
|
21 |
- n <- newSTRef 0 |
|
22 |
- x <- readSTRef n |
|
23 |
- return x |
|
24 |
- |
|
25 |
-mvWAddStr2 w y x s = do |
|
26 |
- (rows, cols) <- HSCurses.scrSize |
|
27 |
- when ((y >= 0) && (x >=0) && (x < cols) && (y < rows)) $ do |
|
28 |
- let space = (cols - x) |
|
29 |
- let s2 = take space s |
|
30 |
- HSCurses.mvWAddStr w y x s2 |
|
31 |
- |
|
32 |
-dispatch :: HSCurses.Key -> IO () |
|
33 |
-dispatch kc = undefined |
|
34 |
- |
|
35 |
-b lim filein cols infinitep = do |
|
36 |
- n <- stToIO $ newSTRef 1 |
|
37 |
- e <- forever $ do |
|
38 |
- x <- stToIO $ readSTRef n |
|
39 |
- |
|
40 |
- eofp <- hIsEOF filein |
|
41 |
- if eofp |
|
42 |
- then do |
|
43 |
- if infinitep |
|
44 |
- then do threadDelay 100 |
|
45 |
- else do threadDelay 100 |
|
46 |
- else do |
|
47 |
- line <- hGetLine filein |
|
48 |
- |
|
49 |
- mvWAddStr2 HSCurses.stdScr ( (x`mod`lim) - 1) 0 $ replicate (cols+1) ' ' |
|
50 |
- mvWAddStr2 HSCurses.stdScr ( (x`mod`lim) - 1) 0 $ (show x) ++ (' ':line) |
|
51 |
- |
|
52 |
- let marker = "--- break ---" |
|
53 |
- div = marker ++ (replicate (cols - (length marker)+1) '-') |
|
54 |
- in mvWAddStr2 HSCurses.stdScr ( ((x+1)`mod`lim) - 1) 0 $ div |
|
55 |
- |
|
56 |
- if infinitep && ( (x+1) `mod` lim == 0) |
|
57 |
- then do |
|
58 |
- kc <- HSCurses.getCh |
|
59 |
- -- dispatch kc |
|
60 |
- return () |
|
61 |
- else |
|
62 |
- return () |
|
63 |
- |
|
64 |
- stToIO $ writeSTRef n (x+1) |
|
65 |
- HSCurses.refresh |
|
66 |
- return () |
|
67 |
- |
|
68 |
-allocate = do |
|
69 |
- HSCurses.initCurses |
|
70 |
- hasColors <- HSCurses.hasColors |
|
71 |
- if hasColors |
|
72 |
- then do |
|
73 |
- HSCurses.startColor |
|
74 |
- HSCurses.initPair |
|
75 |
- (HSCurses.Pair 1) |
|
76 |
- (HSCursesHelper.black) |
|
77 |
- (HSCursesHelper.white) |
|
78 |
- return () |
|
79 |
- else |
|
80 |
- return () |
|
81 |
- |
|
82 |
- |
|
83 |
-deallocate = do |
|
84 |
- HSCurses.endWin |
|
85 |
- |
|
86 |
-work enc run infinitep = do |
|
87 |
- let (runprog:args) = run |
|
88 |
- (rows, cols) <- HSCurses.scrSize |
|
89 |
- (_, Just hout, _, _) <- |
|
90 |
- createProcess (proc runprog args) { |
|
91 |
- std_out=CreatePipe |
|
92 |
- } |
|
93 |
- |
|
94 |
- -- enc <- mkTextEncoding "ISO-8859-1" |
|
95 |
- enc <- mkTextEncoding enc |
|
96 |
- hSetEncoding hout enc |
|
97 |
- |
|
98 |
- b rows hout cols infinitep |
|
99 |
- return () |
|
100 |
- |
|
101 |
- |
|
102 |
-data MyOptions = MyOptions { |
|
103 |
- infinite :: Bool, |
|
104 |
- run :: [String], |
|
105 |
- encoding :: String |
|
106 |
-} deriving (Data, Typeable, Show, Eq) |
|
107 |
- |
|
108 |
-myProgOpts :: MyOptions |
|
109 |
-myProgOpts = MyOptions { |
|
110 |
- infinite = def &= name "i", |
|
111 |
- encoding = "UTF-8" &= name "e", |
|
112 |
- run = def &= args |
|
113 |
-} |
|
114 |
- |
|
115 |
-getOpts :: IO MyOptions |
|
116 |
-getOpts = cmdArgs $ myProgOpts |
|
117 |
- |
|
118 |
-main = do |
|
119 |
- args <- getArgs |
|
120 |
- opts <- getOpts |
|
121 |
- optionHandler opts |
|
122 |
- |
|
123 |
-optionHandler :: MyOptions -> IO () |
|
124 |
-optionHandler opts@MyOptions{..} = do |
|
125 |
- Exception.bracket_ allocate deallocate (work encoding run infinite) |
|
126 |
- |
|
127 |
- |