Pacman Image Data

[<ReflectedDefinition>]
module Program

open FunScript
open FunScript.TypeScript

type ts = Api<"../Typings/lib.d.ts">

let cyand = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAiUlEQVQoU8WSURKAIAhE8Sh6Fc/tVfQoJdqiMDTVV4wfufAAmw3kxEHUz4pA1I8OJVjAKZZ6+XiC0ATTB/gW2mEFtlpHLqaktrQ6TxUQSRCAPX2AWPMLyM0VmPOcV8palxt6uoAMpDjfWJt+o6cr0DPDnfYjyL94NwIcYjXcR/FuYklcxrZ3OO0Ep4dJ/3dR5jcAAAAASUVORK5CYII="
let oranged = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAgklEQVQoU8WS0RGAIAxDZRRYhblZBUZBsBSaUk/9kj9CXlru4g7r1FxBdsFpGwoa2NwrYIFPEIeM6QS+hQQMYC70EjzuuOlt6gT5kRGGTf0Cx5qfwJYOYIw0L6W1bg+09Al2wAcCS8Y/WjqAZhluxD/B3ghZBO6n1sadzLLEbNSg8pzXIVLvbNvPwAAAAABJRU5ErkJggg=="
let pinkd = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAj0lEQVQoU8WSsRWAIAxEZRQpXITGVZzIVWxYxAJHwRfwMInxqZV0XPIvgXeuM05eUuayG73TbULQwKWZGTTwCYIJphfwLcRhAW5DLfWrXFLrNLWBKAIBbOkFxJpfQDIXYAh1XoznumRo6Q0kwE8VTLN8o6UL0ArDnfYjSF/Mg4CEaA330sxD3ApHLvUdSdsBdgNkr9L8gxYAAAAASUVORK5CYII="
let redd = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAkklEQVQoU8WSvRWAIAyEZRQtXIRCV3EiVtGCRSx0FHxBD5MYn1pJl0u+/PDOVcZLY5e47PrJ6TIhaOBSzBoU8AlCE0zP4FuIwwJc25Bz9TyILbVOUwuIJAjAlp5BrPkFpOYC9H6fF+O5LjW09AIS0Az7jUuQN1q6AC0z3Gk/gvTF3AhwiNYQ52Ju4pI4fKljOG0DA3tp97vN6C8AAAAASUVORK5CYII="
let pu1 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAWElEQVQoU62SUQoAIAhD9f6HNiYYolYi9VfzuXIxDRYbI0LCTHsfe3ldi3BgRRUY9Rnku1Rupf4NgiPeVjVU7STckphBceSvrHHtNPI21HWz4NO3eUUAgwVpmjX/zwK8KQAAAABJRU5ErkJggg=="
let pu2 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAW0lEQVQoU8WSwQoAIAhD9f8/2lIwdKRIl7o1e010THBESJiJXca76qnoDxFC3SD9LRpWkLnsLt4gdImtlLX/EK4iDapqr4VuI2+BauQjaOrmSz8xillDp5gQrS054jv/0fkNVAAAAABJRU5ErkJggg=="
let pd1 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAXElEQVQoU62SUQoAIAhD9f6HNgyMWpMs6k/XU5mqwDMTw5yq6JwbAfucwR2qAFHAu75BN11Gt6+Qz54VpMJsMV3BaS9UR8txkUzfLC9DUY0BYbOPGfpyU3g2WdwAOvU1/9KZsT4AAAAASUVORK5CYII="
let pd2 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAU0lEQVQoU62SUQoAIAhD9f6HNgwUGw4s6q/pc6KqwDMTQ01VtGr56ZIZvKEJEAXc9Q26cUm3r5D3zgrywHeoG3ldJrZIRz6C0I1BoR83FTBCeHsLIlw7/wOkQycAAAAASUVORK5CYII="
let pl1 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAVUlEQVQoU62S2woAIAhD9f8/2jAwvGRMyDfF49iQKZUISZ4xE/vZaW7LHbwhBLADqjpSUjBAdglRDQa9hxfcQi+vf5RGnpDlkB4KlMgR0N6pBIH83gIPFCb/N+MLCwAAAABJRU5ErkJggg=="
let pl2 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAUklEQVQoU52SUQoAIAhD3f0PbRQoZgnT/hyttYeQdFRFswYIoubD73JlPibGYA/s1Jmpk+JpDIinWxbiXP3iQslCwbhTxzhHbsWZNFsnCkTevQW2bCb/VRTuVwAAAABJRU5ErkJggg=="
let pr1 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAWElEQVQoU52S4Q4AIASE3fs/tKalSTHyL/O5CyAXzMQ+BxBsbj9exRE8oQqgDUS1BalNVFSuP2WQL94WIygCBEzttZWOvbz2VBnGtLXg1sgV/L8I679yewN9sScO5wcxLQAAAABJRU5ErkJggg=="
let pr2 = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAANCAYAAABy6+R8AAAAVElEQVQoU62SWwoAIAgE9f6HNgqU3BK2R3+J48KoCjwzMaypis61+OyaK3hADOADeuoddJISaQy0iKggbEz2viah7mVPTNq7cp/ApLmcdFPVdaDJBnWdJwjk629HAAAAAElFTkSuQmCC"
let blue = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA4AAAAOCAYAAAAfSC3RAAAAeklEQVQoU62S0Q3AIAhEyyi6UcfoRB2jG+koNkeCoVcaTaw/huMeEkS24KTUmpdrFWHbQ2CAzb5AB0eQFTFYwVnIw/+B5by0cD52vTmGhnaF25wBAb/A6HsibR0ctch5fRHi1zCigvCut4oR+wnbhrBmsZr9DlqCQfbcnfZjDyiZqCEAAAAASUVORK5CYII="

