hscurses-fish-ex (empty) → 1.3.0
raw patch · 5 files changed
+284/−0 lines, 5 filesdep +basedep +hscursesdep +randomsetup-changed
Dependencies added: base, hscurses, random, safe, unix
Files
- LICENSE +31/−0
- README +21/−0
- Setup.hs +10/−0
- hscurses-fish-ex.cabal +22/−0
- hscurses-fish-ex.hs +200/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Dino Morelli 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Dino Morelli nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ README view
@@ -0,0 +1,21 @@+All relevant info is in the source file hscurses-fish-ex.hs++-----+A word about my version numbering scheme:++4-part: major.minor.status.build+3-part: major.status.build++status:+ 0 alpha+ 1 beta+ 2 release candidate+ 3 release++examples:+ 1.3.0.2 v1.3 alpha build 2+ 1.2.1.0 v1.2 beta build 0+ 4.2.24 v4 release candidate build 24+ 2.10.3.5 v2.10 release build 5 (say they were bug fixes)+ 1.5.2.20090818 Can even use a date for build+ v1.5 release candidate 2009-08-18 build
+ Setup.hs view
@@ -0,0 +1,10 @@+#! /usr/bin/env runhaskell++-- Copyright: 2010 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++import Distribution.Simple+++main = defaultMain
+ hscurses-fish-ex.cabal view
@@ -0,0 +1,22 @@+name: hscurses-fish-ex+version: 1.3.0+cabal-version: >= 1.2+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: 2010 Dino Morelli+author: Dino Morelli+maintainer: Dino Morelli <dino@ui3.info>+stability: stable+homepage: http://ui3.info/darcs/hscurses-fish-ex/+synopsis: hscurses swimming fish example+description: Simple curses aquarium written to learn about + the hscurses library.+category: Console, Development, Education, Help,+ User Interfaces+tested-with: GHC>=6.12.1++executable hscurses-fish-ex+ main-is: hscurses-fish-ex.hs+ build-depends: base >= 3 && < 5, hscurses, random, safe, unix+ ghc-options: -Wall
+ hscurses-fish-ex.hs view
@@ -0,0 +1,200 @@+#! /usr/bin/env runhaskell++{- Copyright 2010 Dino Morelli <dino@ui3.info>+ Released under BSD3++ Simple curses aquarium written in Haskell to learn about+ the hscurses library.+ Number of fish can be given as an argument, defaults to 20++ This code lives here:+ http://ui3.info/darcs/hscurses-fish-ex/++ Inspired by this C code:+ http://alexeyt.freeshell.org/code/aquarium.c+-}++import Control.Concurrent ( threadDelay )+import Control.Concurrent.MVar+ ( MVar, newMVar, putMVar, readMVar, takeMVar )+import Control.Monad ( liftM, mplus, replicateM )+import Data.Char ( ord )+import Data.Maybe ( fromJust )+import Safe ( headMay, readMay )+import System.Environment ( getArgs )+import System.Posix.Signals+ ( Handler (Catch), installHandler, sigINT, sigTERM )+import System.Random ( randomRIO )+import UI.HSCurses.Curses+ ( Pair (..), attr0, attrSet, endWin, initCurses, initPair, mvAddCh+ , mvWAddStr, refresh, scrSize, startColor, stdScr, wMove+ )+import UI.HSCurses.CursesHelper+ ( black, blue, cyan, green, magenta, red, white, yellow )+import UI.HSCurses.Widgets ( getWidth )+++{- The data needed to track each fish+-}+data Fish = Fish+ Int -- y+ Int -- x+ Pair -- color+ Bool -- fish is facing right+++interruptHandler :: MVar Bool -> IO ()+interruptHandler mvRunStatus = do+ -- We don't care what it is, we just want to take it from everyone else+ _ <- takeMVar mvRunStatus++ -- Make note in the state that the user wants to quit+ putMVar mvRunStatus True+++worker :: MVar Bool -> [Fish] -> IO ()+worker mvRunStatus priorSchool = do+ -- Update fish positions+ school <- mapM swim priorSchool++ -- Draw the fish+ mapM_ drawFish school+ refresh+ + threadDelay 100000++ -- Pull the run state..+ stopNow <- readMVar mvRunStatus++ -- examine it to figure out what to do next+ if stopNow == True+ then return ()+ else worker mvRunStatus school+++{- Construct a fish on a random row, facing a random direction+ Sets the starting column to be just offscreen+-}+spawn :: IO Fish+spawn = do+ (maxRows, maxCols) <- scrSize++ y <- randomRIO (0, maxRows - 1)+ right <- randomRIO (True, False)+ let x = case right of+ True -> -1+ False -> maxCols+ color <- liftM Pair $ randomRIO (1, 7)++ return $ Fish y x color right+++{- Returns a copy of a fish moved to a random column onscreen+ Used for first-time fish initialization+-}+randomXPos :: Fish -> IO Fish+randomXPos (Fish y _ color right) = do+ maxCols <- liftM getWidth scrSize+ newX <- randomRIO (0, maxCols - 1)+ return $ Fish y newX color right+++{- Move a fish forward. If it's fully offscreen, spawn a random new + fish to replace it.+-}+swim :: Fish -> IO Fish++-- Right-facing fish+swim (Fish y x color right@True) = do+ let modFish = Fish y (x + 1) color right++ maxCols <- liftM getWidth scrSize+ if x > (maxCols + 2)+ then spawn+ else return modFish++-- Left-facing fish+swim (Fish y x color right@False) = do+ let modFish = Fish y (x - 1) color right++ if x < -3+ then spawn+ else return modFish+++{- Draw a fish+ The reason for this complicated draw-each-char is that mvWAddStr+ crashes if part of the string is past the bottom right corner of + the window.+ Not so with calling mvAddCh even with out-of-bounds coords.+-}+drawPart :: Int -> (Int, Char) -> IO ()+drawPart y (x, c) = do+ mvAddCh y x $ fromIntegral . ord $ c+++drawFish :: Fish -> IO ()++-- Right-facing fish+drawFish (Fish y x color True) = do+ attrSet attr0 color+ mapM_ (drawPart y) $ zip [(x - 3) .. x] " ><>"+ wMove stdScr 0 0++-- Left-facing fish+drawFish (Fish y x color False) = do+ attrSet attr0 color+ mapM_ (drawPart y) $ zip [x .. (x + 3)] "<>< "+ wMove stdScr 0 0+++{- Clear the screen by drawing spaces with the given color's background+-}+paintEntireScr :: Pair -> IO ()+paintEntireScr color = do+ (maxRows, maxCols) <- scrSize++ let blanks = replicate (maxCols - 1) ' '++ attrSet attr0 color+ mapM_ (\y -> mvWAddStr stdScr y 0 blanks) [0 .. (maxRows - 1)]+ refresh+++main :: IO ()+main = do+ -- Get number of fish from the command-line, or use a default value+ args <- getArgs+ let nfish = fromJust $ (return args >>= headMay >>= readMay)+ `mplus` return 20++ initCurses++ -- Color initialization+ startColor+ initPair (Pair 1) green black+ initPair (Pair 2) red black+ initPair (Pair 3) yellow black+ initPair (Pair 4) blue black+ initPair (Pair 5) magenta black+ initPair (Pair 6) cyan black+ initPair (Pair 7) white black++ paintEntireScr $ Pair 7++ -- Randomly generate the first school of fish+ school <- mapM randomXPos =<< replicateM nfish spawn++ -- Data for communicating between threads+ mvRunStatus <- newMVar False++ -- A map to install the same handler for multiple signals+ mapM_ ( \signal -> installHandler signal + (Catch $ interruptHandler mvRunStatus) Nothing ) [sigINT, sigTERM]++ -- This starts the endless work loop+ worker mvRunStatus school++ paintEntireScr $ Pair 7++ endWin