Saves temporary files to VK images
Getty Ritter
7 years ago
| 1 | 1 | module Main where |
| 2 | 2 | |
| 3 | import Data.IORef | |
| 4 | import Graphics.UI.Gtk.Cairo | |
| 5 | import Graphics.UI.Gtk hiding (eventButton) | |
| 6 | import Graphics.UI.Gtk.Gdk.Events(eventX,eventY,eventButton) | |
| 3 | import qualified Data.ByteString.Lazy as BS | |
| 4 | import Data.IORef | |
| 5 | import Graphics.UI.Gtk.Cairo | |
| 6 | import Graphics.UI.Gtk hiding (eventButton) | |
| 7 | import Graphics.UI.Gtk.Gdk.Events(eventX,eventY,eventButton) | |
| 7 | 8 | import qualified Graphics.Rendering.Cairo as C |
| 9 | import qualified Image.VK as VK | |
| 8 | 10 | |
| 9 | 11 | data ApplicationState = ApplicationState |
| 10 | 12 | { apLines :: [[(Int, Int)]] |
| 11 | 13 | , apCursor :: Maybe (Int, Int) |
| 14 | , apSize :: (Int,Int) | |
| 15 | , apGrid :: Maybe (Int, Int) | |
| 12 | 16 | } deriving (Eq, Show) |
| 13 | 17 | |
| 14 | 18 | rnd :: Double -> Int |
| 63 | 67 | _ <- initGUI |
| 64 | 68 | window <- windowNew |
| 65 | 69 | da <- drawingAreaNew |
| 66 | set window [ windowDefaultWidth := 200 | |
| 67 | , windowDefaultHeight := 200 | |
| 70 | stRef <- newIORef (ApplicationState [[]] Nothing (800, 800) Nothing) | |
| 71 | set window [ windowDefaultWidth := 800 | |
| 72 | , windowDefaultHeight := 800 | |
| 68 | 73 | , containerChild := da |
| 69 | 74 | , containerBorderWidth := 10 |
| 70 | 75 | ] |
| 71 | stRef <- newIORef (ApplicationState [[]] Nothing) | |
| 72 | 76 | _ <- onMotionNotify da True $ \ event -> do |
| 73 | 77 | st <- readIORef stRef |
| 74 | 78 | let (x, y) = (rnd (eventX event), rnd (eventY event)) |
| 90 | 94 | writeIORef stRef st' |
| 91 | 95 | render da st' |
| 92 | 96 | return True |
| 93 |
_ <- window `onDestroy` |
|
| 97 | _ <- window `onDestroy` (saveFile stRef >> mainQuit) | |
| 94 | 98 | widgetShowAll window |
| 95 | 99 | mainGUI |
| 100 | ||
| 101 | saveFile :: IORef ApplicationState -> IO () | |
| 102 | saveFile ref = do | |
| 103 | st <- readIORef ref | |
| 104 | let (w, h) = apSize st | |
| 105 | let bs = VK.encode $ VK.VKImage | |
| 106 | { VK.vkLines = [ [ (fromIntegral x, fromIntegral y) | |
| 107 | | (x, y) <- line | |
| 108 | ] | |
| 109 | | line <- apLines st | |
| 110 | ] | |
| 111 | , VK.vkMeta = VK.VKMeta (fromIntegral w, fromIntegral h) | |
| 112 | } | |
| 113 | BS.writeFile "/tmp/tmp.vk" bs | |