diff options
Diffstat (limited to 'axis.hs')
-rw-r--r-- | axis.hs | 20 |
1 files changed, 19 insertions, 1 deletions
@@ -8,6 +8,7 @@ import Control.Monad | |||
8 | import qualified Graphics.UI.SDL as SDL | 8 | import qualified Graphics.UI.SDL as SDL |
9 | import AlsaSeq | 9 | import AlsaSeq |
10 | import qualified Data.Set as Set | 10 | import qualified Data.Set as Set |
11 | import qualified Graphics.UI.SDL.TTF as SDL.TTF | ||
11 | 12 | ||
12 | netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String | 13 | netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String |
13 | netwireIsCool = | 14 | netwireIsCool = |
@@ -32,6 +33,12 @@ main = | |||
32 | height = SDL.videoInfoHeight info | 33 | height = SDL.videoInfoHeight info |
33 | --screen <- SDL.setVideoMode width height 32 [SDL.SWSurface, SDL.Fullscreen] | 34 | --screen <- SDL.setVideoMode width height 32 [SDL.SWSurface, SDL.Fullscreen] |
34 | screen <- SDL.setVideoMode width height 32 [SDL.SWSurface] | 35 | screen <- SDL.setVideoMode width height 32 [SDL.SWSurface] |
36 | |||
37 | _ <- SDL.TTF.init | ||
38 | font <- SDL.TTF.openFont "LiberationMono-Bold.ttf" 30 | ||
39 | videoSurface <- SDL.getVideoSurface | ||
40 | videoClipRect <- SDL.getClipRect videoSurface | ||
41 | |||
35 | putStrLn "Initialized." | 42 | putStrLn "Initialized." |
36 | 43 | ||
37 | let parseAlsa keysDown = parseAlsaEvents h keysDown (forwardNoteEvent h q publicAddr) | 44 | let parseAlsa keysDown = parseAlsaEvents h keysDown (forwardNoteEvent h q publicAddr) |
@@ -41,7 +48,18 @@ main = | |||
41 | (ds, s') <- stepSession s | 48 | (ds, s') <- stepSession s |
42 | (ex, w') <- stepWire w ds (Right x) | 49 | (ex, w') <- stepWire w ds (Right x) |
43 | let x' = either (const "") id ex | 50 | let x' = either (const "") id ex |
44 | Control.Monad.when (x /= x' && x' /= "") $ putStrLn x' | 51 | |
52 | Control.Monad.when (x /= x' && x' /= "") $ do | ||
53 | putStrLn x' | ||
54 | fontSurface <- SDL.TTF.renderUTF8Blended font x' (SDL.Color 0 255 0) | ||
55 | fontClipRect <- SDL.getClipRect fontSurface | ||
56 | -- _ <- SDL.fillRect videoSurface (Just fontClipRect) (SDL.Pixel 0) | ||
57 | _ <- SDL.fillRect videoSurface (Just videoClipRect) (SDL.Pixel 0) | ||
58 | _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just fontClipRect) | ||
59 | -- _ <- SDL.updateRect videoSurface fontClipRect | ||
60 | _ <- SDL.updateRect videoSurface videoClipRect | ||
61 | return () | ||
62 | |||
45 | let framerate = 30 | 63 | let framerate = 30 |
46 | let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds) | 64 | let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds) |
47 | SDL.delay (delay) | 65 | SDL.delay (delay) |