open System
open System.Windows.Forms
open System.Drawing
open Microsoft.FSharp.Control.CommonExtensions
open System.Collections.Generic
open System.IO

let SS = DateTime.Now
     
let Sqr a = a*a

let Dist (a:(int*int)) (b:(int*int)) =
    Sqr ((fst a)-(fst b)) + Sqr ((snd a)-(snd b))

let Vect x1 y1 x2 y2 x3 y3 =
    let (dx1, dy1) = (x1-x2, y1-y2)
    let (dx2, dy2) = (x3-x2, y3-y2)
    match (dx1*dy2-dx2*dy1) with
        | p when p<0 -> -1
        | p when p>0 -> +1
        | _ -> 0

let isInter xx yy rr x1 y1 x2 y2 =
    let mutable d = 1000000000
    d <- min d (Dist (xx, yy) (x1, y1))
    d <- min d (Dist (xx, yy) (x2, y2))
    if ((Vect xx yy x1 y1 x2 y2) * (Vect xx yy x2 y2 x1 y1) > 0) then
        let a = y2-y1
        let b = x1-x2
        let c = -a*x1-b*y1
        Sqr (a*xx+b*yy+c) <= (Sqr rr)*(Sqr a + Sqr b)
    else
        d <= Sqr rr

let isIntersects xx yy rr x y w h =
    (isInter xx yy rr x y (x+w) y ||
     isInter xx yy rr (x+w) y (x+w) (y+h) ||
     isInter xx yy rr (x+w) (y+h) x (y+h) ||
     isInter xx yy rr x (y+h) x y)

let dCell = 20
let dCirc = 11
    
type IPaintObject =
    abstract Paint : Graphics -> unit
    abstract Recalc : float -> unit

type DelegateLoad = delegate of (string) -> (int[][]*ResizeArray<IPaintObject>*int)
    
let po = new ResizeArray<IPaintObject>()

type SmoothForm(dx:int, dy:int, _path:string) as x =
    inherit Form()
    do x.DoubleBuffered <- true

    let mutable left = 0
    let mutable down = 0
    let mutable right = 0
    let mutable up = 0
    let mutable need = 0
    let mutable path = _path
    let mutable currLevel = 0
    let mutable complete = 0
    let mutable (dd:DelegateLoad) = null
    let mutable death = 0
    let mutable loading = 0

    let mutable Map = null

    let d = new Dictionary<int, double*double>()

    member x.Load(_map:int[][], obj, _need) = 
        Map <- _map
        po.Clear()
        for o in obj do
            po.Add o
        need <- _need
        x.Init()

    member x.LoadNext() =
        currLevel <- currLevel + 1
        if (File.Exists(path+""+"L"+currLevel.ToString()+".txt") = false) then
            complete <- 1
        else
            x.Loading <- 2
            x.Load(dd.Invoke(path+""+"L"+currLevel.ToString()+".txt"))
            x.Loading <- 0
        x.Invalidate()


    member x.Init() =
        left <- 0
        down <- 0
        right <- 0
        up <- 0

        let mm = Map |> Array.map(fun x -> x |> Array.max) |> Array.max
        let xMin = Array.create (mm+1) 1000.0
        let xMax = Array.create (mm+1) 0.0
        let yMin = Array.create (mm+1) 1000.0
        let yMax = Array.create (mm+1) 0.0
        for i = 0 to x.rows-1 do
            for j = 0 to x.cols-1 do
                if (Map.[i].[j]>0) then
                    let p = Map.[i].[j]
                    xMin.[p] <- min (xMin.[p]) (float (j*dx))
                    xMax.[p] <- max (xMax.[p]) (float ((j+1)*dx))
                    yMin.[p] <- min (yMin.[p]) (float (i*dy))
                    yMax.[p] <- max (yMax.[p]) (float ((i+1)*dy))
        d.Clear()
        for i in [1..mm] do
            d.Add(i, ((xMin.[i]+xMax.[i])/2., (yMin.[i]+yMax.[i])/2.))

    member x.FuncLoad with get() = dd and set(v) = (dd <- v)

    member x.Complete = complete
    member x.Death with get() = death and set(v) = (death <- v)
    member x.Path with get() = path and set(v) = (path <- v)
    member x.map = Map
    member x.Saves = d
    member x.needGather = need
    member x.Loading with get() = loading and set(v) = (loading <- v)

    member x.Left with get() = left and set(v) = (left <- v)
    member x.Right with get() = right and set(v) = (right <- v)
    member x.Down with get() = down and set(v) = (down <- v)
    member x.Up with get() = up and set(v) = (up <- v)        

    member x.DX = dx
    member x.DY = dy
    member x.rows = (Map |> Array.length)
    member x.cols = (Map.[0] |> Array.length)

