├── .gitignore ├── README.md ├── vessel.elm └── vessel.png /.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | cache 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Vessel 2 | ======================== 3 | 4 | 5 | Play: http://slawrence.github.io/vessel/ 6 | 7 | Space to start and left and right arrows to move. 8 | 9 | -------------------------------------------------------------------------------- /vessel.elm: -------------------------------------------------------------------------------- 1 | import Keyboard 2 | import Window 3 | import Text 4 | import Text (centered, monospace, fromString) 5 | import Signal 6 | import Signal ((<~), (~), sampleOn, foldp) 7 | import Time (Time, fps, inSeconds) 8 | import List (length, foldl, filter, map, concatMap, any, (::)) 9 | import Graphics.Element (image, container, middle, Element) 10 | import Graphics.Collage (collage, rect, ngon, filled, move, rotate, toForm) 11 | import Color (lightRed, white, darkRed) 12 | 13 | -- Important game properties 14 | shipStartY = -200 15 | startPieceH = 100 16 | startWidth = 200 17 | minWidth = 50 18 | startSpeed = 500 19 | speedDelta = 0.5 20 | 21 | 22 | -- Inputs 23 | type alias Input = { dir:Int, delta:Float, space:Bool} 24 | delta = inSeconds <~ fps 50 25 | input = sampleOn delta (Input <~ Signal.map .x Keyboard.arrows 26 | ~ delta 27 | ~ Keyboard.space) 28 | -- Models 29 | type alias Ship = { x:Float, y:Float, vx:Float, vy:Float } 30 | type alias Tunnel = { width:Float, speed:Float, x:Float, y:Float, h:Float, ampl:Float } 31 | type alias Piece = { x: Float, y: Float, vx:Float, vy:Float, width:Float, height:Float } 32 | type alias Debri = { x: Float, y: Float, vx:Float, vy:Float, deg:Int } 33 | type alias Game = { cnt:Int, 34 | ship:Ship, 35 | t:Tunnel, 36 | debri:List Debri, 37 | pieces:List Piece, 38 | score:Int, 39 | state:State} 40 | type State = Waiting | Playing | Dead 41 | 42 | -- initial state 43 | defaultGame = 44 | { cnt = 0, 45 | ship = { x=0, y=shipStartY, vx=0, vy=0 }, 46 | t = { width=startWidth, speed=startSpeed, x=curve 0 (toFloat 20), y=300, h=startPieceH, ampl=20 }, 47 | debri = [], 48 | pieces = map (\n -> { x=curve n (toFloat 20), y=(toFloat (n + 30))*10, vx=0, vy=-startSpeed, width=startWidth, height=startPieceH }) [-60..0], 49 | score = 0, 50 | state = Waiting } 51 | 52 | -- Updates 53 | curve : Int -> Float -> Float 54 | curve cnt ampl = 55 | let fcnt = toFloat cnt 56 | degree = (degrees fcnt) * 2 57 | segment = (floor (fcnt / 200)) % 7 -- one more than # of segs 58 | in case segment of 59 | 0 -> (sin (degree * 4)) * ampl 60 | 1 -> (cos (degree * 6) + sin (2*degree)) * ampl 61 | 2 -> (cos (degree * 3) + sin (2*degree)) * ampl 62 | 3 -> 200 63 | 4 -> (cos (degree * 3) + sin (2*degree)) * ampl 64 | 5 -> (cos (degree) + cos (degree*3)) * ampl 65 | 6 -> 0 66 | 67 | towards target x = 68 | let xdelta = (target - x) 69 | neg = (xdelta < 0) 70 | in x + (xdelta / 30) 71 | 72 | updateAmpl cur max = if (cur < max) then cur + 1 else cur 73 | 74 | updateTunnel : Game -> Tunnel 75 | updateTunnel game = 76 | let t = game.t 77 | state = game.state 78 | speed = if game.state == Playing then t.speed + speedDelta else t.speed 79 | ampl = if game.state == Playing then updateAmpl t.ampl 180 else t.ampl 80 | next = curve game.cnt ampl 81 | nx = if (withinN 2 next t.x) then next else towards next t.x 82 | nwidth = if (t.width < minWidth || state == Waiting) then t.width else t.width - 0.1 83 | in 84 | { t | x <- nx 85 | , width <- nwidth 86 | , speed <- speed 87 | , ampl <- ampl 88 | , h <- t.h + speedDelta } 89 | 90 | stepObj t ({x,y,vx,vy} as obj) = 91 | { obj | x <- x + vx*t, y <- y + vy*t } 92 | 93 | stepShip : Time -> Int -> Ship -> Ship 94 | stepShip t dir ship = 95 | let ship1 = stepObj t { ship | vx <- toFloat dir * 360 } 96 | in ship1 97 | 98 | filterPiece piece = piece.y > -400 99 | 100 | stepPiece : Time -> Game -> List Piece 101 | stepPiece t game = 102 | addPiece game 103 | |> map (stepObj t) 104 | |> filter (filterPiece) 105 | 106 | stepDebri t cnt ship debri = map (stepObj t) (addDebri ship cnt debri) 107 | 108 | addD sx sy n = 109 | let vx = sin (degrees (toFloat n)) * 150 110 | vy = cos (degrees (toFloat n)) * 150 111 | in {x=sx, y=sy, vx=vx, vy=vy, deg=10} 112 | 113 | addDebri ship cnt debri = 114 | let l = length debri 115 | d = cnt % 360 116 | in if (l == 0) 117 | then (map (addD ship.x ship.y) (foldl (\n a -> if n % 12 == 0 then [n] ++ a else a ) [] [0..360])) ++ debri 118 | else map (\d -> { d | deg <- (d.deg + 20) % 360 } ) debri 119 | 120 | addPiece : Game -> List Piece 121 | addPiece game = 122 | let nx = game.t.x 123 | ny = game.t.y 124 | speed = game.t.speed 125 | nwidth = game.t.width 126 | h = (800 / (toFloat (length game.pieces))) + 50 127 | in 128 | if game.cnt % 1 == 0 129 | then { x=nx, y=ny, vx=0, vy=-speed, width=nwidth, height=h } :: game.pieces 130 | else game.pieces 131 | 132 | withinN offset px sx = (sx > px - offset) && (sx < px + offset) 133 | 134 | inside : Ship -> Piece -> Bool 135 | inside ship piece = 136 | let halfW = piece.width / 2 137 | in 138 | withinN halfW piece.x ship.x 139 | 140 | updateState : Game -> State 141 | updateState game = 142 | let pieces = game.pieces |> filter (\p -> withinN 60 p.y game.ship.y) 143 | in if any (inside game.ship) pieces 144 | then Playing 145 | else Dead 146 | 147 | hideShip s = { s | x <- -30 148 | , y <- 400 } 149 | 150 | autoShip : Tunnel -> Ship -> Ship 151 | autoShip t s = { s | x <- towards t.x s.x } 152 | 153 | stepDead : Input -> Game -> Game 154 | stepDead {dir,delta,space} game = if space 155 | then { defaultGame | state <- Playing } 156 | else 157 | if (game.cnt > game.score + 200) 158 | then { defaultGame | state <- Waiting } 159 | else { game | debri <- stepDebri delta game.cnt game.ship game.debri 160 | , ship <- hideShip game.ship 161 | , cnt <- (\n -> n + 1) game.cnt } 162 | 163 | stepWaiting : Input -> Game -> Game 164 | stepWaiting {dir,delta,space} game = if space 165 | then { defaultGame | state <- Playing } 166 | else { game | pieces <- stepPiece delta game 167 | , cnt <- (\n -> n + 1) game.cnt 168 | , ship <- autoShip game.t game.ship 169 | , t <- updateTunnel game} 170 | 171 | stepGame : Input -> Game -> Game 172 | stepGame {dir,delta,space} game = 173 | { game | pieces <- stepPiece delta game 174 | , cnt <- (\n -> n + 1) game.cnt 175 | , t <- updateTunnel game 176 | , ship <- stepShip delta dir game.ship 177 | , score <- (\n -> n + 1) game.score 178 | , state <- updateState game } 179 | 180 | stepStart input game = case game.state of 181 | Playing -> stepGame input game 182 | Dead -> stepDead input game 183 | Waiting -> stepWaiting input game 184 | 185 | gameState = foldp stepStart defaultGame input 186 | 187 | -- DISPLAY 188 | drawPiece piece = [rect piece.width piece.height |> filled lightRed 189 | |> move (piece.x, piece.y)] 190 | 191 | drawDebri d = [ngon 3 5 |> filled white |> rotate (degrees (toFloat d.deg)) |> move (d.x, d.y)] 192 | 193 | drawShip ship = [ ngon 3 10 |> filled white 194 | |> rotate (degrees 90) 195 | |> move (ship.x, ship.y) ] 196 | 197 | txt f = centered (monospace (Text.height 15 (Text.color white (fromString (f))))) 198 | displayText game = case game.state of 199 | Playing -> "" 200 | Dead -> (if game.state == Dead then "" ++ (toString game.score) else "") 201 | _ -> "Space to start then arrows" 202 | 203 | displayVessel game x y = 204 | if game.state == Playing then [] else [ toForm (image 396 68 "vessel.png") |> move (0, 100) ] 205 | 206 | display (w,h) game = 207 | container w h middle 208 | (collage 500 500 209 | ([rect 500 500 |> filled darkRed ] ++ 210 | concatMap drawPiece game.pieces ++ 211 | drawShip game.ship ++ 212 | displayVessel game 0 -120 ++ 213 | concatMap drawDebri game.debri ++ 214 | [toForm (txt (displayText game))])) 215 | 216 | main = display <~ Window.dimensions ~ gameState 217 | -------------------------------------------------------------------------------- /vessel.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/slawrence/vessel/b23c322eae34c61127451c8a6b5023babd64dbe7/vessel.png --------------------------------------------------------------------------------