gluturtle 0.0.2 → 0.0.3
raw patch · 4 files changed
+86/−15 lines, 4 files
Files
- gluturtle.cabal +1/−1
- src/Graphics/UI/GLUT/Turtle/Field.hs +66/−11
- tests/randomTurtle.hs +3/−0
- tests/testGLUT.hs +16/−3
gluturtle.cabal view
@@ -2,7 +2,7 @@ cabal-version: >= 1.6 name: gluturtle-version: 0.0.2+version: 0.0.3 stability: alpha author: Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
src/Graphics/UI/GLUT/Turtle/Field.hs view
@@ -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 ()
tests/randomTurtle.hs view
@@ -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
tests/testGLUT.hs view
@@ -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