%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
module TexEditor.Dialogs( dialogBuilders, EdDialog(..)
                        , ApplyAction, PreviewAction, UpdateAction ) 
    where
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
import Graphics.UI.Gtk.Glade( GladeXML, xmlGetWidget )
import Graphics.UI.Gtk.Display.Image( Image )
import Graphics.UI.Gtk.Abstract.Range
    ( Range, castToRange, rangeGetValue, rangeSetValue )
import Graphics.UI.Gtk.MenuComboToolbar.ComboBox
    ( ComboBox, castToComboBox, comboBoxSetActive, comboBoxGetActive
    , comboBoxSetModelText, comboBoxAppendText )
import Graphics.HDemo.TexGen
    ( TextureTree(..), ChannelTree(..), ChannelOp(..), generateTexture )
import Graphics.HDemo.Utils( fractionToWord16 )
import Data.Tree( Forest )
import TexEditor.Data
    ( TreeModelRow(..), EdTextureNode(..), EdChannelName(..), EdNodeType(..)
    , defaultTextureTreeNode )
import TexEditor.Utils( putTexture, modelRowToChannel )
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
textureFromChannel :: EdChannelName -> ChannelTree -> TextureTree
textureFromChannel ECN_RED c = TexTree 256 256 [] c (COLOR 0) (COLOR 0)
textureFromChannel ECN_GREEN c = TexTree 256 256 [] (COLOR 0) c (COLOR 0)
textureFromChannel ECN_BLUE c = TexTree 256 256 [] (COLOR 0) (COLOR 0) c
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
data EdDialog = EDIALOG { edApply :: ApplyAction
                        , edPreview :: PreviewAction
                        , edUpdate :: UpdateAction }
type PreviewAction = Forest TreeModelRow -> Image -> EdChannelName -> IO () 
type ApplyAction = IO TreeModelRow
type UpdateAction = TreeModelRow -> IO ()
type DialogBuilder = GladeXML -> IO EdDialog
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
emptyDialog :: EdDialog
emptyDialog = EDIALOG
              (do ; print "Apply Action" ; return $ defaultTextureTreeNode ENT_COLOR) 
              (\_ _ _-> print "Preview Action") 
              (\_-> print "Update Action")
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
colorDialog :: DialogBuilder
colorDialog xml = do
  colorbar <- xmlGetWidget xml castToRange "pColor_bar"
  return $ emptyDialog 
             { edApply = colorDialogApply colorbar
             , edPreview = colorDialogPreview colorbar
             , edUpdate = colorDialogUpdate colorbar }
\end{code}

\begin{code}
colorDialogApply :: Range -> ApplyAction
colorDialogApply bar = do
  color <- fmap round $ rangeGetValue bar
  return $ TMRow ENT_COLOR True (EN_BASIC (COLOR color))
\end{code}

\begin{code}
colorDialogPreview :: Range -> PreviewAction
colorDialogPreview bar _ image channel = do
  color <- fmap round $ rangeGetValue bar
  putTexture image . generateTexture 
                 $ textureFromChannel channel (COLOR color)
\end{code}

\begin{code}
colorDialogUpdate :: Range -> UpdateAction
colorDialogUpdate bar (TMRow ENT_COLOR _ (EN_BASIC (COLOR color))) = do
  rangeSetValue bar $ fromIntegral color
colorDialogUpdate _ _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
randcolDialog :: DialogBuilder
randcolDialog xml = do
  randbar <- xmlGetWidget xml castToRange "pRandom_value"
  return $ emptyDialog 
             { edApply = randcolDialogApply randbar
             , edPreview = randcolDialogPreview randbar
             , edUpdate = randcolDialogUpdate randbar }
\end{code}

\begin{code}
randcolDialogApply :: Range -> ApplyAction
randcolDialogApply bar = do
  seed <- fmap round $ rangeGetValue bar
  return $ TMRow ENT_RANDCOL True (EN_BASIC (RANDCOL seed))
