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

get drawing of triangles implemented

Browse Source
This commit is contained in:
Humza Shahid
2024-07-31 22:25:15 +01:00
parent cf38d160d5
commit 16fa1e49af
7 changed files with 121 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
dot-to-dot
View File

Binary file not shown.

21
functional-core/app-type.sml
View File

@@ -20,6 +20,16 @@ sig
val initial: app_type
val withTriangleStage: app_type * triangle_stage -> app_type
val addTriangleAndResetStage :
app_type *
Real32.real *
Real32.real *
Real32.real *
Real32.real *
Real32.real *
Real32.real ->
app_type
end
structure AppType :> APP_TYPE =
@@ -56,4 +66,15 @@ struct
let val {triangles, triangleStage = _} = app
in {triangles = triangles, triangleStage = newTriangleStage}
end
fun addTriangleAndResetStage (app: app_type, x1, y1, x2, y2, x3, y3) :
app_type =
let
val {triangles, triangleStage = _} = app
val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
val newTriangles = newTriangle :: triangles
in
{triangles = newTriangles, triangleStage = NO_TRIANGLE}
end
end

14
functional-core/app-update.sml
View File

@@ -189,7 +189,8 @@ struct
end
| FIRST {x1, y1} =>
let
val drawVec = getFirstTriangleStageVector (x1, y1, buttonVec)
val drawVec =
getFirstTriangleStageVector (x1, y1, buttonVec)
val drawMsg = DRAW_BUTTON drawVec
val newTriangleStage = SECOND
@@ -201,13 +202,12 @@ struct
end
| SECOND {x1, y1, x2, y2} =>
let
val drawVec =
getSecondTriangleStageVector (x1, y1, x2, y2, buttonVec)
val drawMsg = DRAW_BUTTON drawVec
val newTriangleStage = NO_TRIANGLE
val model =
AppType.withTriangleStage (model, newTriangleStage)
AppType.addTriangleAndResetStage
(model, x1, y1, x2, y2, hpos, vpos)
val drawVec = getTrianglesVector model
val drawMsg = DRAW_TRIANGLES_AND_RESET_BUTTONS drawVec
in
(model, drawMsg, mouseX, mouseY)
end)

41
imperative-shell/app-draw.sml
View File

@@ -106,4 +106,45 @@ struct
in
()
end
fun initTriangles () =
let
val triangleDrawObject = initDrawObject
(Constants.graphVertexShaderString, Constants.graphFragmentShaderString)
val {vertexBuffer, program, ...} = triangleDrawObject
val _ = Gles3.bindBuffer vertexBuffer
val _ =
Gles3.bufferData
( #[]
, 0
, Gles3.STATIC_DRAW ()
)
val _ = Gles3.vertexAttribPointer (0, 2, 2, 0)
val _ = Gles3.enableVertexAttribArray 0
in
triangleDrawObject
end
fun uploadTrianglesVector (triangleDrawObject: draw_object, vec) =
let
val {vertexBuffer, ...} = triangleDrawObject
val _ = Gles3.bindBuffer vertexBuffer
val _ = Gles3.bufferData (vec, Vector.length vec, Gles3.STATIC_DRAW ())
in
()
end
fun drawTriangles (triangleDrawObject: draw_object, triangleDrawLength) =
let
val {vertexBuffer, program, ...} = triangleDrawObject
val _ = Gles3.bindBuffer vertexBuffer
val _ = Gles3.vertexAttribPointer (0, 2, 2, 0)
val _ = Gles3.enableVertexAttribArray 0
val _ = Gles3.useProgram program
val _ = Gles3.drawArrays
(Gles3.TRIANGLES (), 0, triangleDrawLength)
in
()
end
end

32
imperative-shell/event-loop.sml
View File

