diff --git a/gluturtle.cabal b/gluturtle.cabal --- a/gluturtle.cabal +++ b/gluturtle.cabal @@ -2,7 +2,7 @@ cabal-version: >= 1.6 name: gluturtle -version: 0.0.2 +version: 0.0.3 stability: alpha author: Yoshikuni Jujo maintainer: Yoshikuni Jujo diff --git a/src/Graphics/UI/GLUT/Turtle/Field.hs b/src/Graphics/UI/GLUT/Turtle/Field.hs --- a/src/Graphics/UI/GLUT/Turtle/Field.hs +++ b/src/Graphics/UI/GLUT/Turtle/Field.hs @@ -49,6 +49,9 @@ addCharacter ) where +import System.Exit +import Control.Applicative + import Graphics.UI.GLUT( createWindow, Vertex2(..), renderPrimitive, vertex, PrimitiveMode(..), preservingMatrix, GLfloat, swapBuffers, ($=), displayCallback, @@ -86,6 +89,11 @@ fAction :: IORef (IO ()), fActions :: IORef [IO ()], + fString :: IORef String, + fString2 :: IORef String, + + fInputtext :: IORef (String -> IO Bool), + fLayers :: IORef Layers } @@ -102,26 +110,54 @@ layers <- newLayers 0 (return ()) (return ()) (return ()) action <- newIORef $ return () actions <- newIORef [] + str <- newIORef "coi rodo" + str2 <- newIORef "hello" + inputtext <- newIORef $ const $ return True initialDisplayMode $= [RGBMode, DoubleBuffered] initialWindowSize $= Size 640 480 createWindow "field" - displayCallback $= (sequence_ =<< readIORef actions) -- testAction + displayCallback $= (do + sequence_ =<< readIORef actions) -- testAction G.addTimerCallback 10 (timerAction $ do G.clearColor $= G.Color4 0 0 0 0 G.clear [G.ColorBuffer] sequence_ =<< readIORef actions join $ readIORef action + G.lineWidth $= 1.0 + preservingMatrix $ do + G.scale (0.0005 :: GLfloat) 0.0005 0.0005 + G.clearColor $= G.Color4 0 0 0 0 + G.color (G.Color4 0 1 0 0 :: G.Color4 GLfloat) + w <- G.stringWidth G.Roman "Stroke font" + G.translate (G.Vector3 (-2.5 * (fromIntegral w)) + (-1600) 0 :: + G.Vector3 GLfloat) + G.renderString G.Roman =<< readIORef str + preservingMatrix $ do + G.scale (0.0005 :: GLfloat) 0.0005 0.0005 + G.clearColor $= G.Color4 0 0 0 0 + G.color (G.Color4 0 1 0 0 :: G.Color4 GLfloat) + w <- G.stringWidth G.Roman "Stroke font" + G.translate (G.Vector3 (-2.5 * (fromIntegral w)) + (-1400) 0 :: + G.Vector3 GLfloat) + G.renderString G.Roman =<< readIORef str2 swapBuffers) G.reshapeCallback $= Just (\size -> G.viewport $= (G.Position 0 0, size)) print "main loop go" print "main loop" - return Field{ + let f = Field{ fCoordinates = CoordCenter, fLayers = layers, fAction = action, - fActions = actions + fActions = actions, + fString = str, + fString2 = str2, + fInputtext = inputtext } + G.keyboardMouseCallback $= Just (keyboardProc f) + return f timerAction act = do act @@ -167,8 +203,8 @@ drawLine :: Field -> Layer -> Double -> Color -> Position -> Position -> IO () drawLine f l w c p q = do - atomicModifyIORef_ (fActions f) (makeLineAction p q :) --- G.addTimerCallback 1 $ makeLineAction p q + atomicModifyIORef_ (fActions f) (makeLineAction p q c w :) +-- G.addTimerCallback 1 $ makeLineAction p q c -- swapBuffers flush {- do @@ -192,14 +228,20 @@ ] -- swapBuffers -makeLineAction :: Position -> Position -> IO () -makeLineAction p q = do +makeLineAction :: Position -> Position -> Color -> Double -> IO () +makeLineAction p q c w = do preservingMatrix $ do + G.lineWidth $= fromRational (toRational w) + G.color $ colorToColor4 c -- (G.Color4 1 0 0 0 :: G.Color4 GLfloat) renderPrimitive Lines $ mapM_ vertex [ positionToVertex3 p, positionToVertex3 q ] -- swapBuffers +colorToColor4 :: Color -> G.Color4 GLfloat +colorToColor4 (RGB r g b) = G.Color4 + (fromIntegral r / 255) (fromIntegral g / 255) (fromIntegral b / 255) 0 + makeCharacterAction :: [Position] -> IO () makeCharacterAction ps = preservingMatrix $ do @@ -208,7 +250,7 @@ positionToVertex3 :: Position -> Vertex2 GLfloat positionToVertex3 (Center x y) = Vertex2 (fromRational $ toRational x / 300) - (fromRational $ toRational y / 300) + (fromRational $ toRational y / 300 + 0.2) writeString :: Field -> Layer -> String -> Double -> Color -> Position -> String -> IO () @@ -221,7 +263,8 @@ fillRectangle f l p w h clr = return () fillPolygon :: Field -> Layer -> [Position] -> Color -> Color -> Double -> IO () -fillPolygon f l ps clr lc lw = return () +fillPolygon f l ps clr lc lw = do + atomicModifyIORef_ (fActions f) (makeCharacterAction ps :) -------------------------------------------------------------------------------- @@ -232,7 +275,7 @@ Double -> Position -> Position -> IO () drawCharacterAndLine f ch fclr clr sh lw p q = writeIORef (fAction f) $ do - makeLineAction p q + makeLineAction p q clr lw makeCharacterAction sh clearCharacter :: Character -> IO () @@ -241,7 +284,7 @@ -------------------------------------------------------------------------------- oninputtext :: Field -> (String -> IO Bool) -> IO () -oninputtext _ _ = return () +oninputtext = writeIORef . fInputtext onclick, onrelease :: Field -> (Int -> Double -> Double -> IO Bool) -> IO () onclick _ _ = return () @@ -258,3 +301,15 @@ ontimer :: Field -> Int -> IO Bool -> IO () ontimer f t fun = return () + +keyboardProc :: Field -> G.Key -> G.KeyState -> G.Modifiers -> G.Position -> IO () +keyboardProc f (G.Char 'q') _ _ _ = exitWith ExitSuccess +keyboardProc f (G.Char '\r') G.Down _ _ = do + str <- readIORef $ fString f + ($ str) =<< readIORef (fInputtext f) + writeIORef (fString2 f) str + writeIORef (fString f) "" +keyboardProc f (G.Char c) state _ _ + | state == G.Down = atomicModifyIORef_ (fString f) (++ [c]) + | otherwise = return () +keyboardProc _ _ _ _ _ = return () diff --git a/tests/randomTurtle.hs b/tests/randomTurtle.hs --- a/tests/randomTurtle.hs +++ b/tests/randomTurtle.hs @@ -16,6 +16,9 @@ args <- initialize prgName rawArgs f <- openField t <- newTurtle f +-- pencolor t "white" + pensize t 3 + pencolor t (255, 255, 255) preprocess t (x0, y0) <- position t addTimerCallback 100 $ timerProc $ draw t x0 y0 diff --git a/tests/testGLUT.hs b/tests/testGLUT.hs --- a/tests/testGLUT.hs +++ b/tests/testGLUT.hs @@ -10,8 +10,21 @@ args <- initialize prgName rawArgs f <- openField t <- newTurtle f + oninputtext f (processInput t) -- speed t "slowest" - threadDelay 1000000 - left t 45 - forward t 100 + pencolor t (255, 255, 255) +-- threadDelay 1000000 +-- left t 45 +-- forward t 100 mainLoop + +processInput t "forward" = forward t 100 >> return True +processInput t "left" = left t 90 >> return True +processInput t "begin" = beginfill t >> return True +processInput t "end" = endfill t >> return True +processInput t "turtle" = shape t "turtle" >> return True +processInput t "stamp" = stamp t >> return True +processInput t "bold" = pensize t 3 >> return True +processInput t "big" = shapesize t 3 3 >> return True +processInput t "blue" = pencolor t (0, 0, 255) >> return True +processInput t _ = return True