gluturtle 0.0.27 → 0.0.31
raw patch · 2 files changed
+37/−22 lines, 2 files
Files
- gluturtle.cabal +1/−1
- src/Graphics/UI/GLUT/Turtle/Field.hs +36/−21
gluturtle.cabal view
@@ -2,7 +2,7 @@ cabal-version: >= 1.6 name: gluturtle-version: 0.0.27+version: 0.0.31 stability: alpha author: Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
src/Graphics/UI/GLUT/Turtle/Field.hs view
@@ -96,6 +96,8 @@ data Coordinates = CoordTopLeft | CoordCenter data Field = Field{+ fChanged :: IORef Int,+ fAct :: IO (), fCoordinates :: Coordinates, fBgcolor :: IORef [Color],@@ -139,6 +141,7 @@ openField :: String -> Int -> Int -> IO Field openField name w h = do+ fc <- newIORef 0 fb <- newIORef False fr <- newIORef False fw <- newIORef w@@ -158,29 +161,34 @@ wt <- createWindow name wc <- createWindow "console" let act = do- currentWindow $= Just wt- G.clearColor $= G.Color4 0 0 0 0- G.clear [G.ColorBuffer]- makeFieldColor . head =<< readIORef bgc- sequence_ . reverse . catMaybes =<< readIORef actions- join $ readIORef action- swapBuffers- currentWindow $= Just wc- G.clearColor $= G.Color4 0 0 0 0- G.clear [G.ColorBuffer]- G.lineWidth $= 1.0- ss1 <- readIORef str- ss2 <- readIORef str2- zipWithM_ (printString (-2.8)) [-1800, -1600 .. 1800] (reverse ss1 ++ ss2)- swapBuffers+ change <- readIORef fc+ when (change > 0) $ do+ currentWindow $= Just wt+ G.clearColor $= G.Color4 0 0 0 0+ G.clear [G.ColorBuffer]+ makeFieldColor . head =<< readIORef bgc+ sequence_ . reverse . catMaybes =<< readIORef actions+ join $ readIORef action+ swapBuffers+ currentWindow $= Just wc+ G.clearColor $= G.Color4 0 0 0 0+ G.clear [G.ColorBuffer]+ G.lineWidth $= 1.0+ ss1 <- readIORef str+ ss2 <- readIORef str2+ zipWithM_ (printString (-2.8)) [-1800, -1600 .. 1800] (reverse ss1 ++ ss2)+ swapBuffers+ atomicModifyIORef_ fc (subtract 1) currentWindow $= Just wt- displayCallback $= act+ displayCallback $= atomicModifyIORef_ fc (+ 1) >> act currentWindow $= Just wc displayCallback $= act -- G.keyboardMouseCallback $= Just (\_ _ _ _ -> act)--- G.addTimerCallback 10 $ timerAction act+ G.addTimerCallback 10 $ timerAction act G.reshapeCallback $= Just (\size -> G.viewport $= (G.Position 0 0, size)) let f = Field{+ fChanged = fc,+ fAct = act, fCoordinates = CoordCenter, fLayers = layers, fAction = action,@@ -201,11 +209,14 @@ } G.keyboardMouseCallback $= Just (\k ks m p -> do keyboardProc f k ks m p- act+ atomicModifyIORef_ (fChanged f) (+ 1))+-- act)+{- busy <- readIORef $ fBusy f when (k == G.Char '\r' && not busy) $ do writeIORef (fBusy f) True G.addTimerCallback 10 $ timerActionN f 10 act)+-} -- G.keyboardMouseCallback $= Just (\_ _ _ _ -> act) -- G.addTimerCallback 10 $ timerAction act return f@@ -298,6 +309,7 @@ atomicModifyIORef_ (fActions f) (Just (makeLineAction f p q c w) :) -- G.addTimerCallback 1 $ makeLineAction p q c -- swapBuffers+ atomicModifyIORef_ (fChanged f) (+ 1) flush makeLineAction :: Field -> Position -> Position -> Color -> Double -> IO ()@@ -391,8 +403,9 @@ -} fillPolygon :: Field -> Layer -> [Position] -> Color -> Color -> Double -> IO ()-fillPolygon f _ ps clr lc lw =+fillPolygon f _ ps clr lc lw = do atomicModifyIORef_ (fActions f) (Just (makeCharacterAction f ps clr lc lw) :)+ atomicModifyIORef_ (fChanged f) (+ 1) -------------------------------------------------------------------------------- @@ -401,15 +414,17 @@ makeCharacterAction f sh fclr clr lw writeIORef (fAction f) $ makeCharacterAction f sh fclr clr lw+ atomicModifyIORef_ (fChanged f) (+ 1) drawCharacterAndLine :: Field -> Character -> Color -> Color -> [Position] -> Double -> Position -> Position -> IO () drawCharacterAndLine f _ fclr clr sh lw p q = do- makeLineAction f p q clr lw- makeCharacterAction f sh fclr clr lw+-- makeLineAction f p q clr lw+-- makeCharacterAction f sh fclr clr lw writeIORef (fAction f) $ do makeLineAction f p q clr lw makeCharacterAction f sh fclr clr lw+ atomicModifyIORef_ (fChanged f) (+ 1) clearCharacter :: Field -> IO () clearCharacter f = writeIORef (fAction f) $ return ()