-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathUIBase.hs
429 lines (353 loc) · 20.1 KB
/
UIBase.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- Èíôîðìèðîâàíèå ïîëüçîâàòåëÿ î õîäå âûïîëíåíèÿ ïðîãðàììû (CUI - Console User Interface). ------
----------------------------------------------------------------------------------------------------
module UIBase where
import Prelude hiding (catch)
import Control.Monad
import Control.Concurrent
import Control.OldException
import Data.Char
import Data.IORef
import Foreign
import Foreign.C
import Numeric (showFFloat)
import System.CPUTime (getCPUTime)
import System.IO
import System.Time
#ifdef FREEARC_UNIX
import System.Posix.IO
import System.Posix.Terminal
#endif
import Utils
import Errors
import Files
import FileInfo
import Options
-- |Çäåñü õðàíèòñÿ âñÿ èíôîðìàöèÿ î êîìàíäå è ïðîöåññå å¸ âûïîëíåíèÿ, òðåáóåìàÿ äëÿ îòîáðàæåíèÿ
-- èíäèêàòîðà ïðîãðåññà è âûâîäà ôèíàëüíîé ñòàòèñòèêè
data UI_State = UI_State {
total_files :: !FileCount -- Êîë-âî ôàéëîâ, êîòîðûå îíà äîëæíà îáðàáîòàòü
, total_bytes :: !FileSize -- Îáùèé îáú¸ì ýòèõ ôàéëîâ (â ðàñïàêîâàííîì âèäå)
, archive_total_bytes :: !FileSize -- Îáùèé îáú¸ì ôàéëîâ â àðõèâå - óñòàíàâëèâàåòñÿ òîëüêî äëÿ êîìàíä ðàñïàêîâêè
, archive_total_compressed :: !FileSize -- Îáùèé îáú¸ì ôàéëîâ â àðõèâå (â ñæàòîì âèäå)
, datatype :: DataType -- Îáðàáàòûâàåìàÿ â äàííûé ìîìåíò ÷àñòü àðõèâà: ôàéë/êàòàëîã/ñëóæåáíûå äàííûå
, uiFileinfo :: !(Maybe FileInfo) -- Òåêóùèé îáðàáàòûâàåìûé ôàéë (åñëè åñòü)
--  çàâèñèìîñòè îò òîãî, êàêàÿ ÷àñòü àðõèâà ñåé÷àñ îáðàáàòûâàåòñÿ, ñòàòèñòèêà çàíîñèòñÿ
-- ëèáî íà ñ÷¸ò ôàéëîâ:
, files :: !FileCount -- Êîë-âî óæå îáðàáîòàííûõ ôàéëîâ
, bytes :: !FileSize -- Îáú¸ì óæå îáðàáîòàííûõ äàííûõ â ðàñïàêîâàííîì âèäå
, cbytes :: !FileSize -- Îáú¸ì óæå îáðàáîòàííûõ äàííûõ â óïàêîâàííîì âèäå
-- ëèáî íà ñ÷¸ò êàòàëîãîâ (ñëóæåáíàÿ èíôîðìàöèÿ íå ïîäñ÷èòûâàåòñÿ):
, dirs :: !FileCount -- Êîë-âî ñîçäàííûõ êàòàëîãîâ è äðóãèõ ñëóæåáíûõ áëîêîâ
, dir_bytes :: !FileSize -- Îáú¸ì óæå îáðàáîòàííûõ äàííûõ â ðàñïàêîâàííîì âèäå
, dir_cbytes :: !FileSize -- Îáú¸ì óæå îáðàáîòàííûõ äàííûõ â óïàêîâàííîì âèäå
-- Êðîìå òîãî, ìû çàïîìèíàåì, êàêàÿ ÷àñòü èç ýòèõ äàííûõ - íà ñàìîì äåëå íå óïàêîâûâàëàñü (ýòî ïîëåçíî äëÿ îïðåäåëåíèÿ ðåàëüíîé ñêîðîñòè óïàêîâêè):
, fake_files :: !FileCount -- Êîë-âî óæå îáðàáîòàííûõ ôàéëîâ
, fake_bytes :: !FileSize -- Îáú¸ì óæå îáðàáîòàííûõ äàííûõ â ðàñïàêîâàííîì âèäå
, fake_cbytes :: !FileSize -- Îáú¸ì óæå îáðàáîòàííûõ äàííûõ â óïàêîâàííîì âèäå
-- Èíôîðìàöèÿ î òåêóùåì ñîëèä-áëîêå
, algorithmsCount :: Int -- Êîë-âî àëãîðèòìîâ â öåïî÷êå
, rw_ops :: [[UI_RW FileSize]] -- Ïîñëåäîâàòåëüíîñòü îïåðàöèé ÷òåíèÿ/çàïèñè ñ ðàçáèâêîé ïî îòäåëüíûì àëãîðèòìàì
, r_bytes :: FileSize -- Îáú¸ì óæå îáðàáîòàííûõ äàííûõ íà âõîäå ïåðâîãî àëãîðèòìà ñæàòèÿ
, rnum_bytes :: FileSize -- Îáú¸ì óæå îáðàáîòàííûõ äàííûõ íà âõîäå ïîñëåäíåãî àëãîðèòìà ñæàòèÿ
}
-- |Îáðàáàòûâàåìàÿ â äàííûé ìîìåíò ÷àñòü àðõèâà: ôàéë/êàòàëîã/ñëóæåáíûå äàííûå
data DataType = File | Dir | CData deriving Eq
-- |Îïåðàöèè ÷òåíèÿ è çàïèñè â ñïèñêå îïåðàöèé
data UI_RW a = UI_Read a | UI_Write a
-- |Òèï èíäèêàòîðà - òîëüêî ïðöåíòû èëè + ôàéëû/...
data IndicatorType = INDICATOR_PERCENTS | INDICATOR_FULL deriving Eq
-- Âûïîëíÿåìàÿ ñåé÷àñ êîìàíäà
ref_command = unsafePerformIO$ newIORef$ error "undefined UI::ref_command"
-- Îáðàáàòûâàåìûé àðõèâ (íå ñîâïàäàåò ñ command.$cmd_arcname ïðè òåñòèðîâàíèè âðåìåííîãî àðõèâà ïîñëå óïàêîâêè)
uiArcname = unsafePerformIO$ newIORef$ error "undefined UI::uiArcname"
refStartArchiveTime = unsafePerformIO$ newIORef$ error "undefined UI::refStartArchiveTime"
refStartPauseTime = unsafePerformIO$ newIORef$ error "undefined UI::refStartPauseTime"
refArchiveProcessingTime = unsafePerformIO$ newIORef$ error "undefined UI::refArchiveProcessingTime" :: IORef Double
ref_ui_state = unsafePerformIO$ newIORef$ error "undefined UI::ref_ui_state"
putHeader = unsafePerformIO$ init_once
ref_w0 = unsafePerformIO$ newIORef$ error "undefined UI::ref_w0" :: IORef Int
ref_arcExist = unsafePerformIO$ newIORef$ error "undefined UI::ref_arcExist" :: IORef Bool
-- Òåêóùàÿ ñòàäèÿ âûïîëíåíèÿ êîìàíäû èëè èìÿ ôàéëà èç uiFileinfo
uiMessage = unsafePerformIO$ newIORef$ ("","")
-- |Ñ÷¸ò÷èê ïðîñêàíèðîâàííûõ ôàéëîâ
files_scanned = unsafePerformIO$ newIORef$ (0::Integer)
-- |Ãëîáàëüíàÿ ïåðåìåííàÿ, õðàíÿùàÿ ñîñòîÿíèå èíäèêàòîðà ïðîãðåññà
aProgressIndicatorState = unsafePerformIO$ newIORef$ error "undefined UI::aProgressIndicatorState"
aProgressIndicatorEnabled = unsafePerformIO$ newIORef$ False
-- |Âðåìÿ íà÷àëà îòñ÷¸òà òåêóùåãî èíäèàòîðà
indicator_start_real_secs = unsafePerformIO$ newIORef$ (0::Double)
-- |Ñèíõðîíèçàöèÿ äîñòóïà ê UI
syncUI = withMVar mvarSyncUI . const; mvarSyncUI = unsafePerformIO$ newMVar "mvarSyncUI"
{-# NOINLINE indicators #-}
-- |Ïåðåìåííûå äëÿ ðàçáóæèâàíèÿ òðåäîâ èíäèêàöèè
indicators = unsafePerformIO$ newMVar$ ([]::[MVar Message]) -- list of indicator threads
type Message = (Update, IO()) -- message sent to indicator thread in order to make an update
data Update = ForceUpdate | LazyUpdate deriving (Eq) -- ForceUpdate message requesting whole update sent after (de)compression has been finished
-- |Ïðèíóäèòåëüíî îáíîâèòü âñå èíäèêàòîðû
updateAllIndicators = do
indicators' <- val indicators
for indicators' $ \indicator -> do
x <- newEmptyMVar
putMVar indicator (ForceUpdate, putMVar x ())
takeMVar x
-- |Âûïîëíÿòü â áýêãðàóíäå action êàæäûå secs ñåêóíä
backgroundThread secs action = do
x <- newEmptyMVar
indicators ++= [x] -- äîáàâëåíèå â ýòîò ñïèñîê ïîçâîëÿåò òàêæå îáíîâëÿòü èíäèêàòîðû "èçâíå"
forkIO $ do
foreverM $ do
sleepSeconds secs
putMVar x (LazyUpdate, doNothing0)
forkIO $ do
foreverM $ do
(updateMode, afterAction) <- takeMVar x
syncUI $ do
action updateMode
afterAction
-- |Òðåä, ñëåäÿùèé çà indicator, è âûâîäÿùèé âðåìÿ îò âðåìåíè åãî îáíîâë¸ííûå çíà÷åíèÿ
indicatorThread secs output =
backgroundThread secs $ \updateMode -> do
whenM (val aProgressIndicatorEnabled) $ do
operationTerminated' <- val operationTerminated
(indicator, indType, arcname, winTitleMsg, bRational :: Rational, bytes', total') <- val aProgressIndicatorState
let b = round bRational -- we use Rational in order to save decimal fractions (results of 90%/10% counting rule)
when (indicator /= NoIndicator && not operationTerminated') $ do
bytes <- bytes' b; total <- total'
bytes <- return (bytes `min` total) -- bytes íå äîëæíî ïðåâûøàòü total
-- Îòíîøåíèå îáú¸ìà îáðàáîòàííûõ äàííûõ ê îáùåìó îáú¸ìó
let processed | total>0 = fromIntegral bytes / fromIntegral total :: Double
| otherwise = 1 -- "Processed 0 bytes of 0 == 100%"
secs <- return_real_secs
sec0 <- val indicator_start_real_secs
let remains = if processed>0.001 then " "++showHMS(sec0+(secs-sec0)/processed-secs) else ""
winTitle = trimLeft p++remains++" | " ++ (format winTitleMsg (takeFileName arcname))
p = percents indicator bytes total
output updateMode indicator indType winTitle b bytes total processed p
{-# NOINLINE updateAllIndicators #-}
{-# NOINLINE backgroundThread #-}
{-# NOINLINE indicatorThread #-}
----------------------------------------------------------------------------------------------------
---- Èíäèêàòîð ïðîãðåññà ---------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Òèïû èíäèêàòîðà ïðîãðåññà (ìîë÷àëèâûé, ïðîöåíòû, äåñÿòûå ïðîöåíòà)
data Indicator = NoIndicator | ShortIndicator | LongIndicator deriving (Eq)
bytes_per_sec = 10*mb -- Typical (de)compression speed
-- |Âûáðàòü èíäèêàòîð ïðîãðåññà, îñíîâûâàÿñü íà ïîêàçàíèÿõ ñâèäåòåëåé :)
select_indicator command total_bytes = case (opt_indicator command)
of "0" -> NoIndicator -- îïöèÿ "-i" - îòêëþ÷èòü èíäèêàòîð!
_ | i total_bytes < bytes_per_sec*100 -> ShortIndicator -- èíäèêàòîð â ïðîöåíòàõ, åñëè îáùèé îáú¸ì äàííûõ ìåíüøå 1000 ìá (ïðè ýòîì â ñåêóíäó îáðàáàòûâàåòñÿ áîëüøå îäíîãî ïðîöåíòà äàííûõ)
| otherwise -> LongIndicator -- èíäèêàòîð â äåñÿòûõ äîëÿõ ïðîöåíòà, åñëè äàííûõ áîëüøå 1000 ìá
-- |Âûâåñòè èíäèêàòîð ïðîãðåññà â ñîîòâåòñòâèè ñ âûáðàííîé òî÷íîñòüþ
percents NoIndicator current total = ""
percents ShortIndicator current total = right_justify 3 (ratio2 current total) ++ "%"
percents LongIndicator current total = right_justify 5 (ratio3 current total) ++ "%"
-- |Ñîçäàòü ìåñòî äëÿ èíäèêàòîðà ïðîãðåññà
open_percents = flip replicate ' ' . indicator_len
-- |Âåðíóòüñÿ íàçàä íà ñòîëüêî ñèìâîëîâ, ñêîëüêî çàíèìàåò èíäèêàòîð ïðîãðåññà
back_percents = flip replicate '\b' . indicator_len
-- |Íàïå÷àòàòü ïðîáåëû ïîâåðõ èñïîëüçîâàâøåãîñÿ èíäèêàòîðà ïðîãðåññà
clear_percents i = back_percents i ++ open_percents i
-- |Ðàçìåð èíäèêàòîðà ïðîãðåññà â ñèìâîëàõ
indicator_len NoIndicator = 0
indicator_len ShortIndicator = 4
indicator_len LongIndicator = 6
-- |Format percent ratio with 2 digits
ratio2 count 0 = "100" -- "Processed 0 bytes of 0 == 100%"
ratio2 count total = show$ ((toInteger count)*100) `div` (toInteger total)
-- |Format percent ratio with 2+1 digits
ratio3 count 0 = "100.0" -- "Processed 0 bytes of 0 == 100%"
ratio3 count total = case (show$ ((toInteger count)*1000) `div` (toInteger total)) of
[digit] -> "0." ++ [digit]
digits -> init digits ++ ['.', last digits]
-- |Format percent ratio with 2+2 digits
ratio4 count 0 = "100.00" -- "Processed 0 bytes of 0 == 100%"
ratio4 count total = case (show$ ((toInteger count)*10000) `div` (toInteger total)) of
[digit] -> "0.0" ++ [digit]
[digit1,digit2] -> "0." ++ [digit1,digit2]
digits -> dropEnd 2 digits ++ "." ++ lastElems 2 digits
-- |Format percent ratio with 2+2 digits and rounding
compression_ratio count 0 = "100%" -- "Processed 0 bytes of 0 == 100%"
compression_ratio count total = showFFloat (Just 2) ((i count)/(i total)*100::Double) "%"
-- |Âûâåñòè ÷èñëî, îòäåëÿÿ òûñÿ÷è, ìèëëèîíû è ò.ä.: "1.234.567"
show3 :: (Show a) => a -> [Char]
show3 = reverse.xxx.reverse.show
where xxx (a:b:c:d:e) = a:b:c:',': xxx (d:e)
xxx a = a
{-# NOINLINE ratio2 #-}
{-# NOINLINE ratio3 #-}
{-# NOINLINE ratio4 #-}
{-# NOINLINE compression_ratio #-}
{-# NOINLINE show3 #-}
----------------------------------------------------------------------------------------------------
---- Âñïîìîãàòåëüíûå ôóíêöèè äëÿ ôîðìàòèðîâàíèÿ ÷èñåë/ñòðîê è ðàáîòû ñ âðåìåíåì --------------------
----------------------------------------------------------------------------------------------------
-- |Ðàçíèöà ìåæäó äâóìÿ âðåìåíàìè â ñåêóíäàõ - èñïîëüçóåò îñîáåííîñòè âíóòðåííåãî ïðåäñòàâëåíèÿ!!!
diffTimes (TOD sa pa) (TOD sb pb) = i(sa - sb) + (i(pa-pb) / 1e12)
-- |Äîáàâèòü ñåêóíäû ê âðåìåíè
addTime (TOD sa pa) secs = TOD (sa+sb+sc) pc
where
sb = i$ floor secs
pb = round$ (secs-sb)*1e12
(sc,pc) = (pa+pb) `divMod` (10^12)
-- |Âîçâðàòèòü âðåìÿ â þíèêñîâîì ôîðìàå (ñåêóíä áîã çíàåò ñ êàêîãî âðåìåíè)
getUnixTime = do
(TOD seconds picoseconds) <- getClockTime
return seconds
-- |Íàïå÷àòàòü îáú¸ì èñõîäíûõ è óïàêîâàííûõ äàííûõ, è ñòåïåíü ñæàòèÿ
show_ratio cmd bytes cbytes =
"" ++ show3 (if (cmdType cmd == ADD_CMD) then bytes else cbytes) ++
" => " ++ show_bytes3 (if (cmdType cmd == ADD_CMD) then cbytes else bytes) ++ ". " ++
"Ratio " ++ compression_ratio cbytes bytes
-- |Âîçâðàòèòü ñòðîêó, îïèñûâàþùóþ çàäàííîå âðåìÿ
showTime secs = showFFloat (Just 2) secs " sec"
-- |Âîçâðàòèòü ñòðîêó, îïèñûâàþùóþ çàäàííóþ ñêîðîñòü
showSpeed bytes secs = showFFloat (Just 2) (i bytes/secs/10^6) " mB/s"
-- |Îòôîðìàòèðîâàòü âðåìÿ êàê H:MM:SS
showHMS secs = show hour++":"++left_fill '0' 2 (show min)++":"++left_fill '0' 2 (show sec)
where
s = round secs
sec = (s `mod` 60)
min = (s `div` 60) `mod` 60
hour= (s `div` 3600)
-- |Îòìåòèòü âðåìÿ, êîãäà áûëà äîñòèãíóòà îïðåäåë¸ííàÿ òî÷êà ïðîãðàììû (÷èñòî äëÿ âíóòðåííèõ áåí÷ìàðêîâ)
debugLog label = do
condPrintLine "$" $ label -- âû÷èñëèì label è íàïå÷àòàåì å¸ çíà÷åíèå
real_secs <- return_real_secs
condPrintLineLn "$" $ ": " ++ showTime real_secs
-- |Âûâåñòè èíôîðìàöèþ î ñïèñêå, åñëè îí ñîäåðæèò êàê ìèíèìóì äâà ýëåìåíòà
debugLogList label list = do
drop 1 list &&& debugLog (format label (show3$ length list))
-- |Äîáàâèòü ñòðî÷êó â îòëàäî÷íûé âûâîä ïðîãðàììû
debugLog0 = condPrintLineLn "$"
-- |Âðåìÿ, ðåàëüíî ïðîøåäøåå ñ íà÷àëà âûïîëíåíèÿ êîìàíäû íàä òåêóùèì àðõèâîì
return_real_secs = do
start_time <- val refStartArchiveTime
current_time <- getClockTime
return$ diffTimes current_time start_time
pause_real_secs = do
refStartPauseTime =:: getClockTime
resume_real_secs = do
start_time <- val refStartPauseTime
current_time <- getClockTime
let pause = diffTimes current_time start_time :: Double
refStartArchiveTime .= (`addTime` pause)
-- |Âû÷èòàåò âðåìÿ, ïðîâåä¸ííîå â ïàóçå, èç ðåàëüíîãî âðåìåíè âûïîëíåíèÿ êîìàíäû
pauseTiming = bracket_ pause_real_secs resume_real_secs
-- |Íà âðåìÿ ïåðåâîäèò Win7+ èíäèêàòîð ïðîãðåññà â ñîñòîÿíèå ïàóçû
pauseTaskbar = bracket_ taskbar_Pause taskbar_Resume
{-# NOINLINE diffTimes #-}
{-# NOINLINE show_ratio #-}
{-# NOINLINE debugLog #-}
----------------------------------------------------------------------------------------------------
---- Âûáîð ñîîáùåíèé, ñîîòâåòñòâóþùèõ âûïîëíÿåìîé êîìàíäå ------------------------------------------
----------------------------------------------------------------------------------------------------
msgStart cmd arcExist =
case (cmdType cmd, arcExist) of
(ADD_CMD, False) -> "Creating archive: "
(ADD_CMD, True) -> "Updating archive: "
(LIST_CMD, _) -> "Listing archive: "
(TEST_CMD, _) -> "Testing archive: "
(EXTRACT_CMD, _) -> "Extracting archive: "
(RECOVER_CMD, _) -> "Recovering archive: "
msgStartGUI cmd arcExist =
case (cmd, cmdType cmd, arcExist) of
("ch", _, _) -> "0433 Modifying %1"
("j", _, _) -> "0240 Joining archives to %1"
("d", _, _) -> "0435 Deleting from %1"
("k", _, _) -> "0300 Locking %1"
(_, ADD_CMD, False) -> "0437 Creating %1"
(_, ADD_CMD, True) -> "0438 Updating %1"
(_, LIST_CMD, _) -> "0439 Listing %1"
(_, TEST_CMD, _) -> "0440 Testing %1"
(_, EXTRACT_CMD, _) -> "0441 Extracting from %1"
(_, RECOVER_CMD, _) -> "0382 Repairing %1"
msgFinishGUI cmd arcExist warnings@0 =
case (cmd, cmdType cmd, arcExist) of
("ch", _, _) -> "0238 SUCCESFULLY MODIFIED %1"
("j", _, _) -> "0241 SUCCESFULLY JOINED ARCHIVES TO %1"
("d", _, _) -> "0229 FILES WERE SUCCESFULLY DELETED FROM %1"
("k", _, _) -> "0301 SUCCESFULLY LOCKED %1"
(_, ADD_CMD, False) -> "0443 SUCCESFULLY CREATED %1"
(_, ADD_CMD, True) -> "0444 SUCCESFULLY UPDATED %1"
(_, LIST_CMD, _) -> "0445 SUCCESFULLY LISTED %1"
(_, TEST_CMD, _) -> "0232 SUCCESFULLY TESTED %1"
(_, EXTRACT_CMD, _) -> "0235 FILES WERE SUCCESFULLY EXTRACTED FROM %1"
(_, RECOVER_CMD, _) -> "0383 SUCCESFULLY REPAIRED %1"
msgFinishGUI cmd arcExist warnings =
case (cmd, cmdType cmd, arcExist) of
("ch", _, _) -> "0239 %2 WARNINGS WHILE MODIFYING %1"
("j", _, _) -> "0242 %2 WARNINGS WHILE JOINING ARCHIVES TO %1"
("d", _, _) -> "0230 %2 WARNINGS WHILE DELETING FROM %1"
("k", _, _) -> "0302 %2 WARNINGS WHILE LOCKING %1"
(_, ADD_CMD, False) -> "0434 %2 WARNINGS WHILE CREATING %1"
(_, ADD_CMD, True) -> "0436 %2 WARNINGS WHILE UPDATING %1"
(_, LIST_CMD, _) -> "0442 %2 WARNINGS WHILE LISTING %1"
(_, TEST_CMD, _) -> "0233 %2 WARNINGS WHILE TESTING %1"
(_, EXTRACT_CMD, _) -> "0236 %2 WARNINGS WHILE EXTRACTING FILES FROM %1"
(_, RECOVER_CMD, _) -> "0384 %2 WARNINGS WHILE REPAIRING %1"
msgDo cmd = case (cmdType cmd) of
ADD_CMD -> "0480 Compressing %1"
TEST_CMD -> "0481 Testing %1"
EXTRACT_CMD -> "0482 Extracting %1"
msgSkipping = "0483 Skipping %1"
msgDone cmd = case (cmdType cmd) of
ADD_CMD -> "Compressed "
TEST_CMD -> "Tested "
EXTRACT_CMD -> "Extracted "
msgStat cmd = case (cmdType cmd) of
ADD_CMD -> "Compression "
TEST_CMD -> "Testing "
EXTRACT_CMD -> "Extraction "
-- |Íàïå÷àòàòü "file" èëè "files", â çàâèñèìîñòè îò êîë-âà
show_files3 1 = "1 file"
show_files3 n = show3 n ++ " files"
-- |Íàïå÷àòàòü "archive" èëè "archives", â çàâèñèìîñòè îò êîë-âà
show_archives3 1 = "1 archive"
show_archives3 n = show3 n ++ " archives"
-- |Íàïå÷àòàòü "byte" èëè "bytes", â çàâèñèìîñòè îò êîë-âà
show_bytes3 1 = "1 byte"
show_bytes3 n = show3 n ++ " bytes"
----------------------------------------------------------------------------------------------------
----- External functions ---------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Win7+ taskbar: display progress indicator
foreign import ccall safe "Compression/Common.h Taskbar_SetWindowProgressValue"
taskbar_SetWindowProgressValue :: Ptr () -> Word64 -> Word64 -> IO ()
foreign import ccall safe "Compression/Common.h Taskbar_SetProgressValue"
taskbar_SetProgressValue :: Word64 -> Word64 -> IO ()
-- |Win7+ taskbar: normal-state progress indicator
foreign import ccall safe "Compression/Common.h Taskbar_Normal"
taskbar_Normal :: IO ()
-- |Win7+ taskbar: error-state progress indicator
foreign import ccall safe "Compression/Common.h Taskbar_Error"
taskbar_Error :: IO ()
-- |Win7+ taskbar: pause progress indicator
foreign import ccall safe "Compression/Common.h Taskbar_Pause"
taskbar_Pause :: IO ()
-- |Win7+ taskbar: restore progress indicator after pause
foreign import ccall safe "Compression/Common.h Taskbar_Resume"
taskbar_Resume :: IO ()
-- |Win7+ taskbar: remove progress indicator
foreign import ccall safe "Compression/Common.h Taskbar_Done"
taskbar_Done :: IO ()
#ifdef FREEARC_WIN
-- |Returns Windows HWND of top-level window having the provided title
foreign import ccall safe "Compression/Common.h FindWindowHandleByTitle"
findWindowHandleByTitle :: Ptr CChar -> IO (Ptr ())
#endif
{-
Ñòðóêòóðà UI:
- îäèí ïðîöåññ, ïîëó÷àþùèé èíôîðìàöèþ îò óïàêîâêè/ðàñïàêîâêè è îïðåäåëÿþùèé ñòðóêòóðó âçàèìîäåéñòâèÿ ñ UI:
ui_PROCESS pipe = do
(StartCommand cmd) <- receiveP pipe
(StartArchive cmd) <- receiveP pipe
(StartFile fi fi) <- receiveP pipe
(UnpackedData n) <- receiveP pipe
(CompressedData n) <- receiveP pipe
(EndArchive) <- receiveP pipe
(EndCommand) <- receiveP pipe
(EndProgram) <- receiveP pipe
Ýòîò ïðîöåññ çàïèñûâàåò òåêóùåå ñîñòîÿíèå UI â SampleVar
-}