packages feed

cakyrespa (empty) → 0.0.1

raw patch · 5 files changed

+374/−0 lines, 5 filesdep +GLUTdep +basedep +gluturtlesetup-changed

Dependencies added: GLUT, base, gluturtle, lojbanParser

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2012, Yoshikuni Jujo+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 the Yoshikuni Jujo nor the names of its+    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 EVEN SHALL THE COPYRIGHT HOLDER 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ cakyrespa.cabal view
@@ -0,0 +1,22 @@+build-type:	Simple+cabal-version:	>= 1.6++name:		cakyrespa+version:	0.0.1+stability:	Alpha+license:	BSD3+license-file:	LICENSE++category:	Teaching+synopsis:	run turtle like LOGO with lojban+description:	run turtle like LOGO with lojban+	.+	This is alpha version.++executable	cakyrespa+    hs-source-dirs:	src+    main-is:		cakyrespa.hs+    other-modules:	Language.Lojban.Read+    build-depends:	base >3 && <5, lojbanParser >= 0.1.4,+        gluturtle >= 0.0.7, GLUT+    ghc-options:	-Wall
+ src/Language/Lojban/Read.hs view
@@ -0,0 +1,164 @@+module Language.Lojban.Read (+	Lojban(..),+	Selbri(..),+	Sumti(..),+	Tag(..),+	Mex(..),+	RelativeClause(..),+	readLojban+) where++import Language.Lojban.Parser hiding (+	Tag, Sumti, Selbri, KOhA, FA, Brivla, BAI, Number, LI, RelativeClause,+	Time, KU, Linkargs, FIhO)+import qualified Language.Lojban.Parser as P+import Data.Maybe++main = do+	let	ret = readLojban ".i ko carna fi lo zunle la'u li panono"+	print ret++data Lojban+	= Bridi Selbri [(Tag, Sumti)]+	| Vocative String+	| Free [Free]+	| ParseError String+	deriving (Show, Eq)++data Selbri+	= Brivla String+	| Linkargs Selbri Sumti+	deriving (Show, Eq)++data Sumti+	= KOhA String+	| LA (Either String Selbri)+	| LE Selbri+	| LO Selbri (Maybe RelativeClause)+	| LI Mex+	| KU+	| SFIhO Selbri Sumti+	deriving (Show, Eq)++data RelativeClause+	= POI Lojban+	| Debug String+	deriving (Show, Eq)++data Mex+	= Number Double+	deriving (Show, Eq)++data Tag+	= FA Int+	| FIhO Selbri+	| BAI String+	| Time [String]+	deriving (Show, Eq)++readLojban :: String -> Lojban+readLojban = either (ParseError . show) process . parse++process :: Text -> Lojban+process (TopText _ _ [VocativeSumti [(_, v, _)] _ _] Nothing Nothing Nothing) =+	Vocative v+process (IText_1 _ _ _ [VocativeSumti [(_, v, _)] _ _] Nothing) = Vocative v+process (IText_1 _ _ _ fs@(_ : _) Nothing) = Free fs+process (IText_1 _ _ _ _ (Just t)) = process t+process (TermsBridiTail ss _ _ (SelbriTailTerms selbri ts _ _)) =+	Bridi (readSelbri selbri) $ processTagSumti ss ts+process (TermsBridiTail ss _ _ (P.Selbri selbri)) =+	Bridi (readSelbri selbri) $ processTagSumti ss []+process (P.Selbri selbri) = Bridi (readSelbri selbri) []+process t = error $ "process: " ++ show t++processTagSumti :: [P.Sumti] -> [P.Sumti] -> [(Tag, Sumti)]+processTagSumti s t = let+	(n, e, r) = readTagSumti 1 [] [] s+	(_, _, r') = readTagSumti (if n > 1 then n else 2) e [] t in r ++ r'++readTagSumti :: Int -> [Int] -> [(Tag, Sumti)] -> [P.Sumti]+	-> (Int, [Int], [(Tag, Sumti)])+readTagSumti n e r [] = (n, e, reverse r)+readTagSumti n e r (TagSumti t s : rest) = case readTag t of+	(Just i, tag) -> readTagSumti (next i e) (i : e) ((tag, sumti) : r) rest+	(_, tag) -> readTagSumti n e ((tag, sumti) : r) rest+	where+	sumti = readSumti s+readTagSumti n e r (s : rest) =+	readTagSumti (next n e) (n : e) ((FA n, readSumti s) : r) rest++readTag :: P.Tag -> (Maybe Int, Tag)+readTag (P.FA (_, f, _) _) = let n = fromJust $ lookup f faList in (Just n, FA n)+readTag (P.BAI _ _ (_, b, _) _ _) = (Nothing, BAI b)+readTag (P.Time _ _ _ ts) = (Nothing, Time $ map readTime ts)+readTag t = error $ "readTag: " ++ show t++readTime ::  IntervalProperty -> String+readTime (ZAhO (_, z, _) _) = z++faList :: [(String, Int)]+faList = [+	("fa", 1),+	("fe", 2),+	("fi", 3),+	("fo", 4),+	("fu", 5)+ ]++readSumti :: P.Sumti -> Sumti+readSumti (P.KOhA (_, k, _) _) = KOhA k+readSumti (LALE (_, "lo", _) _ st _ _) = LO selbri relative+	where (selbri, relative) = readSumtiTail st+readSumti (P.LI _ _ m _ _) = LI $ readMex m+readSumti (P.KU _ _) = KU+readSumti (TagSumti (P.FIhO (_, "fi'o", _) _ selbri _ _) sumti) =+	SFIhO (readSelbri selbri) (readSumti sumti)+readSumti s = error $ "readSumti: " ++ show s++readMex :: Operand -> Mex+readMex (P.Number n _ _) = readNumber n++-- readNumber :: P.Number -> Mex+readNumber = Number . paToInt . map (\(_, p, _) -> p)++paToInt :: [String] -> Double+paToInt = pti . reverse+	where+	pti [] = 0+	pti (p : rest) = fromJust (lookup p paList) + 10 * pti rest++paList = [+	("no", 0),+	("pa", 1),+	("re", 2),+	("ci", 3),+	("vo", 4),+	("mu", 5),+	("xa", 6),+	("ze", 7),+	("bi", 8),+	("so", 9)+ ]++readSumtiTail :: SumtiTail -> (Selbri, Maybe RelativeClause)+readSumtiTail (SelbriRelativeClauses s Nothing) =+	(readSelbri s, Nothing)+readSumtiTail (SelbriRelativeClauses s (Just r)) =+	(readSelbri s, Just $ readRelativeClauses r)++readRelativeClauses :: P.RelativeClause -> RelativeClause+readRelativeClauses (NOI (_, "poi", _) _ bridi _ _) =+	POI $ process bridi+readRelativeClauses r = Debug $  show r++readSelbri :: P.Selbri -> Selbri+readSelbri (P.Brivla (_, b, _) _) = Brivla b+readSelbri (P.Linkargs selbri (BE (_, "be", _) _ sumti _ _ _)) =+	Linkargs (readSelbri selbri) (readSumti sumti)+readSelbri s = error $ "readSelbri: " ++ show s+	+next :: Int -> [Int] -> Int+next n e+	| (n + 1) `elem` e = next (n + 1) e+	| otherwise = n + 1
+ src/cakyrespa.hs view
@@ -0,0 +1,158 @@+module Main where++import Graphics.UI.GLUT hiding (R)+import Graphics.UI.GLUT.Turtle++import Language.Lojban.Read++import System.Environment+import Data.Maybe++main :: IO ()+main = do+	prgName <- getProgName+	rawArgs <- getArgs+	_args <- initialize prgName rawArgs+	f <- openField "cakyrespa" 640 480+	t <- newTurtle f+	pencolor t ((255, 255, 255) :: (Int, Int, Int))+	fillcolor t ((255, 255, 255) :: (Int, Int, Int))+	shape t "turtle"+	shapesize t 3 3+	oninputtext f (processInput f t . cmd)+	mainLoop++cmd :: String -> Command+cmd str = case readLojban str of+	(Vocative "co'o") -> COhO+	b@(Bridi (Brivla "carna") s) -> fromMaybe (Unknown b) $ readCarna s+	b@(Bridi (Brivla "crakla") s) -> fromMaybe (Unknown b) $ readCrakla s+	b@(Bridi (Brivla "rixykla") s) -> fromMaybe (Unknown b) $ readRixykla s+	b@(Bridi (Brivla "pilno") s) -> fromMaybe (Unknown b) $ readPilno s+	b@(Bridi (Brivla "clugau") s) -> fromMaybe (Unknown b) $ readClugau s+	r -> Unknown r++readClugau :: [(Tag, Sumti)] -> Maybe Command+readClugau s = do+	KOhA "ko" <- lookup (FA 1) s+	case ((Time ["co'a"], KU) `elem` s, (Time ["co'u"], KU) `elem` s) of+		(True, False) -> return COhACLUGAU+		(False, True) -> return COhUCLUGAU+		_ -> fail "bad"++readPilno :: [(Tag, Sumti)] -> Maybe Command+readPilno s = do+	KOhA "ko" <- lookup (FA 1) s+	selpli <- lookup (FA 2) s+	case selpli of+		LO (Brivla "penbi") (Just (POI (Bridi (Brivla "cisni") [+			(FA 1, LI (Number size))]))) -> return $ PEBYCISNI size+		LO (Linkargs (Brivla "penbi") (SFIhO (Brivla "cisni") (LI+			(Number size)))) _ -> return $ PEBYCISNI size+		LO (Brivla "penbi") (Just (POI (Bridi (Brivla skari) []))) -> do+			(r, g, b) <- lookup skari skaste+			return $ PEBYSKA r g b+		LO (Linkargs (Brivla "penbi") (LO (Brivla skari) _)) _ -> do+			(r, g, b) <- lookup skari skaste+			return $ PEBYSKA r g b+		LO (Brivla "burcu") (Just (POI (Bridi (Brivla skari) []))) -> do+			(r, g, b) <- lookup skari skaste+			return $ BURSKA r g b+		LO (Linkargs (Brivla "burcu") (SFIhO (Brivla "skari") (LO+			(Brivla skari) _))) _ -> do+			(r, g, b) <- lookup skari skaste+			return $ BURSKA r g b+		_ -> return $ UnknownSelpli selpli++skaste :: [(String, (Int, Int, Int))]+skaste = [+	("xekri", (0, 0, 0)),+	("blabi", (255, 255, 255)),++	("xunre", (255, 0, 0)),+	("labri'o", (0, 255, 0)),	-- Lime+	("crinyblabi", (0, 255, 0)),	-- Lime+	("blanu", (0, 0, 255)),++	("pelxu", (255, 255, 0)),+	("cicna", (0, 255, 255)),+	("nukni", (255, 0, 255)),++	("rijyska", (192, 192, 192)),	-- Silver+	("grusi", (128, 128, 128)),++--	("?", (128, 0, 0)),		-- Maroon+	("alzaityska", (128, 128, 0)),	-- Olive+	("crino", (0, 128, 0)),+	("zirpu", (128, 0, 128)),	-- Purple+--	("?", (0, 128, 128)),		-- Teal+--	("?", (0, 0, 128)),		-- Navy++	("bunre", (165, 42, 42)),	-- Brown+	("narju", (255, 165, 0)),	-- Orange+	("sloska", (255, 215, 0)),	-- Gold+	("xunblabi", (255, 192, 203))	-- Pink+ ]++readLAhU2 :: [(Tag, Sumti)] -> Maybe Double+readLAhU2 s = do+	LI (Number d) <- lookup (BAI "la'u") s+	return d++readCrakla :: [(Tag, Sumti)] -> Maybe Command+readCrakla s = do+	KOhA "ko" <- lookup (FA 1) s+	return $ CRAKLA $ fromMaybe 100 $ readLAhU2 s++readRixykla :: [(Tag, Sumti)] -> Maybe Command+readRixykla s = do+	KOhA "ko" <- lookup (FA 1) s+	return $ RIXYKLA $ fromMaybe 100 $ readLAhU2 s++readCarna :: [(Tag, Sumti)] -> Maybe Command+readCarna s = do+	KOhA "ko" <- lookup (FA 1) s+	let	LO (Brivla lr) _ =+			fromMaybe (LO (Brivla "zunle") Nothing) $ lookup (FA 3) s+	 	d = fromMaybe 90 $ readLAhU2 s+	case lr of+		"zunle" -> return $ ZUNLE d+		"pritu" -> return $ PRITU d+		_ -> fail "bad"++data Command+	= CRAKLA Double | RIXYKLA Double+	| ZUNLE Double | PRITU Double+	| PEBYCISNI Double+	| PEBYSKA Int Int Int+	| BURSKA Int Int Int+	| COhACLUGAU+	| COhUCLUGAU+	| COhO | Unknown Lojban | ParseErrorC+	| UnknownSelpli Sumti+	deriving Show++data LR = L | R | BadLR deriving Show++processInput :: Field -> Turtle -> Command -> IO Bool+processInput _ t (CRAKLA d) = forward t d >> return True+processInput _ t (RIXYKLA d) = backward t d >> return True+processInput _ t (ZUNLE d) = left t d >> return True+processInput _ t (PRITU d) = right t d >> return True+processInput _ t (PEBYCISNI s) = pensize t s >> return True+processInput _ t (PEBYSKA r g b) = pencolor t (r, g, b) >> return True+processInput _ t (BURSKA r g b) = fillcolor t (r, g, b) >> return True+processInput _ t COhACLUGAU = beginfill t >> return True+processInput _ t COhUCLUGAU = endfill t >> return True+processInput _ _ COhO = return False+processInput f _ u@(Unknown _) = do+	outputString f ".i mi na jimpe"+	putStrLn $ show u+	return True+processInput f _ u@(UnknownSelpli _) = do+	outputString f ".i mi na djuno lo bi'unai selpli"+	putStrLn $ show u+	return True+processInput f _ ParseErrorC = do+	outputString f ".i di'u na drani fo lo gerna"+	return True