humza/sml-projects
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add GameType.game_type which stores player and wall types, add GameUpdate.update function which takes a game type and returns a new game type, and refactor player/wall files, and gl-draw file, in light of these changes

Browse Source
This commit is contained in:
Humza Shahid
2024-12-15 09:10:19 +00:00
parent 1017bf1b7a
commit cc7f30f718
8 changed files with 165 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files

0
cat Normal file
View File

70
fcore/game-type.sml
View File

@@ -1,4 +1,70 @@
structure GameTyoe =
struct
signature GAME_TYPE =
sig
type wall = {id: int, x: int, y: int, width: int, height: int}
datatype player_y_axis =
ON_GROUND
| FALLING
| JUMPING of int
| FLOATING of int
datatype player_x_axis = MOVE_LEFT | STAY_STILL | MOVE_RIGHT
type player =
{ yAxis: player_y_axis
, xAxis: player_x_axis
, health: int
, x: int
, y: int
, jumpPressed: bool
}
type game_type = {player: player, walls: wall vector, wallTree: QuadTree.t}
val initial: game_type
end
structure GameType :> GAME_TYPE =
struct
type wall = {id: int, x: int, y: int, width: int, height: int}
datatype player_y_axis =
ON_GROUND
| FALLING
| JUMPING of int
| FLOATING of int
datatype player_x_axis = MOVE_LEFT | STAY_STILL | MOVE_RIGHT
type player =
{ yAxis: player_y_axis
, xAxis: player_x_axis
, health: int
, x: int
, y: int
, jumpPressed: bool
}
type game_type = {player: player, walls: wall vector, wallTree: QuadTree.t}
val initial: game_type =
let
val player =
{ yAxis = JUMPING 0
, xAxis = STAY_STILL
, health = 3
, x = 500
, y = 500
, jumpPressed = false
}
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 wall4 = {id = 4, x = 155, y = 911, width = 155, height = 55}
val walls = Vector.fromList [wall1, wall2, wall3, wall4]
val wallTree = Wall.generateTree walls
in
{player = player, walls = walls, wallTree = wallTree}
end
end

10
fcore/game-update.sml Normal file
View File

@@ -0,0 +1,10 @@
structure GameUpdate =
struct
fun update (game, input) =
let
val {player, walls, wallTree} = game
val player = Player.move (game, input)
in
{player = player, walls = walls, wallTree = wallTree}
end
end

114
fcore/player.sml
View File

