graph-rewriting-cl-0.2.2: Main.hs

{-# LANGUAGE UnicodeSyntax, FlexibleInstances #-}
module Main where

import GraphRewriting.GL.Render
import GraphRewriting.GL.UI as UI
import Term (parseFile)
import Graph
import GL ()
import Rules
import GraphRewriting
import GraphRewriting.Graph.Write.Unsafe as Unsafe
import GraphRewriting.Layout.Coulomb
import GraphRewriting.Layout.SpringEmbedder
import GraphRewriting.Layout.Gravitation
import GraphRewriting.Layout.Wrapper


instance Render (Wrapper Vertex) where render = render . wrappee

main ∷ IO ()
main = do
	(prog,args) ← UI.initialise
	file ← case args of
		[f] → return f
		___ → error "usage: comb [GLUT-options] <file>"
	term ← parseFile file
	let graph = fromTerm term
	UI.run 40 id layoutStep (wrapGraph graph) ruleTree 

layoutStep n = do
	(cgf, cf, sf, rot) ← readOnly $ do
		cgf ← centralGravitation n
		cf ← coulombForce n
		sf ← springForce 1.5 n
		rot ← angularMomentum n
		return (cgf, cf, sf, rot)
	Unsafe.adjustNode (Position . sf (*0.9) . cgf (*0.01) . cf (\x → min (100/(x^2+0.1)) 10) . position) n
	-- Unsafe.adjustNode (rot (*0.9)) n

-- anyRule = anyOf [ eliminate, ruleI, ruleK0, ruleK1, ruleS0, ruleS1, ruleS2, ruleE0, ruleE1, ruleE2, ruleD0, ruleD1, ruleD2]

ruleTree = Branch "All"
--	[Branch "Optimisation"
--	 	[Leaf "S(Kx)(Ky) -> K(xy)" optimStoK,
--	 	 Leaf "S(Kx)I    -> x"     optimStox,
--	 	 Leaf "S(Kx)y    -> Bxy"   optimStoB,
--	 	 Leaf "Sx(Ky)    -> Cxy"   optimStoC,
--	 	 Leaf "S(Bkx)y   -> S'kxy" optimStoS',
--	 	 Leaf "B(kx)y    -> B'kxy" optimBtoB',
--	 	 Leaf "C(Bkx)y   -> C'kxy" optimCtoC'],
	[Branch "General"
	 	[Leaf "Eliminate" eliminate,
	 	 Leaf "Erase" (erase0 <|> eraseApplicator),
	 	 Leaf "Duplicate" duplicate],
	 Branch "Combinators"
	 	[Leaf "S" combinatorS,
	 	 Leaf "K" combinatorK,
	 	 Leaf "I" combinatorI,
	 	 Leaf "B" combinatorB,
	 	 Leaf "C" combinatorC,
	 	 Leaf "S'" combinatorS',
	 	 Leaf "B'" combinatorB',
	 	 Leaf "C'" combinatorC',
	 	 Leaf "W" combinatorW]]