Last active

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

Example of time and keyboard usage in netwire. Displays bouncing text and quit when 'q' pressed

View netwire-flying-word.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
{-# LANGUAGE Arrows #-}
 
import Control.Wire
import Prelude hiding ((.), id)
import System.Console.ANSI
import Data.Maybe
import Control.Arrow
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Time.Clock
import GHC.Conc
 
deltaClockSession dt =
Session $ do
t0 <- liftIO getCurrentTime
return (0, loop t0)
where
loop t' =
Session $ do
threadDelay dt
t <- liftIO getCurrentTime
let realdt = realToFrac (diffUTCTime t t')
return (realdt, loop t)
 
control whenInhibited whenProduced wire = loop wire (deltaClockSession 10000)
where
loop w' session' = do
(mx, w, session) <- stepSession w' session' ()
case mx of
Left ex -> whenInhibited ex
Right x -> whenProduced x
loop w session `catch` (\_ -> ansiFinishUI)
 
ansiFinishUI = do
scrollPageUp 1
setCursorPosition 24 0
showCursor
 
 
impure f = mkFixM $ \_ x -> Right <$> f x
showW :: (Show a) => WireM IO a a
showW = impure (\x -> putStrLn (show x) >> return x )
clearScreenW = impure (\x -> clearScreen >> return x)
moveCursorW = impure (\(x, y) -> setCursorPosition y x >> return (x, y))
 
foreign import ccall unsafe "conio.h getch" c_getch :: IO Char
foreign import ccall unsafe "conio.h kbhit" c_kbhit :: IO Bool
whenKeyPressed = mkFixM $ \_ _ -> do
isKey <- c_kbhit
if isKey then Right <$> c_getch
else return (Left ())
 
redrawWordW word =
arr id &&& delay (40, 10)
>>> impure redrawWord
where redrawWord ((x, y), (prevx, prevy)) = do
hideCursor
setCursorPosition prevy prevx
putStr (replicate (length word) ' ')
setCursorPosition y x
putStr word
showCursor
 
drawUI =
let horizontalLine = replicate 80 '='
in do
setCursorPosition 0 0
putStr horizontalLine
setCursorPosition 23 0
putStr horizontalLine
setCursorPosition 24 0
putStr " > press 'q' to quit program"
 
ui = do clearScreen
hideCursor
drawUI
showCursor
startUI = perform . pure ui >>> inhibit ()
 
bounce (limX1, limY1)
(limX2, limY2)
((x, y), (speedX, speedY)) ((dx, dy), _) =
let newSx = if x >= limX2 || x <= limX1
then -speedX else speedX
newSy = if y >= limY2 || y <= limY1
then -speedY else speedY
in ((x + dx * newSx, y + dy * newSy), (newSx, newSy))
 
flyingWordW word startPos startVel =
periodically (1 / velocity) >>> pure 1
>>> accum1 (bounce (1,1) (80 - length word, 22)) (startPos, startVel)
>>> arr fst >>> redrawWordW word
>>> pure ()
where velocity = 20
quitBehavior =
whenKeyPressed >>> when (== 'q') >>> quit
main = control return return $
startUI
-->
flyingWordW "Love" (40, 10) (2, 1)
&&& flyingWordW "Pain" (10, 5) (2, 1)
&&& flyingWordW "Hate" (20, 10) (2, -1)
&&& flyingWordW "Haskell" (20, 10) (-2, -2)
&&& quitBehavior
>>> pure ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.