@@ -1,7 +1,6 @@
structure Player =
struct
datatype y_axis = ON_GROUND | FALLING | JUMPING of int | FLOATING of int
datatype x_axis = MOVE_LEFT | STAY_STILL | MOVE_RIGHT
open GameType
(* width/height *)
val size = 35
@@ -11,29 +10,6 @@ struct
val jumpLimit = 150
val floatLimit = 3
type t =
{ yAxis: y_axis
, xAxis: x_axis
, health: int
, x: int
, y: int
, jumpPressed: bool
}
(* placeholder *)
val initial: t =
{ yAxis = JUMPING 0
, xAxis = STAY_STILL
, health = 3
, x = 500
, y = 500
, jumpPressed = false
}
(* 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, jumpPressed) =
{ yAxis = yAxis
, xAxis = xAxis
@@ -43,38 +19,47 @@ struct
, jumpPressed = jumpPressed
}
fun checkWalls (yAxis, xAxis, x, y, health, jumpPressed, lst) =
fun checkWalls (yAxis, xAxis, x, y, health, jumpPressed, lst, game: game_type) =
let
open QuadTree
in
case lst of
(QUERY_ON_LEFT_SIDE, wallID) :: tl =>
let
val {x = wallX, width = wallWidth, ...} = Wall.getID wallID
val {walls, ...} = game
val {x = wallX, width = wallWidth, ...} =
Vector.sub (walls, wallID - 1)
val newX = wallX + wallWidth
in
checkWalls (yAxis, xAxis, newX, y, health, jumpPressed, tl)
checkWalls (yAxis, xAxis, newX, y, health, jumpPressed, tl, game)
end
| (QUERY_ON_RIGHT_SIDE, wallID) :: tl =>
let
val {x = wallX, width = wallWidth, ...} = Wall.getID wallID
val {walls, ...} = game
val {x = wallX, width = wallWidth, ...} =
Vector.sub (walls, wallID - 1)
val newX = wallX - size
in
checkWalls (yAxis, xAxis, newX, y, health, jumpPressed, tl)
checkWalls (yAxis, xAxis, newX, y, health, jumpPressed, tl, game)
end
| (QUERY_ON_BOTTOM_SIDE, wallID) :: tl =>
let
val {y = wallY, ...} = Wall.getID wallID
val {walls, ...} = game
val {y = wallY, ...} = Vector.sub (walls, wallID - 1)
val newY = wallY - size
in
checkWalls (ON_GROUND, xAxis, x, newY, health, jumpPressed, tl)
checkWalls
(ON_GROUND, xAxis, x, newY, health, jumpPressed, tl, game)
end
| (QUERY_ON_TOP_SIDE, wallID) :: tl =>
checkWalls (yAxis, xAxis, x, y, health, jumpPressed, tl)
checkWalls (yAxis, xAxis, x, y, health, jumpPressed, tl, game)
| [] => mkPlayer (health, xAxis, yAxis, x, y, jumpPressed)
end
fun helpMove (x, y, xAxis, yAxis, health, jumpPressed) =
fun helpMove (x, y, xAxis, yAxis, health, jumpPressed, game: game_type) =
let
(* check against wall quad tree *)
val desiredX =
@@ -87,27 +72,37 @@ struct
ON_GROUND =>
let
val collisions = QuadTree.getCollisionSides
(desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
(desiredX, y, size, size, 0, 0, 1920, 1080, 0, #wallTree game)
in
checkWalls
(yAxis, xAxis, desiredX, y, health, jumpPressed, collisions)
(yAxis, xAxis, desiredX, y, health, jumpPressed, collisions, game)
end
| FLOATING floated =>
let
val collisions = QuadTree.getCollisionSides
(desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
(desiredX, y, size, size, 0, 0, 1920, 1080, 0, #wallTree game)
val yAxis =
if floated = floatLimit then FALLING else FLOATING (floated + 1)
in
checkWalls
(yAxis, xAxis, desiredX, y, health, jumpPressed, collisions)
(yAxis, xAxis, desiredX, y, health, jumpPressed, collisions, game)
end
| FALLING =>
let
val desiredY = y + moveBy
val collisions = QuadTree.getCollisionSides
(desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
( desiredX
, desiredY
, size
, size
, 0
, 0
, 1920
, 1080
, 0
, #wallTree game
)
in
checkWalls
( yAxis
@@ -117,6 +112,7 @@ struct
, health
, jumpPressed
, collisions
, game
)
end
| JUMPING jumped =>
@@ -124,7 +120,7 @@ struct
(* if we are above the jump limit, trigger a fall *)
let
val collisions = QuadTree.getCollisionSides
(desiredX, y, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
(desiredX, y, size, size, 0, 0, 1920, 1080, 0, #wallTree game)
in
checkWalls
( FLOATING 0
@@ -134,6 +130,7 @@ struct
, health
, jumpPressed
, collisions
, game
)
end
else
@@ -144,7 +141,17 @@ struct
val desiredY = y - moveBy
val collisions = QuadTree.getCollisionSides
(desiredX, desiredY, size, size, 0, 0, 1920, 1080, 0, Wall.tree)
( desiredX
, desiredY
, size
, size
, 0
, 0
, 1920
, 1080
, 0
, #wallTree game
)
in
checkWalls
( yAxis
@@ -154,6 +161,7 @@ struct
, health
, jumpPressed
, collisions
, game
)
end
end
@@ -195,9 +203,11 @@ struct
ON_GROUND => if jumpPressed then prevAxis else JUMPING 0
| _ => prevAxis
fun move ({x, y, yAxis, health, jumpPressed, ...}: t, input) =
fun move (game: game_type, input) =
let
val {x, y, yAxis, health, jumpPressed, ...} = #player game
val {leftHeld, rightHeld, upHeld, downHeld} = input
val xAxis = getXAxis (leftHeld, rightHeld)
in
case (upHeld, downHeld) of
@@ -206,27 +216,27 @@ struct
val yAxis = defaultYAxis yAxis
val jumpPressed = false
in
helpMove (x, y, xAxis, yAxis, health, jumpPressed)
helpMove (x, y, xAxis, yAxis, health, jumpPressed, game)
end
| (true, true) =>
let
val yAxis = defaultYAxis yAxis
in
helpMove (x, y, xAxis, yAxis, health, jumpPressed)
let val yAxis = defaultYAxis yAxis
in helpMove (x, y, xAxis, yAxis, health, jumpPressed, game)
end
| (true, false) =>
let
val yAxis = onJumpPressed (yAxis, jumpPressed)
val jumpPressed = true
in
helpMove (x, y, xAxis, yAxis, health, jumpPressed)
helpMove (x, y, xAxis, yAxis, health, jumpPressed, game)
end
| (false, true) =>
(* todo: should move down if on platform *)
let
val jumpPressed = false
in
helpMove (x, y, xAxis, yAxis, health, jumpPressed)
let val jumpPressed = false
in helpMove (x, y, xAxis, yAxis, health, jumpPressed, game)
end
end
(* placeholder *)
fun getDrawVec ({x, y, ...}: player) =
Block.lerp (x, y, realSize, realSize, 1920.0, 1080.0, 0.5, 0.5, 0.5)
end

4
fcore/quad-tree.sml
View File

@@ -2,6 +2,8 @@ signature QUAD_TREE =
sig
type t
val empty: t
datatype collision_side =
QUERY_ON_LEFT_SIDE
| QUERY_ON_TOP_SIDE
@@ -41,6 +43,8 @@ struct
}
| LEAF of item vector
val empty = LEAF (Vector.fromList [])
fun fromItem (itemID, startX, startY, width, height) =
let
val item = mkItem (itemID, startX, startY, width, height)

34
fcore/wall.sml
View File

@@ -1,18 +1,6 @@
structure Wall =
struct
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 wall4 = {id = 4, x = 155, y = 911, width = 155, height = 55}
val wallVec = Vector.fromList [wall1, wall2, wall3, wall4]
fun getID n =
Vector.sub (wallVec, n - 1)
fun generateTree (pos, wallVec, acc) =
fun helpGenerateTree (pos, wallVec, acc) =
if pos = Vector.length wallVec then
acc
else
@@ -21,33 +9,27 @@ struct
val acc = QuadTree.insert
(x, y, width, height, 0, 0, 1920, 1080, id, acc)
in
generateTree (pos + 1, wallVec, acc)
helpGenerateTree (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 generateTree wallVec = helpGenerateTree (0, wallVec, QuadTree.empty)
fun helpGenerateWalls (pos, wallVec, acc, winWidth, winHeight) =
fun helpGetDrawVec (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 {x, y, width, height, id = _} = 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)
helpGetDrawVec (pos + 1, wallVec, acc, winWidth, winHeight)
end
fun generateWalls () =
helpGenerateWalls (0, wallVec, [], 1920.0, 1080.0)
fun getDrawVec wallVec =
helpGetDrawVec (0, wallVec, [], 1920.0, 1080.0)
end

7
oms.mlb
View File

@@ -1,16 +1,21 @@
$(SML_LIB)/basis/basis.mlb
(* fcore *)
fcore/quad-tree.sml
ann
"allowVectorExps true"
in
fcore/block.sml
end
fcore/quad-tree.sml
fcore/wall.sml
fcore/game-type.sml
fcore/player.sml
fcore/game-update.sml
(* shell *)
$(SML_LIB)/basis/mlton.mlb

14
shell/gl-draw.sml
View File

@@ -140,7 +140,7 @@ struct
()
end
fun helpLoop (shellState as {window, ...}: t, player) =
fun helpLoop (shellState as {window, ...}: t, game) =
case Glfw.windowShouldClose window of
false =>
let
@@ -153,11 +153,11 @@ struct
* - finally, draw
* *)
val wallVec = Wall.generateWalls ()
val input = InputState.getSnapshot ()
val player = Player.move (player, input)
val playerVec = Player.getVec player
val game = GameUpdate.update (game, input)
val wallVec = Wall.getDrawVec (#walls game)
val playerVec = Player.getDrawVec (#player game)
val shellState = uploadWall (shellState, wallVec)
val shellState = uploadPlayer (shellState, playerVec)
@@ -167,12 +167,12 @@ struct
val _ = Glfw.swapBuffers window
val _ = Glfw.waitEvents ()
in
helpLoop (shellState, player)
helpLoop (shellState, game)
end
| true => Glfw.terminate ()
fun loop window =
let val shellState = create window
in helpLoop (shellState, Player.initial)
in helpLoop (shellState, GameType.initial)
end
end