let form = new SmoothForm(Text="F# The world hardest game",  Visible=true, TopMost=true,
                            Width=22*dCell+8, Height=14*dCell+33,
                            dx=dCell, dy=dCell,
                            FormBorderStyle=FormBorderStyle.FixedSingle,
                            _path = @"C:Documents and SettingsslimМои документыVisual Studio 2010ProjectsTCFS_Console")

form.KeyDown
    |> Event.filter(fun args -> (args.KeyValue >= 37) && (args.KeyValue <= 40)) 
    |> Event.add (fun args ->
        match (args.KeyCode) with
            | Keys.Down -> form.Down <- 1
            | Keys.Left -> form.Left <- 1
            | Keys.Right -> form.Right <- 1
            | Keys.Up -> form.Up <- 1     
        )

form.KeyUp
    |> Event.filter(fun args -> (args.KeyValue >= 37) && (args.KeyValue <= 40))
    |> Event.add (fun args ->
        match (args.KeyCode) with
            | Keys.Down -> form.Down <- 0
            | Keys.Left -> form.Left <- 0
            | Keys.Right -> form.Right <- 0
            | Keys.Up -> form.Up <- 0
        )

form.Paint.Add(fun arg ->
    let g = arg.Graphics
    if (form.Complete = 0) then
        if (form.Loading = 0) then
            for i=0 to form.rows-1 do
                for j=0 to form.cols-1 do
                    match (form.map.[i].[j], (i+j)%2) with
                        | (-1, _) -> g.FillRectangle(Brushes.DarkViolet, j*form.DX, i*form.DY, form.DX, form.DY)
                        | ( 0, 0) -> g.FillRectangle(Brushes.White, j*form.DX, i*form.DY, form.DX, form.DY)
                        | ( 0, 1) -> g.FillRectangle(Brushes.LightGray, j*form.DX, i*form.DY, form.DX, form.DY)
                        | ( p, _) when p>0 -> g.FillRectangle(Brushes.LightGreen, j*form.DX, i*form.DY+1, form.DX, form.DY)
                    if (i>0 && (form.map.[i].[j]>=0 && form.map.[i-1].[j]<0
                            ||  form.map.[i].[j]<0 && form.map.[i-1].[j]>=0)) then
                        g.DrawLine(new Pen(Color.Black, float32 2), j*form.DX, i*form.DY, (j+1)*form.DX, i*form.DY)
                    if (j>0 && (form.map.[i].[j]>=0 && form.map.[i].[j-1]<0
                            ||  form.map.[i].[j]<0 && form.map.[i].[j-1]>=0)) then
                        g.DrawLine(new Pen(Color.Black, float32 2), j*form.DX, i*form.DY, j*form.DX, (i+1)*form.DY)
            for obj in po do
                obj.Recalc((DateTime.Now-SS).TotalSeconds)
                obj.Paint(g)
            async { do! Async.Sleep(10)
                    form.Invalidate() } |> Async.Start
        else
            if (form.Loading = 1) then
                form.LoadNext()
    else
        g.FillRectangle(Brushes.Magenta, 0, 0, form.Width, form.Height);
        g.DrawString("Deaths: " + form.Death.ToString(), new Font(FontFamily.GenericMonospace, float32 32.), Brushes.Black, float32 20., float32 100.)
)