\end{code}

\begin{code}
randcolDialogPreview :: Range -> PreviewAction
randcolDialogPreview bar _ image channel = do
  seed <- fmap round $ rangeGetValue bar
  putTexture image . generateTexture 
                 $ textureFromChannel channel (RANDCOL seed)
\end{code}

\begin{code}
randcolDialogUpdate :: Range -> UpdateAction
randcolDialogUpdate bar (TMRow ENT_RANDCOL _ (EN_BASIC (RANDCOL seed))) = do
  rangeSetValue bar $ fromIntegral seed
randcolDialogUpdate _ _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
sineplasmaDialog :: DialogBuilder
sineplasmaDialog xml = do
  numx <- xmlGetWidget xml castToRange "pSinePlasma_numx"
  numy <- xmlGetWidget xml castToRange "pSinePlasma_numy"
  return $ emptyDialog 
             { edApply = sineplasmaDialogApply numx numy
             , edPreview = sineplasmaDialogPreview numx numy 
             , edUpdate = sineplasmaDialogUpdate numx numy }
\end{code}

\begin{code}
sineplasmaDialogApply :: Range -> Range -> ApplyAction
sineplasmaDialogApply barx bary = do
  nx <- fmap round $ rangeGetValue barx
  ny <- fmap round $ rangeGetValue bary
  return $ TMRow ENT_SINEPLASMA True (EN_BASIC (SINEPLASMA nx ny))
\end{code}

\begin{code}
sineplasmaDialogPreview :: Range -> Range -> PreviewAction
sineplasmaDialogPreview barx bary _ image channel = do
  nx <- fmap round $ rangeGetValue barx
  ny <- fmap round $ rangeGetValue bary
  putTexture image . generateTexture 
                 $ textureFromChannel channel (SINEPLASMA nx ny)
\end{code}

\begin{code}
sineplasmaDialogUpdate :: Range -> Range -> UpdateAction
sineplasmaDialogUpdate barx bary (TMRow ENT_SINEPLASMA _
                                  (EN_BASIC (SINEPLASMA x y))) = do
  rangeSetValue barx $ fromIntegral x
  rangeSetValue bary $ fromIntegral y
sineplasmaDialogUpdate _ _ _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
fracplasmaDialog :: DialogBuilder
fracplasmaDialog xml = do
  randbar <- xmlGetWidget xml castToRange "pFracPlasma_seed"
  nbar <- xmlGetWidget xml castToRange "pFracPlasma_iters"
  return $ emptyDialog 
             { edApply = fracplasmaDialogApply randbar nbar
             , edPreview = fracplasmaDialogPreview randbar nbar 
             , edUpdate = fracplasmaDialogUpdate randbar nbar }
\end{code}

\begin{code}
fracplasmaDialogApply :: Range -> Range -> ApplyAction
fracplasmaDialogApply sbar nbar = do
  seed <- fmap round $ rangeGetValue sbar
  n <- fmap round $ rangeGetValue nbar
  return $ TMRow ENT_FRACPLASMA True (EN_BASIC (FRACPLASMA seed n))
\end{code}

\begin{code}
fracplasmaDialogPreview :: Range -> Range -> PreviewAction
fracplasmaDialogPreview sbar nbar _ image channel = do
  seed <- fmap round $ rangeGetValue sbar
  n <- fmap round $ rangeGetValue nbar
  putTexture image . generateTexture 
                 $ textureFromChannel channel (FRACPLASMA seed n)
\end{code}

\begin{code}
fracplasmaDialogUpdate :: Range -> Range -> UpdateAction
fracplasmaDialogUpdate sbar nbar (TMRow ENT_FRACPLASMA _
                                  (EN_BASIC (FRACPLASMA seed n))) = do
  rangeSetValue sbar $ fromIntegral seed
  rangeSetValue nbar $ fromIntegral n
