module Main where
import Graphics.UI.Gtk
import Data.Map as Map
import Control.Monad.Trans (liftIO)
import Data.IORef
import Data.Maybe
import Menu
import TextArea
import Control.Concurrent
main :: IO()
main = do
initGUI
splashScreen <- getSplashScreen
window <- windowNew
label <- labelNewWithMnemonic "Hi"
bufferIn <- textBufferNew Nothing
bufferOut <- textBufferNew Nothing
bufferStackFunc <- textBufferNew Nothing
bufferStackVar <- textBufferNew Nothing
labelIn <- labelNewWithMnemonic "Input:"
viewIn <- textViewNewWithBuffer bufferIn
labelOut <- labelNewWithMnemonic "Output:"
viewOut <- textViewNewWithBuffer bufferOut
labelStackFunc <- labelNewWithMnemonic "Functionstack"
viewStackFunc <- textViewNewWithBuffer bufferStackFunc
labelStackVar <- labelNewWithMnemonic "Variablestack"
viewStackVar <- textViewNewWithBuffer bufferStackVar
buttonPopUpIn <- buttonNewWithLabel ""
setButtonProps buttonPopUpIn
buttonPopUpOut <- buttonNewWithLabel ""
setButtonProps buttonPopUpOut
buttonPopUpStackF <- buttonNewWithLabel ""
setButtonProps buttonPopUpStackF
buttonPopUpStackV <- buttonNewWithLabel ""
setButtonProps buttonPopUpStackV
layout <- layoutNew Nothing Nothing
lwin <- scrolledWindowNew Nothing Nothing
scrolledWindowSetPolicy lwin PolicyAutomatic PolicyAutomatic
containerAdd lwin layout
textArea <- textAreaNew layout 10 10
onClicked buttonPopUpIn $ postGUIAsync $ textViewWindowShow bufferIn "Input"
onClicked buttonPopUpOut $ postGUIAsync $ textViewWindowShow bufferOut "Output"
onClicked buttonPopUpStackF $ postGUIAsync $ textViewWindowShow bufferStackFunc "Function-Stack"
onClicked buttonPopUpStackV $ postGUIAsync $ textViewWindowShow bufferStackVar "Variable-Stack"
hboxLabelButtonIn <- hBoxNew False 0
boxPackStart hboxLabelButtonIn labelIn PackNatural 1
boxPackEnd hboxLabelButtonIn buttonPopUpIn PackNatural 0
hboxLabelButtonOut <- hBoxNew False 0
boxPackStart hboxLabelButtonOut labelOut PackNatural 1
boxPackEnd hboxLabelButtonOut buttonPopUpOut PackNatural 0
hboxInfoLine <- hBoxNew False 0
modeLabel <- labelNew $ Just "Mode: Replace"
currentLabel <- labelNew $ Just "(0,0)"
boxPackEnd hboxInfoLine currentLabel PackNatural 3
boxPackStart hboxInfoLine modeLabel PackNatural 3
boxStackFunc <- vBoxNew False 0
hboxLabelButtonFunc <- hBoxNew False 0
boxPackStart hboxLabelButtonFunc labelStackFunc PackNatural 0
boxPackEnd hboxLabelButtonFunc buttonPopUpStackF PackNatural 10
boxPackStart boxStackFunc hboxLabelButtonFunc PackNatural 0
swinStackF <- scrolledWindowNew Nothing Nothing
scrolledWindowSetPolicy swinStackF PolicyAutomatic PolicyAutomatic
containerAdd swinStackF viewStackFunc
boxPackStart boxStackFunc swinStackF PackGrow 0
boxStackVar <- vBoxNew False 0
hboxLabelButtonVar <- hBoxNew False 0
boxPackStart hboxLabelButtonVar labelStackVar PackNatural 0
boxPackEnd hboxLabelButtonVar buttonPopUpStackV PackNatural 10
boxPackStart boxStackVar hboxLabelButtonVar PackNatural 0
swinStackV <- scrolledWindowNew Nothing Nothing
scrolledWindowSetPolicy swinStackV PolicyAutomatic PolicyAutomatic
containerAdd swinStackV viewStackVar
boxPackStart boxStackVar swinStackV PackGrow 0
boxStack <- hBoxNew True 0
boxPackStart boxStack boxStackFunc PackGrow 2
boxPackStart boxStack boxStackVar PackGrow 2
boxView <- vBoxNew False 0
boxLay <- hBoxNew False 0
boxPackStart boxView hboxLabelButtonIn PackNatural 2
swinIn <- scrolledWindowNew Nothing Nothing
scrolledWindowSetPolicy swinIn PolicyAutomatic PolicyAutomatic
containerAdd swinIn viewIn
boxPackStart boxView swinIn PackGrow 0
inSap <- hSeparatorNew
boxPackStart boxView inSap PackNatural 2
boxPackStart boxView hboxLabelButtonOut PackNatural 2
swinOut <- scrolledWindowNew Nothing Nothing
scrolledWindowSetPolicy swinOut PolicyAutomatic PolicyAutomatic
containerAdd swinOut viewOut
boxPackStart boxView swinOut PackGrow 1
outSap <- hSeparatorNew
boxPackStart boxView outSap PackNatural 2
boxPackStart boxView boxStack PackGrow 1
boxPackStart boxLay lwin PackGrow 1
vSep <- vSeparatorNew
boxPackStart boxLay vSep PackNatural 2
boxPackEnd boxLay boxView PackNatural 1
table <- tableNew 5 1 False
menuBar <- createMenu window textArea bufferOut
extraBar <- createExtraBar
vSepa <- hSeparatorNew
tableAttach table menuBar 0 1 0 1 [Fill] [Fill] 0 0
tableAttach table extraBar 0 1 1 2 [Fill] [Fill] 0 0
tableAttach table boxLay 0 1 2 3 [Expand,Fill] [Expand,Fill] 0 0
tableAttach table vSepa 0 1 3 4 [Fill] [Fill] 0 0
tableAttach table hboxInfoLine 0 1 4 5 [Fill] [Fill] 2 2
set window [containerChild := table, windowDefaultHeight := 550, windowDefaultWidth := 850, windowWindowPosition := WinPosCenter]
onDestroy window mainQuit
widgetShowAll window
widgetDestroy splashScreen
mainGUI
return ()
createExtraBar = do
extraBar <- menuBarNew
image <- imageNewFromStock stockExecute IconSizeMenu
run <- imageMenuItemNewWithLabel ""
imageMenuItemSetImage run image
menuShellAppend extraBar run
imageD <- imageNewFromStock stockGoForward IconSizeMenu
debugg <- imageMenuItemNewWithLabel ""
imageMenuItemSetImage debugg imageD
menuShellAppend extraBar debugg
mode <- menuNew
replaceMode <- radioMenuItemNewWithLabel "replace"
insertMode <- radioMenuItemNewWithLabelFromWidget replaceMode "insert"
smartMode <- radioMenuItemNewWithLabelFromWidget replaceMode "smart"
modeItem <- menuItemNewWithLabel "mode"
menuItemSetSubmenu modeItem mode
menuShellAppend extraBar modeItem
menuShellAppend mode replaceMode
menuShellAppend mode insertMode
menuShellAppend mode smartMode
return extraBar
setButtonProps button = do
image <- imageNewFromFile "full.png"
buttonSetImage button image
buttonSetImagePosition button PosRight
textViewWindowShow textBuffer title = do
window <- windowNew
windowSetDefaultSize window 400 300
windowSetPosition window WinPosCenter
swin <- scrolledWindowNew Nothing Nothing
scrolledWindowSetPolicy swin PolicyAutomatic PolicyAutomatic
textView <- textViewNewWithBuffer textBuffer
containerAdd swin textView
set window [containerChild := swin, windowTitle := title]
widgetShowAll window
return ()
getSplashScreen :: IO Window
getSplashScreen = do
splashScreen <- windowNew
set splashScreen [windowDefaultHeight := 200, windowDefaultWidth := 400, windowWindowPosition := WinPosCenter, windowTitle := "Starting Editor"]
windowSetDefaultSize splashScreen 400 200
windowSetPosition splashScreen WinPosCenter
layout <- layoutNew Nothing Nothing
label <- labelNewWithMnemonic "Rail Editor starting ..."
layoutPut layout label 30 30
set splashScreen [containerChild := layout]
widgetShowAll splashScreen
return splashScreen