let maze = "\
##/------------7/------------7##,\
##|............|!............|##,\
##|./__7./___7.|!./___7./__7.|##,\
##|o|  !.|   !.|!.|   !.|  !o|##,\
##|.L--J.L---J.LJ.L---J.L--J.|##,\
##|..........................|##,\
##|./__7./7./______7./7./__7.|##,\
##|.L--J.|!.L--7/--J.|!.L--J.|##,\
##|......|!....|!....|!......|##,\
##L____7.|L__7 |! /__J!./____J##,\
#######!.|/--J LJ L--7!.|#######,\
#######!.|!          |!.|#######,\
#######!.|! /__==__7 |!.|#######,\
-------J.LJ |      ! LJ.L-------,\
########.   | **** !   .########,\
_______7./7 |      ! /7./_______,\
#######!.|! L______J |!.|#######,\
#######!.|!          |!.|#######,\
#######!.|! /______7 |!.|#######,\
##/----J.LJ L--7/--J LJ.L----7##,\
##|............|!............|##,\
##|./__7./___7.|!./___7./__7.|##,\
##|.L-7!.L---J.LJ.L---J.|/-J.|##,\
##|o..|!.......<>.......|!..o|##,\
##L_7.|!./7./______7./7.|!./_J##,\
##/-J.LJ.|!.L--7/--J.|!.LJ.L-7##,\
##|......|!....|!....|!......|##,\
##|./____JL__7.|!./__JL____7.|##,\
##|.L--------J.LJ.L--------J.|##,\
##|..........................|##,\
##L--------------------------J##".Split(',')

let pills = maze |> Array.map (fun line -> line.ToCharArray() |> Array.map (fun c -> c))