fracplasmaDialogUpdate _ _ _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
distanceDialog :: DialogBuilder
distanceDialog _ = return $ emptyDialog 
                   { edPreview = distanceDialogPreview }
\end{code}

\begin{code}
distanceDialogPreview :: PreviewAction
distanceDialogPreview _ image channel = do
  putTexture image . generateTexture 
                 $ textureFromChannel channel (DISTANCE 128 128 128)
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
catromDialog :: DialogBuilder
catromDialog xml = do
  randbar <- xmlGetWidget xml castToRange "pCatrom_seed"
  nbar <- xmlGetWidget xml castToRange "pCatrom_value"
  return $ emptyDialog 
             { edApply = catromDialogApply randbar nbar
             , edPreview = catromDialogPreview randbar nbar
             , edUpdate = catromDialogUpdate randbar nbar}
\end{code}

\begin{code}
catromDialogApply :: Range -> Range -> ApplyAction
catromDialogApply sbar nbar = do
  seed <- fmap round $ rangeGetValue sbar
  n <- fmap round $ rangeGetValue nbar
  return $ TMRow ENT_CATROM True (EN_BASIC (CATROM seed n))
\end{code}

\begin{code}
catromDialogPreview :: Range -> Range -> PreviewAction
catromDialogPreview sbar nbar _ image channel = do
  seed <- fmap round $ rangeGetValue sbar
  n <- fmap round $ rangeGetValue nbar
  putTexture image . generateTexture 
                 $ textureFromChannel channel (CATROM seed n)
\end{code}

\begin{code}
catromDialogUpdate :: Range -> Range -> UpdateAction
catromDialogUpdate sbar nbar (TMRow ENT_CATROM _ (EN_BASIC (CATROM seed n))) = do
  rangeSetValue sbar $ fromIntegral seed
  rangeSetValue nbar $ fromIntegral n
catromDialogUpdate _ _ _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
sinedistDialog :: DialogBuilder
sinedistDialog xml = do
  xbar <- xmlGetWidget xml castToRange "pSineDist_numx"
  ybar <- xmlGetWidget xml castToRange "pSineDist_numy"
  return $ emptyDialog 
             { edApply = sinedistDialogApply xbar ybar
             , edPreview = sinedistDialogPreview xbar ybar
             , edUpdate = sinedistDialogUpdate xbar ybar }
\end{code}

\begin{code}
sinedistDialogApply :: Range -> Range -> ApplyAction
sinedistDialogApply xbar ybar = do
  nx <- fmap round $ rangeGetValue xbar
  ny <- fmap round $ rangeGetValue ybar
  return $ TMRow ENT_SINEDIST True (EN_SINEDIST nx ny)
\end{code}

\begin{code}
sinedistDialogPreview :: Range -> Range -> PreviewAction
sinedistDialogPreview xbar ybar (x:[]) image channel = do
  nx <- fmap round $ rangeGetValue xbar
  ny <- fmap round $ rangeGetValue ybar
  putTexture image . generateTexture 
                 $ textureFromChannel channel 
                       (SINEDIST nx ny (modelRowToChannel x))
sinedistDialogPreview _ _ _ _ _ = error "invalid Texture Node"
\end{code}

\begin{code}
sinedistDialogUpdate :: Range -> Range -> UpdateAction
sinedistDialogUpdate xbar ybar (TMRow ENT_SINEDIST _ (EN_SINEDIST nx ny)) = do
  rangeSetValue xbar $ fromIntegral nx
  rangeSetValue ybar $ fromIntegral ny
sinedistDialogUpdate _ _ _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
mixfDialog :: DialogBuilder
mixfDialog xml = do
  opbox <- xmlGetWidget xml castToComboBox "pMixf_op"
  comboBoxSetModelText opbox
  mapM_ (comboBoxAppendText opbox) $ map show [ADDL ..]
  comboBoxSetActive opbox 0

  fbar <- xmlGetWidget xml castToRange "pMixf_factor"
  return $ emptyDialog
             { edApply = mixfDialogApply opbox fbar
             , edPreview = mixfDialogPreview opbox fbar
             , edUpdate = mixfDialogUpdate opbox fbar }
