Add tests for wxStyledTextCtrl

darcs-hash:20071124143323-c1071-d29d1bf4550c9d5cc9889495a56444e075d3fc50.gz

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 ()

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 ()

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 ()

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 ]