let tl =    [|0b00000000;0b00000000;0b00000000;0b00000000;0b00000011;0b00000100;0b00001000;0b00001000|]
let top =   [|0b00000000;0b00000000;0b00000000;0b00000000;0b11111111;0b00000000;0b00000000;0b00000000|]
let tr =    [|0b00000000;0b00000000;0b00000000;0b00000000;0b11000000;0b00100000;0b00010000;0b00010000|]
let left =  [|0b00001000;0b00001000;0b00001000;0b00001000;0b00001000;0b00001000;0b00001000;0b00001000|]
let blank = [|0b00000000;0b00000000;0b00000000;0b00000000;0b00000000;0b00000000;0b00000000;0b00000000|]
let right = [|0b00010000;0b00010000;0b00010000;0b00010000;0b00010000;0b00010000;0b00010000;0b00010000|]
let bl =    [|0b00001000;0b00001000;0b00000100;0b00000011;0b00000000;0b00000000;0b00000000;0b00000000|]
let bottom =[|0b00000000;0b00000000;0b00000000;0b11111111;0b00000000;0b00000000;0b00000000;0b00000000|]
let br =    [|0b00010000;0b00010000;0b00100000;0b11000000;0b00000000;0b00000000;0b00000000;0b00000000|]
let door =  [|0b00000000;0b00000000;0b00000000;0b00000000;0b11111111;0b00000000;0b00000000;0b00000000|]
let pill =  [|0b00000000;0b00000000;0b00000000;0b00011000;0b00011000;0b00000000;0b00000000;0b00000000|]
let power = [|0b00000000;0b00011000;0b00111100;0b01111110;0b01111110;0b00111100;0b00011000;0b00000000|]

type Brush = Blue | Yellow

let toTile c =
    match c with
    | '=' -> door, Blue
    | '_' -> top, Blue
    | '|' -> left, Blue
    | '!' -> right, Blue
    | '/' -> tl, Blue
    | '7' -> tr, Blue
    | 'L' -> bl, Blue
    | 'J' -> br, Blue
    | '-' -> bottom, Blue
    | '.' -> pill, Yellow
    | 'o' -> power, Yellow
    | _ -> blank, Blue

let isWall x=
    match x with
    | '_' | '|' | '!' | '/' | '7' | 'L' | 'J' | '-' | '*' -> true
    | _ -> false

let tileAt (x,y) =
    if x < 0 then ' '
    elif x > 30 then ' '
    else maze.[y].[x]

let isWallAt (x,y) = tileAt(x,y) |> isWall

[<JSEmit("return {0} & {1};")>]
let BitwiseAnd(a:int,b:int) : int = failwith "never"

let draw f (lines:int[]) =
    let width = 8
    lines |> Array.iteri (fun y line ->
        for x = 0 to width-1 do
            let bit = (1 <<< (width - 1 - x))
            let pattern = BitwiseAnd(line,bit)
            if pattern <> 0 then f (x,y)
    )

let createImage data =
    let image = unbox<ts.HTMLImageElement>(ts.document.createElement("image"))
    image.src <- data
    unbox<ts.HTMLElement>(image)

type Plotter(context:ts.CanvasRenderingContext2D) =
    member __.createBrush(r,g,b,a) =
        let id = context.createImageData(float 1,float 1)
        let d = id.data
        d.[0] <- float r; d.[1] <- float g; d.[2] <- float b; d.[3] <- float a
        id
    member __.plot(brush,x,y) =
        context.putImageData(brush, float x, float y)

let createBackground () =
    let background = unbox<ts.HTMLCanvasElement>(ts.document.createElement("canvas"))
    background.width <- 256.
    background.height <- 256.
    let context = background.getContext("2d")
    context.fillStyle <- "rgb(0,0,0)"
    context.fillRect (0., 0. , 256., 256.);
    let plotter = Plotter(context)
    let blue = plotter.createBrush (63,63,255,255)
    let yellow = plotter.createBrush (255,255,0,255)
    let lines = maze
    for y = 0 to lines.Length-1 do
        let line = lines.[y]
        for x = 0 to line.Length-1 do
            let c = line.[x]
            let tile, color = toTile c
            let brush = match color with Blue -> blue | Yellow -> yellow
            let f (x',y') = plotter.plot(brush, x*8 + x', y*8 + y')
            draw f tile
    unbox<ts.HTMLElement>(background)