@@ -19,7 +19,14 @@ struct
end
fun draw
(drawMailbox, window, graphDrawObject, buttonDrawObject, buttonDrawLength) =
( drawMailbox
, window
, graphDrawObject
, buttonDrawObject
, buttonDrawLength
, triangleDrawObject
, triangleDrawLength
) =
if not (Glfw.windowShouldClose window) then
case Mailbox.recvPoll drawMailbox of
NONE =>
@@ -28,6 +35,7 @@ struct
val _ = Gles3.clear ()
val _ = AppDraw.drawGraphLines graphDrawObject
val _ = AppDraw.drawTriangles (triangleDrawObject, triangleDrawLength)
val _ = AppDraw.drawButton (buttonDrawObject, buttonDrawLength)
val _ = Glfw.pollEvents ()
@@ -39,6 +47,8 @@ struct
, graphDrawObject
, buttonDrawObject
, buttonDrawLength
, triangleDrawObject
, triangleDrawLength
)
end
| SOME drawMsg =>
@@ -54,6 +64,24 @@ struct
, graphDrawObject
, buttonDrawObject
, buttonDrawLength
, triangleDrawObject
, triangleDrawLength
)
end
| DRAW_TRIANGLES_AND_RESET_BUTTONS triangleVec =>
let
val _ = AppDraw.uploadTrianglesVector (triangleDrawObject, triangleVec)
val triangleDrawLength = Vector.length triangleVec div 2
(* have to reset buttons too *)
in
draw
( drawMailbox
, window
, graphDrawObject
, buttonDrawObject
, 0
, triangleDrawObject
, triangleDrawLength
)
end
| NO_DRAW =>
@@ -63,6 +91,8 @@ struct
, graphDrawObject
, buttonDrawObject
, buttonDrawLength
, triangleDrawObject
, triangleDrawLength
))
else
Glfw.terminate ()

15
imperative-shell/shell.sml
View File

@@ -9,13 +9,15 @@ struct
val _ = Glfw.windowHint (Glfw.CONTEXT_VERSION_MAJOR (), 3)
val _ = Glfw.windowHint (Glfw.DEPRECATED (), Glfw.FALSE ())
val _ = Glfw.windowHint (Glfw.SAMPLES (), 4)
val window =
Glfw.createWindow (Constants.windowWidth, Constants.windowHeight, "MLton - dot to dot")
val window =
Glfw.createWindow
(Constants.windowWidth, Constants.windowHeight, "MLton - dot to dot")
val _ = Glfw.makeContextCurrent window
val _ = Gles3.loadGlad ()
val graphDrawObject = AppDraw.initGraphLines ()
val buttonDrawObject = AppDraw.initButton ()
val triangleDrawObject = AppDraw.initTriangles ()
val inputMailbox = Mailbox.mailbox ()
val drawMailbox = Mailbox.mailbox ()
@@ -25,7 +27,14 @@ struct
val _ = CML.spawn (fn () => EventLoop.update (inputMailbox, drawMailbox))
val _ = CML.spawn (fn () =>
EventLoop.draw
(drawMailbox, window, graphDrawObject, buttonDrawObject, 0))
( drawMailbox
, window
, graphDrawObject
, buttonDrawObject
, 0
, triangleDrawObject
, 0
))
in
()
end

14
message-types/draw-msg.sml
View File

@@ -1,11 +1,15 @@
signature DRAW_MESSAGE =
sig
datatype t = DRAW_BUTTON of Real32.real vector
| NO_DRAW
datatype t =
DRAW_BUTTON of Real32.real vector
| DRAW_TRIANGLES_AND_RESET_BUTTONS of Real32.real vector
| NO_DRAW
end
structure DrawMessage :> DRAW_MESSAGE =
struct
datatype t = DRAW_BUTTON of Real32.real vector
| NO_DRAW
struct
datatype t =
DRAW_BUTTON of Real32.real vector
| DRAW_TRIANGLES_AND_RESET_BUTTONS of Real32.real vector
| NO_DRAW
end