import System.Exit
import Graphics.UI.GLUT
import Control.Monad
import Control.Concurrent
import Graphics.Rendering.OpenGL
import Data.IORef
import Data.Function
import Data.List

type R = GLdouble

data Kosha = (:=^.^=:) {koshaNapravlenie :: [R], koshaKoordinata :: [R]}
data Misha = (:>^^<:) {mishaNapravlenie :: [R], mishaKoordinata :: [R]}

koshi = map ([sK,0] :=^.^=:) [[0,0.5],[0.5,0],[-0.5,0],[0,-0.5]]
mishi = map ([0,sM] :>^^<:)  (replicateM 2 [-0.7,-0.5..0.7])
initial = (koshi,mishi)
sK = 0.005; dtK = 0.08
sM = 0.005

main = initialWindowSize $= Size 987 987 >>
    initialWindowPosition $= Position 0 0 >>
    initialDisplayMode $= [DoubleBuffered] >>
    createWindow "ursula" >>
	newIORef initial >>= \ior ->
        keyboardMouseCallback $= Just (\_ _ _ _ -> exitWith ExitSuccess) >>
        displayCallback $= dlay ior >>
        idleCallback $= Just (anime ior) >>
        mainLoop

dlay ior = clearColor $= Color4 0 0 0 0 >>
    clear [ColorBuffer] >>
    readIORef ior >>= drawDoxyq >>
    swapBuffers

anime ior = modifyIORef' ior shag >>
    threadDelay 20000 >>
    postRedisplay Nothing

drawDoxyq (koshi,mishi) =
    currentColor $= Color4 1 1 1 1 >>
    drawCircle (1 :: R) [0,0] >>
    currentColor $= Color4 0 0 0 0 >>
    mapM_ drawKosha koshi >>
    mapM_ drawMisha mishi

drawKosha (_ :=^.^=: c) = drawCircle 0.04 c >>
    currentColor $= Color4 0.5 0.5 0.3 0.8 >>
    mapM_ (drawCircle 0.01) [c .+. [-0.02,0.01],c .+. [0.02,0.01]] >>
    mapM_ (drawCircle 0.015) [c .+. [-0.01,-0.015],c .+. [0.01,-0.015]] >>
    currentColor $= Color4 0 0 0 0 >>
    mapM_ (drawCircle 0.012) [c .+. [-0.009,-0.007],c .+. [0.009,-0.007]]

drawMisha (_ :>^^<: c) = currentColor $= Color4 0.6 0.6 0.6 0.6 >> drawCircle 0.02 c

drawCircle r [x,y] = renderPrimitive TriangleFan (mapM_ vertex [Vertex2 (x+r*cos t) (y+r*sin t) | t <- [0,0.1..2*pi]])

(.+.) = zipWith (+)
(.-.) = zipWith (-)
v .*. u = sum (zipWith (*) v u)
[a,b] .<>. [c,d] = a*d - b*c
v .<. u = atan2 (v .<>. u) (v .*. u)
norm = sqrt . sum . map (^2)
dist a b = norm (a .-. b)
t *. v = map (*t) v
arg [x,y] = atan2 y x
neg = map negate
povernut [x,y] t = [x*cos t-y*sin t,y*cos t+x*sin t]

shag (koshi,mishi) = (koshi',mishi') where
    koshi' = map obrabotatKoshu koshi
    mishi' = mishi >>= obrabotatMishu

    obrabotatKoshu (v :=^.^=: c) = v' :=^.^=: c' where
        v' = povernut v (dtK * (v .<. (cm .-. c)))
        c' = c .+. v'
        blizhajshajaMisha@(_ :>^^<: cm) = minimumBy (compare `on` dist c . mishaKoordinata) mishi

    obrabotatMishu (v :>^^<: c) = [v' :>^^<: c' | 0.04 < dist c ck] where
        c' = c .+. v'
        v'  | vperediKosha = povernut v (if norm (c .+. (100 *. povernut v (pi/2))) < 1 then pi/2 else -pi/2)
            | stenaRjadom = head [v' | tt <- [0,0.01..], t <- [tt,-tt], let v' = povernut v t, 0.4 < rasstojanieDoSteni v']
            | otherwise = v
        vperediKosha = or [dist c ck < 0.3 && abs (v .<. (ck .-. c)) < (pi/4) | _ :=^.^=: ck <- koshi]
        stenaRjadom = rasstojanieDoSteni v < 0.2
        rasstojanieDoSteni v = norm (t *. v) where
            t = reshitKvUr [norm v^2,2*(c .*. v),norm c^2 - 1]
        reshitKvUr [a,b,c] = maximum [(-b - sqrt d)/2/a,(-b + sqrt d)/2/a] where
            d = b^2 - 4*a*c
        blizhajshajaKosha@(_ :=^.^=: ck) = minimumBy (compare `on` dist c . koshaKoordinata) koshi