slight refactoring (move pure parsing functions to functional core in a separate file)
This commit is contained in:
52
functional-core/app/app-init.sml
Normal file
52
functional-core/app/app-init.sml
Normal file
@@ -0,0 +1,52 @@
|
||||
signature APP_INIT =
|
||||
sig
|
||||
val fromWindowWidthAndHeight: int * int -> AppType.app_type
|
||||
end
|
||||
|
||||
structure AppInit :> APP_INIT =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
fun helpFromWidthAndHeight
|
||||
(windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) : app_type =
|
||||
let
|
||||
val xClickPoints = ClickPoints.generate (wStart, wFinish)
|
||||
val yClickPoints = ClickPoints.generate (hStart, hFinish)
|
||||
in
|
||||
{ triangles = []
|
||||
, triangleStage = NO_TRIANGLE
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, undo = []
|
||||
, redo = []
|
||||
, mouseX = 0.0
|
||||
, mouseY = 0.0
|
||||
, showGraph = true
|
||||
}
|
||||
end
|
||||
|
||||
fun fromWindowWidthAndHeight (windowWidth, windowHeight) =
|
||||
if windowWidth = windowHeight then
|
||||
helpFromWidthAndHeight
|
||||
(windowWidth, windowHeight, 0, windowWidth, 0, windowHeight)
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val wStart = difference div 2
|
||||
val wFinish = wStart + windowHeight
|
||||
in
|
||||
helpFromWidthAndHeight
|
||||
(windowWidth, windowHeight, wStart, wFinish, 0, windowHeight)
|
||||
end
|
||||
else
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val hStart = difference div 2
|
||||
val hFinish = hStart + windowWidth
|
||||
in
|
||||
helpFromWidthAndHeight
|
||||
(windowWidth, windowHeight, 0, windowWidth, hStart, hFinish)
|
||||
end
|
||||
end
|
||||
71
functional-core/app/app-type.sml
Normal file
71
functional-core/app/app-type.sml
Normal file
@@ -0,0 +1,71 @@
|
||||
signature APP_TYPE =
|
||||
sig
|
||||
datatype triangle_stage =
|
||||
NO_TRIANGLE
|
||||
| FIRST of {x1: Real32.real, y1: Real32.real}
|
||||
| SECOND of
|
||||
{x1: Real32.real, x2: Real32.real, y1: Real32.real, y2: Real32.real}
|
||||
|
||||
type triangle =
|
||||
{ x1: Real32.real
|
||||
, x2: Real32.real
|
||||
, x3: Real32.real
|
||||
, y1: Real32.real
|
||||
, y2: Real32.real
|
||||
, y3: Real32.real
|
||||
}
|
||||
|
||||
type app_type =
|
||||
{ triangles: triangle list
|
||||
, triangleStage: triangle_stage
|
||||
, windowWidth: int
|
||||
, windowHeight: int
|
||||
, xClickPoints: Real32.real vector
|
||||
, yClickPoints: Real32.real vector
|
||||
, undo: (Real32.real * Real32.real) list
|
||||
, redo: (Real32.real * Real32.real) list
|
||||
, mouseX: Real32.real
|
||||
, mouseY: Real32.real
|
||||
, showGraph: bool
|
||||
}
|
||||
end
|
||||
|
||||
structure AppType :> APP_TYPE =
|
||||
struct
|
||||
type triangle =
|
||||
{ x1: Real32.real
|
||||
, y1: Real32.real
|
||||
, x2: Real32.real
|
||||
, y2: Real32.real
|
||||
, x3: Real32.real
|
||||
, y3: Real32.real
|
||||
}
|
||||
|
||||
datatype triangle_stage =
|
||||
NO_TRIANGLE
|
||||
(*
|
||||
* triangle_stage represents a work-in-progress triangle which is not fully completed,
|
||||
* because user has to click one (x, y) pair, then a second pair,
|
||||
* and then a third, to draw a complete triangle.
|
||||
*
|
||||
* There is no THIRD triangle_stage because that represents a complete triangle,
|
||||
* which should be added to the `triangles` list.
|
||||
*)
|
||||
| FIRST of {x1: Real32.real, y1: Real32.real}
|
||||
| SECOND of
|
||||
{x1: Real32.real, y1: Real32.real, x2: Real32.real, y2: Real32.real}
|
||||
|
||||
type app_type =
|
||||
{ triangles: triangle list
|
||||
, triangleStage: triangle_stage
|
||||
, windowWidth: int
|
||||
, windowHeight: int
|
||||
, xClickPoints: Real32.real vector
|
||||
, yClickPoints: Real32.real vector
|
||||
, undo: (Real32.real * Real32.real) list
|
||||
, redo: (Real32.real * Real32.real) list
|
||||
, mouseX: Real32.real
|
||||
, mouseY: Real32.real
|
||||
, showGraph: bool
|
||||
}
|
||||
end
|
||||
244
functional-core/app/app-update.sml
Normal file
244
functional-core/app/app-update.sml
Normal file
@@ -0,0 +1,244 @@
|
||||
signature APP_UPDATE =
|
||||
sig
|
||||
val update: AppType.app_type * InputMessage.t
|
||||
-> AppType.app_type * UpdateMessage.t
|
||||
end
|
||||
|
||||
structure AppUpdate :> APP_UPDATE =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
open DrawMessage
|
||||
open FileMessage
|
||||
open InputMessage
|
||||
open UpdateMessage
|
||||
|
||||
fun mouseMoveOrRelease (model: app_type) =
|
||||
let
|
||||
val (drawVec, _, _) = ClickPoints.getClickPosition (1.0, 0.0, 0.0, model)
|
||||
val drawVec = TriangleStage.toVector (model, drawVec)
|
||||
val drawMsg = DRAW_DOT drawVec
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
|
||||
fun mouseLeftClick (model: app_type) =
|
||||
let
|
||||
val (dotVec, hpos, vpos) =
|
||||
ClickPoints.getClickPosition (0.0, 0.0, 1.0, model)
|
||||
val newUndoTuple = (hpos, vpos)
|
||||
in
|
||||
if Vector.length dotVec > 0 then
|
||||
case #triangleStage model of
|
||||
NO_TRIANGLE =>
|
||||
let
|
||||
val drawVec = TriangleStage.toVector (model, dotVec)
|
||||
val drawMsg = DRAW_DOT drawVec
|
||||
|
||||
val newTriangleStage = FIRST {x1 = hpos, y1 = vpos}
|
||||
val model =
|
||||
AppWith.addTriangleStage (model, newTriangleStage, newUndoTuple)
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
| FIRST {x1, y1} =>
|
||||
let
|
||||
val drawVec = TriangleStage.firstToVector (x1, y1, dotVec, model)
|
||||
val drawMsg = DRAW_DOT drawVec
|
||||
|
||||
val newTriangleStage = SECOND
|
||||
{x1 = x1, y1 = y1, x2 = hpos, y2 = vpos}
|
||||
val model =
|
||||
AppWith.addTriangleStage (model, newTriangleStage, newUndoTuple)
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
| SECOND {x1, y1, x2, y2} =>
|
||||
let
|
||||
val model = AppWith.addTriangle
|
||||
(model, x1, y1, x2, y2, hpos, vpos, newUndoTuple)
|
||||
|
||||
val drawVec = Triangles.toVector model
|
||||
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
else
|
||||
(model, NO_MAILBOX)
|
||||
end
|
||||
|
||||
fun resizeWindow (model, width, height) =
|
||||
let
|
||||
val model = AppWith.windowResize (model, width, height)
|
||||
val triangles = Triangles.toVector model
|
||||
|
||||
val graphLines =
|
||||
if #showGraph model then GraphLines.generate model
|
||||
else Vector.fromList []
|
||||
|
||||
val dots = TriangleStage.toVector (model, Vector.fromList [])
|
||||
|
||||
val drawMsg =
|
||||
RESIZE_TRIANGLES_DOTS_AND_GRAPH
|
||||
{triangles = triangles, graphLines = graphLines, dots = dots}
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
|
||||
fun undoAction model =
|
||||
case #triangleStage model of
|
||||
FIRST {x1, y1} =>
|
||||
(* Change FIRST to NO_TRIANGLE and clear dots. *)
|
||||
let
|
||||
val model =
|
||||
AppWith.undo (model, NO_TRIANGLE, #triangles model, (x1, y1))
|
||||
in
|
||||
(model, DRAW CLEAR_DOTS)
|
||||
end
|
||||
| SECOND {x1, y1, x2, y2} =>
|
||||
(* Change FIRST to SECOND and redraw dots. *)
|
||||
let
|
||||
val newTriangleStage = FIRST {x1 = x1, y1 = y1}
|
||||
val model =
|
||||
AppWith.undo (model, newTriangleStage, #triangles model, (x2, y2))
|
||||
|
||||
val emptyVec: Real32.real vector = Vector.fromList []
|
||||
val drawVec = TriangleStage.firstToVector (x1, y1, emptyVec, model)
|
||||
val drawMsg = DRAW_DOT drawVec
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
| NO_TRIANGLE =>
|
||||
(case #triangles model of
|
||||
{x1, y1, x2, y2, x3, y3} :: trianglesTl =>
|
||||
(* Have to slice off (x3, y3) from triangle head,
|
||||
* turn (x1, y1, x2, y2) into a triangleStage,
|
||||
* and redraw both triangle and triangleStage. *)
|
||||
let
|
||||
val triangleStage = SECOND {x1 = x1, y1 = y1, x2 = x2, y2 = y2}
|
||||
val model =
|
||||
AppWith.undo (model, triangleStage, trianglesTl, (x3, y3))
|
||||
|
||||
val newTriangleVec = Triangles.toVector model
|
||||
val emptyVec: Real32.real vector = Vector.fromList []
|
||||
val drawVec = TriangleStage.secondToVector
|
||||
(x1, y1, x2, y2, emptyVec, model)
|
||||
val drawMsg =
|
||||
DRAW_TRIANGLES_AND_DOTS
|
||||
{triangles = newTriangleVec, dots = drawVec}
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
| [] =>
|
||||
(* Can't undo, because there are no actions to undo. *)
|
||||
(model, NO_MAILBOX))
|
||||
|
||||
fun redoAction model =
|
||||
case #redo model of
|
||||
(redoHd as (x, y)) :: tl =>
|
||||
(* There is a click point to redo. *)
|
||||
(case #triangleStage model of
|
||||
NO_TRIANGLE =>
|
||||
(* add to triangle stage, and redraw dots *)
|
||||
let
|
||||
val newTriangleStage = FIRST {x1 = x, y1 = y}
|
||||
val model =
|
||||
AppWith.redo
|
||||
(model, newTriangleStage, #triangles model, redoHd)
|
||||
|
||||
val emptyVec: Real32.real vector = Vector.fromList []
|
||||
val drawVec = TriangleStage.firstToVector (x, y, emptyVec, model)
|
||||
val drawMsg = DRAW_DOT drawVec
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
| FIRST {x1, y1} =>
|
||||
(* add to triangle stage, redraw dots *)
|
||||
let
|
||||
val newTriangleStage = SECOND {x1 = x1, y1 = y1, x2 = x, y2 = y}
|
||||
val model =
|
||||
AppWith.redo
|
||||
(model, newTriangleStage, #triangles model, redoHd)
|
||||
|
||||
val emptyVec: Real32.real vector = Vector.fromList []
|
||||
val drawVec = TriangleStage.secondToVector
|
||||
(x1, y1, x, y, emptyVec, model)
|
||||
val drawMsg = DRAW_DOT drawVec
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
| SECOND {x1, y1, x2, y2} =>
|
||||
(* clear triangle stage, add to trinagle list and redraw triangles *)
|
||||
let
|
||||
val newTriangleStage = NO_TRIANGLE
|
||||
val newTriangle =
|
||||
{x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x, y3 = y}
|
||||
val newTriangles = newTriangle :: (#triangles model)
|
||||
val model =
|
||||
AppWith.redo (model, newTriangleStage, newTriangles, redoHd)
|
||||
|
||||
val drawVec = Triangles.toVector model
|
||||
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end)
|
||||
| [] =>
|
||||
(* Nothing to redo. *)
|
||||
(model, NO_MAILBOX)
|
||||
|
||||
fun toggleGraph (model: app_type) =
|
||||
if #showGraph model then
|
||||
let
|
||||
val model = AppWith.graphVisibility (model, false)
|
||||
val drawMsg = DRAW_GRAPH (Vector.fromList [])
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
else
|
||||
let
|
||||
val model = AppWith.graphVisibility (model, true)
|
||||
val graphLines = GraphLines.generate model
|
||||
val drawMsg = DRAW_GRAPH graphLines
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
|
||||
fun getSaveTrianglesMsg model =
|
||||
let
|
||||
val {triangles, ...} = model
|
||||
val fileMsg = SAVE_TRIANGLES triangles
|
||||
in
|
||||
(model, FILE fileMsg)
|
||||
end
|
||||
|
||||
fun getLoadTriangleMsg model =
|
||||
(model, FILE LOAD_TRIANGLES)
|
||||
|
||||
fun useTriangles (model, triangles) =
|
||||
let
|
||||
val model = AppWith.useTriangles (model, triangles)
|
||||
val drawVec = Triangles.toVector model
|
||||
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
|
||||
in
|
||||
(model, DRAW drawMsg)
|
||||
end
|
||||
|
||||
fun trianglesLoadError model = (model, NO_MAILBOX)
|
||||
|
||||
fun update (model: app_type, inputMsg) =
|
||||
case inputMsg of
|
||||
MOUSE_MOVE {x = mouseX, y = mouseY} =>
|
||||
let val model = AppWith.mousePosition (model, mouseX, mouseY)
|
||||
in mouseMoveOrRelease model
|
||||
end
|
||||
| MOUSE_LEFT_RELEASE => mouseMoveOrRelease model
|
||||
| MOUSE_LEFT_CLICK => mouseLeftClick model
|
||||
| RESIZE_WINDOW {width, height} => resizeWindow (model, width, height)
|
||||
| UNDO_ACTION => undoAction model
|
||||
| REDO_ACTION => redoAction model
|
||||
| KEY_G => toggleGraph model
|
||||
| KEY_CTRL_S => getSaveTrianglesMsg model
|
||||
| KEY_CTRL_L => getLoadTriangleMsg model
|
||||
| USE_TRIANGLES triangles => useTriangles (model, triangles)
|
||||
| TRIANGLES_LOAD_ERROR => trianglesLoadError model
|
||||
end
|
||||
343
functional-core/app/app-with.sml
Normal file
343
functional-core/app/app-with.sml
Normal file
@@ -0,0 +1,343 @@
|
||||
signature APP_WITH =
|
||||
sig
|
||||
val graphVisibility: AppType.app_type * bool -> AppType.app_type
|
||||
|
||||
val windowResize: AppType.app_type * int * int -> AppType.app_type
|
||||
|
||||
val mousePosition: AppType.app_type * Real32.real * Real32.real
|
||||
-> AppType.app_type
|
||||
|
||||
val undo:
|
||||
AppType.app_type
|
||||
* AppType.triangle_stage
|
||||
* AppType.triangle list
|
||||
* (Real32.real * Real32.real)
|
||||
-> AppType.app_type
|
||||
|
||||
val redo:
|
||||
AppType.app_type
|
||||
* AppType.triangle_stage
|
||||
* AppType.triangle list
|
||||
* (Real32.real * Real32.real)
|
||||
-> AppType.app_type
|
||||
|
||||
(*
|
||||
* add functions clear the redo stack,
|
||||
* as they are meant to be called after a click action,
|
||||
* and also add new click position to undo stack.
|
||||
*)
|
||||
val addTriangleStage:
|
||||
AppType.app_type * AppType.triangle_stage * (Real32.real * Real32.real)
|
||||
-> AppType.app_type
|
||||
|
||||
val addTriangle:
|
||||
AppType.app_type
|
||||
* Real32.real
|
||||
* Real32.real
|
||||
* Real32.real
|
||||
* Real32.real
|
||||
* Real32.real
|
||||
* Real32.real
|
||||
* (Real32.real * Real32.real)
|
||||
-> AppType.app_type
|
||||
|
||||
val useTriangles: AppType.app_type * AppType.triangle list -> AppType.app_type
|
||||
end
|
||||
|
||||
structure AppWith :> APP_WITH =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
(* add to undo, clear redo *)
|
||||
fun addTriangleStage
|
||||
(app: app_type, newTriangleStage: triangle_stage, newUndoHd) : app_type =
|
||||
let
|
||||
val
|
||||
{ triangleStage = _
|
||||
, triangles
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, undo
|
||||
, redo = _
|
||||
, mouseX
|
||||
, mouseY
|
||||
, showGraph
|
||||
} = app
|
||||
|
||||
val newUndo = newUndoHd :: undo
|
||||
in
|
||||
{ triangleStage = newTriangleStage
|
||||
, undo = newUndo
|
||||
, redo = []
|
||||
, triangles = triangles
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, showGraph = showGraph
|
||||
}
|
||||
end
|
||||
|
||||
fun addTriangle (app: app_type, x1, y1, x2, y2, x3, y3, newUndoHd) : app_type =
|
||||
let
|
||||
val
|
||||
{ triangles
|
||||
, triangleStage = _
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, undo
|
||||
, redo = _
|
||||
, mouseX
|
||||
, mouseY
|
||||
, showGraph
|
||||
} = app
|
||||
|
||||
val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3}
|
||||
val newTriangles = newTriangle :: triangles
|
||||
val newUndo = newUndoHd :: undo
|
||||
in
|
||||
{ triangleStage = NO_TRIANGLE
|
||||
, triangles = newTriangles
|
||||
, undo = newUndo
|
||||
, redo = []
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, showGraph = showGraph
|
||||
}
|
||||
end
|
||||
|
||||
fun helpWindowResize
|
||||
(app: app_type, windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) :
|
||||
app_type =
|
||||
let
|
||||
val
|
||||
{ xClickPoints = _
|
||||
, yClickPoints = _
|
||||
, windowWidth = _
|
||||
, windowHeight = _
|
||||
, triangles
|
||||
, triangleStage
|
||||
, undo
|
||||
, redo
|
||||
, mouseX
|
||||
, mouseY
|
||||
, showGraph
|
||||
} = app
|
||||
|
||||
val xClickPoints = ClickPoints.generate (wStart, wFinish)
|
||||
val yClickPoints = ClickPoints.generate (hStart, hFinish)
|
||||
in
|
||||
{ xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, triangles = triangles
|
||||
, triangleStage = triangleStage
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, undo = undo
|
||||
, redo = redo
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, showGraph = showGraph
|
||||
}
|
||||
end
|
||||
|
||||
fun windowResize (app: app_type, windowWidth, windowHeight) =
|
||||
if windowWidth = windowHeight then
|
||||
helpWindowResize
|
||||
(app, windowWidth, windowHeight, 0, windowWidth, 0, windowHeight)
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val wStart = difference div 2
|
||||
val wFinish = wStart + windowHeight
|
||||
in
|
||||
helpWindowResize
|
||||
(app, windowWidth, windowHeight, wStart, wFinish, 0, windowHeight)
|
||||
end
|
||||
else
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val hStart = difference div 2
|
||||
val hFinish = hStart + windowWidth
|
||||
in
|
||||
helpWindowResize
|
||||
(app, windowWidth, windowHeight, 0, windowWidth, hStart, hFinish)
|
||||
end
|
||||
|
||||
fun mousePosition (app: app_type, mouseX, mouseY) =
|
||||
let
|
||||
val
|
||||
{ mouseX = _
|
||||
, mouseY = _
|
||||
, triangles
|
||||
, triangleStage
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, undo
|
||||
, redo
|
||||
, showGraph
|
||||
} = app
|
||||
in
|
||||
{ mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, triangles = triangles
|
||||
, triangleStage = triangleStage
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, undo = undo
|
||||
, redo = redo
|
||||
, showGraph = showGraph
|
||||
}
|
||||
end
|
||||
|
||||
(* add to redo, pop one from undo *)
|
||||
fun undo (app: app_type, newTriangleStage, newTriangles, newRedoHd) =
|
||||
let
|
||||
val
|
||||
{ triangleStage = _
|
||||
, triangles = _
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, undo
|
||||
, redo
|
||||
, mouseX
|
||||
, mouseY
|
||||
, showGraph
|
||||
} = app
|
||||
|
||||
val newUndo =
|
||||
case undo of
|
||||
hd :: tl => tl
|
||||
| empty => empty
|
||||
|
||||
val newRedo = newRedoHd :: redo
|
||||
in
|
||||
{ triangleStage = newTriangleStage
|
||||
, triangles = newTriangles
|
||||
, undo = newUndo
|
||||
, redo = newRedo
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, showGraph = showGraph
|
||||
}
|
||||
end
|
||||
|
||||
(* add to undo, pop one from redo *)
|
||||
fun redo (app: app_type, newTriangleStage, newTriangles, newUndoHd) =
|
||||
let
|
||||
val
|
||||
{ triangleStage = _
|
||||
, triangles = _
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, undo
|
||||
, redo
|
||||
, mouseX
|
||||
, mouseY
|
||||
, showGraph
|
||||
} = app
|
||||
|
||||
val newUndo = newUndoHd :: undo
|
||||
val newRedo =
|
||||
case redo of
|
||||
hd :: tl => tl
|
||||
| empty => empty
|
||||
in
|
||||
{ triangleStage = newTriangleStage
|
||||
, triangles = newTriangles
|
||||
, undo = newUndo
|
||||
, redo = newRedo
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, showGraph = showGraph
|
||||
}
|
||||
end
|
||||
|
||||
fun graphVisibility (app: app_type, shouldShowGraph) =
|
||||
let
|
||||
val
|
||||
{ triangleStage
|
||||
, triangles
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, undo
|
||||
, redo
|
||||
, mouseX
|
||||
, mouseY
|
||||
, showGraph = _
|
||||
} = app
|
||||
in
|
||||
{ showGraph = shouldShowGraph
|
||||
, triangleStage = triangleStage
|
||||
, triangles = triangles
|
||||
, undo = undo
|
||||
, redo = redo
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
}
|
||||
end
|
||||
|
||||
fun useTriangles (app: app_type, triangles) =
|
||||
let
|
||||
val
|
||||
{ xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, undo
|
||||
, redo
|
||||
, mouseX
|
||||
, mouseY
|
||||
, showGraph
|
||||
, triangles = _
|
||||
, triangleStage = _
|
||||
} = app
|
||||
|
||||
val triangleStage = NO_TRIANGLE
|
||||
in
|
||||
{ triangleStage = triangleStage
|
||||
, triangles = triangles
|
||||
, undo = []
|
||||
, redo = []
|
||||
, showGraph = showGraph
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
}
|
||||
end
|
||||
end
|
||||
212
functional-core/app/click-points.sml
Normal file
212
functional-core/app/click-points.sml
Normal file
@@ -0,0 +1,212 @@
|
||||
signature CLICK_POINTS =
|
||||
sig
|
||||
val generate: int * int -> Real32.real vector
|
||||
val getClickPosition:
|
||||
Real32.real * Real32.real * Real32.real * AppType.app_type
|
||||
-> Real32.real vector * Real32.real * Real32.real
|
||||
end
|
||||
|
||||
structure ClickPoints :> CLICK_POINTS =
|
||||
struct
|
||||
fun generate (start, finish) =
|
||||
let
|
||||
val difference = finish - start
|
||||
val increment = Real32.fromInt difference / 40.0
|
||||
val start = Real32.fromInt start
|
||||
in
|
||||
Vector.tabulate (41, fn idx => (Real32.fromInt idx * increment) + start)
|
||||
end
|
||||
|
||||
(*
|
||||
* Range to detect from clickable position.
|
||||
* For example, if we have a clickable position at (x, y) = (500, 500),
|
||||
* with a range of 15, we can detect clicks targeting this position
|
||||
* from top left at (485, 485) to bottom right at (515, 515).
|
||||
* *)
|
||||
val range = 15.0
|
||||
|
||||
fun getVerticalClickPos
|
||||
( yClickPoints
|
||||
, idx
|
||||
, horizontalPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
) =
|
||||
if idx = Vector.length yClickPoints then
|
||||
(#[], 0.0, 0.0)
|
||||
else
|
||||
let
|
||||
val curVerticalPos = Vector.sub (yClickPoints, idx)
|
||||
in
|
||||
if
|
||||
mouseY < curVerticalPos - range orelse mouseY > curVerticalPos + range
|
||||
then
|
||||
getVerticalClickPos
|
||||
( yClickPoints
|
||||
, idx + 1
|
||||
, horizontalPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
else
|
||||
let
|
||||
(* calculate normalised device coordinates *)
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
val hpos = horizontalPos - halfWidth
|
||||
val vpos = ~(curVerticalPos - halfHeight)
|
||||
|
||||
(* coordinates to form small box around clicked area *)
|
||||
val left = (hpos - 5.0) / halfWidth
|
||||
val right = (hpos + 5.0) / halfWidth
|
||||
val bottom = (vpos - 5.0) / halfHeight
|
||||
val top = (vpos + 5.0) / halfHeight
|
||||
|
||||
(* normalised device coordinates of drawVec should be relative
|
||||
* to actual windowWidth and windowHeight,
|
||||
* even if not a square, to display cursor position... *)
|
||||
val drawVec = Ndc.ltrbToVertex (left, top, right, bottom, r, g, b)
|
||||
in
|
||||
(*
|
||||
* ...however, normalised device coordinate of hpos and vpos
|
||||
* should be relative to the vertical centre
|
||||
* (if height is greater than width)
|
||||
* or horizontal centre
|
||||
* (if width is greater than height).
|
||||
*
|
||||
* So, for example, a 900x1000 resolution
|
||||
* will have clickable points from 50...950,
|
||||
* in increments of 50.
|
||||
* Because we always want to show canvas as a square
|
||||
* with an aspect ratio of 1:1.
|
||||
* For displaying the click position on the screen, drawVec
|
||||
* which uses actual windowWidth and windowHeight, is fine.
|
||||
* However, we want to attach the meaning "start" to 50
|
||||
* and "end" to 950,
|
||||
* so the hpos and vpos stored in the app's triangle list
|
||||
* subtracts the offset 50 if needed,
|
||||
* allowing us to treat the coordinates as a 900x900 square.
|
||||
*
|
||||
* We may not actually want to render a square to the screen
|
||||
* if the screen's aspect ratio is not 1:1,
|
||||
* but it's the responsibility of the rendering code
|
||||
* which turns triangles into OpenGL vectors
|
||||
* to do that.
|
||||
* *)
|
||||
if windowWidth = windowHeight then
|
||||
let
|
||||
val hpos = hpos / halfWidth
|
||||
val vpos = vpos / halfHeight
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val offset = Real32.fromInt (difference div 2)
|
||||
val hpos = hpos / (halfWidth - offset)
|
||||
val vpos = vpos / halfHeight
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
else
|
||||
(* windowHeight > windowWidth *)
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val offset = Real32.fromInt (difference div 2)
|
||||
val hpos = hpos / halfWidth
|
||||
val vpos = vpos / (halfHeight - offset)
|
||||
in
|
||||
(drawVec, hpos, vpos)
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
fun getHorizontalClickPos
|
||||
( xClickPoints
|
||||
, yClickPoints
|
||||
, idx
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
) =
|
||||
if idx = Vector.length xClickPoints then
|
||||
(#[], 0.0, 0.0)
|
||||
else
|
||||
let
|
||||
val curPos = Vector.sub (xClickPoints, idx)
|
||||
in
|
||||
if mouseX < curPos - range orelse mouseX > curPos + range then
|
||||
getHorizontalClickPos
|
||||
( xClickPoints
|
||||
, yClickPoints
|
||||
, idx + 1
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
else
|
||||
getVerticalClickPos
|
||||
( yClickPoints
|
||||
, 0
|
||||
, curPos
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
end
|
||||
|
||||
(*
|
||||
* This function returns a vector containing the position data of the
|
||||
* clicked square.
|
||||
* If a square wasn't found at the clicked position,
|
||||
* an empty vector is returned.
|
||||
*)
|
||||
fun getClickPosition (r, g, b, app: AppType.app_type) =
|
||||
let
|
||||
val
|
||||
{ xClickPoints
|
||||
, yClickPoints
|
||||
, mouseX
|
||||
, mouseY
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, ...
|
||||
} = app
|
||||
in
|
||||
getHorizontalClickPos
|
||||
( xClickPoints
|
||||
, yClickPoints
|
||||
, 0
|
||||
, mouseX
|
||||
, mouseY
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
)
|
||||
end
|
||||
end
|
||||
189
functional-core/app/graph-lines.sml
Normal file
189
functional-core/app/graph-lines.sml
Normal file
@@ -0,0 +1,189 @@
|
||||
signature GRAPH_LINES =
|
||||
sig
|
||||
val generate: AppType.app_type -> Real32.real vector
|
||||
end
|
||||
|
||||
structure GraphLines :> GRAPH_LINES =
|
||||
struct
|
||||
(*
|
||||
* This function only produces the desired result
|
||||
* when the window is a square and has the aspect ratio 1:1.
|
||||
* This is because the function assumes it can use
|
||||
* the same position coordinates both horizontally and vertically.
|
||||
*)
|
||||
fun helpGenGraphLinesSquare (pos: Real32.real, limit, acc) =
|
||||
if pos >= limit then
|
||||
Vector.concat acc
|
||||
else
|
||||
let
|
||||
val pos2 = pos + 0.05
|
||||
val vec =
|
||||
#[ (* x = _.1 *)
|
||||
pos - 0.002, ~1.0
|
||||
, pos + 0.002, ~1.0
|
||||
, pos + 0.002, 1.0
|
||||
|
||||
, pos + 0.002, 1.0
|
||||
, pos - 0.002, 1.0
|
||||
, pos - 0.002, ~1.0
|
||||
|
||||
(* y = _.1 *)
|
||||
, ~1.0, pos - 0.002
|
||||
, ~1.0, pos + 0.002
|
||||
, 1.0, pos + 0.002
|
||||
|
||||
, 1.0, pos + 0.002
|
||||
, 1.0, pos - 0.002
|
||||
, ~1.0, pos - 0.002
|
||||
|
||||
(* x = _.05 *)
|
||||
, pos2 - 0.001, ~1.0
|
||||
, pos2 + 0.001, ~1.0
|
||||
, pos2 + 0.001, 1.0
|
||||
|
||||
, pos2 + 0.001, 1.0
|
||||
, pos2 - 0.001, 1.0
|
||||
, pos2 - 0.001, ~1.0
|
||||
|
||||
(* y = _.05 *)
|
||||
, ~1.0, pos2 - 0.001
|
||||
, ~1.0, pos2 + 0.001
|
||||
, 1.0, pos2 + 0.001
|
||||
|
||||
, 1.0, pos2 + 0.001
|
||||
, 1.0, pos2 - 0.001
|
||||
, ~1.0, pos2 - 0.001
|
||||
]
|
||||
val acc = vec :: acc
|
||||
val nextPos = pos + 0.1
|
||||
in
|
||||
helpGenGraphLinesSquare (nextPos, limit, acc)
|
||||
end
|
||||
|
||||
fun helpGenGraphLinesHorizontal
|
||||
(pos, xClickPoints, acc, halfWidth, yMin, yMax) =
|
||||
if pos = Vector.length xClickPoints then
|
||||
acc
|
||||
else
|
||||
let
|
||||
val curX = Vector.sub (xClickPoints, pos)
|
||||
val ndc = (curX - halfWidth) / halfWidth
|
||||
val vec =
|
||||
if (pos + 1) mod 2 = 0 then
|
||||
(* if even (thin lines) *)
|
||||
#[
|
||||
ndc - 0.001, yMin
|
||||
, ndc + 0.001, yMin
|
||||
, ndc + 0.001, yMax
|
||||
|
||||
, ndc + 0.001, yMax
|
||||
, ndc - 0.001, yMax
|
||||
, ndc - 0.001, yMin
|
||||
]
|
||||
else
|
||||
(* if odd (thick lines) *)
|
||||
#[
|
||||
ndc - 0.002, yMin
|
||||
, ndc + 0.002, yMin
|
||||
, ndc + 0.002, yMax
|
||||
|
||||
, ndc + 0.002, yMax
|
||||
, ndc - 0.002, yMax
|
||||
, ndc - 0.002, yMin
|
||||
]
|
||||
val acc = vec :: acc
|
||||
in
|
||||
helpGenGraphLinesHorizontal
|
||||
(pos + 1, xClickPoints, acc, halfWidth, yMin, yMax)
|
||||
end
|
||||
|
||||
fun helpGenGraphLinesVertical (pos, yClickPoints, acc, halfHeight, xMin, xMax) =
|
||||
if pos = Vector.length yClickPoints then
|
||||
acc
|
||||
else
|
||||
let
|
||||
val curY = Vector.sub (yClickPoints, pos)
|
||||
val ndc = (curY - halfHeight) / halfHeight
|
||||
val vec =
|
||||
if (pos + 1) mod 2 = 0 then
|
||||
(* if even (thin lines) *)
|
||||
#[
|
||||
xMin, ndc - 0.001
|
||||
, xMin, ndc + 0.001
|
||||
, xMax, ndc + 0.001
|
||||
|
||||
, xMax, ndc + 0.001
|
||||
, xMax, ndc - 0.001
|
||||
, xMin, ndc - 0.001
|
||||
]
|
||||
else
|
||||
(* if odd (thick lines) *)
|
||||
#[
|
||||
xMin, ndc - 0.002
|
||||
, xMin, ndc + 0.002
|
||||
, xMax, ndc + 0.002
|
||||
|
||||
, xMax, ndc + 0.002
|
||||
, xMax, ndc - 0.002
|
||||
, xMin, ndc - 0.002
|
||||
]
|
||||
val acc = vec :: acc
|
||||
in
|
||||
helpGenGraphLinesVertical
|
||||
(pos + 1, yClickPoints, acc, halfHeight, xMin, xMax)
|
||||
end
|
||||
|
||||
fun helpGenerate (windowWidth, windowHeight, xClickPoints, yClickPoints) =
|
||||
if windowWidth = windowHeight then
|
||||
helpGenGraphLinesSquare (~1.0, 1.0, [])
|
||||
else if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val offset = difference div 2
|
||||
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
|
||||
val start = offset - (windowWidth div 2)
|
||||
val start = Real32.fromInt start / halfWidth
|
||||
|
||||
val finish = (windowWidth - offset) - (windowWidth div 2)
|
||||
val finish = Real32.fromInt finish / halfWidth
|
||||
|
||||
val lines = helpGenGraphLinesHorizontal
|
||||
(0, xClickPoints, [], halfWidth, ~1.0, 1.0)
|
||||
val lines = helpGenGraphLinesVertical
|
||||
(0, yClickPoints, lines, halfHeight, start, finish)
|
||||
in
|
||||
Vector.concat lines
|
||||
end
|
||||
else
|
||||
(* windowWidth < windowHeight *)
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val offset = difference div 2
|
||||
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
|
||||
val start = offset - (windowHeight div 2)
|
||||
val start = Real32.fromInt start / halfHeight
|
||||
|
||||
val finish = (windowHeight - offset) - (windowHeight div 2)
|
||||
val finish = Real32.fromInt finish / halfHeight
|
||||
|
||||
val lines = helpGenGraphLinesHorizontal
|
||||
(0, xClickPoints, [], halfWidth, start, finish)
|
||||
val lines = helpGenGraphLinesVertical
|
||||
(0, yClickPoints, lines, halfHeight, ~1.0, 1.0)
|
||||
in
|
||||
Vector.concat lines
|
||||
end
|
||||
|
||||
fun generate (app: AppType.app_type) =
|
||||
let
|
||||
val {windowWidth, windowHeight, xClickPoints, yClickPoints, ...} = app
|
||||
in
|
||||
helpGenerate (windowWidth, windowHeight, xClickPoints, yClickPoints)
|
||||
end
|
||||
end
|
||||
41
functional-core/app/ndc.sml
Normal file
41
functional-core/app/ndc.sml
Normal file
@@ -0,0 +1,41 @@
|
||||
structure Ndc =
|
||||
struct
|
||||
(* ndc = normalised device coordinates *)
|
||||
|
||||
fun ltrbToVertex (left, top, right, bottom, r, g, b) =
|
||||
#[ left, bottom, r, g, b
|
||||
, right, bottom, r, g, b
|
||||
, left, top, r, g, b
|
||||
|
||||
, left, top, r, g, b
|
||||
, right, bottom, r, g, b
|
||||
, right, top, r, g, b
|
||||
]
|
||||
|
||||
(* This function adjusts the x position to be centre-aligned to the grid
|
||||
* if windowWidth is greater than height
|
||||
* (where screen size does not have 1:1 aspect ratio). *)
|
||||
fun centreAlignX (x, windowWidth, windowHeight, halfWidth) =
|
||||
if windowWidth > windowHeight then
|
||||
let
|
||||
val difference = windowWidth - windowHeight
|
||||
val offset = Real32.fromInt (difference div 2)
|
||||
in
|
||||
x * (halfWidth - offset)
|
||||
end
|
||||
else
|
||||
x * halfWidth
|
||||
|
||||
(* Similar to centreAlignX, except it centre-aligns the y-point
|
||||
* when windowHeight is greater than windowWidth. *)
|
||||
fun centreAlignY (y, windowWidth, windowHeight, halfHeight) =
|
||||
if windowHeight > windowWidth then
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val offset = Real32.fromInt (difference div 2)
|
||||
in
|
||||
y * (halfHeight - offset)
|
||||
end
|
||||
else
|
||||
y * halfHeight
|
||||
end
|
||||
62
functional-core/app/triangle-stage.sml
Normal file
62
functional-core/app/triangle-stage.sml
Normal file
@@ -0,0 +1,62 @@
|
||||
structure TriangleStage =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
fun firstToVector (x1, y1, drawVec, model) =
|
||||
let
|
||||
val windowWidth = #windowWidth model
|
||||
val windowHeight = #windowHeight model
|
||||
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
|
||||
val x1px = Ndc.centreAlignX (x1, windowWidth, windowHeight, halfWidth)
|
||||
val left = (x1px - 5.0) / halfWidth
|
||||
val right = (x1px + 5.0) / halfWidth
|
||||
|
||||
val y1px = Ndc.centreAlignY (y1, windowWidth, windowHeight, halfHeight)
|
||||
val top = (y1px + 5.0) / halfHeight
|
||||
val bottom = (y1px - 5.0) / halfHeight
|
||||
|
||||
val firstVec = Ndc.ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0)
|
||||
in
|
||||
Vector.concat [firstVec, drawVec]
|
||||
end
|
||||
|
||||
fun secondToVector (x1, y1, x2, y2, drawVec, model) =
|
||||
let
|
||||
val windowWidth = #windowWidth model
|
||||
val windowHeight = #windowHeight model
|
||||
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
|
||||
val x1px = Ndc.centreAlignX (x1, windowWidth, windowHeight, halfWidth)
|
||||
val left = (x1px - 5.0) / halfWidth
|
||||
val right = (x1px + 5.0) / halfWidth
|
||||
|
||||
val y1px = Ndc.centreAlignY (y1, windowWidth, windowHeight, halfHeight)
|
||||
val top = (y1px + 5.0) / halfHeight
|
||||
val bottom = (y1px - 5.0) / halfHeight
|
||||
|
||||
val firstVec = Ndc.ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0)
|
||||
|
||||
val x2px = Ndc.centreAlignX (x2, windowWidth, windowHeight, halfWidth)
|
||||
val left = (x2px - 5.0) / halfWidth
|
||||
val right = (x2px + 5.0) / halfWidth
|
||||
|
||||
val y2px = Ndc.centreAlignY (y2, windowWidth, windowHeight, halfHeight)
|
||||
val top = (y2px + 5.0) / halfHeight
|
||||
val bottom = (y2px - 5.0) / halfHeight
|
||||
|
||||
val secVec = Ndc.ltrbToVertex (left, top, right, bottom, 0.0, 0.0, 1.0)
|
||||
in
|
||||
Vector.concat [firstVec, secVec, drawVec]
|
||||
end
|
||||
|
||||
fun toVector (model: app_type, drawVec) =
|
||||
case #triangleStage model of
|
||||
NO_TRIANGLE => drawVec
|
||||
| FIRST {x1, y1} => firstToVector (x1, y1, drawVec, model)
|
||||
| SECOND {x1, y1, x2, y2} => secondToVector (x1, y1, x2, y2, drawVec, model)
|
||||
end
|
||||
48
functional-core/app/triangles.sml
Normal file
48
functional-core/app/triangles.sml
Normal file
@@ -0,0 +1,48 @@
|
||||
signature TRIANGLES =
|
||||
sig
|
||||
val toVector: AppType.app_type -> Real32.real vector
|
||||
end
|
||||
|
||||
structure Triangles :> TRIANGLES =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
fun helpToVector (lst, acc, windowWidth, windowHeight, halfWidth, halfHeight) =
|
||||
case lst of
|
||||
{x1, y1, x2, y2, x3, y3} :: tl =>
|
||||
let
|
||||
val x1 = Ndc.centreAlignX (x1, windowWidth, windowHeight, halfWidth)
|
||||
val x2 = Ndc.centreAlignX (x2, windowWidth, windowHeight, halfWidth)
|
||||
val x3 = Ndc.centreAlignX (x3, windowWidth, windowHeight, halfWidth)
|
||||
|
||||
val y1 = Ndc.centreAlignY (y1, windowWidth, windowHeight, halfHeight)
|
||||
val y2 = Ndc.centreAlignY (y2, windowWidth, windowHeight, halfHeight)
|
||||
val y3 = Ndc.centreAlignY (y3, windowWidth, windowHeight, halfHeight)
|
||||
|
||||
val vec =
|
||||
#[ x1 / halfWidth
|
||||
, y1 / halfHeight
|
||||
, x2 / halfWidth
|
||||
, y2 / halfHeight
|
||||
, x3 / halfWidth
|
||||
, y3 / halfHeight
|
||||
]
|
||||
val acc = vec :: acc
|
||||
in
|
||||
helpToVector
|
||||
(tl, acc, windowWidth, windowHeight, halfWidth, halfHeight)
|
||||
end
|
||||
| [] => acc
|
||||
|
||||
fun toVector (app: app_type) =
|
||||
let
|
||||
val windowWidth = #windowWidth app
|
||||
val windowHeight = #windowHeight app
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
val lst = helpToVector
|
||||
(#triangles app, [], windowWidth, windowHeight, halfWidth, halfHeight)
|
||||
in
|
||||
Vector.concat lst
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user