type RedSquare(xx:int, yy:int, ww:int, hh:int, speed:int) =
    let mutable xCoord = float xx
    let mutable yCoord = float yy
    let mutable width = ww
    let mutable height = hh
    let mutable dying = 0
    let mutable gather = 0
    let mutable last = 0.0
    let mutable xSave = float xx
    let mutable ySave = float yy
    let mutable lastSave = 1

    member rs.X with get() = int xCoord and set(v) = (xCoord <- v)
    member rs.Y with get() = int yCoord and set(v) = (yCoord <- v)
    member rs.W with get() = width and set(v) = (width <- v)
    member rs.H with get() = height and set(v) = (height <- v)
    member rs.Got with get() = gather
    member rs.isDying with get() = (dying>0)

    member rs.Die() =
        if (dying = 0) then
            dying <- 1
            gather <- 0
            form.Death <- form.Death+1
    member rs.Add() =
        gather <- gather+1

    interface IPaintObject with
        member obj.Paint(g) =
            let rect = 
                match (dying) with
                    | 0 -> Rectangle(x=int xCoord-width/2, y=int yCoord-height/2, width=width, height=height)
                    | p when 2*p>=ww ->
                                        xCoord <- xSave
                                        yCoord <- ySave
                                        dying <- 0
                                        Rectangle(x=int xCoord-width/2, y=int yCoord-height/2, width=width, height=height)
                    | p ->
                            dying <- dying+1
                            Rectangle(x=int xCoord-width/2+p, y=int yCoord-height/2+p, width=width-p-p, height=height-p-p)
            g.FillRectangle(Brushes.Red, rect)
            g.DrawRectangle(new Pen(Color.Black, float32 2), rect)
        member obj.Recalc(T) =
            let t = T-last
            let mutable xOld = 0.0
            let mutable yOld = 0.0

            if (dying=0) then
                xOld <- xCoord
                yOld <- yCoord
                xCoord <- xCoord - ((float (form.Left))*(float speed)*t)
                if (form.map.[int (yCoord-float height/2.)/dCell].[int (xCoord-float width/2.)/dCell]<0 ||
                    form.map.[int (yCoord+float height/2.)/dCell].[int (xCoord-float width/2.)/dCell]<0) then
                    xCoord <- xOld
                    yCoord <- yOld

                xOld <- xCoord
                yOld <- yCoord
                xCoord <- xCoord + ((float (form.Right))*(float speed)*t)
                if (form.map.[int (yCoord-float height/2.)/dCell].[int (xCoord+float width/2.)/dCell]<0 ||
                    form.map.[int (yCoord+float height/2.)/dCell].[int (xCoord+float width/2.)/dCell]<0) then
                    xCoord <- xOld
                    yCoord <- yOld

                xOld <- xCoord
                yOld <- yCoord
                yCoord <- yCoord - ((float (form.Up))*(float speed)*t)
                if (form.map.[int (yCoord-float height/2.)/dCell].[int (xCoord-float width/2.)/dCell]<0 ||
                    form.map.[int (yCoord-float height/2.)/dCell].[int (xCoord+float width/2.)/dCell]<0) then
                    xCoord <- xOld
                    yCoord <- yOld

                xOld <- xCoord
                yOld <- yCoord
                yCoord <- yCoord + ((float (form.Down))*(float speed)*t)
                if (form.map.[int (yCoord+float height/2.)/dCell].[int (xCoord-float width/2.)/dCell]<0 ||
                    form.map.[int (yCoord+float height/2.)/dCell].[int (xCoord+float width/2.)/dCell]<0) then
                    xCoord <- xOld
                    yCoord <- yOld

                let rr = int yCoord/dCell
                let cc = int xCoord/dCell
                if (form.map.[rr].[cc] > lastSave && form.map.[rr].[cc] <> form.Saves.Count) then
                    lastSave <- form.map.[rr].[cc]
                    xSave <- fst form.Saves.[lastSave]
                    ySave <- snd form.Saves.[lastSave]

                if (form.map.[rr].[cc] = form.Saves.Count && gather = form.needGather) then
                    form.Loading <- 1
                    
            last <- T

type BlueCircle(xx:int, yy:int, rr:int, speed:int, segments:(int*int)[]) =
    let len = segments |> Array.length

    let mutable X = xx
    let mutable Y = yy
       
    member bc.Stable with get() = (bc.TotalDist < 1e-8)
    member bc.Speed with get() = float speed
    member bc.Dists = segments |> Array.map(fun (dx, dy) -> Math.Sqrt(float(dx*dx+dy*dy)))
    member bc.TotalDist = bc.Dists |> Array.sum
    member bc.TotalTime = bc.TotalDist/bc.Speed

    interface IPaintObject with
        member obj.Paint(g) =
            let rect = Rectangle(x=X-rr, y=Y-rr, width=rr+rr, height=rr+rr)
            g.FillEllipse(Brushes.Blue, rect)
            g.DrawEllipse(Pens.Black, rect)
        member bc.Recalc(tt) =
            if (bc.Stable=false) then
                let mutable t1 = tt�.TotalTime
                let mutable ind = 0
                X <- xx
                Y <- yy
                while (ind<len-1 && t1*bc.Speed>=bc.Dists.[ind]) do
                    X <- X + (fst segments.[ind])
                    Y <- Y + (snd segments.[ind])
                    t1 <- t1-bc.Dists.[ind]/bc.Speed
                    ind <- ind+1
            
                let (dx, dy) = (((float (fst segments.[ind]))/(bc.Dists.[ind])),
                                ((float (snd segments.[ind]))/(bc.Dists.[ind])))
                X <- X + int (dx*t1*bc.Speed)
                Y <- Y + int (dy*t1*bc.Speed)

                let rs = seq { for obj in po do
                                    match obj with
                                        | :? RedSquare as p ->
                                            yield p 
                                        | _ -> yield! Seq.empty
                                } |> Seq.head

                if (isIntersects X Y rr (rs.X-rs.W/2) (rs.Y-rs.H/2) (rs.W) (rs.H)) then
                    rs.Die()