let clearCell background (x,y) =
    let background = unbox<ts.HTMLCanvasElement>(background)
    let context = background.getContext("2d")
    let plotter = Plotter(context)
    let black = plotter.createBrush (0,0,0,255)
    for y' = 0 to 7 do
        for x' = 0 to 7 do
            plotter.plot(black, x*8 + x', y*8 + y')

let noWall (x,y) (ex,ey) =
    let bx, by = (x+6+ex) >>> 3, (y+6+ey) >>> 3
    isWallAt (bx,by) |> not

let verticallyAligned (x,y) =  (x % 8) = 5
let horizontallyAligned (x,y) = (y % 8) = 5
let isAligned n = (n % 8) = 5

let canGoUp (x,y) = isAligned x && noWall (x,y) (0,-4)
let canGoDown (x,y) = isAligned x && noWall (x,y) (0,5)
let canGoLeft (x,y) = isAligned y && noWall (x,y) (-4,0)
let canGoRight (x,y) = isAligned y && noWall (x,y) (5,0)

let wrap (x,y) (dx,dy) =
    let x =
        if dx = -1 && x = 0 then 30 * 8
        elif dx = 1  && x = 30 *8 then 0
        else x
    x + dx, y + dy

type Ghost(image:ts.HTMLElement,x,y,v) =
    let mutable x' = x
    let mutable y' = y
    let mutable v' = v
    member val Image = image
    member __.X = x'
    member __.Y = y'
    member __.V = v'
    member ghost.Reset() =
        x' <- x
        y' <- y
    member ghost.Move(v) =
        v' <- v
        let dx,dy = v
        let x,y = wrap (x',y') (dx,dy)
        x' <- x
        y' <- y

let chooseDirection (ghost:Ghost) =
    let x,y = ghost.X, ghost.Y
    let dx,dy = ghost.V
    let isBackwards (a,b) =
        (a <> 0 && a = -dx) || (b <> 0 && b = -dy)
    let directions =
        [|canGoLeft(x,y),(-1,0)
          canGoDown(x,y),(0,1)
          canGoRight(x,y),(1,0)
          canGoUp(x,y),(0,-1)|]
        |> Array.filter fst
        |> Array.map snd
        |> Array.filter (not << isBackwards)
    let i = int (ts.Math.floor(ts.Math.random() * float directions.Length))
    let dx,dy = directions.[i]
    dx,dy

let createGhosts context =
    [|
         redd, (16, 11), (1,0)
         cyand, (14, 15), (1,0)
         pinkd, (16, 13), (0,-1)
         oranged, (18, 15), (-1,0)
    |]
    |> Array.map (fun (data,(x,y),v) ->
        let image = createImage data
        Ghost(image, (x*8)-7, (y*8)-3, v)
    )

type Keys() =
    let leftCode, upCode, rightCode, downCode = 90(*z*), 81(*q*), 88(*x*), 65(*a*)
    let mutable isLeft = false
    let mutable isUp = false
    let mutable isDown = false
    let mutable isRight = false
    let update (e,pressed) =
        let e = (unbox<ts.KeyboardEventExtensions>(e))
        let keyCode = int e.keyCode
        if keyCode = leftCode then isLeft <- pressed
        if keyCode = rightCode then isRight <- pressed
        if keyCode = upCode then isUp <- pressed
        if keyCode = downCode then isDown <- pressed
    member keys.Update (e,pressed) = update(e,pressed)
    member keys.LeftPressed = isLeft
    member keys.RightPressed = isRight
    member keys.UpPressed = isUp
    member keys.DownPressed = isDown

