.Compile code with --define DIRECTX to play with XBox 360 controllers - you will need the February 2006 DirectX SDK installed.
//-----------------------------------------------------------------------------
// LightCycles.fs Mini game using windows forms
//
// 2007 written by Phillip Trelford
//-----------------------------------------------------------------------------
#light
#if DIRECTX // February 2006 DirectX SDK
#R @"C:\WINDOWS\assembly\GAC_32\Microsoft.DirectX\2.0.0.0__31bf3856ad364e35\Microsoft.DirectX.dll"
open Microsoft.DirectX.XInput // Required to read XBox 360 controllers
#endif
open System
open System.Drawing
open System.Windows.Forms
/// Game states
type GameState = | Start | Play | Over
/// Form key handler type
type KeyHandler (form:Form) =
do form.KeyPreview <- true
let keys = Enum.GetValues (type Keys) :?> (Keys [])
let keysDown = Array.create keys.Length false
let FindKeyIndex code = keys |> Array.find_index (fun x -> code = x)
do form.KeyDown.Add (fun e -> keysDown.[FindKeyIndex e.KeyCode] <- true)
do form.KeyUp.Add (fun e -> keysDown.[FindKeyIndex e.KeyCode] <- false)
member this.IsKeyDown (keyCode:Keys) = keysDown.[FindKeyIndex keyCode]
member this.AnyKeyDown () = keysDown |> Array.exists (fun x -> x)
/// Player direction type
type Direction = | Left | Right | Up | Down
/// Player type
type Player (color,startX,startY,direction,keys,keyHandler:KeyHandler) =
let mutable x = startX
let mutable y = startY
let mutable d = direction
member this.Color = color
member this.X = x
member this.Y = y
member this.Keys = keys
/// Reset player to start values
member this.Reset () = x <- startX; y <- startY; d <- direction
/// Updates player position
member this.Update i =
// Read keyborad
let mutable newD = d
let up, down, left, right = keys
if keyHandler.IsKeyDown(up) then newD <- Up
if keyHandler.IsKeyDown(down) then newD <- Down
if keyHandler.IsKeyDown(left) then newD <- Left
if keyHandler.IsKeyDown(right) then newD <- Right
#if DIRECTX
// Read XBox 360 controller
let state = Controller.GetState(i)
if state.IsConnected then
let pad = state.GamePad
if pad.UpButton then newD <- Up
if pad.DownButton then newD <- Down
if pad.LeftButton then newD <- Left
if pad.RightButton then newD <- Right
#endif
/// Don't allow suicide move
match (d,newD) with
| (Left, Right) | (Right, Left) | (Up, Down) | (Down, Up) -> ()
| _ -> d <- newD
/// Update position with direction
match d with
| Up -> y <- y - 1
| Down -> y <- y + 1
| Left -> x <- x - 1
| Right -> x <- x + 1
/// Main form
let form = new Form (Text="Light Cycles", Width=680, Height=544)
do /// Layout for game window and status panel
let layout = new TableLayoutPanel(Dock=DockStyle.Fill, ColumnCount = 2)
layout.ColumnStyles.Add( ColumnStyle(SizeType = SizeType.Percent, Width = 100.0f ) ) |> ignore
layout.ColumnStyles.Add( ColumnStyle(SizeType = SizeType.Absolute, Width = 128.0f) ) |> ignore
/// Play area in pixels
let playArea = 500
/// Game play area bitmap
let bm = new Bitmap(playArea, playArea)
/// Clears screen
let ClearScreen () =
using (Graphics.FromImage(bm)) (fun graphics -> graphics.Clear(Color.Black))
/// Draws text to screen
let DrawText s =
using (Graphics.FromImage(bm)) (fun graphics ->
let rect = new RectangleF(0.0f,0.0f,float32 playArea,float32 playArea)
let align = new StringFormat(Alignment=StringAlignment.Center, LineAlignment=StringAlignment.Center)
graphics.DrawString(s, form.Font, Brushes.White, rect, align)
)
// Initialise screen
ClearScreen ()
DrawText "Press any key to start"
/// PictureBox to contain game bitmap
let pictureBox = new PictureBox(Dock=DockStyle.Fill)
pictureBox.Image <- bm
layout.Controls.Add(pictureBox)
let keyHandler = KeyHandler (form)
/// Players array
let players =
[| Player (Color.Red,playArea/2+20,playArea/2,Down,(Keys.Q,Keys.A,Keys.Z,Keys.X),keyHandler);
Player (Color.LightBlue,playArea/2-20,playArea/2,Up,(Keys.P,Keys.L,Keys.N,Keys.M),keyHandler) |]
players |> Array.iter (fun player -> bm.SetPixel(player.X,player.Y,player.Color))
/// Display player controls
let statusPanel = new TableLayoutPanel(Dock=DockStyle.Fill, ColumnCount=1, BackColor=Color.DarkGray)
players |> Array.iteri (fun i player ->
let name =
[| ((new Label (Text=sprintf "Player %d" i, ForeColor=player.Color)) :> Control) |]
let up, down, left, right = player.Keys
let controls =
Array.combine [|"Up";"Down";"Left";"Right"|] [|up;down;left;right|]
|> Array.map (fun (name,key) -> (new Label (Text=sprintf "%s '%O'" name key)) :> Control )
Array.append name controls
|> statusPanel.Controls.AddRange
)
layout.Controls.Add(statusPanel)
form.Controls.Add(layout)
/// Game play - returns true if there has been a collision otherwise false
let PlayGame () =
let collisions = players |> Array.mapi (fun i player ->
player.Update i
let x, y = (player.X, player.Y)
let wall = x < 0 || x >= playArea || y < 0 || y >= playArea
if wall then
true
else
let bgColor = bm.GetPixel(x, y)
bm.SetPixel (x, y, player.Color)
players |> Array.exists (fun player -> let c = player.Color in c.R = bgColor.R && c.G = bgColor.G && c.B = bgColor.B )
)
pictureBox.Refresh ()
match collisions |> Array.tryfind_index (fun x -> x = true) with
| Some(i) -> i
| None -> (-1)
/// Current game state
let gameState = ref GameState.Start
let gameOverWaitCount = ref 200
let r = new Random()
/// Timer instance
let timer = new Timer()
timer.Interval <- 1000/50
// Timer event
timer.Tick.Add (fun _ ->
match !gameState with
| Start ->
if keyHandler.AnyKeyDown () then
ClearScreen ()
gameState := GameState.Play
| Play ->
let i = PlayGame ()
if i>=0 then
gameState := GameState.Over
gameOverWaitCount := 200
DrawText (sprintf "Game Over - Play %d Lost" i)
pictureBox.Refresh ()
| Over ->
// Shake screen
form.Left <- form.Left + if !gameOverWaitCount > 150 then r.Next(5) - 2 else 0
// Decrement Game Over wait
decr gameOverWaitCount
if !gameOverWaitCount <= 0 then
gameState := GameState.Start
players |> Array.iter (fun player -> player.Reset ())
ClearScreen ()
DrawText "Press any key to start"
pictureBox.Refresh ()
)
timer.Start ()
[<STAThread>]
do Application.Run(form)
