DLLUI.hs

{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- Èíôîðìèðîâàíèå ïîëüçîâàòåëÿ î õîäå âûïîëíåíèÿ ïðîãðàììû (CUI - Console User Interface).  ------
----------------------------------------------------------------------------------------------------
module DLLUI 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_WIN
import System.Win32.Types
#endif
#ifdef FREEARC_UNIX
import System.Posix.IO
import System.Posix.Terminal
#endif

import TABI
import Utils
import Charsets
import Errors
import Files
import FileInfo
import Options
import UIBase


-- |Íà÷àòü âûïîëíåíèå ïðîãðàììû
guiStartProgram = do
  errorHandlers   =: [\msg -> gui_callback "error"   [Pair "message" (W msg)]]
  warningHandlers =: [\msg -> gui_callback "warning" [Pair "message" (W msg)]]
  return ()

-- |Âûçûâàåòñÿ â íà÷àëå îáðàáîòêè àðõèâà
guiStartArchive = doNothing0

-- |Îòìåòèòü íà÷àëî óïàêîâêè èëè ðàñïàêîâêè äàííûõ
guiStartProcessing = do
  ui_state <- val ref_ui_state
  gui_callback "total"    [ Pair "files"       (total_files ui_state)
                          , Pair "original"    (total_bytes ui_state)]

-- |Íà÷àëî ñëåäóþùåãî òîìà àðõèâà
guiStartVolume filename = do
  gui_callback "volume"   [ Pair "filename"    (W filename)]

-- |Âûçûâàåòñÿ â íà÷àëå îáðàáîòêè ôàéëà
guiStartFile = do
  (msg,filename)  <- val uiMessage
  gui_callback "file"     [ Pair "message"     (W msg)
                          , Pair "filename"    (W filename)]

-- |Òåêóùèé îáú¸ì èñõîäíûõ/ñæàòûõ äàííûõ
guiUpdateProgressIndicator = do
  ui_state <- val ref_ui_state
  gui_callback "progress" [ Pair "original"    (bytes  ui_state)
                          , Pair "compressed"  (cbytes ui_state)]

-- |Ïðèîñòàíîâèòü âûâîä èíäèêàòîðà ïðîãðåññà è ñòåðåòü åãî ñëåäû
uiSuspendProgressIndicator = doNothing0

-- |Âîçîáíîâèòü âûâîä èíäèêàòîðà ïðîãðåññà è âûâåñòè åãî òåêóùåå çíà÷åíèå
uiResumeProgressIndicator = doNothing0

-- |Ñäåëàòü ïàóçó â âûïîëíåíèè ïðîãðàììû
guiPauseAtEnd = doNothing0

-- |Çàâåðøèòü âûïîëíåíèå ïðîãðàììû
guiDoneProgram = doNothing0


----------------------------------------------------------------------------------------------------
---- Çàïðîñû ê ïîëüçîâàòåëþ ("Ïåðåçàïèñàòü ôàéë?" è ò.ï.) ------------------------------------------
----------------------------------------------------------------------------------------------------

-- |Çàïðîñ î ïåðåçàïèñè ôàéëà
askOverwrite diskname _ _ arcfile  =  ask (diskname,arcfile)
{-# NOINLINE askOverwrite #-}

-- |Îáùèé ìåõàíèçì äëÿ âûäà÷è çàïðîñîâ ê ïîëüçîâàòåëþ
ask question ref_answer answer_on_u =  do
  old_answer <- val ref_answer
  new_answer <- case old_answer of
                  "a" -> return old_answer
                  "u" -> return old_answer
                  "s" -> return old_answer
                  _   -> ask_user question
  ref_answer =: new_answer
  case new_answer of
    "u" -> return answer_on_u
    _   -> return (new_answer `elem` ["y","a"])

-- |Ñîáñòâåííî îáùåíèå ñ ïîëüçîâàòåëåì ïðîèñõîäèò çäåñü
ask_user (diskname,fi) = do
  answer <- gui_callback_with_result "can_be_extracted?"   [ Pair "diskname"       (W diskname)
                                                           , Pair "filename"       (W$ storedName fi)
                                                           , Pair "original"       (fiSize fi)
                                                           , Pair "compressed"     (0::Int)
                                                           , Pair "time"           (fromEnum$ fiTime fi)
                                                           , Pair "attr"           (fiAttr fi)
                                                           , Pair "is_folder?"     (fiIsDir fi)
                                                           , Pair "crc"            (0::Int)
                                                           , Pair "is_encrypted?"  (False)
                                                           ]
  return [chr answer]


----------------------------------------------------------------------------------------------------
---- Çàïðîñ ïàðîëåé --------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

ask_passwords = (ask_encryption_password, ask_decryption_password, bad_decryption_password)

-- |Ïå÷àòàåò ñîîáùåíèå î òîì, ÷òî ââåä¸ííûé ïàðîëü íå ïîäõîäèò äëÿ äåøèôðîâàíèÿ
bad_decryption_password = doNothing0

-- |Çàïðîñ ïàðîëÿ ïðè ñæàòèè. Èñïîëüçóåòñÿ íåâèäèìûé ââîä
-- è çàïðîñ ïîâòîðÿåòñÿ äâàæäû äëÿ èñêëþ÷åíèÿ îøèáêè ïðè åãî ââîäå
ask_encryption_password opt_parseData = do
  return ""

-- |Çàïðîñ ïàðîëÿ äëÿ ðàñïàêîâêè. Èñïîëüçóåòñÿ íåâèäèìûé ââîä
ask_decryption_password opt_parseData = do
  let size=1000::Int
  allocaBytes (size*2) $ \ptr -> do
  gui_callback "ask_password"   [ Pair "password_buf"  ptr
                                , Pair "password_size" size]
  peekCWString ptr

uiPrintArcComment arcComment = doNothing0

-- |Ââåñòè ñ stdin êîììåíòàðèé ê àðõèâó
uiInputArcComment old_comment = do
  return ""

resetConsoleTitle = doNothing0



gui_callback_with_result request params = do
  callback <- val var_gui_callback
  TABI.call callback (Pair "request" request : params)

gui_callback request params  =  gui_callback_with_result request params >> return ()

var_gui_callback = unsafePerformIO$ newIORef (error "undefined DLLUI::var_callback")      :: IORef TABI.C_FUNCTION