API tools faq
paste
Advertisement
ptrelford

Pacman Sounds in FunScript

ptrelford
Sep 15th, 2013
227
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
F# 21.27 KB | None | 0 0
raw download clone embed print report
  1. [<ReflectedDefinition>]
  2. module Program
  3.  
  4. open FunScript
  5. open FunScript.TypeScript
  6.  
  7. type ts = Api<"../Typings/lib.d.ts">
  8.  
  9. let cyand = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAiUlEQVQoU8WSURKAIAhE8Sh6Fc/tVfQoJdqiMDTVV4wfufAAmw3kxEHUz4pA1I8OJVjAKZZ6+XiC0ATTB/gW2mEFtlpHLqaktrQ6TxUQSRCAPX2AWPMLyM0VmPOcV8palxt6uoAMpDjfWJt+o6cr0DPDnfYjyL94NwIcYjXcR/FuYklcxrZ3OO0Ep4dJ/3dR5jcAAAAASUVORK5CYII="
  10. let oranged = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAgklEQVQoU8WS0RGAIAxDZRRYhblZBUZBsBSaUk/9kj9CXlru4g7r1FxBdsFpGwoa2NwrYIFPEIeM6QS+hQQMYC70EjzuuOlt6gT5kRGGTf0Cx5qfwJYOYIw0L6W1bg+09Al2wAcCS8Y/WjqAZhluxD/B3ghZBO6n1sadzLLEbNSg8pzXIVLvbNvPwAAAAABJRU5ErkJggg=="
  11. let pinkd = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAj0lEQVQoU8WSsRWAIAxEZRQpXITGVZzIVWxYxAJHwRfwMInxqZV0XPIvgXeuM05eUuayG73TbULQwKWZGTTwCYIJphfwLcRhAW5DLfWrXFLrNLWBKAIBbOkFxJpfQDIXYAh1XoznumRo6Q0kwE8VTLN8o6UL0ArDnfYjSF/Mg4CEaA330sxD3ApHLvUdSdsBdgNkr9L8gxYAAAAASUVORK5CYII="
  12. let redd = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAkklEQVQoU8WSvRWAIAyEZRQtXIRCV3EiVtGCRSx0FHxBD5MYn1pJl0u+/PDOVcZLY5e47PrJ6TIhaOBSzBoU8AlCE0zP4FuIwwJc25Bz9TyILbVOUwuIJAjAlp5BrPkFpOYC9H6fF+O5LjW09AIS0Az7jUuQN1q6AC0z3Gk/gvTF3AhwiNYQ52Ju4pI4fKljOG0DA3tp97vN6C8AAAAASUVORK5CYII="
  13. let pu1 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAWElEQVQoU62SUQoAIAhD9f6HNiYYolYi9VfzuXIxDRYbI0LCTHsfe3ldi3BgRRUY9Rnku1Rupf4NgiPeVjVU7STckphBceSvrHHtNPI21HWz4NO3eUUAgwVpmjX/zwK8KQAAAABJRU5ErkJggg=="
  14. let pu2 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAW0lEQVQoU8WSwQoAIAhD9f8/2lIwdKRIl7o1e010THBESJiJXca76qnoDxFC3SD9LRpWkLnsLt4gdImtlLX/EK4iDapqr4VuI2+BauQjaOrmSz8xillDp5gQrS054jv/0fkNVAAAAABJRU5ErkJggg=="
  15. let pd1 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAXElEQVQoU62SUQoAIAhD9f6HNgyMWpMs6k/XU5mqwDMTw5yq6JwbAfucwR2qAFHAu75BN11Gt6+Qz54VpMJsMV3BaS9UR8txkUzfLC9DUY0BYbOPGfpyU3g2WdwAOvU1/9KZsT4AAAAASUVORK5CYII="
  16. let pd2 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAU0lEQVQoU62SUQoAIAhD9f6HNgwUGw4s6q/pc6KqwDMTQ01VtGr56ZIZvKEJEAXc9Q26cUm3r5D3zgrywHeoG3ldJrZIRz6C0I1BoR83FTBCeHsLIlw7/wOkQycAAAAASUVORK5CYII="
  17. let pl1 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAVUlEQVQoU62S2woAIAhD9f8/2jAwvGRMyDfF49iQKZUISZ4xE/vZaW7LHbwhBLADqjpSUjBAdglRDQa9hxfcQi+vf5RGnpDlkB4KlMgR0N6pBIH83gIPFCb/N+MLCwAAAABJRU5ErkJggg=="
  18. let pl2 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAUklEQVQoU52SUQoAIAhD3f0PbRQoZgnT/hyttYeQdFRFswYIoubD73JlPibGYA/s1Jmpk+JpDIinWxbiXP3iQslCwbhTxzhHbsWZNFsnCkTevQW2bCb/VRTuVwAAAABJRU5ErkJggg=="
  19. let pr1 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAWElEQVQoU52S4Q4AIASE3fs/tKalSTHyL/O5CyAXzMQ+BxBsbj9exRE8oQqgDUS1BalNVFSuP2WQL94WIygCBEzttZWOvbz2VBnGtLXg1sgV/L8I679yewN9sScO5wcxLQAAAABJRU5ErkJggg=="
  20. let pr2 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAVElEQVQoU62SWwoAIAgE9f6HNgqU3BK2R3+J48KoCjwzMaypis61+OyaK3hADOADeuoddJISaQy0iKggbEz2viah7mVPTNq7cp/ApLmcdFPVdaDJBnWdJwjk629HAAAAAElFTkSuQmCC"
  21. let blue = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAeklEQVQoU62S0Q3AIAhEyyi6UcfoRB2jG+koNkeCoVcaTaw/huMeEkS24KTUmpdrFWHbQ2CAzb5AB0eQFTFYwVnIw/+B5by0cD52vTmGhnaF25wBAb/A6HsibR0ctch5fRHi1zCigvCut4oR+wnbhrBmsZr9DlqCQfbcnfZjDyiZqCEAAAAASUVORK5CYII="
  22. let eyed = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAUElEQVQoU2NkIBMwkqmPYYA13rt37z/I6UpKSiguwSYOVwCThPkZphmXOHU0OjtD7Nu7F+FckI3YxFH8oqgI8eP9+6h+xCY+wNFBSiqiv1MBDgYsD185vj8AAAAASUVORK5CYII="
  23. let _200 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAS0lEQVQoU2NkIBMwkqmPYYA0vpVR+Q9zsvCTO4yE+CC1KE4FaYBpxEfDNWKzgWiNIIUw5xKyGa+N+PyM4UdS4nSA4pEUJ8LUku1UAMC0VA8iscBNAAAAAElFTkSuQmCC"
  24. let _400 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAASElEQVQoU2NkIBMwkqmPYYA0vpVR+S/85A4jMg3zAkwcmQ9ig52KTSO6Qch8FI3oNhClEaaJWJvhNmLTSJQfyYnLAYpHujoVAChTXA9pVJi5AAAAAElFTkSuQmCC"
  25. let _800 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAQElEQVQoU2NkIBMwkqmPYYA0vpVR+Q9zsvCTO4yE+CC1YKeCFMI0EEOjaES3EZ8BtLERn5/hNpITlwMUj3R1KgCe5lwPHtUmcwAAAABJRU5ErkJggg=="
  26. let _1600 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAQ0lEQVQoU2NkIBMwkqmPYQA0vpVR+S/85A4jiIY5mxg+WANMIYiGaUYXR+ejaES3EdlAvBrxKSTJRnx+HoDoGDopBwDHLGwPAhDgRQAAAABJRU5ErkJggg=="
  27.  
  28. let createImage data =
  29.     let image = unbox<ts.HTMLImageElement>(ts.document.createElement("image"))  
  30.     image.src <- data
  31.     unbox<ts.HTMLElement>(image)
  32.  
  33. let maze = "\
  34. ##/------------7/------------7##,\
  35. ##|............|!............|##,\
  36. ##|./__7./___7.|!./___7./__7.|##,\
  37. ##|o|  !.|   !.|!.|   !.|  !o|##,\
  38. ##|.L--J.L---J.LJ.L---J.L--J.|##,\
  39. ##|..........................|##,\
  40. ##|./__7./7./______7./7./__7.|##,\
  41. ##|.L--J.|!.L--7/--J.|!.L--J.|##,\
  42. ##|......|!....|!....|!......|##,\
  43. ##L____7.|L__7 |! /__J!./____J##,\
  44. #######!.|/--J LJ L--7!.|#######,\
  45. #######!.|!          |!.|#######,\
  46. #######!.|! /__==__7 |!.|#######,\
  47. -------J.LJ |      ! LJ.L-------,\
  48. ########.   | **** !   .########,\
  49. _______7./7 |      ! /7./_______,\
  50. #######!.|! L______J |!.|#######,\
  51. #######!.|!          |!.|#######,\
  52. #######!.|! /______7 |!.|#######,\
  53. ##/----J.LJ L--7/--J LJ.L----7##,\
  54. ##|............|!............|##,\
  55. ##|./__7./___7.|!./___7./__7.|##,\
  56. ##|.L-7!.L---J.LJ.L---J.|/-J.|##,\
  57. ##|o..|!.......<>.......|!..o|##,\
  58. ##L_7.|!./7./______7./7.|!./_J##,\
  59. ##/-J.LJ.|!.L--7/--J.|!.LJ.L-7##,\
  60. ##|......|!....|!....|!......|##,\
  61. ##|./____JL__7.|!./__JL____7.|##,\
  62. ##|.L--------J.LJ.L--------J.|##,\
  63. ##|..........................|##,\
  64. ##L--------------------------J##".Split(',')
  65.  
  66. let tileBits = [|
  67.     [|0b00000000;0b00000000;0b00000000;0b00000000;0b00000011;0b00000100;0b00001000;0b00001000|] // tl
  68.     [|0b00000000;0b00000000;0b00000000;0b00000000;0b11111111;0b00000000;0b00000000;0b00000000|] // top
  69.     [|0b00000000;0b00000000;0b00000000;0b00000000;0b11000000;0b00100000;0b00010000;0b00010000|] // tr
  70.     [|0b00001000;0b00001000;0b00001000;0b00001000;0b00001000;0b00001000;0b00001000;0b00001000|] // left
  71.     [|0b00010000;0b00010000;0b00010000;0b00010000;0b00010000;0b00010000;0b00010000;0b00010000|] // right
  72.     [|0b00001000;0b00001000;0b00000100;0b00000011;0b00000000;0b00000000;0b00000000;0b00000000|] // bl
  73.     [|0b00000000;0b00000000;0b00000000;0b11111111;0b00000000;0b00000000;0b00000000;0b00000000|] // bottom
  74.     [|0b00010000;0b00010000;0b00100000;0b11000000;0b00000000;0b00000000;0b00000000;0b00000000|] // br
  75.     [|0b00000000;0b00000000;0b00000000;0b00000000;0b11111111;0b00000000;0b00000000;0b00000000|] // door
  76.     [|0b00000000;0b00000000;0b00000000;0b00011000;0b00011000;0b00000000;0b00000000;0b00000000|] // pill
  77.     [|0b00000000;0b00011000;0b00111100;0b01111110;0b01111110;0b00111100;0b00011000;0b00000000|] // power
  78.     |]
  79.  
  80. let blank = [|0b00000000;0b00000000;0b00000000;0b00000000;0b00000000;0b00000000;0b00000000;0b00000000|]
  81.  
  82. [<AutoOpen>]
  83. module Maze =
  84.     let isWall (c:char) = "_|!/7LJ-".IndexOf(c) <> -1
  85.  
  86.     let tileAt (x,y) = if x < 0 || x > 30 then ' ' else maze.[y].[x]
  87.        
  88.     let isWallAt (x,y) = tileAt(x,y) |> isWall
  89.  
  90.     let noWall (x,y) (ex,ey) =
  91.         let bx, by = (x+6+ex) >>> 3, (y+6+ey) >>> 3
  92.         isWallAt (bx,by) |> not
  93.  
  94.     let verticallyAligned (x,y) =  (x % 8) = 5
  95.     let horizontallyAligned (x,y) = (y % 8) = 5
  96.     let isAligned n = (n % 8) = 5
  97.  
  98.     let canGoUp (x,y) = isAligned x && noWall (x,y) (0,-4)
  99.     let canGoDown (x,y) = isAligned x && noWall (x,y) (0,5)
  100.     let canGoLeft (x,y) = isAligned y && noWall (x,y) (-4,0)
  101.     let canGoRight (x,y) = isAligned y && noWall (x,y) (5,0)
  102.  
  103. [<AutoOpen>]
  104. module Background =
  105.     let tileColors = "BBBBBBBBBYY"
  106.     let tileChars =  "/_7|!L-J=.o"
  107.  
  108.     let toTile (c:char) =
  109.         let i = tileChars.IndexOf(c)
  110.         if i = -1 then blank, 'B'
  111.         else tileBits.[i], tileColors.[i]
  112.  
  113.     let draw f (lines:int[]) =
  114.         let width = 8  
  115.         lines |> Array.iteri (fun y line ->
  116.             for x = 0 to width-1 do
  117.                 let bit = (1 <<< (width - 1 - x))
  118.                 let pattern = line &&& bit
  119.                 if pattern <> 0 then f (x,y)
  120.         )
  121.  
  122.     let createBrush (context:ts.CanvasRenderingContext2D) (r,g,b,a) =
  123.         let id = context.createImageData(float 1,float 1)
  124.         let d = id.data
  125.         d.[0] <- float r; d.[1] <- float g; d.[2] <- float b; d.[3] <- float a
  126.         id
  127.  
  128.     let createBackground () =
  129.         let background = unbox<ts.HTMLCanvasElement>(ts.document.createElement("canvas"))  
  130.         background.width <- 256.
  131.         background.height <- 256.    
  132.         let context = background.getContext("2d")
  133.         context.fillStyle <- "rgb(0,0,0)"
  134.         context.fillRect (0., 0. , 256., 256.);
  135.         let blue = createBrush context (63,63,255,255)
  136.         let yellow = createBrush context (255,255,0,255)
  137.         let lines = maze      
  138.         for y = 0 to lines.Length-1 do
  139.             let line = lines.[y]
  140.             for x = 0 to line.Length-1 do
  141.                 let c = line.[x]
  142.                 let tile, color = toTile c                
  143.                 let brush = match color with 'Y' -> yellow | _ -> blue
  144.                 let f (x',y') =
  145.                     context.putImageData(brush, (float) (x*8 + x'), (float) (y*8 + y'))
  146.                 draw f tile
  147.         unbox<ts.HTMLElement>(background)
  148.  
  149.     let countDots () =
  150.         maze |> Array.sumBy (fun line -> line.ToCharArray() |> Array.sumBy (function '.' -> 1 | 'o' -> 1 | _ -> 0))
  151.  
  152.     let clearCell background (x,y) =
  153.         let background = unbox<ts.HTMLCanvasElement>(background)
  154.         let context = background.getContext("2d")
  155.         context.fillStyle <- "rgb(0,0,0)"
  156.         context.fillRect (float (x*8), float (y*8), 8., 8.);
  157.  
  158. let wrap (x,y) (dx,dy) =
  159.     let x =
  160.         if dx = -1 && x = 0 then 30 * 8
  161.         elif dx = 1  && x = 30 *8 then 0
  162.         else x
  163.     x + dx, y + dy
  164.  
  165. type Ghost(image:ts.HTMLElement,x,y,v) =
  166.     let mutable x' = x
  167.    let mutable y' = y
  168.     let mutable v' = v
  169.    member val Image = image
  170.    member val IsReturning = false with get, set
  171.    member __.X = x'
  172.     member __.Y = y'
  173.    member __.V = v'
  174.     member ghost.Reset() =
  175.         x' <- x
  176.        y' <- y
  177.     member ghost.Move(v) =
  178.         v' <- v        
  179.        let dx,dy = v
  180.        let x,y = wrap (x',y') (dx,dy)
  181.        x' <- x
  182.         y' <- y
  183.  
  184. let createGhosts context =
  185.    [|
  186.         redd, (16, 11), (1,0)
  187.         cyand, (14, 15), (1,0)
  188.         pinkd, (16, 13), (0,-1)
  189.         oranged, (18, 15), (-1,0)
  190.    |]
  191.    |> Array.map (fun (data,(x,y),v) ->
  192.        Ghost(createImage data, (x*8)-7, (y*8)-3, v)        
  193.    )
  194.  
  195. [<AutoOpen>]
  196. module GhostMovement =
  197.    let flood canFill fill (x,y) =
  198.        let rec f n = function
  199.            | [] -> ()
  200.            | ps ->
  201.                let ps = ps |> List.filter (fun (x,y) -> canFill (x,y))
  202.                ps |> List.iter (fun (x,y) -> fill (x,y,n))
  203.                ps |> List.collect (fun (x,y) -> [(x-1,y);(x+1,y);(x,y-1);(x,y+1)])
  204.                |> f (n+1)
  205.        f 0 [(x,y)]
  206.  
  207.    let route_home =
  208.        let numbers =
  209.            maze |> Array.map (fun line ->
  210.                line.ToCharArray()
  211.                |> Array.map (fun c -> if isWall c then 999 else -1)
  212.            )
  213.        let canFill (x:int,y:int) =
  214.            y>=0 && y < (numbers.Length-1) &&
  215.            x>=0 && x < (numbers.[y].Length-1) &&
  216.            numbers.[y].[x] = -1          
  217.        let fill (x,y,n) = numbers.[y].[x] <- n
  218.        flood canFill fill (16,15)
  219.        numbers
  220.  
  221.    let fillValue (x,y) (ex,ey) =
  222.        let bx = int (ts.Math.floor(float ((x+6+ex)/8)))
  223.        let by = int (ts.Math.floor(float ((y+6+ey)/8)))
  224.        route_home.[by].[bx]
  225.  
  226.    let fillUp (x,y) = fillValue (x,y) (0,-4)
  227.    let fillDown (x,y) = fillValue (x,y) (0,5)
  228.    let fillLeft (x,y) = fillValue (x,y) (-4,0)
  229.    let fillRight (x,y) = fillValue (x,y) (5,0)
  230.  
  231.    let chooseDirection (ghost:Ghost) =
  232.        let x,y = ghost.X, ghost.Y
  233.        let dx,dy = ghost.V
  234.        let isBackwards (a,b) =
  235.            (a <> 0 && a = -dx) || (b <> 0 && b = -dy)
  236.        let directions =
  237.            [|if canGoLeft(x,y) then yield (-1,0), fillLeft(x,y)
  238.              if canGoDown(x,y) then yield (0,1), fillDown(x,y)
  239.              if canGoRight(x,y) then yield (1,0), fillRight(x,y)
  240.              if canGoUp(x,y) then yield (0,-1), fillUp(x,y) |]
  241.        let dx,dy =
  242.            if ghost.IsReturning
  243.            then
  244.                directions
  245.                |> Array.sortBy snd                
  246.                |> fun xs ->
  247.                    let v, n = xs.[0]
  248.                    if n = 0 then ghost.IsReturning <- false
  249.                    v
  250.            else            
  251.                directions
  252.                |> Array.map fst
  253.                |> Array.filter (not << isBackwards)
  254.                |> fun xs ->
  255.                    let i = int (ts.Math.floor(ts.Math.random() * float xs.Length))
  256.                    xs.[i]
  257.        dx,dy
  258.  
  259. type Keys() =
  260.    let mutable keysPressed = Set.empty
  261.    member keys.Reset () = keysPressed <- Set.empty
  262.    member keys.IsPressed keyCode = Set.contains keyCode keysPressed
  263.    member keys.Update (e,pressed) =
  264.        let e = (unbox<ts.KeyboardEventExtensions>(e))
  265.        let keyCode = int e.keyCode
  266.        let op =  if pressed then Set.add else Set.remove
  267.        keysPressed <- op keyCode keysPressed
  268.  
  269. type Pacman () =
  270.    let pu1, pu2 = createImage pu1, createImage pu2
  271.    let pd1, pd2 = createImage pd1, createImage pd2
  272.    let pl1, pl2 = createImage pl1, createImage pl2
  273.    let pr1, pr2 = createImage pr1, createImage pr2
  274.    let lastp = ref pr1
  275.    member __.ImageAt(x,y,v) =
  276.        let p1, p2 =
  277.            match !v with
  278.            | -1,  0 -> pl1, pl2
  279.            |  1,  0 -> pr1, pr2
  280.            |  0, -1 -> pu1, pu2
  281.            |  0,  1 -> pd1, pd2
  282.            |  _,  _ -> !lastp, !lastp
  283.        let x' = int (ts.Math.floor(float (!x/6)))
  284.         let y' = int (ts.Math.floor(float (!y/6)))
  285.        let p = if (x' + y') % 2 = 0 then p1 else p2
  286.        lastp := p
  287.        p
  288.      
  289. [<JSEmit("(new Audio({0})).play();")>]
  290. let sound(file:string) : unit = failwith "never"
  291.  
  292. let playLevel (keys:Keys, onLevelCompleted, onGameOver) =
  293.    let pacman = Pacman()
  294.    let pills = maze |> Array.map (fun line -> line.ToCharArray() |> Array.map (fun c -> c))
  295.  
  296.    let canvas = unbox<ts.HTMLCanvasElement>(ts.document.getElementById("canvas"))
  297.    canvas.width <- 256.
  298.    canvas.height <- 256.    
  299.    let context = canvas.getContext("2d")
  300.    context.fillStyle <- "rgb(0,0,0)"
  301.    context.fillRect (0., 0. , 256., 256.);
  302.    let bonusImages = [|createImage _200; createImage _400; createImage _800; createImage _1600|]
  303.    let background = createBackground()
  304.    let ghosts = createGhosts(context)
  305.    let blue,eyed = createImage blue, createImage eyed
  306.  
  307.    let dotsLeft = ref (countDots())
  308.    let score = ref 0
  309.    let bonus = ref 0
  310.    let bonuses = ref []
  311.    let energy = ref 128
  312.    let flashCountdown = ref 0
  313.    let powerCountdown = ref 0
  314.    let x, y = ref (16 * 8 - 7), ref (23 * 8 - 3)
  315.    let v = ref (0,0)
  316.  
  317.    let moveGhosts () =
  318.        ghosts |> Array.iter (fun ghost ->
  319.            ghost.Move(chooseDirection ghost)
  320.        )
  321.  
  322.    let movePacman () =
  323.        let inputs =
  324.            [|
  325.            if keys.IsPressed 81 (*q*) then yield canGoUp (!x,!y), (0,-1)
  326.            if keys.IsPressed 65 (*a*) then yield canGoDown (!x,!y), (0,1)
  327.            if keys.IsPressed 90 (*z*) then yield canGoLeft (!x,!y), (-1,0)
  328.            if keys.IsPressed 88 (*x*) then yield canGoRight (!x,!y), (1,0)
  329.            |]
  330.        let canGoForward =
  331.            match !v with
  332.            | 0,-1 -> canGoUp(!x,!y)
  333.            | 0,1  -> canGoDown(!x,!y)
  334.            | -1,0 -> canGoLeft(!x,!y)
  335.            | 1, 0 -> canGoRight(!x,!y)
  336.            | _ -> false
  337.        let availableDirections =
  338.            inputs
  339.            |> Array.filter fst
  340.            |> Array.map snd
  341.            |> Array.sortBy (fun v' -> v' = !v)
  342.        if availableDirections.Length > 0 then
  343.            v := availableDirections.[0]
  344.        elif inputs.Length = 0 || not canGoForward then
  345.            v := 0,0              
  346.        let x',y' = wrap (!x,!y) !v
  347.        x := x'
  348.         y := y'
  349.  
  350.    let eatPills () =
  351.        let tx = int (ts.Math.floor(float ((!x+6)/8)))
  352.        let ty = int (ts.Math.floor(float ((!y+6)/8)))      
  353.        let c = pills.[ty].[tx]
  354.        if c = '.' then
  355.            pills.[ty].[tx] <- ' '
  356.            clearCell background (tx,ty)
  357.            score := !score + 10
  358.            decr dotsLeft            
  359.            sound("Dot5.wav")
  360.        if c = 'o' then          
  361.            pills.[ty].[tx] <- ' '
  362.            clearCell background (tx,ty)
  363.            bonus := 0
  364.            score := !score + 50
  365.            powerCountdown := 250
  366.            decr dotsLeft
  367.            sound("Powerup.wav")
  368.            
  369.    let touchingGhosts () =
  370.        let px, py = !x, !y
  371.        ghosts |> Array.filter (fun ghost ->
  372.            let x,y = ghost.X, ghost.Y
  373.            ((px >= x && px < x + 13) ||
  374.             (x < px + 13 && x >= px)) &&
  375.            ((py >= y && py < y + 13) ||
  376.             (y < py + 13 && y >= py))
  377.        )
  378.  
  379.    let collisionDetection () =
  380.        let touched = touchingGhosts ()
  381.        if touched.Length > 0
  382.        then
  383.            if !powerCountdown > 0 then
  384.                touched |> Array.iter (fun ghost ->
  385.                    if not ghost.IsReturning then
  386.                        sound "EatGhost.wav"
  387.                        ghost.IsReturning <- true
  388.                        score := !score + ((int ) (ts.Math.pow(2.,float !bonus))) * 200
  389.                        let image = bonusImages.[!bonus]
  390.                        bonuses := (100, (image, ghost.X, ghost.Y)) :: !bonuses
  391.                        bonus :=  min 3 (!bonus + 1)
  392.                )
  393.            else
  394.                decr energy
  395.                if !flashCountdown = 0 then sound "Hurt.wav"
  396.                flashCountdown := 30
  397.        if !flashCountdown > 0 then decr flashCountdown
  398.    
  399.    let updateBonus () =
  400.        let removals,remainders =
  401.            !bonuses
  402.            |> List.map (fun (count,x) -> count-1,x)
  403.            |> List.partition (fst >> (=) 0)
  404.        bonuses := remainders
  405.  
  406.    let logic () =
  407.        moveGhosts()
  408.        movePacman()
  409.        eatPills ()
  410.        if !powerCountdown > 0 then decr powerCountdown
  411.        collisionDetection()
  412.        updateBonus ()
  413.  
  414.    let renderPacman () =
  415.        let p = pacman.ImageAt(x,y,v)
  416.        if (!flashCountdown >>> 1) % 2 = 0
  417.        then context.drawImage(p, float !x, float !y)
  418.  
  419.    let renderEnergy () =
  420.        context.fillStyle <- "yellow"
  421.        context.fillRect(120., 250., float !energy, 2.)
  422.  
  423.    let renderGhosts () =
  424.        ghosts |> Array.iter (fun ghost ->
  425.            let image =
  426.                if ghost.IsReturning then eyed
  427.                else
  428.                    if !powerCountdown = 0
  429.                    then ghost.Image
  430.                    elif !powerCountdown > 100 || ((!powerCountdown >>> 3) % 2) <> 0
  431.                    then blue
  432.                    else ghost.Image
  433.            context.drawImage(image, float ghost.X, float ghost.Y)
  434.        )
  435.  
  436.    let renderScore () =
  437.        context.fillStyle <- "white"
  438.        context.font <- "bold 8px";
  439.        context.fillText("Score " + (!score).ToString(), 0., 255.)
  440.  
  441.    let renderBonus () =
  442.        !bonuses |> List.iter (fun (_,(image,x,y)) -> context.drawImage(image, float x, float y))
  443.  
  444.    let render () =
  445.        context.drawImage(background, 0., 0.)
  446.        renderScore ()
  447.        renderEnergy ()
  448.        renderPacman()
  449.        renderGhosts ()
  450.        renderBonus ()
  451.  
  452.    let rec update () =
  453.        logic ()
  454.        render ()
  455.        if !dotsLeft = 0 then onLevelCompleted()
  456.        elif !energy <= 0 then onGameOver()
  457.        else ts.setTimeout(update, 1000. / 60.) |> ignore
  458.  
  459.    update()
  460.  
  461. let rec game (keys:Keys) =
  462.    keys.Reset()
  463.    let canvas = unbox<ts.HTMLCanvasElement>(ts.document.getElementById("canvas"))
  464.    let context = canvas.getContext("2d")
  465.    let drawText(text,x,y) =
  466.        context.fillStyle <- "white"
  467.        context.font <- "bold 8px";
  468.        context.fillText(text, x, y)
  469.    let levelCompleted () =
  470.        drawText("COMPLETED",96.,96.)
  471.        ts.setTimeout((fun () -> game(keys)),5000.) |> ignore
  472.    let gameOver () =
  473.        drawText("GAME OVER",96.,96.)
  474.        ts.setTimeout((fun () -> game(keys)),5000.) |> ignore
  475.    let start () =
  476.        let background = createBackground()
  477.        context.drawImage(background, 0., 0.)
  478.        context.fillStyle <- "white"
  479.        context.font <- "bold 8px";
  480.        drawText("CLICK TO START", 88., 96.)
  481.        canvas.AsHTMLElement().onclick <- (fun e ->
  482.            canvas.AsHTMLElement().onclick <- null
  483.            playLevel (keys, levelCompleted, gameOver)
  484.            box true
  485.        )
  486.    start()
  487.    
  488. let main () =
  489.    let keys = Keys()
  490.    ts.addEventListener("keydown", unbox<ts.EventListener>(fun e -> keys.Update(e, true)))
  491.    ts.addEventListener("keyup", unbox<ts.EventListener>(fun e ->keys.Update(e,false)))    
  492.    game (keys)    
  493.  
  494. do Runtime.Run(directory="Web", components=Interop.Components.all)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!