\end{code}

\begin{code}
mixfDialogApply :: ComboBox -> Range -> ApplyAction
mixfDialogApply opbox fbar = do
  i <- fmap toEnum $ comboBoxGetActive opbox
  factor <- fmap (/100) $ rangeGetValue fbar
  return $ TMRow ENT_MIXF True (EN_MIXF i factor)
\end{code}

\begin{code}
mixfDialogPreview :: ComboBox -> Range -> PreviewAction
mixfDialogPreview opbox fbar forest image channel = do
  i <- fmap toEnum $ comboBoxGetActive opbox
  factor <- fmap (fractionToWord16 . (/100)) $ rangeGetValue fbar
  putTexture image . generateTexture 
                 $ textureFromChannel channel (MIXF i factor la lb)
    where la = modelRowToChannel $ forest !! 0
          lb = modelRowToChannel $ forest !! 1
\end{code}

\begin{code}
mixfDialogUpdate :: ComboBox -> Range -> UpdateAction
mixfDialogUpdate opbox fbar (TMRow ENT_MIXF _ (EN_MIXF op factor)) = do
  comboBoxSetActive opbox $ fromEnum op
  rangeSetValue fbar (factor * 100)
mixfDialogUpdate _ _ _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
compDialog :: DialogBuilder
compDialog xml = do
  opbox <- xmlGetWidget xml castToComboBox "pComp_op"
  comboBoxSetModelText opbox
  mapM_ (comboBoxAppendText opbox) $ map show [ADDL ..]
  comboBoxSetActive opbox 0

  return $ emptyDialog
             { edApply = compDialogApply opbox
             , edPreview = compDialogPreview opbox
             , edUpdate = compDialogUpdate opbox }
\end{code}

\begin{code}
compDialogApply :: ComboBox -> ApplyAction
compDialogApply opbox = do
  i <- fmap toEnum $ comboBoxGetActive opbox
  return $ TMRow ENT_COMP True (EN_COMP i)
\end{code}

\begin{code}
compDialogPreview :: ComboBox -> PreviewAction
compDialogPreview opbox forest image channel = do
  i <- fmap toEnum $ comboBoxGetActive opbox
  putTexture image . generateTexture 
                 $ textureFromChannel channel (COMP i la lb)
    where la = modelRowToChannel $ forest !! 0
          lb = modelRowToChannel $ forest !! 1
\end{code}

\begin{code}
compDialogUpdate :: ComboBox -> UpdateAction
compDialogUpdate opbox (TMRow ENT_COMP _ (EN_COMP op)) = do
  comboBoxSetActive opbox $ fromEnum op
compDialogUpdate _ _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
filterDialog :: DialogBuilder
filterDialog _ = return $ emptyDialog
                 { edApply = filterDialogApply
                 , edPreview = filterDialogPreview
                 , edUpdate = filterDialogUpdate }
\end{code}

\begin{code}
filterDialogApply :: ApplyAction
filterDialogApply = do
  return $ TMRow ENT_FILTER True (EN_FILTER)
\end{code}

\begin{code}
filterDialogPreview :: PreviewAction
filterDialogPreview forest image channel = do
  putTexture image . generateTexture 
                 $ textureFromChannel channel (FILTER layer)
    where layer = modelRowToChannel $ forest !! 0
\end{code}

\begin{code}
filterDialogUpdate :: UpdateAction
filterDialogUpdate (TMRow ENT_FILTER _ (EN_FILTER)) = return ()
filterDialogUpdate _ = error "invalid Texture Node"
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
dialogBuilders :: [ DialogBuilder ]
dialogBuilders = [ colorDialog, randcolDialog, sineplasmaDialog
                 , fracplasmaDialog, distanceDialog, catromDialog
                 , sinedistDialog, mixfDialog, compDialog, filterDialog ]
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%