let main() =
    let keys = Keys()
    ts.addEventListener("keydown", unbox<ts.EventListener>(fun e -> keys.Update(e, true)))
    ts.addEventListener("keyup", unbox<ts.EventListener>(fun e ->keys.Update(e,false)))

    let canvas = unbox<ts.HTMLCanvasElement>(ts.document.getElementById("canvas"))
    canvas.width <- 256.
    canvas.height <- 256.
    let context = canvas.getContext("2d")
    context.fillStyle <- "rgb(0,0,0)"
    context.fillRect (0., 0. , 256., 256.);

    let background = createBackground()
    let ghosts = createGhosts(context)
    let pu1, pu2 = createImage pu1, createImage pu2
    let pd1, pd2 = createImage pd1, createImage pd2
    let pl1, pl2 = createImage pl1, createImage pl2
    let pr1, pr2 = createImage pr1, createImage pr2
    let blue = createImage blue

    let score = ref 0
    let flashCountdown = ref 0
    let powerCountdown = ref 0
    let x, y = ref (16 * 8 - 7), ref (23 * 8 - 3)
    let v = ref (0,0)
    let lastp = ref pr1

    let moveGhosts () =
        ghosts |> Array.iter (fun ghost ->
            let v = chooseDirection ghost
            ghost.Move(v)
        )

    let movePacman () =
        v :=
            if keys.LeftPressed && canGoLeft(!x,!y) then (-1,0)
            elif keys.RightPressed && canGoRight(!x,!y) then (1,0)
            elif keys.UpPressed && canGoUp(!x,!y) then (0,-1)
            elif keys.DownPressed && canGoDown(!x,!y) then (0,1)
            else (0,0)
        let x',y' = wrap (!x,!y) !v
        x := x'
        y := y'

    let eatPills () =
        let tx = int (ts.Math.floor(float ((!x+6)/8)))
        let ty = int (ts.Math.floor(float ((!y+6)/8)))
        let c = pills.[ty].[tx]
        if c = '.' then
            pills.[ty].[tx] <- ' '
            clearCell background (tx,ty)
            score := !score + 10
        if c = 'o' then
            pills.[ty].[tx] <- ' '
            clearCell background (tx,ty)
            score := !score + 50
            powerCountdown := 250

    let touchingGhosts () =
        let px, py = !x, !y
        ghosts |> Array.filter (fun ghost ->
            let x,y = ghost.X, ghost.Y
            ((px >= x && px < x + 13) ||
             (x < px + 13 && x >= px)) &&
            ((py >= y && py < y + 13) ||
             (y < py + 13 && y >= py))
        )

    let collisionDetection () =
        let touched = touchingGhosts ()
        if touched.Length > 0
        then
            if !powerCountdown > 0 then
                touched |> Array.iter (fun ghost ->
                    ghost.Reset()
                    score := !score + 100
                )
            else
                flashCountdown := 30
        if !flashCountdown > 0
        then flashCountdown := !flashCountdown - 1

    let logic () =
        moveGhosts()
        movePacman()
        eatPills ()
        if !powerCountdown > 0 then powerCountdown := !powerCountdown - 1
        collisionDetection()

    let getPacmanImage () =
        let p1, p2 =
            match !v with
            | -1,  0 -> pl1, pl2
            |  1,  0 -> pr1, pr2
            |  0, -1 -> pu1, pu2
            |  0,  1 -> pd1, pd2
            |  _,  _ -> !lastp, !lastp
        let x' = int (ts.Math.floor(float (!x/6)))
        let y' = int (ts.Math.floor(float (!y/6)))
        if (x' + y') % 2 = 0 then p1 else p2

    let renderPacman () =
        let p = getPacmanImage()
        lastp := p
        if !flashCountdown % 2 = 0
        then context.drawImage(p, float !x, float !y)

    let renderGhosts () =
        ghosts |> Array.iter (fun ghost ->
            let image =
                if !powerCountdown = 0
                then ghost.Image
                else blue
            context.drawImage(image, float ghost.X, float ghost.Y)
        )

    let renderScore () =
        context.fillStyle <- "white"
        context.font <- "bold 8px";
        context.fillText("Score " + (!score).ToString(), 0., 255.)

    let render () =
        context.drawImage(background, 0., 0.)
        renderScore ()
        renderPacman()
        renderGhosts ()

    let rec update () =
        render ()
        logic ()
        ts.setTimeout(update, 1000. / 60.) |> ignore

    update()

do Runtime.Run(directory="Web", components=Interop.Components.all)