//----------------------------------------------------------------------------- // LightCycles.fs Mini game using windows forms // // 2007 written by Phillip Trelford //----------------------------------------------------------------------------- #light #if DIRECTX #R @"C:\WINDOWS\assembly\GAC_32\Microsoft.DirectX\2.0.0.0__31bf3856ad364e35\Microsoft.DirectX.dll" // Feb 206 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 () [] do Application.Run(form)