diff --git a/fcore/player.sml b/fcore/player.sml index 97f71ca..4ab2d69 100644 --- a/fcore/player.sml +++ b/fcore/player.sml @@ -5,53 +5,100 @@ struct (* width/height *) val size = 35 + val realSize = 35.0 val moveBy = 5 - val jumpLimit = 55 + val jumpLimit = 150 type t = {yAxis: y_axis, xAxis: x_axis, health: int, x: int, y: int} + (* placeholder *) + val initial: t = + {yAxis = JUMPING 0, xAxis = STAY_STILL, health = 3, x = 500, y = 500} + + (* placeholder *) + fun getVec ({x, y, ...}: t) = + Block.lerp (x, y, realSize, realSize, 1920.0, 1080.0, 0.5, 0.5, 0.5) + fun mkPlayer (health, xAxis, yAxis, x, y) = {yAxis = yAxis, xAxis = xAxis, health = health, x = x, y = y} - fun move (player: t) = + fun checkWalls (yAxis, xAxis, x, y, health, lst) = let - val {yAxis, xAxis, x, y, health} = player + open QuadTree + in + case lst of + (QUERY_ON_LEFT_SIDE, wallID) :: tl => + let + val {x = wallX, width = wallWidth, ...} = Wall.getID wallID + val newX = wallX + wallWidth + in + checkWalls (yAxis, xAxis, newX, y, health, tl) + end + | (QUERY_ON_RIGHT_SIDE, wallID) :: tl => + let + val {x = wallX, width = wallWidth, ...} = Wall.getID wallID + val newX = wallX - size + in + checkWalls (yAxis, xAxis, newX, y, health, tl) + end + | (QUERY_ON_BOTTOM_SIDE, wallID) :: tl => + let + val {y = wallY, ...} = Wall.getID wallID + val newY = wallY - size + in + checkWalls (yAxis, xAxis, x, newY, health, tl) + end + | (QUERY_ON_TOP_SIDE, wallID) :: tl => + checkWalls (yAxis, xAxis, x, y, health, tl) + | [] => mkPlayer (health, xAxis, yAxis, x, y) + end - (* todo: check for wall and platform collisions - * in case analysis for both axis - * *) - val x = + fun move ({x, y, xAxis, yAxis, health}: t) = + let + (* check against wall quad tree *) + val desiredX = case xAxis of - MOVE_LEFT => - (* todo: check if we are trying to move left - * even though player is against wall. - * In that case, keep same action (it is a sign for us to animate), - * but don't actually move leftwards. *) - x - moveBy - | MOVE_RIGHT => (* todo: check against wall *) x + moveBy - | STAY_STILL => x + STAY_STILL => x + | MOVE_LEFT => x - moveBy + | MOVE_RIGHT => x + moveBy in case yAxis of - JUMPING jumped => - (* check if we hit jump limit; - * if we did, change to falling case. - * *) - if jumped + moveBy <= jumpLimit then + ON_GROUND => + let + val collisions = QuadTree.getCollisionSides + (desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree) + in + checkWalls (yAxis, xAxis, desiredX, y, health, collisions) + end + | FALLING => + let + val desiredY = y + moveBy + val collisions = QuadTree.getCollisionSides + (desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree) + in + checkWalls (yAxis, xAxis, desiredX, desiredY, health, collisions) + end + | JUMPING jumped => + if jumped + moveBy > jumpLimit then + (* if we are above the jump limit, trigger a fall *) let - val jumped = jumped + moveBy - val yAxis = JUMPING jumped - val y = y + moveBy + val collisions = QuadTree.getCollisionSides + (desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree) in - mkPlayer (health, xAxis, yAxis, x, y) + checkWalls (FALLING, xAxis, desiredX, y, health, collisions) end else - mkPlayer (health, xAxis, FALLING, x, y) - | FALLING => - (* todo: keep decrementing and falling down - * until we hit ground or platform - * *) - mkPlayer (health, xAxis, yAxis, x, y - moveBy) - | ON_GROUND => mkPlayer (health, xAxis, yAxis, x, y) + (* jump *) + let + val newJumped = jumped + moveBy + val yAxis = JUMPING newJumped + val desiredY = y - moveBy + + val collisions = QuadTree.getCollisionSides + (desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree) + in + checkWalls (yAxis, xAxis, desiredX, desiredY, health, collisions) + end end end diff --git a/fcore/quad-tree.sml b/fcore/quad-tree.sml index 28ad05a..40bbb07 100644 --- a/fcore/quad-tree.sml +++ b/fcore/quad-tree.sml @@ -8,20 +8,18 @@ sig | QUERY_ON_RIGHT_SIDE | QUERY_ON_BOTTOM_SIDE - val insert : int * int * int * int * - int * int * int * int * - int * t -> t + val insert: int * int * int * int * int * int * int * int * int * t -> t - val getCollisions : int * int * int * int * - int * int * int * int * - int * t -> int list + val fromItem: int * int * int * int * int -> t - val getCollisionSides : int * int * int * int * - int * int * int * int * - int * t -> (collision_side * int) list + val getCollisions: int * int * int * int * int * int * int * int * int * t + -> int list + + val getCollisionSides: int * int * int * int * int * int * int * int * int * t + -> (collision_side * int) list end -structure QuadTree : QUAD_TREE = +structure QuadTree: QUAD_TREE = struct type item = {itemID: int, startX: int, startY: int, width: int, height: int} @@ -43,6 +41,14 @@ struct } | LEAF of item vector + fun fromItem (itemID, startX, startY, width, height) = + let + val item = mkItem (itemID, startX, startY, width, height) + val elements = Vector.fromList [item] + in + LEAF elements + end + (* max size of vector before we split it further *) val maxSize = 3 @@ -68,23 +74,47 @@ struct val middleY = quadY + halfHeight val isInTopLeft = isItemInQuad - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, halfWidth, halfHeight + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , halfWidth + , halfHeight ) val isInTopRight = isItemInQuad - ( itemX, itemY, itemWidth, itemHeight - , middleX, quadY, halfWidth, halfHeight + ( itemX + , itemY + , itemWidth + , itemHeight + , middleX + , quadY + , halfWidth + , halfHeight ) val isInBottomLeft = isItemInQuad - ( itemX, itemY, itemWidth, itemHeight - , quadX, middleY, halfWidth, halfHeight + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , middleY + , halfWidth + , halfHeight ) val isInBottomRight = isItemInQuad - ( itemX, itemY, itemWidth, itemHeight - , middleX, middleY, halfWidth, halfHeight + ( itemX + , itemY + , itemWidth + , itemHeight + , middleX + , middleY + , halfWidth + , halfHeight ) in if isInTopLeft then TOP_LEFT @@ -135,9 +165,16 @@ struct end fun insert - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - , itemID, tree: t + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + , itemID + , tree: t ) = case tree of NODE {topLeft, topRight, bottomLeft, bottomRight, elements} => @@ -146,8 +183,14 @@ struct * Else, add to elements vector in current node. *) (case whichQuadrant - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight ) of TOP_LEFT => @@ -160,9 +203,16 @@ struct val halfHeight = quadHeight div 2 val newTopLeft = insert - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, halfWidth, halfHeight - , itemID, topLeft + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , halfWidth + , halfHeight + , itemID + , topLeft ) in NODE @@ -180,9 +230,16 @@ struct val middleX = quadX + halfWidth val newTopRight = insert - ( itemX, itemY, itemWidth, itemHeight - , middleX, quadY, halfWidth, halfHeight - , itemID, topRight + ( itemX + , itemY + , itemWidth + , itemHeight + , middleX + , quadY + , halfWidth + , halfHeight + , itemID + , topRight ) in NODE @@ -200,9 +257,16 @@ struct val middleY = quadY + halfHeight val newBottomLeft = insert - ( itemX, itemY, itemWidth, itemHeight - , quadX, middleY, halfWidth, halfHeight - , itemID, bottomLeft + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , middleY + , halfWidth + , halfHeight + , itemID + , bottomLeft ) in NODE @@ -221,9 +285,16 @@ struct val middleY = quadY + halfHeight val newBottomRight = insert - ( itemX, itemY, itemWidth, itemHeight - , middleX, middleY, halfWidth, halfHeight - , itemID, bottomRight + ( itemX + , itemY + , itemWidth + , itemHeight + , middleX + , middleY + , halfWidth + , halfHeight + , itemID + , bottomRight ) in NODE @@ -258,39 +329,85 @@ struct in (case whichQuadrant - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight ) of TOP_LEFT => splitLeaf - ( quadX, quadY, quadWidth, quadHeight - , [item], [], [], [], [] - , elements, pos + ( quadX + , quadY + , quadWidth + , quadHeight + , [item] + , [] + , [] + , [] + , [] + , elements + , pos ) | TOP_RIGHT => splitLeaf - ( quadX, quadY, quadWidth, quadHeight - , [], [item], [], [], [] - , elements, pos + ( quadX + , quadY + , quadWidth + , quadHeight + , [] + , [item] + , [] + , [] + , [] + , elements + , pos ) | BOTTOM_LEFT => splitLeaf - ( quadX, quadY, quadWidth, quadHeight - , [], [], [item], [], [] - , elements, pos + ( quadX + , quadY + , quadWidth + , quadHeight + , [] + , [] + , [item] + , [] + , [] + , elements + , pos ) | BOTTOM_RIGHT => splitLeaf - ( quadX, quadY, quadWidth, quadHeight - , [], [], [], [item], [] - , elements, pos + ( quadX + , quadY + , quadWidth + , quadHeight + , [] + , [] + , [] + , [item] + , [] + , elements + , pos ) | PARENT_QUADRANT => splitLeaf - ( quadX, quadY, quadWidth, quadHeight - , [], [], [], [], [item] - , elements, pos + ( quadX + , quadY + , quadWidth + , quadHeight + , [] + , [] + , [] + , [] + , [item] + , elements + , pos )) end else @@ -310,11 +427,8 @@ struct val endX = startX + width val endY = startY + height in - iX < endX - andalso itemEndX > startX - andalso iY < endY - andalso itemEndY > startY - andalso itemID <> checkID + iX < endX andalso itemEndX > startX andalso iY < endY + andalso itemEndY > startY andalso itemID <> checkID end fun getCollisionsVec (iX, iY, iW, iH, itemID, pos, elements, acc) = @@ -323,150 +437,211 @@ struct else let val item = Vector.sub (elements, pos) - val acc = - if isColliding (iX, iY, iW, iH, itemID, item) - then #itemID item :: acc + val acc = + if isColliding (iX, iY, iW, iH, itemID, item) then #itemID item :: acc else acc in getCollisionsVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc) end - fun getCollisionsAll - ( iX, iY, iW, iH, qW, qH - , itemID, acc, tree - ) = - case tree of + fun getCollisionsAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) = + case tree of NODE {topLeft, topRight, bottomLeft, bottomRight, elements} => let - val acc = - getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc) + val acc = getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc) val halfWidth = qW div 2 val halfHeight = qH div 2 - val acc = - getCollisionsAll - ( iX, iY, iW, iH, halfWidth, halfHeight - , itemID, acc, topLeft - ) + val acc = getCollisionsAll + (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft) - val acc = - getCollisionsAll - ( iX, iY, iW, iH, halfWidth, halfHeight - , itemID, acc, topRight - ) + val acc = getCollisionsAll + (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight) - val acc = - getCollisionsAll - ( iX, iY, iW, iH, halfWidth, halfHeight - , itemID, acc, bottomLeft - ) + val acc = getCollisionsAll + (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft) in getCollisionsAll - ( iX, iY, iW, iH, halfWidth, halfWidth - , itemID, acc, bottomRight - ) + (iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight) end | LEAF elements => getCollisionsVec (iX, iY, iW, iH, itemID, 0, elements, acc) - fun helpGetCollisions - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - , itemID, acc, tree: t + fun helpGetCollisions + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + , itemID + , acc + , tree: t ) = case tree of NODE {topLeft, topRight, bottomLeft, bottomRight, elements} => let (* get colliding elements in this node first *) - val acc = - getCollisionsVec - ( itemX, itemY, itemWidth, itemHeight - , itemID, 0, elements, acc - ) + val acc = getCollisionsVec + (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc) val halfWidth = quadWidth div 2 val halfHeight = quadHeight div 2 in - (case whichQuadrant - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - ) + (case + whichQuadrant + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + ) of TOP_LEFT => - helpGetCollisions - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, halfWidth, halfHeight - , itemID, acc, topLeft + helpGetCollisions + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , halfWidth + , halfHeight + , itemID + , acc + , topLeft ) | TOP_RIGHT => - helpGetCollisions - ( itemX, itemY, itemWidth, itemHeight - , quadX + halfWidth, quadY, halfWidth, halfHeight - , itemID, acc, topRight + helpGetCollisions + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + halfWidth + , quadY + , halfWidth + , halfHeight + , itemID + , acc + , topRight ) | BOTTOM_LEFT => - helpGetCollisions - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY + halfHeight, halfWidth, halfHeight - , itemID, acc, bottomLeft + helpGetCollisions + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + halfHeight + , halfWidth + , halfHeight + , itemID + , acc + , bottomLeft ) - | BOTTOM_RIGHT => - helpGetCollisions - ( itemX, itemY, itemWidth, itemHeight - , quadX + halfWidth, quadY + halfHeight - , halfWidth, halfHeight - , itemID, acc, bottomRight + | BOTTOM_RIGHT => + helpGetCollisions + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + halfWidth + , quadY + halfHeight + , halfWidth + , halfHeight + , itemID + , acc + , bottomRight ) - | PARENT_QUADRANT => + | PARENT_QUADRANT => (* In this function, PARENT_QUADRANT means * that the item is not in any of the main quadrants * but may possibly in the parent quadrant OR * it may be in any of the child quadrants. * So descend down on all the children, accumulating acc. * *) - let - val acc = - getCollisionsAll - ( itemX, itemY, itemWidth, itemHeight - , halfWidth, halfHeight - , itemID, acc, topLeft - ) + let + val acc = getCollisionsAll + ( itemX + , itemY + , itemWidth + , itemHeight + , halfWidth + , halfHeight + , itemID + , acc + , topLeft + ) - val acc = - getCollisionsAll - ( itemX, itemY, itemWidth, itemHeight - , halfWidth, halfHeight - , itemID, acc, topRight - ) + val acc = getCollisionsAll + ( itemX + , itemY + , itemWidth + , itemHeight + , halfWidth + , halfHeight + , itemID + , acc + , topRight + ) - val acc = - getCollisionsAll - ( itemX, itemY, itemWidth, itemHeight - , halfWidth, halfHeight - , itemID, acc, bottomLeft - ) - in - getCollisionsAll - ( itemX, itemY, itemWidth, itemHeight - , halfWidth, halfHeight - , itemID, acc, bottomRight - ) - end) + val acc = getCollisionsAll + ( itemX + , itemY + , itemWidth + , itemHeight + , halfWidth + , halfHeight + , itemID + , acc + , bottomLeft + ) + in + getCollisionsAll + ( itemX + , itemY + , itemWidth + , itemHeight + , halfWidth + , halfHeight + , itemID + , acc + , bottomRight + ) + end) end | LEAF elements => - getCollisionsVec - ( itemX, itemY, itemWidth, itemHeight - , itemID, 0, elements, acc - ) + getCollisionsVec + (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc) - fun getCollisions - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - , itemID, tree + fun getCollisions + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + , itemID + , tree ) = - helpGetCollisions - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - , itemID, [], tree + helpGetCollisions + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + , itemID + , [] + , tree ) (* no variant to represent 'no collision' case @@ -505,26 +680,16 @@ struct val minXDist = iHalfW + cHalfW val minYDist = iHalfH + cHalfH - val depthX = - if diffX > 0 - then minXDist - diffX - else (~minXDist) - diffX + val depthX = if diffX > 0 then minXDist - diffX else (~minXDist) - diffX - val depthY = - if diffY > 0 - then minYDist - diffY - else (~minYDist) - diffY + val depthY = if diffY > 0 then minYDist - diffY else (~minYDist) - diffY in if abs depthX < abs depthY then - if depthX > 0 then - QUERY_ON_LEFT_SIDE - else - QUERY_ON_RIGHT_SIDE + if depthX > 0 then QUERY_ON_LEFT_SIDE else QUERY_ON_RIGHT_SIDE + else if depthY > 0 then + QUERY_ON_TOP_SIDE else - if depthY > 0 then - QUERY_ON_TOP_SIDE - else - QUERY_ON_BOTTOM_SIDE + QUERY_ON_BOTTOM_SIDE end (* like getCollisionsVec, but instead of consing just the itemID, @@ -536,153 +701,215 @@ struct else let val item = Vector.sub (elements, pos) - val acc = - if isColliding (iX, iY, iW, iH, itemID, item) then - let - val side = getCollisionSide (iX, iY, iW, iH, item) - in - (side, #itemID item) :: acc + val acc = + if isColliding (iX, iY, iW, iH, itemID, item) then + let val side = getCollisionSide (iX, iY, iW, iH, item) + in (side, #itemID item) :: acc end - else acc + else + acc in getCollisionSideVec (iX, iY, iW, iH, itemID, pos + 1, elements, acc) end - fun getCollisionSidesAll - ( iX, iY, iW, iH, qW, qH - , itemID, acc, tree - ) = - case tree of + fun getCollisionSidesAll (iX, iY, iW, iH, qW, qH, itemID, acc, tree) = + case tree of NODE {topLeft, topRight, bottomLeft, bottomRight, elements} => let - val acc = - getCollisionSideVec (iX, iY, iW, iH, itemID, 0, elements, acc) + val acc = getCollisionSideVec + (iX, iY, iW, iH, itemID, 0, elements, acc) val halfWidth = qW div 2 val halfHeight = qH div 2 - val acc = - getCollisionSidesAll - ( iX, iY, iW, iH, halfWidth, halfHeight - , itemID, acc, topLeft - ) + val acc = getCollisionSidesAll + (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topLeft) - val acc = - getCollisionSidesAll - ( iX, iY, iW, iH, halfWidth, halfHeight - , itemID, acc, topRight - ) + val acc = getCollisionSidesAll + (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, topRight) - val acc = - getCollisionSidesAll - ( iX, iY, iW, iH, halfWidth, halfHeight - , itemID, acc, bottomLeft - ) + val acc = getCollisionSidesAll + (iX, iY, iW, iH, halfWidth, halfHeight, itemID, acc, bottomLeft) in getCollisionSidesAll - ( iX, iY, iW, iH, halfWidth, halfWidth - , itemID, acc, bottomRight - ) + (iX, iY, iW, iH, halfWidth, halfWidth, itemID, acc, bottomRight) end | LEAF elements => getCollisionSideVec (iX, iY, iW, iH, itemID, 0, elements, acc) fun helpGetCollisionSides - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - , itemID, acc, tree: t + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + , itemID + , acc + , tree: t ) = case tree of NODE {topLeft, topRight, bottomLeft, bottomRight, elements} => let (* get colliding elements in this node first *) - val acc = - getCollisionSideVec - ( itemX, itemY, itemWidth, itemHeight - , itemID, 0, elements, acc - ) + val acc = getCollisionSideVec + (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc) val halfWidth = quadWidth div 2 val halfHeight = quadHeight div 2 in - (case whichQuadrant - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - ) + (case + whichQuadrant + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + ) of TOP_LEFT => helpGetCollisionSides - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, halfWidth, halfHeight - , itemID, acc, topLeft + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , halfWidth + , halfHeight + , itemID + , acc + , topLeft ) | TOP_RIGHT => helpGetCollisionSides - ( itemX, itemY, itemWidth, itemHeight - , quadX + halfWidth, quadY, halfWidth, halfHeight - , itemID, acc, topRight + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + halfWidth + , quadY + , halfWidth + , halfHeight + , itemID + , acc + , topRight ) | BOTTOM_LEFT => helpGetCollisionSides - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY + halfHeight, halfWidth, halfHeight - , itemID, acc, bottomLeft + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + halfHeight + , halfWidth + , halfHeight + , itemID + , acc + , bottomLeft ) - | BOTTOM_RIGHT => + | BOTTOM_RIGHT => helpGetCollisionSides - ( itemX, itemY, itemWidth, itemHeight - , quadX + halfWidth, quadY + halfHeight - , halfWidth, halfHeight - , itemID, acc, bottomRight + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + halfWidth + , quadY + halfHeight + , halfWidth + , halfHeight + , itemID + , acc + , bottomRight ) - | PARENT_QUADRANT => + | PARENT_QUADRANT => (* In this function, PARENT_QUADRANT means * that the item is not in any of the main quadrants * but may possibly in the parent quadrant OR * it may be in any of the child quadrants. * So descend down on all the children, accumulating acc. * *) - let - val acc = - getCollisionSidesAll - ( itemX, itemY, itemWidth, itemHeight - , halfWidth, halfHeight - , itemID, acc, topLeft - ) + let + val acc = getCollisionSidesAll + ( itemX + , itemY + , itemWidth + , itemHeight + , halfWidth + , halfHeight + , itemID + , acc + , topLeft + ) - val acc = - getCollisionSidesAll - ( itemX, itemY, itemWidth, itemHeight - , halfWidth, halfHeight - , itemID, acc, topRight - ) + val acc = getCollisionSidesAll + ( itemX + , itemY + , itemWidth + , itemHeight + , halfWidth + , halfHeight + , itemID + , acc + , topRight + ) - val acc = - getCollisionSidesAll - ( itemX, itemY, itemWidth, itemHeight - , halfWidth, halfHeight - , itemID, acc, bottomLeft - ) - in - getCollisionSidesAll - ( itemX, itemY, itemWidth, itemHeight - , halfWidth, halfHeight - , itemID, acc, bottomRight - ) - end) + val acc = getCollisionSidesAll + ( itemX + , itemY + , itemWidth + , itemHeight + , halfWidth + , halfHeight + , itemID + , acc + , bottomLeft + ) + in + getCollisionSidesAll + ( itemX + , itemY + , itemWidth + , itemHeight + , halfWidth + , halfHeight + , itemID + , acc + , bottomRight + ) + end) end | LEAF elements => getCollisionSideVec - ( itemX, itemY, itemWidth, itemHeight - , itemID, 0, elements, acc - ) + (itemX, itemY, itemWidth, itemHeight, itemID, 0, elements, acc) fun getCollisionSides - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - , itemID, tree + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + , itemID + , tree ) = helpGetCollisionSides - ( itemX, itemY, itemWidth, itemHeight - , quadX, quadY, quadWidth, quadHeight - , itemID, [], tree + ( itemX + , itemY + , itemWidth + , itemHeight + , quadX + , quadY + , quadWidth + , quadHeight + , itemID + , [] + , tree ) end diff --git a/fcore/wall.sml b/fcore/wall.sml index 88d6ba1..aaf706a 100644 --- a/fcore/wall.sml +++ b/fcore/wall.sml @@ -1,9 +1,52 @@ structure Wall = struct - (* Wall or platform, where player can land after falling. - * Difference between wall and platform is that one can jump to a platform - * and go below it, but wall is completely opaque. *) - datatype wall_type = WALL | PLATFORM + type t = {id: int, x: int, y: int, width: int, height: int} + val wall1 = {id = 1, x = 0, y = 0, width = 100, height = 1080} + val wall2 = {id = 2, x = 1820, y = 0, width = 100, height = 1080} + val wall3 = {id = 3, x = 0, y = 980, width = 1920, height = 108} + val wallVec = Vector.fromList [wall1, wall2, wall3] + + fun getID n = + Vector.sub (wallVec, n - 1) + + fun generateTree (pos, wallVec, acc) = + if pos = Vector.length wallVec then + acc + else + let + val {id, x, y, width, height} = Vector.sub (wallVec, pos) + val acc = QuadTree.insert + (x, y, width, height, 0, 0, 1920, 1080, id, acc) + in + generateTree (pos + 1, wallVec, acc) + end + + val tree = + let + val {id, x, y, width, height} = Vector.sub (wallVec, 0) + val acc = QuadTree.fromItem (id, x, y, width, height) + in + generateTree (1, wallVec, acc) + end + + fun helpGenerateWalls (pos, wallVec, acc, winWidth, winHeight) = + if pos = Vector.length wallVec then + Vector.concat acc + else + let + val wall = Vector.sub (wallVec, pos) + val {x, y, width, height, ...} = wall + val width = Real32.fromInt width + val height = Real32.fromInt height + val block = Block.lerp + (x, y, width, height, winWidth, winHeight, 0.0, 0.0, 0.0) + val acc = block :: acc + in + helpGenerateWalls (pos + 1, wallVec, acc, winWidth, winHeight) + end + + fun generateWalls () = + helpGenerateWalls (0, wallVec, [], 1920.0, 1080.0) end diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml new file mode 100644 index 0000000..abebc2f --- /dev/null +++ b/message-types/input-msg.sml @@ -0,0 +1,11 @@ +signature INPUT_MSG = +sig + datatype t = + RESIZE_WINDOW of {width: int, height: int} +end + +structure InputMsg = +struct + datatype t = + RESIZE_WINDOW of {width: int, height: int} +end diff --git a/oms.mlb b/oms.mlb index 75fc9ae..a3771d3 100644 --- a/oms.mlb +++ b/oms.mlb @@ -1,6 +1,8 @@ $(SML_LIB)/basis/basis.mlb (* fcore *) +message-types/input-msg.sml + ann "allowVectorExps true" in @@ -8,8 +10,8 @@ in end fcore/quad-tree.sml -fcore/player.sml fcore/wall.sml +fcore/player.sml (* shell *) $(SML_LIB)/basis/mlton.mlb diff --git a/shell/gl-draw.sml b/shell/gl-draw.sml index 13e3411..2e4b124 100644 --- a/shell/gl-draw.sml +++ b/shell/gl-draw.sml @@ -2,7 +2,16 @@ structure GlDraw = struct open CML - type t = { window: MLton.Pointer.t } + type t = + { window: MLton.Pointer.t + , mbox: InputMsg.t Mailbox.mbox + , wallVertexBuffer: Word32.word + , wallProgram: Word32.word + , wallLength: int + , playerVertexBuffer: Word32.word + , playerProgram: Word32.word + , playerLength: int + } fun createShader (shaderType, shaderString) = let @@ -25,17 +34,86 @@ struct fun create window = let + val mbox = Mailbox.mailbox () (* create vertex buffer, program, etc. *) - val textVertexBuffer = Gles3.createBuffer () val xyrgbVertexShader = createShader (Gles3.VERTEX_SHADER, GlShaders.xyrgbVertexShaderString) val rgbFragmentShader = createShader (Gles3.FRAGMENT_SHADER, GlShaders.rgbFragmentShaderString) - val placeholderProgram = createProgram (xyrgbVertexShader, rgbFragmentShader) + (* wall here includes both walls and platforms *) + val wallVertexBuffer = Gles3.createBuffer () + val wallProgram = createProgram (xyrgbVertexShader, rgbFragmentShader) + + val playerVertexBuffer = Gles3.createBuffer () + val playerProgram = createProgram (xyrgbVertexShader, rgbFragmentShader) in - {window = window} + { window = window + , mbox = mbox + , wallVertexBuffer = wallVertexBuffer + , wallProgram = wallProgram + , wallLength = 0 + , playerVertexBuffer = playerVertexBuffer + , playerProgram = playerProgram + , playerLength = 0 + } + end + + fun uploadWall (shellState: t, vec) = + let + val + { window + , mbox + , playerVertexBuffer + , playerProgram + , playerLength + , wallVertexBuffer + , wallProgram + , wallLength = _ + } = shellState + + val _ = Gles3.bindBuffer wallVertexBuffer + val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW) + val newWallLength = Vector.length vec div 5 + in + { window = window + , mbox = mbox + , playerVertexBuffer = playerVertexBuffer + , playerProgram = playerProgram + , playerLength = playerLength + , wallVertexBuffer = wallVertexBuffer + , wallProgram = wallProgram + , wallLength = newWallLength + } + end + + fun uploadPlayer (shellState: t, vec) = + let + val + { window + , mbox + , wallVertexBuffer + , wallProgram + , wallLength + , playerVertexBuffer + , playerProgram + , playerLength = _ + } = shellState + + val _ = Gles3.bindBuffer playerVertexBuffer + val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW) + val newPlayerLength = Vector.length vec div 5 + in + { window = window + , mbox = mbox + , wallVertexBuffer = wallVertexBuffer + , wallProgram = wallProgram + , wallLength = wallLength + , playerVertexBuffer = playerVertexBuffer + , playerProgram = playerProgram + , playerLength = newPlayerLength + } end fun drawXyrgb (vertexBuffer, program, drawLength) = @@ -57,7 +135,21 @@ struct else () - fun helpLoop (shellState as {window, ...}: t) = + fun drawWall ({wallVertexBuffer, wallProgram, wallLength, ...}: t) = + drawXyrgb (wallVertexBuffer, wallProgram, wallLength) + + fun drawPlayer ({playerVertexBuffer, playerProgram, playerLength, ...}: t) = + drawXyrgb (playerVertexBuffer, playerProgram, playerLength) + + fun draw (shellState: t) = + let + val _ = drawWall shellState + val _ = drawPlayer shellState + in + () + end + + fun helpLoop (shellState as {window, ...}: t, player) = case Glfw.windowShouldClose window of false => let @@ -69,15 +161,26 @@ struct * - consume draw messages * - finally, draw * *) + + val wallVec = Wall.generateWalls () + val shellState = uploadWall (shellState, wallVec) + + val player = Player.move player + val playerVec = Player.getVec player + val shellState = uploadWall (shellState, wallVec) + val shellState = uploadPlayer (shellState, playerVec) + + val _ = draw shellState + val _ = Glfw.swapBuffers window val _ = Glfw.waitEvents () in - helpLoop shellState + helpLoop (shellState, player) end | true => Glfw.terminate () fun loop window = let val shellState = create window - in helpLoop shellState + in helpLoop (shellState, Player.initial) end end