-- Copyright 2006 mutantlemon.com

module GuiTests where

import Maybe(fromJust)
import qualified Control.Exception as C
import Data.IORef
import Data.Bits
import Control.Monad

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Glade

import WordUtil
import Machine
import Memory
import RomImage
import CpuExecution

type State = Maybe (((RegisterStates, Memory), IrqStates), Maybe HandlerId)

test01 :: IO ()
test01 = do
  initGUI

  windowXml <- C.catch
               ((xmlNew gladeFile) >>= return . fromJust)
               (\e -> putStrLn ("Error Loading " ++ gladeFile) >> C.throwIO e)

  return ()

  let bindWidget x y = xmlGetWidget windowXml x y
  window_main <- bindWidget castToWindow "window_main"
  menu_open <- bindWidget castToMenuItem "menu_open"
  menu_quit <- bindWidget castToMenuItem "menu_quit"
  menu_step <- bindWidget castToMenuItem "menu_step"
  menu_run <- bindWidget castToMenuItem "menu_run"
  menu_pause <- bindWidget castToMenuItem "menu_pause"
  button_open <- bindWidget castToToolButton "button_open"
  button_step <- bindWidget castToToolButton "button_step"
  button_run <- bindWidget castToToolButton "button_run"
  button_pause <- bindWidget castToToolButton "button_pause"
  reg_a <- bindWidget castToEntry "reg_a"
  reg_b <- bindWidget castToEntry "reg_b"
  reg_c <- bindWidget castToEntry "reg_c"
  reg_d <- bindWidget castToEntry "reg_d"
  reg_e <- bindWidget castToEntry "reg_e"
  reg_f <- bindWidget castToEntry "reg_f"
  reg_h <- bindWidget castToEntry "reg_h"
  reg_l <- bindWidget castToEntry "reg_l"
  reg_pc <- bindWidget castToEntry "reg_pc"
  reg_sp <- bindWidget castToEntry "reg_sp"
  flag_ime <- bindWidget castToCheckButton "flag_ime"
  flag_z <- bindWidget castToEntry "flag_z"
  flag_n <- bindWidget castToEntry "flag_n"
  flag_h <- bindWidget castToEntry "flag_h"
  flag_c <- bindWidget castToEntry "flag_c"
  reg_ie <- bindWidget castToEntry "reg_ie"
  reg_stat <- bindWidget castToEntry "reg_stat"
  dissassembler_textview <- bindWidget castToTextView "dissassembler_textview"

  state <- newIORef (Nothing::State)

  let setStepSensitivity s = mapM_ (`widgetSetSensitivity` s) [toWidget button_step, toWidget menu_step]
  let setRunSensitivity s = mapM_ (`widgetSetSensitivity` s) [toWidget button_run, toWidget menu_run]
  let setPauseSensitivity s = mapM_ (`widgetSetSensitivity` s) [toWidget button_pause, toWidget menu_pause]

  let updateRunCommandsSensitivity = do
        s <- readIORef state
        case s of
          Nothing -> do
                     setStepSensitivity False
                     setRunSensitivity False
                     setPauseSensitivity False
          Just (_, Nothing) -> do
                             setStepSensitivity True
                             setRunSensitivity True
                             setPauseSensitivity False
          Just (_, Just _) -> do
                            setStepSensitivity False
                            setRunSensitivity False
                            setPauseSensitivity True

  let updateDebugPanel = do
        s <- readIORef state
        case s of
          Nothing -> return ()
          Just (((regS, memS), irqS), _) -> do
            reg_a `entrySetText` showHex1 (getRegState regS M_A)
            reg_b `entrySetText` showHex1 (getRegState regS M_B)
            reg_c `entrySetText` showHex1 (getRegState regS M_C)
            reg_d `entrySetText` showHex1 (getRegState regS M_D)
            reg_e `entrySetText` showHex1 (getRegState regS M_E)
            reg_f `entrySetText` showHex1 (getRegState regS M_F)
            reg_h `entrySetText` showHex1 (getRegState regS M_H)
            reg_l `entrySetText` showHex1 (getRegState regS M_L)
            reg_pc `entrySetText` showHex2 (getReg2State regS M_PC)
            reg_sp `entrySetText` showHex2 (getReg2State regS M_SP)
            reg_ie `entrySetText` showHex1 (readMem memS 0xFFFF)
            reg_stat `entrySetText` showHex1 (readMem memS 0xFF41)
            flag_ime `toggleButtonSetActive` irqStateIME irqS
            flag_z `entrySetText` show (fromEnum (testBit (getRegState regS M_F) 7))
            flag_n `entrySetText` show (fromEnum (testBit (getRegState regS M_F) 6))
            flag_h `entrySetText` show (fromEnum (testBit (getRegState regS M_F) 5))
            flag_c `entrySetText` show (fromEnum (testBit (getRegState regS M_F) 4))
            
  let displayCurrentInstruction = do
        s <- readIORef state
        case s of
          Nothing -> return ()
          Just (((regS, memS), _), _) -> do
            let pc = getReg2State regS M_PC
            let instruction = fetchInstruction (regS, memS)
            let s = (showHex2 pc) ++ " " ++ (show instruction) ++ "\n"
            buffer <- textViewGetBuffer dissassembler_textview
            n <- textBufferGetLineCount buffer
            when (n > instructionHistoryCount)
                 (do iterStart <- textBufferGetStartIter buffer
                     iter1 <- textBufferGetIterAtLine buffer 1
                     textBufferDelete buffer iterStart iter1)
            endIter <- textBufferGetEndIter buffer
            textBufferInsert buffer endIter s

  let clearInstructionDisplay = do
        buffer <- textViewGetBuffer dissassembler_textview 
        startIter <- textBufferGetStartIter buffer
        endIter <- textBufferGetEndIter buffer
        textBufferDelete buffer startIter endIter

  let step = do
        modifyIORef state (\s -> case s of
                                   Nothing -> Nothing
                                   Just (m, b) -> Just (updateMachine m, b))
        updateDebugPanel
        displayCurrentInstruction

  let run = do
        handlerId <- idleAdd (replicateM_ 100 step >> return True) priorityDefaultIdle
        modifyIORef state (\s -> case s of
                                   Nothing -> Nothing
                                   Just (m, _) -> Just (m, Just handlerId))
        updateRunCommandsSensitivity

  let pause = do
        s <- readIORef state
        case s of
          Nothing -> return ()
          Just (_, Nothing) -> return ()
          Just (_, Just handlerId) -> idleRemove handlerId
        modifyIORef state (\s -> case s of
                                   Nothing -> Nothing
                                   Just (m, _) -> Just (m, Nothing))
        updateRunCommandsSensitivity

  let open = do
        fileSelect <- fileChooserDialogNew
                        (Just "Open Game Boy ROM")
                        (Just window_main)
                        FileChooserActionOpen
                        [("Open", ResponseOk), ("Cancel", ResponseDeleteEvent)]
        response <- dialogRun fileSelect
        action <- case response of
                    ResponseOk -> do
                      romFile <- fileChooserGetFilename fileSelect
                      return (do romImage <- loadRomImage (fromJust romFile)
                                 writeIORef state $ Just (((initialRegisterStates,
                                                           initMemory romImage),
                                                          initialIrqStates), Nothing))
                    ResponseDeleteEvent -> do
                      return $ return ()
        widgetDestroy fileSelect
        action
        updateRunCommandsSensitivity
        updateDebugPanel
        clearInstructionDisplay
        displayCurrentInstruction

  let quit = widgetDestroy window_main >> mainQuit

  menu_quit `onActivateLeaf` quit
  window_main `onDestroy` quit

  menu_open `onActivateLeaf` open
  button_open `onToolButtonClicked` open

  menu_step `onActivateLeaf` step
  button_step `onToolButtonClicked` step

  menu_run `onActivateLeaf` run
  button_run `onToolButtonClicked` run

  menu_pause `onActivateLeaf` pause
  button_pause `onToolButtonClicked` pause

  updateRunCommandsSensitivity

  mainGUI
  return ()

  where
    gladeFile = "guis/test01/test01.glade"
    instructionHistoryCount = 20