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)
#endifAdd a code snippet to your website: www.paste.org