diff --git a/samples/test/STC.hs b/samples/test/STC.hs new file mode 100644 index 00000000..5d743963 --- /dev/null +++ b/samples/test/STC.hs @@ -0,0 +1,9 @@ + +import Graphics.UI.WX +import Graphics.UI.WXCore + +main = start $ do + f <- frame [text := "Scintilla Test"] + s <- styledTextCtrlCreate f 0 "bla" (Rect 0 0 500 500) 0 + styledTextCtrlInsertText s 0 "hello world!" + return () diff --git a/samples/test/STC2.hs b/samples/test/STC2.hs new file mode 100644 index 00000000..e4052f37 --- /dev/null +++ b/samples/test/STC2.hs @@ -0,0 +1,13 @@ + +import Graphics.UI.WX +import Graphics.UI.WXCore + +main = start $ do + f <- frame [text := "Scintilla Test"] + p <- panel f [] + s <- styledTextCtrlCreate f 0 "bla" (Rect 0 0 500 500) 0 + b <- button p [text:= "print text in console", + on command := styledTextCtrlGetText s >>= putStrLn] +{- set f [ layout := container p $ column 5 [ fill $ widget s, + hfill $ widget b], clientSize := sz 300 300]-} + return () diff --git a/samples/test/STCEvent.hs b/samples/test/STCEvent.hs new file mode 100644 index 00000000..2e4ab357 --- /dev/null +++ b/samples/test/STCEvent.hs @@ -0,0 +1,35 @@ + +import Graphics.UI.WX +import Graphics.UI.WXCore + +calltiptext = "I can write whatever I want here" + +main = start $ do + f <- frame [text := "Scintilla Test"] + p <- panel f [] + textlog <- textCtrl p [clientSize := sz 500 200] + textCtrlMakeLogActiveTarget textlog + logMessage "logging enabled" + s <- styledTextCtrl p [] + set s [on stcEvent := handler s] + styledTextCtrlSetMouseDwellTime s 2000 + set f [ layout := container p $ + column 5 $ [ fill $ widget s + , hfill $ widget textlog + ] + , clientSize := sz 500 500 + ] + +handler :: StyledTextCtrl a -> EventSTC -> IO () +handler _ STCUpdateUI = return () +handler _ STCStyleNeeded = return () +handler _ STCPainted = return () +handler stc e = do logMessage $ show e + case e of + (STCDwellStart xy) -> do + pos <- styledTextCtrlPositionFromPoint stc xy + styledTextCtrlCallTipShow stc pos calltiptext + (STCDwellEnd xy) -> do + active <- styledTextCtrlCallTipActive stc + when active $ styledTextCtrlCallTipCancel stc + _ -> return () \ No newline at end of file diff --git a/samples/test/STCLexer.hs b/samples/test/STCLexer.hs new file mode 100644 index 00000000..300ceb48 --- /dev/null +++ b/samples/test/STCLexer.hs @@ -0,0 +1,42 @@ +module Main where + +import Graphics.UI.WX +import Graphics.UI.WXCore + +colorscheme = [ ( wxSTC_HA_DEFAULT, rgb 0 0 0 ) + , ( wxSTC_HA_IDENTIFIER, rgb 0 0 0 ) + , ( wxSTC_HA_KEYWORD, rgb 0 0 255 ) + , ( wxSTC_HA_NUMBER, rgb 100 100 100 ) + , ( wxSTC_HA_STRING, rgb 100 100 200 ) + , ( wxSTC_HA_CHARACTER, rgb 0 100 200 ) + , ( wxSTC_HA_CLASS, rgb 255 0 255 ) + , ( wxSTC_HA_MODULE, rgb 255 0 0 ) + , ( wxSTC_HA_CAPITAL, rgb 0 255 0 ) + , ( wxSTC_HA_DATA, rgb 255 0 0 ) + , ( wxSTC_HA_IMPORT, rgb 150 0 200 ) + , ( wxSTC_HA_OPERATOR, rgb 256 0 0 ) + , ( wxSTC_HA_INSTANCE, rgb 150 61 90 ) + , ( wxSTC_HA_COMMENTLINE, rgb 10 80 100 ) + , ( wxSTC_HA_COMMENTBLOCK, rgb 0 60 0 ) + , ( wxSTC_HA_COMMENTBLOCK2, rgb 0 30 0 ) + , ( wxSTC_HA_COMMENTBLOCK3, rgb 0 10 0 ) + ] + +keywords = "as case class data default deriving do else hiding if import " ++ + "in infix infixl infixr instance let module newtype of qualified" ++ + "then type where" + +main = start $ do + f <- frame [text := "Scintilla Test", visible := False] + p <- panel f [] + s <- styledTextCtrl p [ clientSize := sz 500 500] + styledTextCtrlLoadFile s "LexerTest.hs" + styledTextCtrlStyleClearAll s + styledTextCtrlSetLexer s wxSTC_LEX_HASKELL + styledTextCtrlSetKeyWords s 0 keywords + let fontstyle = fontFixed { _fontFace = "Monospace" } + (font, _) <- fontCreateFromStyle fontstyle + mapM_ (\style -> styledTextCtrlStyleSetFont s style font) [0..wxSTC_STYLE_LASTPREDEFINED] + sequence_ [styledTextCtrlStyleSetForeground s k c | (k, c) <- colorscheme] + set f [ layout := container p $ fill $ widget s ] + set f [ visible := True ]