type YellowCircle(xx:int, yy:int, rr:int, tr:float) =
    let mutable XX = 0
    let mutable Disable = false

    member yc.isDead with get() = Disable and set(v) = (Disable <- v)
    member yc.Take() =
        yc.isDead <- true

    interface IPaintObject with
        member obj.Paint(g) =
            if (not Disable) then
                let rect = Rectangle(x=xx-rr+XX, y=yy-rr, width=rr+rr-XX-XX, height=rr+rr)
                g.FillEllipse(Brushes.Yellow, rect)
                g.DrawEllipse(Pens.Black, rect)
        member yc.Recalc(tt:float) =
            let rs =  seq { for obj in po do
                                match obj with
                                    | :? RedSquare as p ->
                                        yield p 
                                    | _ -> yield! Seq.empty
                            } |> Seq.head
            if (not Disable && rs.isDying=false) then
                let mutable t = tt%tr
                if (t*2.>tr) then t <- tr-t
                XX <- int (((float rr)/(tr/2.))*t)

                if (isIntersects xx yy rr (rs.X-rs.W/2) (rs.Y-rs.H/2) (rs.W) (rs.H)) then
                    yc.Take()
                    rs.Add()
            else
                if (Disable && rs.isDying=true) then
                    Disable <- false

// Ф-ция парсит файл по заданому пути, выковыривая параметры уровня
let LoadLevel _path =
    let pp = new ResizeArray<IPaintObject>()

    let data = File.ReadAllLines(_path) |> Array.toSeq;
    let tmp = 0
    let tmpD = 0.0
    let nm = (data |> Seq.head).Split([|' '|])
    let (n, m) = (Int32.Parse(nm.[0]), Int32.Parse(nm.[1]))
    let L1 = data
             |> Seq.skip 1
             |> Seq.take n
             |> Seq.toArray
             |> Array.map(fun x -> x.Split([|' '|]) |> Array.filter(fun x -> Int32.TryParse(x, ref tmp)) |> Array.map(fun x -> Int32.Parse(x)))

    let lbc = Int32.Parse(data
             |> Seq.skip (1+n)
             |> Seq.head)

    let bc = data
             |> Seq.skip 1
             |> Seq.skip n
             |> Seq.skip 1
             |> Seq.take lbc
             |> Seq.toArray
             |> Array.map(fun x ->
                    let b = x.Replace('.', ',').Split([|' '|]) |> Array.filter(fun x -> Double.TryParse(x, ref tmpD)) |> Array.map(fun x -> Double.Parse(x))
                    let c = int (b.[4])
                    let move = 
                        [|
                            for i in [0..c-1] do
                                yield (int(b.[5+2*i]*(float)dCell), int(b.[5+2*i+1]*(float)dCell))
                        |]
                    new BlueCircle(int (b.[0]*(float)dCell), int (b.[1]*(float)dCell), int(b.[2]*(float)dCirc), int(b.[3]*(float)dCell), move)
                )

    let ly = Int32.Parse(data
             |> Seq.skip 1
             |> Seq.skip n
             |> Seq.skip 1
             |> Seq.skip lbc
             |> Seq.head)

    let y = data
             |> Seq.skip 1
             |> Seq.skip n
             |> Seq.skip 1
             |> Seq.skip lbc
             |> Seq.skip 1
             |> Seq.take ly
             |> Seq.toArray
             |> Array.map(fun x ->
                    let b = x.Replace('.', ',').Split([|' '|]) |> Array.filter(fun x -> Double.TryParse(x, ref tmpD)) |> Array.map(fun x -> Double.Parse(x))
                    new YellowCircle(int (b.[0]*(float)dCell), int (b.[1]*(float)dCell), int(b.[2]*(float)dCirc), (b.[3]))
                )

    let rs = data         
             |> Seq.skip 1
             |> Seq.skip n
             |> Seq.skip 1
             |> Seq.skip lbc
             |> Seq.skip 1
             |> Seq.skip ly
             |> Seq.take 1
             |> Seq.toArray
             |> Array.map(fun x ->
                    let b = x.Replace('.', ',').Split([|' '|]) |> Array.filter(fun x -> Double.TryParse(x, ref tmpD)) |> Array.map(fun x -> Double.Parse(x))
                    new RedSquare(int (b.[0]*(float)dCell), int (b.[1]*(float)dCell), int(b.[2]), int(b.[3]), int(b.[4]*(float dCell)))
             )
             |> Array.toSeq
             |> Seq.head
    for obj in bc do
        pp.Add obj

    for obj in y do
        pp.Add obj

    pp.Add rs
    (L1, pp, ly)

form.FuncLoad <- new DelegateLoad(LoadLevel)
form.LoadNext()

form.Show()

#if COMPILED
[<STAThread>]
do Application.Run(form)
#endif