packages feed

cakyrespa 0.0.15 → 0.0.22

raw patch · 8 files changed

+759/−665 lines, 8 filesdep ~gluturtledep ~yjtools

Dependency ranges changed: gluturtle, yjtools

Files

cakyrespa.cabal view
@@ -2,7 +2,7 @@ cabal-version:	>= 1.6  name:		cakyrespa-version:	0.0.15+version:	0.0.22 stability:	Alpha license:	BSD3 license-file:	LICENSE@@ -24,7 +24,7 @@ executable	cakyrespa     hs-source-dirs:	src     main-is:		cakyrespa.hs-    other-modules:	Language.Lojban.Read+    other-modules:	Minde, Jimpe, Tcidu, Liste, Klesi     build-depends:	base >3 && <5, lojbanParser >= 0.1.5,-        gluturtle >= 0.0.20, GLUT, yjsvg, yjtools >= 0.9.16+        gluturtle >= 0.0.31, GLUT, yjsvg, yjtools >= 0.9.18     ghc-options:	-Wall
+ src/Jimpe.hs view
@@ -0,0 +1,265 @@+module Jimpe (jimpe) where++import Klesi(+	Minde(..),+	Text(..), Selbri(..), Tag(..), Sumti(..), Mex(..), RelativeClause(..))+import Liste(skaste)++import Control.Applicative((<$>))+import Data.Maybe(fromMaybe)+import Data.Tuple.Tools(uncurry3)++--------------------------------------------------------------------------------++jimpe :: Text -> Minde+jimpe = flip jmi []++jmi :: Text -> [Sumti] -> Minde+jmi t@(Bridi (Brivla brivla) terms) args = fromMaybe (SRERA $ show t) $+	lookup brivla midste >>= \mid -> mid terms args+jmi t@(Bridi (NA (Brivla brivla)) terms) args = fromMaybe (SRERA $ show t) $+	lookup brivla narmidste >>= \mid -> mid terms args+jmi (Prenex sumste bridi) _ = MIDYSTE $ jmi bridi <$> mapM bagi sumste+	where+	bagi (STense "ba" pavsu'i relsu'i) = bagi pavsu'i ++ bagi relsu'i+	bagi sumti = [sumti]+jmi (TagGI "ba" pavbri relbri) args =+	MIDYSTE [jmi pavbri args, jmi relbri args]+jmi (MultiText texts) args = MIDYSTE $ map (($ args) . jmi) texts+jmi (Vocative "co'o") _ = COhO+jmi l _ = SRERA $ show l++type Midytcidu = [(Tag, Sumti)] -> [Sumti] -> Maybe Minde++midste, narmidste :: [(String, Midytcidu)]+midste = [+	("klama", klama),+	("crakla", crakla),+	("rixykla", rixykla),+	("carna", carna),+	("clugau", clugau),+	("galfi", galfi),+	("pilno", pilno),+	("cisni", cisni),+	("cisnygau", cisnygau),+	("viska", viska),+	("rapli", rapli),+	("xruti", xruti),+	("morji", morji),+	("gasnu", gasnu),+	("rejgau", rejgau),+	("tcidu", tcidu)]+narmidste = [+	("pilno", napilno),+	("viska", naviska)]++apply :: Monad m => [Sumti] -> Sumti -> (Sumti -> m a) -> m a+apply args (CEhU i) cmd+	| length args >= i = cmd $ args !! (i - 1)+	| otherwise = fail "apply: too few args"+apply _ sumti cmd = cmd sumti++apply2 :: Monad m => [Sumti] -> Sumti -> Sumti -> (Sumti -> Sumti -> m a) -> m a+apply2 args s1 s2 cmd = apply args s2 =<< apply args s1 (return . cmd)++klama, crakla, rixykla, carna, clugau, galfi, pilno, cisni, cisnygau, viska,+	rapli, xruti, morji, gasnu, rejgau, tcidu, napilno, naviska :: Midytcidu++klama terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	selkla <- lookup (FA 2) terms+	apply args selkla $ \sk -> case sk of+		LI (JOhI [Number x, Number y]) -> return $ KLAMA x y+		_ -> return $ SRERA $ show terms ++ " " ++ show args++crakla terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	return . CRAKLA . fromMaybe 100 $ la'u terms args++rixykla terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	return . RIXYKLA . fromMaybe 100 $ la'u terms args++carna terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	farna <- case lookup (FA 3) terms of+		Nothing -> return "zunle"+		Just far -> apply args far $ \f -> case f of+			LO (Brivla zp) _ -> return zp+			_ -> fail "carna: bad direction"+	($ fromMaybe 90 $ la'u terms args) <$> case farna of+		"zunle" -> return ZUNLE+		"pritu" -> return PRITU+		_ -> fail "carna: bad direction"++la'u :: [(Tag, Sumti)] -> [Sumti] -> Maybe Double+la'u terms args = do+	klani <- lookup (BAI 1 "la'u") terms+	apply args klani $ \k -> case k of+		LI (Number n) -> return n+		_ -> fail "la'u: not number"++clugau terms _ = do+	KOhA "ko" <- lookup (FA 1) terms+	case ((Time ["co'a"], KU) `elem` terms,+		(Time ["co'u"], KU) `elem` terms) of+		(True, False) -> return COhACLUGAU+		(False, True) -> return COhUCLUGAU+		_ -> fail "clugau: bad tense"++galfi terms args = do+	TUhA (KOhA "ko") <- lookup (FA 1) terms+	LO (Brivla "foldi") Nothing <- lookup (FA 2) terms+	terga'i <- lookup (FA 3) terms+	apply args terga'i $ \skasu'i -> case skasu'i of+		LO (Brivla skale'u) Nothing -> do+			skari <- lookup skale'u skaste+			return $ let (r, g, b) = skari in FLOSKA r g b+		_ -> return $ SRERA $ "galfi: " ++ show terms ++ " " ++ show args++pilno terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	sp <- lookup (FA 2) terms+	apply args sp $ selpli terms args . be2poi++selpli :: [(Tag, Sumti)] -> [Sumti] -> Sumti -> Maybe Minde+selpli terms args (LO (Brivla "penbi") (Just (POI bridi))) = do+	peb <- penbi args bridi+	return $ if (Time ["ba"], KU) `elem` terms+		then peb+		else MIDYSTE [peb, PILNOLOPENBI]+selpli terms _ (LO (Brivla "penbi") Nothing)+	| (Time ["ba"], KU) `elem` terms = return $ MIDYSTE []+	| otherwise = return PILNOLOPENBI+selpli _ args (LO (Brivla "burcu") (Just (POI bridi))) = burcu args bridi+selpli terms args (Relative sp r) = apply args sp $ \pb -> case pb of+	LO (Brivla "penbi") _ -> selpli terms args (LO (Brivla "penbi") (Just r))+	LO (Brivla "burcu") _ -> selpli terms args (LO (Brivla "burcu") (Just r))+	_ -> fail "selpli: bad selpli"+selpli _ _ sp = return $ SRERA $ "selpli: unknown selpli " ++ show sp++penbi :: [Sumti] -> Text -> Maybe Minde+penbi _ (Bridi (Brivla skari) []) = pebyska skari+penbi args (Bridi (Brivla "penbi") [(FA 2, skari)]) = applyLO args skari pebyska+penbi args (Bridi (ME skari) []) = applyLO args skari pebyska+penbi args (Bridi (Brivla "cisni") [(FA 2, cisnysu'i)]) =+	apply args cisnysu'i $ \cs -> case cs of+		LI (Number cisnyna'u) -> return $ PEBYCISNI cisnyna'u+		_ -> fail "bad"+penbi _ relative = return $ SRERA $ "penbi: no such penbi" ++ show relative++pebyska :: String -> Maybe Minde+pebyska skari = uncurry3 PEBYSKA <$> lookup skari skaste++burcu :: [Sumti] -> Text -> Maybe Minde+burcu _ (Bridi (Brivla skari) []) = burska skari+burcu args (Bridi (ME skari) []) = applyLO args skari burska+burcu args (Bridi (SE 2 (Brivla "skari")) [(FA 1, skari)]) =+	applyLO args skari burska+burcu args (Bridi (Brivla "skari") [(FA 2, skari)]) =+	applyLO args skari burska+burcu _ relative = return $ SRERA $ "burcu: no such burcu" ++ show relative++burska :: String -> Maybe Minde+burska skari = uncurry3 BURSKA <$> lookup skari skaste++applyLO :: Monad m => [Sumti] -> Sumti -> (String -> m a) -> m a+applyLO args sumti cmd = apply args sumti $ \su'i -> case su'i of+	LO (Brivla lerfu) Nothing -> cmd lerfu+	_ -> fail $ "applyLO: bad sumti " ++ show su'i++be2poi :: Sumti -> Sumti+be2poi (LO (BE selbri (SFIhO modal sumti)) Nothing) =+	LO selbri $ Just $ POI $ Bridi modal [(FA 1, sumti)]+be2poi (LO (BE selbri sumti) Nothing) =+	LO selbri $ Just $ POI $ Bridi selbri [(FA 2, sumti)]+be2poi sumti = sumti++cisni terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	csn <- lookup (FA 2) terms+	apply args csn $ \c -> case c of+		LI (Number n) -> return $ CISNI n+		_ -> return $ SRERA $ "cisni: " ++ show terms++cisnygau terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	LO (Brivla "foldi") _ <- lookup (FA 2) terms+	csn <- lookup (FA 3) terms+	apply args csn $ \sk -> case sk of+		LI (JOhI [Number x, Number y]) -> return $ CISNYGAUFOLDI x y+		_ -> return $ SRERA $ show terms ++ " " ++ show args++viska terms _ = do+	KOhA "ko" <- lookup (FA 2) terms+	return VISKA++rapli terms args = do+	fasnu <- lookup (FA 1) terms+	namcu <- lookup (FA 2) terms+	apply2 args fasnu namcu $ \fau nac -> case (fau, nac) of+		(LO (NU f) _, LI (Number n)) ->+			return $ MIDYSTE $ replicate (round n) (jmi f [])+		_ -> return $ SRERA $ show terms++xruti terms _ = do+	KOhA "ko" <- lookup (FA 1) terms+	return XRUTI++morji terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	GOI lerfu duhu <- lookup (FA 2) terms+	apply2 args lerfu duhu $ \ler d -> case (ler, d) of+		(LerfuString cmene, LO (DUhU fasnu) _) ->+			return $ MORJI cmene $ jmi fasnu+		_ -> return $ SRERA $ "morji: " ++ show terms++gasnu terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	LerfuString cmene <- lookup (FA 2) terms+	return $ GASNU cmene args++rejgau terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	cmene <- lookup (BAI 1 "me'e") terms+	setai <- lookup (BAI 2 "tai") terms+	apply2 args cmene setai $ \cme st -> case (cme, st) of+		(ZOI fp, LA (Right (Brivla "cakyrespa"))) ->+			return $ REJGAUSETAICAK fp+		(ZOI fp, LA (Left "syvygyd")) ->+			return $ REJGAUSETAISVG fp+		(ZOI fp, LA (Left "lojban")) ->+			return $ REJGAUSETAIJBO fp+		_ -> return $ SRERA $ "rejgau: " ++ show setai++tcidu terms args = do+	KOhA "ko" <- lookup (FA 1) terms+	setai <- lookup (BAI 2 "tai") terms+	apply args setai $ \st -> case st of+		(LA (Right (Brivla "cakyrespa"))) -> do+			sumti <- lookup (FA 2) terms+			fps <- apply args sumti $ \smt -> case smt of+				LA (Right (ME fps)) -> return fps+				LAhE fps -> return fps+				_ -> fail "tcidu: bad"+			apply args fps $ \smt -> case smt of+				ZOI fp -> return $ TCIDU fp+				_ -> fail "tcidu: bad"+		(LA (Left "lojban")) -> do+			sumti <- lookup (FA 2) terms+			fps <- apply args sumti $ \smt -> case smt of+				LA (Right (ME fps)) -> return fps+				LAhE fps -> return fps+				_ -> fail "tcidu: bad"+			apply args fps $ \smt -> case smt of+				ZOI fp -> return $ TCIDUSETAIJBO fp+				_ -> fail "tcidu: bad"+		_ -> fail "tcidu: bad"++napilno terms _ = do+	KOhA "ko" <- lookup (FA 1) terms+	return NAPILNOLOPENBI++naviska terms _ = do+	KOhA "ko" <- lookup (FA 2) terms+	return NAVISKA
+ src/Klesi.hs view
@@ -0,0 +1,88 @@+module Klesi (+	Minde(..),+	Text(..), Selbri(..), Tag(..), Sumti(..), Mex(..), RelativeClause(..)+) where++import Language.Lojban.Parser(Free(..))++--------------------------------------------------------------------------------++data Minde+	= KLAMA Double Double+	| CRAKLA Double				| RIXYKLA Double+	| ZUNLE Double				| PRITU Double+	| COhACLUGAU				| COhUCLUGAU+	| PEBYCISNI Double			| PEBYSKA Int Int Int+	| BURSKA Int Int Int			| FLOSKA Int Int Int+	| NAPILNOLOPENBI			| PILNOLOPENBI+	| NAVISKA				| VISKA+	| CISNI Double				| CISNYGAUFOLDI Double Double+	| XRUTI+	| MORJI String ([Sumti] -> Minde)	| GASNU String [Sumti]+	| REJGAUSETAIJBO FilePath		| TCIDUSETAIJBO FilePath+	| REJGAUSETAICAK FilePath		| TCIDU FilePath+	| REJGAUSETAISVG FilePath+	| COhO+	| MIDYSTE [Minde]+	| SRERA String++data Text+	= Bridi Selbri [(Tag, Sumti)]+	| Prenex [Sumti] Text+	| TagGI String Text Text+	| Vocative String+	| Free [Free]+	| MultiText [Text]+	| UnknownText String+	| ParseError String+	deriving (Show, Eq)++data Selbri+	= Brivla String+	| NA Selbri+	| SE Int Selbri+	| BE Selbri Sumti+	| ME Sumti+	| NU Text+	| DUhU Text+	| UnknownSelbri String+	deriving (Show, Eq)++data Tag+	= FA Int+	| BAI Int String+	| FIhO Selbri+	| Time [String]+	| UnknownTag String+	deriving (Show, Eq)++data Sumti+	= KU+	| CEhUPre+	| CEhU Int+	| KOhA String+	| LA (Either String Selbri)+	| LE Selbri+	| LO Selbri (Maybe RelativeClause)+	| LI Mex+	| LerfuString String+	| ZOI String+	| TUhA Sumti+	| LAhE Sumti+	| GOI Sumti Sumti+	| Relative Sumti RelativeClause+	| STense String Sumti Sumti+	| SFIhO Selbri Sumti+	| UnknownSumti String+	deriving (Show, Eq)++data Mex+	= Number Double+	| JOhI [Mex]+	| UnknownMex String+	deriving (Show, Eq)++data RelativeClause+	= POI Text+	| UnknownRelativeClause String+	deriving (Show, Eq)
− src/Language/Lojban/Read.hs 
@@ -1,295 +0,0 @@-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, NU, NA, LA, ZOI, ME, JOhI, SE, GOI,-	LerfuString, Prenex)-import qualified Language.Lojban.Parser as P-import Data.Maybe-import Data.Char-import Control.Arrow--data Lojban-	= Bridi Selbri [(Tag, Sumti)]-	| TenseGI String Lojban Lojban-	| Vocative String-	| Free [Free]-	| Prenex [Sumti] Lojban-	| ParseError String-	| NotImplemented String-	deriving (Show, Eq)--data Selbri-	= Brivla String-	| Linkargs Selbri Sumti-	| NU Lojban-	| DUhU Lojban-	| NotImplementedSelbri String-	| NA Selbri-	| ME Sumti-	| SE Int Selbri-	deriving (Show, Eq)--data Sumti-	= KOhA String-	| CEhU Int-	| CEhUPre-	| LA (Either String Selbri)-	| LE Selbri-	| LO Selbri (Maybe RelativeClause)-	| LI Mex-	| KU-	| SFIhO Selbri Sumti-	| ZOI String-	| TUhA Sumti-	| GOI Sumti Sumti-	| LerfuString String-	| STense String Sumti Sumti-	| NotImplementedSumti String-	deriving (Show, Eq)--data RelativeClause-	= POI Lojban-	| Debug String-	| NotImplementedRelativeClause String-	deriving (Show, Eq)--data Mex-	= Number Double-	| JOhI [Mex]-	| NotImplementedMex String-	deriving (Show, Eq)--data Tag-	= FA Int-	| FIhO Selbri-	| BAI (Maybe String) String-	| Time [String]-	| NotImplementedTag String-	deriving (Show, Eq)--readLojban :: String -> Lojban-readLojban = processSE . either (ParseError . show) (process 1) . parse--processSE :: Lojban -> Lojban-processSE (Bridi (NA (SE n selbri)) ss) = processSE $-	Bridi (NA selbri) $ map (first $ flipTag n) ss-processSE (Bridi (SE n selbri) ss) = processSE $-	Bridi selbri $ map (first $ flipTag n) ss-processSE l = l--processCEhU :: Int -> [(Tag, Sumti)] -> [(Tag, Sumti)]-processCEhU n [] = []-processCEhU n ((t, CEhUPre) : rest) = (t, CEhU n) : processCEhU (n + 1) rest-processCEhU n ((t, (LO s (Just (POI (Bridi (ME CEhUPre) ss))))) : rest) =-	(t, LO s $ Just $ POI $ Bridi (ME $ CEhU n) ss) : processCEhU (n + 1) rest-processCEhU n (s : rest) = s : processCEhU n rest--countc :: Text -> Int-countc = countCEhU 0 . (\(Bridi _ s) -> s) . process'--countCEhU :: Int -> [(Tag, Sumti)] -> Int-countCEhU n [] = n-countCEhU n ((t, CEhUPre) : rest) = countCEhU (n + 1) rest-countCEhU n ((t, (LO s (Just (POI (Bridi (ME CEhUPre) ss))))) : rest) =-	countCEhU (n + 1) rest-countCEhU n (_ : rest) = countCEhU n rest--flipTag :: Int -> Tag -> Tag-flipTag n (FA f)-	| f == 1 = FA n-	| f == n = FA 1-flipTag _ t = t--process n s = case process' s of-	Bridi selbri terms -> Bridi selbri (processCEhU n terms)-	r -> r--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 1 t-process' (P.Prenex ss (_, "zo'u", _) _ t) = Prenex (map readSumti ss) $ process 1 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' (TermsBridiTail ss _ _-	(GekSentence-		(STagGik-			(P.Time _ [((_, tense, _), _, _)] _ _)-			((_, "gi", _), _, _))-		t ((_, "gi", _), _, _) u _ _ _)) =-	TenseGI tense-		(process 1 $ TermsBridiTail ss undefined undefined t)-		(process (1 +-			(countc $ TermsBridiTail ss undefined undefined t)) $-			TermsBridiTail ss undefined undefined u)-process' (GekSentence-	(STagGik-		(P.Time _ [((_, tense, _), _, _)] _ _)-		((_, "gi", _), _, _))-	t ((_, "gi", _), _, _) u _ _ _) =-	TenseGI tense-		(process 1 t)-		(process 1 u)-process' (P.Selbri selbri) = Bridi (readSelbri selbri) []-process' (P.SelbriTailTerms selbri ts _ _) =-	Bridi (readSelbri selbri) $ processTagSumti [] ts-process' t = NotImplemented $ "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 _ Nothing (_, b, _) _ _) = (Nothing, BAI Nothing b)-readTag (P.BAI _ (Just (_, s, _)) (_, b, _) _ _) = (Nothing, BAI (Just s) b)-readTag (P.Time _ [((_, t, _), Nothing, Nothing)] _ _) =-	(Nothing, Time [t])-readTag (P.Time _ _ _ ts) = (Nothing, Time $ map readTime ts)-readTag t = (Nothing, NotImplementedTag $ "readTag: " ++ show t)--readTime ::  IntervalProperty -> String-readTime (ZAhO (_, z, _) _) = z-readTime ip = "readTime: " ++ show ip--faList :: [(String, Int)]-faList = [-	("fa", 1),-	("fe", 2),-	("fi", 3),-	("fo", 4),-	("fu", 5)- ]--readSumti :: P.Sumti -> Sumti-readSumti (P.KOhA (_, "ce'u", _) [XINumber (_, "xi", _) _ [([], pa, [])] _]) =-	CEhU $ round $ paToInt [pa]-readSumti (P.KOhA (_, "ce'u", _) []) = CEhUPre-readSumti s@(P.KOhA (_, "ce'u", _) f) = NotImplementedSumti $ show s-readSumti (P.KOhA (_, k, _) _) = KOhA k-readSumti (LALE (_, "lo", _) _ st _ _) = LO selbri relative-	where (selbri, relative) = readSumtiTail st-readSumti (LALE (_, "la", _) _ st _ _) = LA $ Right selbri-	where (selbri, _relative) = readSumtiTail st-readSumti (P.LA (_, "la", _) _ _ [(_, n, _)] _) = LA $ Left n-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 (P.ZOI _ "zoi" ws _ _) = ZOI $ processZOI $ concat ws-readSumti (P.LAhE_NAhE (_, "tu'a", _) _ _ _ s _ _) = TUhA $ readSumti s-readSumti (P.OuterQuantifier _ s (Just (P.GOI (_, "goi", _) _ t _ _))) =-	GOI (readSumti s) (readSumti t)-readSumti (P.LerfuString ls _ _) = LerfuString $ concatMap (\(_, s, _) -> s) ls-readSumti (GekSumti-	(STagGik (P.Time _ [((_, pu, _), _, _)] _ _) ((_, "gi", _), _, _))-	s ((_, "gi", _), _, _) t) = STense pu (readSumti s) (readSumti t)-readSumti s = NotImplementedSumti $ "readSumti: " ++ show s--processZOI :: String -> String-processZOI ('.' : str) = let ('.' : s) = reverse str in-	dropWhile isSpace $ reverse $ dropWhile isSpace s--readMex :: Operand -> Mex-readMex (P.Number n _ _) = readNumber n-readMex (P.JOhI (_, "jo'i", _) _ ns _ _) = JOhI $ map readMex ns-readMex o = NotImplementedMex $ "readMex: " ++ show o--readNumber :: [Clause] -> Mex-readNumber = Number . paToInt . map (\(_, p, _) -> p)--processKIhO :: [String] -> [String]-processKIhO = reverse . pk 3 . reverse-	where-	pk _ [] = []-	pk n ("ki'o" : rest) = replicate n "no" ++ pk 3 rest-	pk n (pa : rest)-		| n > 0 = pa : pk (n - 1) rest-		| otherwise = pa : pk 2 rest--paToInt :: [String] -> Double-paToInt ("ni'u" : pas) = - (pti $ reverse $ processKIhO pas)-paToInt pas = pti $ reverse $ processKIhO pas--pti [] = 0-pti (p : rest) = fromJust (lookup' p paList) + 10 * pti rest--lookup' :: Eq a => a -> [([a], b)] -> Maybe b-lookup' _ [] = Nothing-lookup' x ((xs, y) : ys)-	| x `elem` xs = Just y-	| otherwise = lookup' x ys--paList :: [([String], Double)]-paList = [-	(["no", "0"], 0),-	(["pa", "1"], 1),-	(["re", "2"], 2),-	(["ci", "3"], 3),-	(["vo", "4"], 4),-	(["mu", "5"], 5),-	(["xa", "6"], 6),-	(["ze", "7"], 7),-	(["bi", "8"], 8),-	(["so", "9"], 9)- ]--readSumtiTail :: SumtiTail -> (Selbri, Maybe RelativeClause)-readSumtiTail (SelbriRelativeClauses s Nothing) =-	(readSelbri s, Nothing)-readSumtiTail (SelbriRelativeClauses s (Just r)) =-	(readSelbri s, Just $ readRelativeClauses r)-readSumtiTail st = (NotImplementedSelbri $ "readSumtiTail: " ++ show st, Nothing)--readRelativeClauses :: P.RelativeClause -> RelativeClause-readRelativeClauses (NOI (_, "poi", _) _ bridi _ _) =-	POI $ process 1 bridi-readRelativeClauses r = Debug $  show r--readSelbri :: P.Selbri -> Selbri-readSelbri (P.Brivla (_, b, _) _) = Brivla $ map toLower b-readSelbri (P.Linkargs selbri (BE (_, "be", _) _ sumti _ _ _)) =-	Linkargs (readSelbri selbri) (readSumti sumti)-readSelbri (P.NU (_, "nu", _) _ _ _ bridi _ _) = NU $ process 1 bridi-readSelbri (P.NU (_, "du'u", _) _ _ _ bridi _ _) = DUhU $ process 1 bridi-readSelbri (P.NA (_, "na", _) _ s) = NA $ readSelbri s-readSelbri (P.ME (_, "me", _) _ s _ _ _ _) = ME $ readSumti s-readSelbri (P.SE (_, se, _) _ s) = SE (fromJust $ lookup se seList) $ readSelbri s-readSelbri s = NotImplementedSelbri $ "readSelbri: " ++ show s--seList = [-	("se", 2),-	("te", 3),-	("ve", 4),-	("xe", 5)- ]-	-next :: Int -> [Int] -> Int-next n e-	| (n + 1) `elem` e = next (n + 1) e-	| otherwise = n + 1
+ src/Liste.hs view
@@ -0,0 +1,93 @@+module Liste (skaste, mezofatcidu, mezosetcidu, mezopatcidu) where++import Data.Maybe++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+ ]++mezofatcidu :: String -> Int+mezofatcidu = fromJust . flip lookup mezofaliste++mezofaliste :: [(String, Int)]+mezofaliste = [+	("fa", 1),+	("fe", 2),+	("fi", 3),+	("fo", 4),+	("fu", 5)+ ]++mezopatcidu :: [String] -> Double+mezopatcidu ("ni'u" : pas) = - (pti $ reverse $ processKIhO pas)+mezopatcidu pas = pti $ reverse $ processKIhO pas++pti :: [String] -> Double+pti [] = 0+pti (p : rest) = fromJust (lookup' p mezopaliste) + 10 * pti rest++lookup' :: Eq a => a -> [([a], b)] -> Maybe b+lookup' _ [] = Nothing+lookup' x ((xs, y) : ys)+	| x `elem` xs = Just y+	| otherwise = lookup' x ys++processKIhO :: [String] -> [String]+processKIhO = reverse . pk 3 . reverse+	where+	pk _ [] = []+	pk n ("ki'o" : rest) = replicate n "no" ++ pk 3 rest+	pk n (pa : rest)+		| n > 0 = pa : pk (n - 1) rest+		| otherwise = pa : pk 2 rest++mezopaliste :: [([String], Double)]+mezopaliste = [+	(["no", "0"], 0),+	(["pa", "1"], 1),+	(["re", "2"], 2),+	(["ci", "3"], 3),+	(["vo", "4"], 4),+	(["mu", "5"], 5),+	(["xa", "6"], 6),+	(["ze", "7"], 7),+	(["bi", "8"], 8),+	(["so", "9"], 9)+ ]++mezosetcidu :: String -> Int+mezosetcidu = fromJust . flip lookup mezoseliste++mezoseliste :: [(String, Int)]+mezoseliste = [+	("se", 2),+	("te", 3),+	("ve", 4),+	("xe", 5)+ ]
+ src/Minde.hs view
@@ -0,0 +1,68 @@+module Minde (minde) where++import Klesi(Minde(..), Sumti)++import Text.XML.YJSVG(showSVG)+import Graphics.UI.GLUT.Turtle(setFieldSize,+	Field, outputString,+	Turtle, runInputs, inputs, getSVG,+	goto, forward, backward, left, right, beginfill, endfill, undo,+	penup, pendown, hideturtle, showturtle, shapesize,+	pensize, pencolor, fillcolor, bgcolor, windowWidth, windowHeight)++import Control.Applicative((<$>))+import Data.IORef(IORef, readIORef)+import Data.IORef.Tools(atomicModifyIORef_)++--------------------------------------------------------------------------------++vabytcidu :: Eq a => a -> IORef [(a, b)] -> IO (Maybe b)+vabytcidu cmene vanbi = lookup cmene <$> readIORef vanbi++vabyciha :: a -> b -> IORef [(a, b)] -> IO ()+vabyciha cmene fasnu vanbi = atomicModifyIORef_ vanbi ((cmene, fasnu) :)++minde :: Field -> Turtle -> IORef [(String, [Sumti] -> Minde)] -> Minde -> IO Bool+minde _ t _ (KLAMA x y) = goto t x y >> return True+minde _ t _ (CRAKLA d) = forward t d >> return True+minde _ t _ (RIXYKLA d) = backward t d >> return True+minde _ t _ (ZUNLE d) = left t d >> return True+minde _ t _ (PRITU d) = right t d >> return True+minde _ t _ COhACLUGAU = beginfill t >> return True+minde _ t _ COhUCLUGAU = endfill t >> return True+minde _ t _ (PEBYCISNI s) = pensize t s >> return True+minde _ t _ (PEBYSKA r g b) = pencolor t (r, g, b) >> return True+minde _ t _ (BURSKA r g b) = fillcolor t (r, g, b) >> return True+minde _ t _ (FLOSKA r g b) = bgcolor t (r, g, b) >> return True+minde _ t _ NAPILNOLOPENBI = penup t >> return True+minde _ t _ PILNOLOPENBI = pendown t >> return True+minde _ t _ NAVISKA = hideturtle t >> return True+minde _ t _ VISKA = showturtle t >> return True+minde _ t _ (CISNI s) = shapesize t s s >> return True+minde f _ _ (CISNYGAUFOLDI w h) = setFieldSize f w h >> return True+minde _ t _ XRUTI = undo t >> return True+minde _ _ vanbi (MORJI cmene fasnu) = vabyciha cmene fasnu vanbi >> return True+minde f t vanbi (GASNU cmene sumti) = vabytcidu cmene vanbi >>=+	minde f t vanbi . maybe (SRERA $ "not defined: " ++ cmene) ($ sumti)+minde _ t _ (REJGAUSETAICAK fp) = inputs t >>= writeFile fp . show >> return True+minde _ t _ (TCIDU fp) = readFile fp >>= runInputs t . read >> return True+minde _ t _ (REJGAUSETAISVG fp) = do+	w <- windowWidth t+	h <- windowHeight t+	svg <- getSVG t+	writeFile fp $ showSVG w h svg+	return True+minde _ _ _ (REJGAUSETAIJBO _) = return True+minde _ _ _ (TCIDUSETAIJBO _) = return True+minde _ _ _ COhO = return False+minde f t vanbi (MIDYSTE cl) = mapWhile (minde f t vanbi) cl+minde f _ _ (SRERA str) = do+	outputString f ".i mi na jimpe"+	putStrLn $ "error: " ++ str+	return True++mapWhile :: Monad m => (a -> m Bool) -> [a] -> m Bool+mapWhile _ [] = return True+mapWhile f (x : xs) = do+	b <- f x+	if b then mapWhile f xs else return False
+ src/Tcidu.hs view
@@ -0,0 +1,213 @@+module Tcidu(parse) where++import Control.Arrow(first, second)+import Data.Maybe(catMaybes)+import Data.Char(isSpace, toLower)+import qualified Language.Lojban.Parser as P(+	parse, Text, Clause,+	Sentence(..), Gek(..), Free(..), IntervalProperty(..),+	Selbri(..), Linkargs(..),+	Tag(..), Sumti(..), SumtiTail(..), RelativeClause(..), Operand(..))+import Klesi(+	Text(..), Selbri(..), Tag(..), Sumti(..), Mex(..), RelativeClause(..))+import Liste(mezofatcidu, mezosetcidu, mezopatcidu)++--------------------------------------------------------------------------------++parse :: String -> Text+parse = either (ParseError . show) (snd . process 1) . P.parse++process :: Int -> P.Text -> (Int, Text)+process n ptext = second flipText $ proc n ptext+	where+	flipText (Bridi (NA (SE i selbri)) terms) =+		flipText $ Bridi (NA selbri) $ flipTerms i terms+	flipText (Bridi (SE i selbri) terms) =+		flipText $ Bridi selbri $ flipTerms i terms+	flipText text = text+	flipTerms i = map $ first flipTag+		where+		flipTag (FA f)+			| f == 1 = FA i+			| f == i = FA 1+		flipTag t = t++some :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])+some _ x0 [] = (x0, [])+some f x0 (y : ys) = let+	(x1, z) = f x0 y+	(x', zs) = some f x1 ys in+	(x', z : zs)++proc :: Int -> P.Text -> (Int, Text)+proc n (P.TopText _ _ _ _ (Just t) _) = proc n t+proc n (P.TopText _ _ [P.VocativeSumti [(_, v, _)] _ _] _ _ _) = (n, Vocative v)+proc n (P.TopText _ _ fs@(_ : _) _ _ _) = (n, Free fs)+proc n (P.IText_1 _ _ _ _ (Just t)) = proc n t+proc n (P.IText_1 _ _ _ [P.VocativeSumti [(_, v, _)] _ _] _) = (n, Vocative v)+proc n (P.IText_1 _ _ _ fs@(_ : _) _) = (n, Free fs)+proc n (P.StatementI ptext iptexts) =+	(0, MultiText $ map snd $ map (proc 1) $ ptext : ptexts)+	where+	ptexts = catMaybes $ map (\(_, _, t) -> t) iptexts+proc n (P.Selbri selbri) = (n, Bridi (readSelbri selbri) [])+proc n (P.SelbriTailTerms pselbri pterms _ _) = (n', Bridi selbri terms)+	where	selbri = readSelbri pselbri+		(n', terms) = processTagSumti n [] pterms+proc n (P.TermsBridiTail pterms _ _ (P.Selbri pselbri)) = (n', Bridi selbri terms)+	where	selbri = readSelbri pselbri+		(n', terms) = processTagSumti n pterms []+proc n (P.TermsBridiTail pterms1 _ _ (P.SelbriTailTerms pselbri pterms2 _ _)) =+	(n', Bridi selbri terms)+	where	selbri = readSelbri pselbri+		(n', terms) = processTagSumti n pterms1 pterms2+proc n (P.Prenex psumti (_, "zo'u", _) _ t) = (n', Prenex sumti ret)+	where	sumti = map readSumti psumti+		(n', ret) = process n t+proc n (P.PrenexSentence psumti (_, "zo'u", _) _ t) = (n', Prenex sumti ret)+	where	sumti = map readSumti psumti+		(n', ret) = process n t+proc n (P.TermsBridiTail ss _ _+	(P.GekSentence+		(P.STagGik+			(P.Time _ [((_, tense, _), _, _)] _ _)+			((_, "gi", _), _, _))+		t ((_, "gi", _), _, _) u _ _ _)) =+	(n2, TagGI tense ret1 ret2)+	where+	(n1, ret1) = process n $ P.TermsBridiTail ss undefined undefined t+	(n2, ret2) = process n1 $ P.TermsBridiTail ss undefined undefined u+proc n (P.GekSentence+	(P.STagGik+		(P.Time _ [((_, tense, _), _, _)] _ _)+		((_, "gi", _), _, _))+	t ((_, "gi", _), _, _) u _ _ _) =+	(n, TagGI tense (snd $ process n t) (snd $ process n u))+proc n t = (n, UnknownText $ "proc: " ++ show t)++processTagSumti :: Int -> [P.Sumti] -> [P.Sumti] -> (Int, [(Tag, Sumti)])+processTagSumti n = curry $ processCEhU n . uncurry pTagSumti+	where+	pTagSumti s t = let+		(n', e, r) = readTagSumti 1 [] [] s+		(_, _, r') = readTagSumti (if n' > 1 then n' else 2) e [] t in+		r ++ r'++processCEhU :: Int -> [(Tag, Sumti)] -> (Int, [(Tag, Sumti)])+processCEhU n [] = (n, [])+processCEhU n ((t, sumti) : rest) = (n', (t, ce'u n) : terms')+	where+	(b, ce'u) = pCEhU sumti+	(n', terms') = processCEhU (n + b) rest++pCEhU :: Sumti -> (Int, Int -> Sumti)+pCEhU CEhUPre = (1, CEhU)+pCEhU (LO selbri (Just (POI (Bridi (ME sumti) ss)))) = let (b, s) = pCEhU sumti in+	(b, \n -> LO selbri $ Just $ POI $ Bridi (ME $ s n) ss)+pCEhU (LO (BE selbri sumti) Nothing) = let (b, s) = pCEhU sumti in+	(b, \n -> LO (BE selbri $ s n) Nothing)+pCEhU (SFIhO modal sumti) =+	let (b, s) = pCEhU sumti in (b, SFIhO modal . s)+pCEhU (GOI sumti1 sumti2) =+	let (b1, s1) = pCEhU sumti1; (b2, s2) = pCEhU sumti2 in+		(b1 + b2, \n -> GOI (s1 n) (s2 $ b1 + n))+pCEhU (LA (Right (ME sumti))) =+	let (b, s) = pCEhU sumti in (b, LA . Right . ME . s)+pCEhU (Relative sumti r) = let (b, s) = pCEhU sumti in (b, flip Relative r . s)+pCEhU (LAhE sumti) = let (b, s) = pCEhU sumti in (b, LAhE . s)+pCEhU sumti = (0, const sumti)++readTagSumti :: Int -> [Int] -> [(Tag, Sumti)] -> [P.Sumti]+	-> (Int, [Int], [(Tag, Sumti)])+readTagSumti n e r [] = (n, e, reverse r)+readTagSumti n e r (P.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, _) _) = (Just $ mezofatcidu f, FA $ mezofatcidu f)+readTag (P.BAI _ Nothing (_, b, _) _ _) = (Nothing, BAI 1 b)+readTag (P.BAI _ (Just (_, s, _)) (_, b, _) _ _) =+	(Nothing, BAI (mezosetcidu s) b)+readTag (P.Time _ [((_, t, _), Nothing, Nothing)] _ _) = (Nothing, Time [t])+readTag (P.Time _ _ _ ts) = (Nothing, Time $ map readTime ts)+readTag t = (Nothing, UnknownTag $ "readTag: " ++ show t)++readTime :: P.IntervalProperty -> String+readTime (P.ZAhO (_, z, _) _) = z+readTime ip = "readTime: " ++ show ip++readSumti :: P.Sumti -> Sumti+readSumti (P.KOhA (_, "ce'u", _) [P.XINumber (_, "xi", _) _ [([], pa, [])] _]) =+	CEhU $ round $ mezopatcidu [pa]+readSumti (P.KOhA (_, "ce'u", _) []) = CEhUPre+readSumti s@(P.KOhA (_, "ce'u", _) f) =+	UnknownSumti $ show s ++ " " ++ show f+readSumti (P.KOhA (_, k, _) _) = KOhA k+readSumti (P.LALE (_, "lo", _) _ st _ _) = LO selbri relative+	where (selbri, relative) = readSumtiTail st+readSumti (P.LALE (_, "la", _) _ st _ _) = LA $ Right selbri+	where (selbri, _relative) = readSumtiTail st+readSumti (P.LA (_, "la", _) _ _ [(_, n, _)] _) = LA $ Left n+readSumti (P.LI _ _ m _ _) = LI $ readMex m+readSumti (P.KU _ _) = KU+readSumti (P.TagSumti (P.FIhO (_, "fi'o", _) _ selbri _ _) sumti) =+	SFIhO (readSelbri selbri) (readSumti sumti)+readSumti (P.ZOI _ "zoi" ws _ _) = ZOI $ processZOI $ concat ws+readSumti (P.LAhE_NAhE (_, "tu'a", _) _ _ _ s _ _) = TUhA $ readSumti s+readSumti (P.OuterQuantifier _ s (Just (P.GOI (_, "goi", _) _ t _ _))) =+	GOI (readSumti s) (readSumti t)+readSumti (P.OuterQuantifier _ s (Just r)) =+	Relative (readSumti s) (readRelativeClauses r)+readSumti (P.LerfuString ls _ _) = LerfuString $ concatMap (\(_, s, _) -> s) ls+readSumti (P.GekSumti+	(P.STagGik (P.Time _ [((_, pu, _), _, _)] _ _) ((_, "gi", _), _, _))+	s ((_, "gi", _), _, _) t) = STense pu (readSumti s) (readSumti t)+readSumti (P.LAhE_NAhE (_, "la'e", _) _ _ _ s _ _) = LAhE $ readSumti s+readSumti s = UnknownSumti $ "readSumti: " ++ show s++processZOI :: String -> String+processZOI ('.' : str) = let ('.' : s) = reverse str in+	dropWhile isSpace $ reverse $ dropWhile isSpace s+processZOI str = let ('.' : s) = reverse str in+	dropWhile isSpace $ reverse $ dropWhile isSpace s++readMex :: P.Operand -> Mex+readMex (P.Number n _ _) = readNumber n+readMex (P.JOhI (_, "jo'i", _) _ ns _ _) = JOhI $ map readMex ns+readMex o = UnknownMex $ "readMex: " ++ show o++readNumber :: [P.Clause] -> Mex+readNumber = Number . mezopatcidu . map (\(_, p, _) -> p)++readSumtiTail :: P.SumtiTail -> (Selbri, Maybe RelativeClause)+readSumtiTail (P.SelbriRelativeClauses s Nothing) =+	(readSelbri s, Nothing)+readSumtiTail (P.SelbriRelativeClauses s (Just r)) =+	(readSelbri s, Just $ readRelativeClauses r)+readSumtiTail st = (UnknownSelbri $ "readSumtiTail: " ++ show st, Nothing)++readRelativeClauses :: P.RelativeClause -> RelativeClause+readRelativeClauses (P.NOI (_, "poi", _) _ bridi _ _) =+	POI $ snd $ process 1 bridi+readRelativeClauses r = UnknownRelativeClause $  show r++readSelbri :: P.Selbri -> Selbri+readSelbri (P.Brivla (_, b, _) _) = Brivla $ map toLower b+readSelbri (P.Linkargs selbri (P.BE (_, "be", _) _ sumti _ _ _)) =+	BE (readSelbri selbri) (readSumti sumti)+readSelbri (P.NU (_, "nu", _) _ _ _ bridi _ _) = NU $ snd $ process 1 bridi+readSelbri (P.NU (_, "du'u", _) _ _ _ bridi _ _) = DUhU $ snd $ process 1 bridi+readSelbri (P.NA (_, "na", _) _ s) = NA $ readSelbri s+readSelbri (P.ME (_, "me", _) _ s _ _ _ _) = ME $ readSumti s+readSelbri (P.SE (_, se, _) _ s) = SE (mezosetcidu se) $ readSelbri s+readSelbri s = UnknownSelbri $ "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
@@ -1,379 +1,41 @@ module Main where -import Graphics.UI.GLUT hiding (R, Repeat)-import Graphics.UI.GLUT.Turtle-import Text.XML.YJSVG+import Minde(minde)+import Jimpe(jimpe)+import Tcidu(parse)+import Klesi(Text(ParseError), Minde(REJGAUSETAIJBO, TCIDUSETAIJBO)) -import Language.Lojban.Read+import Graphics.UI.GLUT(mainLoop)+import Graphics.UI.GLUT.Turtle(+	initialize, openField, prompt, oninputtext,+	newTurtle, notundo, shape, shapesize)	+import Data.IORef(newIORef, readIORef)+import Data.IORef.Tools(atomicModifyIORef_) -import System.Environment-import System.IO.Unsafe-import Data.Maybe-import Data.IORef-import Data.IORef.Tools-import Control.Applicative-import Control.Monad +--------------------------------------------------------------------------------+ main :: IO () main = do-	prgName <- getProgName-	rawArgs <- getArgs-	_args <- initialize prgName rawArgs+	_args <- initialize 	f <- openField "cakyrespa" 640 480-	prompt f ".i " 	t <- newTurtle f---	pencolor t ((255, 255, 255) :: (Int, Int, Int))---	fillcolor t ((255, 255, 255) :: (Int, Int, Int))+	env <- newIORef []+	cmds <- newIORef []+	prompt f ".i " 	shape t "turtle" 	shapesize t 3 3-	oninputtext f (processInput f t . cmd)+	notundo t+	oninputtext f $ \cmd -> do+		let	p = parse cmd+			j = jimpe p+		case (p, j) of+			(_, REJGAUSETAIJBO fp) ->+				writeFile fp . unlines . reverse =<< readIORef cmds+			(_, TCIDUSETAIJBO fp) ->+				readFile fp >>= minde f t env . jimpe . parse+					>> return ()+			(ParseError _, _) -> return ()+			_ -> atomicModifyIORef_ cmds ((".i" ++ cmd) :)+		minde f t env j 	mainLoop--cmd :: String -> Command-cmd = flip pcmd [] . readLojban--pcmd :: Lojban -> [Argument] -> Command-pcmd p = case p of-	Vocative "co'o" -> const COhO-	TenseGI "ba" b c -> \args -> Commands (pcmd b args) (pcmd c args)-	Prenex ss b -> const $ CommandList $ do-		rss <- mapM sumtiToArgument ss-		return $ pcmd b rss-	b@(Bridi (Brivla "gasnu") s) ->-		\args -> fromMaybe (Unknown b) $ readGasnu s args-	b@(Bridi (Brivla "morji") s) -> const $ fromMaybe (Unknown b) $ readMorji s-	b@(Bridi (Brivla "klama") s) -> const $ fromMaybe (Unknown b) $ readKlama s-	b@(Bridi (Brivla "galfi") s) -> const $ fromMaybe (Unknown b) $ readGalfi s-	b@(Bridi (Brivla "tcidu") s) -> const $ fromMaybe (Unknown b) $ readTcidu s-	b@(Bridi (Brivla "rejgau") s) -> const $ fromMaybe (Unknown b) $ readRejgau s-	b@(Bridi (Brivla "viska") s) -> const $ fromMaybe (Unknown b) $ readViska s-	b@(Bridi (NA (Brivla "viska")) s) -> const $ fromMaybe (Unknown b) $ readNAViska s-	b@(Bridi (Brivla "cisni") s) -> const $ fromMaybe (Unknown b) $ readCisni s-	b@(Bridi (Brivla "xruti") s) -> const $ fromMaybe (Unknown b) $ readXruti s-	b@(Bridi (Brivla "rapli") s) -> const $ fromMaybe (Unknown b) $ readRapli s-	b@(Bridi (Brivla "carna") s) -> fromMaybe (const $ Unknown b) $ readCarna s-	b@(Bridi (Brivla "crakla") s) -> fromMaybe (const $ Unknown b) $ readCrakla s-	b@(Bridi (Brivla "rixykla") s) -> const $ fromMaybe (Unknown b) $ readRixykla s-	b@(Bridi (Brivla "pilno") s) ->-		fromMaybe (const $ Unknown b) $ readBAPilno s-	b@(Bridi (NA (Brivla "pilno")) s) -> const $ fromMaybe (Unknown b) $ readNAPilno s-	b@(Bridi (Brivla "clugau") s) -> const $ fromMaybe (Unknown b) $ readClugau s-	r -> const $ Unknown r--updateReaders :: (Lojban -> Maybe Command) -> Lojban -> Maybe ([Argument] -> Command)-updateReaders reader text = do-	c <- reader text-	return $ const c--readGasnu s a = do-	KOhA "ko" <- lookup (FA 1) s-	LerfuString cmene <- lookup (FA 2) s-	return $ GASNU cmene a--readMorji s = do-	KOhA "ko" <- lookup (FA 1) s-	GOI (LerfuString cmene) (LO (DUhU fasnu) _) <- lookup (FA 2) s-	return $ MORJI cmene $ pcmd fasnu--readKlama s = do-	KOhA "ko" <- lookup (FA 1) s-	LI (JOhI [Number x, Number y]) <- lookup (FA 2 ) s-	return $ KLAMA x y--readGalfi s = do-	TUhA (KOhA "ko") <- lookup (FA 1) s-	LO (Brivla "foldi") Nothing <- lookup (FA 2) s-	LO (Brivla skari) Nothing <- lookup (FA 3) s-	clr <- lookup skari skaste-	return $ let (r, g, b) = clr in FLOSKA r g b--readTcidu s = do-	KOhA "ko" <- lookup (FA 1) s-	LA (Right (ME (ZOI fp))) <- lookup (FA 2) s-	return $ READFILE fp--readRejgau s = do-	KOhA "ko" <- lookup (FA 1) s-	ZOI fp <- lookup (BAI Nothing "me'e") s-	tai <- lookup (BAI (Just "se") "tai") s-	case tai of-		LA (Right (Brivla "cakyrespa")) -> return $ SAVEASCAK fp-		LA (Left "syvygyd") -> return $ SAVEASSVG fp-		s -> error $ show s--readViska :: [(Tag, Sumti)] -> Maybe Command-readViska s = do-	KOhA "ko" <- lookup (FA 2) s-	return VISKA--readNAViska :: [(Tag, Sumti)] -> Maybe Command-readNAViska s = do-	KOhA "ko" <- lookup (FA 2) s-	return NAVISKA--readNAPilno :: [(Tag, Sumti)] -> Maybe Command-readNAPilno s = do-	KOhA "ko" <- lookup (FA 1) s-	return NAPILNOLOPENBI--readCisni :: [(Tag, Sumti)] -> Maybe Command-readCisni s = do-	LI (Number n) <- lookup (FA 1) s-	KOhA "ko" <- lookup (FA 2) s-	return $ CISNI n--readXruti :: [(Tag, Sumti)] -> Maybe Command-readXruti s = do-	KOhA "ko" <- lookup (FA 1) s-	return $ XRUTI--readRapli :: [(Tag, Sumti)] -> Maybe Command-readRapli s = do-	LO (NU p) _ <- lookup (FA 1) s-	LI (Number n) <- lookup (FA 2) s-	return $ Repeat (round n) (pcmd p [])--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"--readBAPilno :: [(Tag, Sumti)] -> Maybe ([Argument] -> Command)-readBAPilno s = do-	cm <- readPilno s-	if (Time ["ba"], KU) `elem` s then return cm-		else return $ \args -> Commands (cm args) PILNOLOPENBI--readPilno :: [(Tag, Sumti)] -> Maybe ([Argument] -> 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 $ const $ PEBYCISNI size-		LO (Linkargs (Brivla "penbi") (SFIhO (Brivla "cisni") (LI-			(Number size)))) _ -> return $ const $ PEBYCISNI size-		LO (Brivla "penbi") (Just (POI (Bridi (Brivla skari) []))) -> do-			(r, g, b) <- lookup skari skaste-			return $ const $ PEBYSKA r g b-		LO (Linkargs (Brivla "penbi") (LO (Brivla skari) _)) _ -> do-			(r, g, b) <- lookup skari skaste-			return $ const $ PEBYSKA r g b-		LO (Brivla "penbi") (Just (POI (Bridi (ME me) []))) -> do-			case me of-				LO (Brivla skari) _ -> do-					(r, g, b) <- lookup skari skaste-					return $ const $ PEBYSKA r g b-				CEhU i -> return $ \args ->-					fromMaybe (ErrorC "bad args") $ do-						skari <- getALO args i-						pebska <- mapM colorNameToPEBYSKA skari-						return $ CommandList pebska-		LO (Brivla "burcu") (Just (POI (Bridi (Brivla skari) []))) -> do-			(r, g, b) <- lookup skari skaste-			return $ const $ BURSKA r g b-		LO (Linkargs (Brivla "burcu") (SFIhO (Brivla "skari") (LO-			(Brivla skari) _))) _ -> do-			(r, g, b) <- lookup skari skaste-			return $ const $ BURSKA r g b-		LO (Brivla "penbi") Nothing -> return $ const PILNOLOPENBI-		_ -> return $ const $ UnknownSelpli selpli---colorNameToPEBYSKA :: String -> Maybe Command-colorNameToPEBYSKA skari = do-	(r, g, b) <- lookup skari skaste-	return $ PEBYSKA r g b--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 (Either Double Int)-readLAhU2 s = do-	lahu <- lookup (BAI Nothing "la'u") s-	case lahu of-		LI (Number d) -> return $ Left d-		CEhU i -> return $ Right i-		_ -> fail "bad"--readCrakla :: [(Tag, Sumti)] -> Maybe ([Argument] -> Command)-readCrakla s = do-	KOhA "ko" <- lookup (FA 1) s-	return $ case readLAhU2 s of-		Just (Left d) -> const $ CRAKLA d-		Just (Right i) -> \args -> if length args < i-			then ErrorC $ "too few args " ++ show i ++ " for " ++-				show (length args)-			else case args !! (i - 1) of-				ADouble d -> CRAKLA d-				_ -> ErrorC "bad argument"-		_ -> const $ CRAKLA 100---	return $ const $ CRAKLA $ maybe 100 (\(Left d) -> d) $ readLAhU2 s--readRixykla :: [(Tag, Sumti)] -> Maybe Command-readRixykla s = do-	KOhA "ko" <- lookup (FA 1) s-	return $ RIXYKLA $ maybe 100 (\(Left d) -> d) $ readLAhU2 s--readCarna :: [(Tag, Sumti)] -> Maybe ([Argument] -> Command)-readCarna s = do-	KOhA "ko" <- lookup (FA 1) s-	LO (Brivla lr) _ <- return $---	let	LO (Brivla lr) _ =-			fromMaybe (LO (Brivla "zunle") Nothing) $ lookup (FA 3) s---		d = maybe 90 (\(Left d) -> d) $ readLAhU2 s-	let	d = fromMaybe (Left 90) $ readLAhU2 s-	case lr of-		"zunle" -> return $ flip (either $ const . ZUNLE) d $ \i args ->-			maybe (ErrorC "bad args") ZUNLE $ getDouble args i-		"pritu" -> return $ flip (either $ const . PRITU) d $ \i args ->-			maybe (ErrorC "bad args") PRITU $ getDouble args i-		_ -> fail "bad"--getDouble :: [Argument] -> Int -> Maybe Double-getDouble args i = do-	when (length args < i) $ fail "bad"-	ADouble d <- return $ args !! (i - 1)-	return d--getALO :: [Argument] -> Int -> Maybe [String]-getALO args i = do-	when (length args < i) $ fail "bad"-	ALO s <- return $ args !! (i - 1)-	return [s]--data Argument-	= ADouble Double-	| AInt Int-	| ACommand Command-	| ALO String-	| ACons Argument Argument---	deriving Show--sumtiToArgument (LI (Number n)) = [ADouble n]-sumtiToArgument (LO (Brivla s) _) = [ALO s]-sumtiToArgument (STense "ba" s_ t_) =-	sumtiToArgument s_ ++-	sumtiToArgument t_-sumtiToArgument s = error $ "sumtiToArgument :" ++ show s--data Command-	= KLAMA Double Double-	| CRAKLA Double | RIXYKLA Double-	| ZUNLE Double | PRITU Double-	| PEBYCISNI Double-	| PEBYSKA Int Int Int-	| BURSKA Int Int Int-	| FLOSKA Int Int Int-	| COhACLUGAU-	| COhUCLUGAU-	| Commands Command Command-	| CommandList [Command]-	| Repeat Int Command-	| XRUTI-	| CISNI Double-	| NAPILNOLOPENBI-	| PILNOLOPENBI-	| NAVISKA-	| VISKA-	| SAVEASSVG FilePath-	| SAVEASCAK FilePath-	| READFILE FilePath-	| MORJI String ([Argument] -> Command)-	| GASNU String [Argument]-	| COhO | Unknown Lojban | ParseErrorC | UnknownSelpli Sumti-	| ErrorC String---	deriving Show--type Table = [(String, [Argument] -> Command)]-theTable :: IORef Table-theTable = unsafePerformIO $ newIORef []-morji :: String -> ([Argument] -> Command) -> IO ()-morji cmene fasnu = atomicModifyIORef_ theTable ((cmene, fasnu) :)-tcidu :: String -> IO (Maybe ([Argument] -> Command))-tcidu cmene = lookup cmene <$> readIORef theTable--data LR = L | R | BadLR deriving Show--processInput :: Field -> Turtle -> Command -> IO Bool-processInput _ t (KLAMA x y) = goto t x y >> return True-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 (FLOSKA r g b) = bgcolor t (r, g, b) >> return True-processInput _ t COhACLUGAU = beginfill t >> return True-processInput _ t COhUCLUGAU = endfill t >> return True-processInput _ t XRUTI = undo t >> return True-processInput _ t (CISNI s) = shapesize t s s >> return True-processInput _ t NAPILNOLOPENBI = penup t >> return True-processInput _ t PILNOLOPENBI = pendown t >> return True-processInput _ t NAVISKA = hideturtle t >> return True-processInput _ t VISKA = showturtle t >> return True-processInput _ _ COhO = return False-processInput f t (Commands c d) = processInput f t c >> processInput f t d-processInput f t (CommandList cl) =-	mapM_ (processInput f t) cl >> return True-processInput f t (Repeat n c) = sequence_ (replicate n (processInput f t c)) >>-	return True-processInput f t (MORJI cmene fasnu) = morji cmene fasnu >> return True-processInput f t (GASNU cmene sumti) = do-	mfasnu <- tcidu cmene-	flip (maybe $ processInput f t $ ErrorC $ "not defined: " ++ cmene) mfasnu $-		\fasnu -> processInput f t $ fasnu sumti-processInput _ t (SAVEASSVG fp) = do-	w <- windowWidth t-	h <- windowHeight t-	svg <- getSVG t-	writeFile fp $ showSVG w h svg-	return True-processInput _ t (SAVEASCAK fp) = inputs t >>= writeFile fp . show >> return True-processInput _ t (READFILE fp) = readFile fp >>= runInputs t . read >> return True-processInput f _ (Unknown u) = do-	outputString f ".i mi na jimpe"-	putStr "Unknown " >> print u-	return True-processInput f _ (UnknownSelpli us) = do-	outputString f ".i mi na djuno lo bi'unai selpli"-	putStr "Unknown " >> print us-	return True-processInput f _ ParseErrorC = do-	outputString f ".i di'u na drani fo lo gerna"-	return True-processInput f _ (ErrorC str) = do-	putStrLn $ "error: " ++ str-	return True