begin merging files which were previously in temp-squares directory into main

This commit is contained in:
2025-07-06 14:56:54 +01:00
parent 395d6002d8
commit 2e0549097e
33 changed files with 31 additions and 2513 deletions

BIN
dotscape

Binary file not shown.

View File

@@ -1,35 +1,36 @@
$(SML_LIB)/basis/basis.mlb
(* FUNCTIONAL CORE *)
functional-core/app/app-type.sml
fcore/app-type.sml
ann
"allowVectorExps true"
in
functional-core/app/ndc.sml
functional-core/app/click-points.sml
functional-core/app/graph-lines.sml
functional-core/app/triangles.sml
fcore/ndc.sml
fcore/graph-lines.sml
cozette-sml/fonts/cozette-ascii.mlb
end
functional-core/app/triangle-stage.sml
fcore/click-points.sml
fcore/app-init.sml
fcore/app-with.sml
functional-core/app/app-init.sml
functional-core/app/app-with.sml
message-types/input-msg.sml
message-types/file-msg.sml
message-types/draw-msg.sml
message-types/file-msg.sml
message-types/input-msg.sml
message-types/update-msg.sml
functional-core/app/app-update.sml
fcore/quad-tree.sml
fcore/common-update.sml
fcore/normal-mode.sml
fcore/browse-mode.sml
fcore/app-update.sml
(* pure file parsing functions *)
functional-core/file/parse-file.sml
fcore/parse-file.sml
(* IMPERATIVE SHELL *)
$(SML_LIB)/basis/mlton.mlb
$(SML_LIB)/cml/cml.mlb
ann

View File

@@ -14,16 +14,11 @@ struct
else
let
val chr = String.sub (str, pos)
val chrVec = Vector.fromList []
(*
*
val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr)
val chrVec = chrFun
(startX, startY, 25.0, 25.0, windowWidth, windowHeight, r, g, b)
* *)
val acc = chrVec :: acc
in
stringToVec

5
fcore/parse-file.sml Normal file
View File

@@ -0,0 +1,5 @@
structure ParseFile =
struct
(* unimplemented *)
fun parseLine line = NONE
end

View File

@@ -157,10 +157,6 @@ typedef Pointer Objptr;
extern "C" {
#endif
MLLIB_PUBLIC(void mltonMouseMoveCallback (Real32 x0, Real32 x1);)
MLLIB_PUBLIC(void mltonMouseClickCallback (Int32 x0, Int32 x1);)
MLLIB_PUBLIC(void mltonFramebufferSizeCallback (Int32 x0, Int32 x1);)
MLLIB_PUBLIC(void mltonKeyCallback (Int32 x0, Int32 x1, Int32 x2, Int32 x3);)
#undef MLLIB_PRIVATE
#undef MLLIB_PUBLIC

View File

@@ -1,88 +0,0 @@
signature APP_INIT =
sig
val fromWindowWidthAndHeight: int * int * int * int -> AppType.app_type
end
structure AppInit :> APP_INIT =
struct
open AppType
fun helpFromWidthAndHeight
( windowWidth
, windowHeight
, wStart
, wFinish
, hStart
, hFinish
, widthClickPoints
, heightClickPoints
) : app_type =
let
val xClickPoints =
ClickPoints.generate (wStart, wFinish, widthClickPoints)
val yClickPoints =
ClickPoints.generate (hStart, hFinish, heightClickPoints)
in
{ mode = AppType.NORMAL_MODE
, triangles = []
, triangleStage = NO_TRIANGLE
, windowWidth = windowWidth
, windowHeight = windowHeight
, numClickPointsX = widthClickPoints
, numClickPointsY = heightClickPoints
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, undo = []
, redo = []
, mouseX = 0.0
, mouseY = 0.0
, showGraph = true
, arrowX = 0
, arrowY = 0
, openFilePath = ""
, fileBrowser = Vector.fromList []
, fileBrowserIdx = 0
, r = 0.0
, g = 0.0
, b = 0.0
, num = 0
}
end
fun fromWindowWidthAndHeight
(windowWidth, windowHeight, widthClickPoints, heightClickPoints) =
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
, widthClickPoints
, heightClickPoints
)
end
else
let
val difference = windowHeight - windowWidth
val hStart = difference div 2
val hFinish = hStart + windowWidth
in
helpFromWidthAndHeight
( windowWidth
, windowHeight
, 0
, windowWidth
, hStart
, hFinish
, widthClickPoints
, heightClickPoints
)
end
end

View File

@@ -1,58 +0,0 @@
structure AppType =
struct
datatype app_mode = NORMAL_MODE | BROWSE_MODE
datatype file_browser_item = IS_FILE of string | IS_FOLDER of string
type triangle =
{ x1: Real32.real
, x2: Real32.real
, x3: Real32.real
, y1: Real32.real
, y2: Real32.real
, y3: Real32.real
, r: Real32.real
, g: Real32.real
, b: 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 =
{ mode: app_mode
, triangles: triangle list
, triangleStage: triangle_stage
, windowWidth: int
, windowHeight: int
, numClickPointsX: int
, numClickPointsY: int
, xClickPoints: Real32.real vector
, yClickPoints: Real32.real vector
, undo: (Real32.real * Real32.real) list
, redo: (Real32.real * Real32.real) list
, showGraph: bool
, mouseX: Real32.real
, mouseY: Real32.real
, arrowX: int
, arrowY: int
, openFilePath: string
, fileBrowser: file_browser_item vector
, fileBrowserIdx: int
, r: Real32.real
, g: Real32.real
, b: Real32.real
, num: int
}
end

View File

@@ -1,607 +0,0 @@
signature APP_UPDATE =
sig
val update: AppType.app_type * InputMessage.t
-> AppType.app_type * UpdateMessage.t list
end
structure AppUpdate :> APP_UPDATE =
struct
open AppType
open DrawMessage
open FileMessage
open InputMessage
open UpdateMessage
fun getDotVecFromIndices (model, hIdx, vIdx) =
let
val {windowWidth, windowHeight, ...} = model
val xpos = Vector.sub (#xClickPoints model, hIdx)
val ypos = Vector.sub (#yClickPoints model, vIdx)
in
ClickPoints.getDrawDotRgb
(xpos, ypos, 1.0, 0.0, 0.0, windowWidth, windowHeight)
end
fun mouseMoveOrRelease (model: app_type) =
let
val drawVec =
case ClickPoints.getClickPositionFromMouse model of
SOME (hIdx, vIdx) => getDotVecFromIndices (model, hIdx, vIdx)
| NONE => Vector.fromList []
val drawVec = TriangleStage.toVector (model, drawVec)
val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
fun getDrawDotMsgWhenArrowIsAtBoundary model =
let
val {arrowX, arrowY, ...} = model
val dotVec = getDotVecFromIndices (model, arrowX, arrowY)
val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
fun moveArrowUp (model: app_type) =
let
val {arrowX, arrowY, ...} = model
in
if arrowY > 0 then
let
val newArrowY = arrowY - 1
val model = AppWith.arrowY (model, newArrowY)
val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
getDrawDotMsgWhenArrowIsAtBoundary model
end
fun moveArrowLeft (model: app_type) =
let
val {arrowX, arrowY, ...} = model
in
if arrowX > 0 then
let
val newArrowX = arrowX - 1
val model = AppWith.arrowX (model, newArrowX)
val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
getDrawDotMsgWhenArrowIsAtBoundary model
end
fun moveArrowRight (model: app_type) =
let
val {arrowX, arrowY, xClickPoints, ...} = model
in
if arrowX < Vector.length xClickPoints - 1 then
let
val newArrowX = arrowX + 1
val model = AppWith.arrowX (model, newArrowX)
val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
getDrawDotMsgWhenArrowIsAtBoundary model
end
fun moveArrowDown (model: app_type) =
let
val {arrowX, arrowY, yClickPoints, ...} = model
in
if arrowY < Vector.length yClickPoints - 1 then
let
val newArrowY = arrowY + 1
val model = AppWith.arrowY (model, newArrowY)
val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
val dotVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT dotVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
getDrawDotMsgWhenArrowIsAtBoundary model
end
fun addCoordinates (model: app_type, hIdx, vIdx) =
let
val
{ windowWidth
, windowHeight
, xClickPoints
, yClickPoints
, triangleStage
, ...
} = model
val xpos = Vector.sub (xClickPoints, hIdx)
val ypos = Vector.sub (yClickPoints, vIdx)
val dotVec = ClickPoints.getDrawDotRgb
(xpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
val halfWidth = Real32.fromInt (windowWidth div 2)
val halfHeight = Real32.fromInt (windowHeight div 2)
val hpos =
ClickPoints.xposToNdc (xpos, windowWidth, windowHeight, halfWidth)
val vpos =
ClickPoints.yposToNdc (ypos, windowWidth, windowHeight, halfHeight)
val newUndoTuple = (hpos, vpos)
in
case triangleStage of
NO_TRIANGLE =>
let
val drawVec = TriangleStage.toVector (model, dotVec)
val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
val newTriangleStage = FIRST {x1 = hpos, y1 = vpos}
val model = AppWith.addTriangleStage
(model, newTriangleStage, newUndoTuple, hIdx, vIdx)
in
(model, drawMsg)
end
| FIRST {x1, y1} =>
let
val drawVec = TriangleStage.firstToVector (x1, y1, dotVec, model)
val drawMsg = DRAW_DOT drawVec
val drawMsg = [DRAW drawMsg]
val newTriangleStage = SECOND
{x1 = x1, y1 = y1, x2 = hpos, y2 = vpos}
val model = AppWith.addTriangleStage
(model, newTriangleStage, newUndoTuple, hIdx, vIdx)
in
(model, drawMsg)
end
| SECOND {x1, y1, x2, y2} =>
let
val model = AppWith.addTriangle
(model, x1, y1, x2, y2, hpos, vpos, newUndoTuple, hIdx, vIdx)
val drawVec = Triangles.toVector model
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
end
fun mouseLeftClick model =
case ClickPoints.getClickPositionFromMouse model of
SOME (hIdx, vIdx) => addCoordinates (model, hIdx, vIdx)
| NONE => (model, [])
fun enterOrSpaceCoordinates model =
let val {arrowX, arrowY, ...} = model
in addCoordinates (model, arrowX, arrowY)
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}
val drawMsg = [DRAW drawMsg]
in
(model, 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
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
| NO_TRIANGLE =>
(case #triangles model of
{x1, y1, x2, y2, x3, y3, r, g, b} :: 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}
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
| [] =>
(* Can't undo, because there are no actions to undo. *)
(model, []))
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
val drawMsg = [DRAW drawMsg]
in
(model, 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
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
| SECOND {x1, y1, x2, y2} =>
(* clear triangle stage, add to trinagle list and redraw triangles *)
let
val {r, g, b, ...} = model
val newTriangleStage = NO_TRIANGLE
val newTriangle =
{ x1 = x1
, y1 = y1
, x2 = x2
, y2 = y2
, x3 = x
, y3 = y
, r = r
, g = g
, b = b
}
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
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end)
| [] => (* Nothing to redo. *) (model, [])
fun toggleGraph (model: app_type) =
if #showGraph model then
let
val model = AppWith.graphVisibility (model, false)
val drawMsg = DRAW_GRAPH (Vector.fromList [])
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
else
let
val model = AppWith.graphVisibility (model, true)
val graphLines = GraphLines.generate model
val drawMsg = DRAW_GRAPH graphLines
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
fun updateNum (model: app_type, inputNum) =
let
val oldNum = #num model
val newNum = oldNum * 10 + inputNum
val newNum = if newNum > 255 then 0 else newNum
in
(AppWith.num (model, newNum), [])
end
fun updateRed model = (AppWith.r model, [])
fun updateGreen model = (AppWith.g model, [])
fun updateBlue model = (AppWith.b model, [])
fun getSaveTrianglesMsg model =
let
val {triangles, ...} = model
val fileMsg = SAVE_TRIANGLES triangles
val fileMsg = [FILE fileMsg]
in
(model, fileMsg)
end
fun getLoadTrianglesMsg model =
(model, [FILE LOAD_TRIANGLES])
fun getExportTrianglesMsg model =
let
val {triangles, ...} = model
val fileMsg = EXPORT_TRIANGLES (#triangles model)
val fileMsg = [FILE fileMsg]
in
(model, fileMsg)
end
fun useTrianglesInNormalMode (model, triangles) =
let
val model = AppWith.useTrianglesAndSetNormalMode (model, triangles)
val drawVec = Triangles.toVector model
val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec
val drawMsg = [DRAW drawMsg]
in
(model, drawMsg)
end
fun trianglesLoadError model = (model, [])
fun enterBrowseMode model =
let
val model = AppWith.mode (model, AppType.BROWSE_MODE)
(* todo: should draw modal window as well *)
val fileMsg = LOAD_FILES (#openFilePath model)
val fileMsg = [FILE fileMsg]
in
(model, fileMsg)
end
fun handleFileBrowserAndPathInNormalMode (model, fileBrowser, path) =
let val model = AppWith.fileBrowserAndPath (model, fileBrowser, path)
in (model, [])
end
fun updateNormalMode (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
| NUM num => updateNum (model, num)
| KEY_R => updateRed model
| KEY_G => updateGreen model
| KEY_B => updateBlue model
| RESIZE_WINDOW {width, height} => resizeWindow (model, width, height)
| UNDO_ACTION => undoAction model
| REDO_ACTION => redoAction model
| KEY_T => toggleGraph model
| KEY_CTRL_S => getSaveTrianglesMsg model
| KEY_CTRL_L => getLoadTrianglesMsg model
| KEY_CTRL_E => getExportTrianglesMsg model
| KEY_CTRL_O => enterBrowseMode model
| ARROW_UP => moveArrowUp model
| ARROW_LEFT => moveArrowLeft model
| ARROW_RIGHT => moveArrowRight model
| ARROW_DOWN => moveArrowDown model
| KEY_ENTER => enterOrSpaceCoordinates model
| KEY_SPACE => enterOrSpaceCoordinates model
| USE_TRIANGLES triangles => useTrianglesInNormalMode (model, triangles)
| TRIANGLES_LOAD_ERROR => trianglesLoadError model
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
handleFileBrowserAndPathInNormalMode (model, fileBrowser, path)
fun stringToVec
(pos, str, acc, startX, startY, windowWidth, windowHeight, r, g, b) =
if pos = String.size str then
acc
else
let
val chr = String.sub (str, pos)
val chrFun = Vector.sub (CozetteAscii.asciiTable, Char.ord chr)
val chrVec = chrFun
(startX, startY, 25.0, 25.0, windowWidth, windowHeight, r, g, b)
val acc = chrVec :: acc
in
stringToVec
( pos + 1
, str
, acc
, startX + 12
, startY
, windowWidth
, windowHeight
, r
, g
, b
)
end
fun buildFileBrowserText
(pos, fileBrowser, acc, startY, windowWidth, windowHeight, selectedIdx) =
if pos = Vector.length fileBrowser then
Vector.concat acc
else
let
val item = Vector.sub (fileBrowser, pos)
val itemText =
case item of
IS_FILE str => str
| IS_FOLDER str => str
val acc =
if pos <> selectedIdx then
stringToVec
( 0
, itemText
, acc
, 10
, startY
, windowWidth
, windowHeight
, 0.0
, 0.0
, 0.0
)
else
stringToVec
( 0
, itemText
, acc
, 10
, startY
, windowWidth
, windowHeight
, 0.35
, 0.35
, 0.75
)
in
buildFileBrowserText
( pos + 1
, fileBrowser
, acc
, startY + 23
, windowWidth
, windowHeight
, selectedIdx
)
end
fun redrawFileBrowser (model: app_type) =
let
val {windowWidth, windowHeight, fileBrowser, fileBrowserIdx, ...} = model
val ww = Real32.fromInt windowWidth
val wh = Real32.fromInt windowHeight
val textVec = buildFileBrowserText
(0, fileBrowser, [], 10, ww, wh, fileBrowserIdx)
val drawMsg = DRAW_MODAL_TEXT textVec
in
(model, [DRAW drawMsg])
end
fun handleFileBrowserAndPathInBrowseMode (model, fileBrowser, path) =
let val model = AppWith.fileBrowserAndPath (model, fileBrowser, path)
in redrawFileBrowser model
end
fun browseModeArrowUp (model: app_type) =
let
val {fileBrowser, fileBrowserIdx, ...} = model
val fileBrowserIdx =
if fileBrowserIdx > 0 then fileBrowserIdx - 1
else Int.max (0, Vector.length fileBrowser - 1)
val model = AppWith.fileBrowserIdx (model, fileBrowserIdx)
in
redrawFileBrowser model
end
fun browseModeArrowDown (model: app_type) =
let
val {fileBrowser, fileBrowserIdx, ...} = model
val fileBrowserIdx =
if fileBrowserIdx = Vector.length fileBrowser - 1 then 0
else fileBrowserIdx + 1
val model = AppWith.fileBrowserIdx (model, fileBrowserIdx)
in
redrawFileBrowser model
end
fun selectCurrentFileItem model =
let
val {fileBrowser, fileBrowserIdx, openFilePath, ...} = model
in
if Vector.length fileBrowser > 0 then
let
val path =
case Vector.sub (fileBrowser, fileBrowserIdx) of
IS_FILE str => str
| IS_FOLDER str => str
val path = String.concat [openFilePath, "/", path]
val fileMsg = SELECT_PATH path
in
(model, [FILE fileMsg])
end
else
(model, [])
end
fun updateBrowseMode (model: app_type, inputMsg) =
case inputMsg of
ARROW_UP => browseModeArrowUp model
| ARROW_DOWN => browseModeArrowDown model
| TRIANGLES_LOAD_ERROR => trianglesLoadError model
(* todo:
| ARROW_LEFT =>
*)
| ARROW_RIGHT => selectCurrentFileItem model
| KEY_ENTER => selectCurrentFileItem model
| KEY_SPACE => selectCurrentFileItem model
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
handleFileBrowserAndPathInBrowseMode (model, fileBrowser, path)
| USE_TRIANGLES triangles => useTrianglesInNormalMode (model, triangles)
| _ => (model, [])
fun update (model: app_type, inputMsg) =
case #mode model of
NORMAL_MODE => updateNormalMode (model, inputMsg)
| BROWSE_MODE => updateBrowseMode (model, inputMsg)
end

View File

@@ -1,995 +0,0 @@
structure AppWith =
struct
open AppType
(* add to undo, clear redo *)
fun addTriangleStage
(app: app_type, newTriangleStage: triangle_stage, newUndoHd, arrowX, arrowY) :
app_type =
let
val
{ triangleStage = _
, mode
, triangles
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo = _
, showGraph
, mouseX
, mouseY
, arrowX = _
, arrowY = _
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
val newUndo = newUndoHd :: undo
in
{ triangleStage = newTriangleStage
, undo = newUndo
, redo = []
, mode = mode
, triangles = triangles
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun addTriangle
(app: app_type, x1, y1, x2, y2, x3, y3, newUndoHd, arrowX, arrowY) :
app_type =
let
val
{ mode
, triangles
, triangleStage = _
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo = _
, showGraph
, mouseX
, mouseY
, arrowX = _
, arrowY = _
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
val newTriangle =
{ x1 = x1
, y1 = y1
, x2 = x2
, y2 = y2
, x3 = x3
, y3 = y3
, r = r
, g = g
, b = b
}
val newTriangles = newTriangle :: triangles
val newUndo = newUndoHd :: undo
in
{ mode = mode
, triangleStage = NO_TRIANGLE
, triangles = newTriangles
, undo = newUndo
, redo = []
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun arrowX (app: app_type, arrowX) =
let
val
{ mode
, xClickPoints
, yClickPoints
, numClickPointsX
, numClickPointsY
, windowWidth
, windowHeight
, triangles
, triangleStage
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX = _
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
in
{ mode = mode
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, triangles = triangles
, triangleStage = triangleStage
, windowWidth = windowWidth
, windowHeight = windowHeight
, undo = undo
, redo = redo
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun arrowY (app: app_type, arrowY) =
let
val
{ mode
, xClickPoints
, yClickPoints
, numClickPointsX
, numClickPointsY
, windowWidth
, windowHeight
, triangles
, triangleStage
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY = _
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
in
{ mode = mode
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, triangles = triangles
, triangleStage = triangleStage
, windowWidth = windowWidth
, windowHeight = windowHeight
, undo = undo
, redo = redo
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun helpWindowResize
(app: app_type, windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) :
app_type =
let
val
{ mode
, xClickPoints = _
, yClickPoints = _
, numClickPointsX
, numClickPointsY
, windowWidth = _
, windowHeight = _
, triangles
, triangleStage
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
val xClickPoints = ClickPoints.generate (wStart, wFinish, numClickPointsX)
val yClickPoints = ClickPoints.generate (hStart, hFinish, numClickPointsY)
in
{ mode = mode
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, triangles = triangles
, triangleStage = triangleStage
, windowWidth = windowWidth
, windowHeight = windowHeight
, undo = undo
, redo = redo
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
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
{ mode
, mouseX = _
, mouseY = _
, triangles
, triangleStage
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, showGraph
, arrowX
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
in
{ mode = mode
, mouseX = mouseX
, mouseY = mouseY
, triangles = triangles
, triangleStage = triangleStage
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, undo = undo
, redo = redo
, showGraph = showGraph
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
(* add to redo, pop one from undo *)
fun undo (app: app_type, newTriangleStage, newTriangles, newRedoHd) =
let
val
{ mode
, triangleStage = _
, triangles = _
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
val newUndo =
case undo of
hd :: tl => tl
| empty => empty
val newRedo = newRedoHd :: redo
in
{ mode = mode
, triangleStage = newTriangleStage
, triangles = newTriangles
, undo = newUndo
, redo = newRedo
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
(* add to undo, pop one from redo *)
fun redo (app: app_type, newTriangleStage, newTriangles, newUndoHd) =
let
val
{ mode
, triangleStage = _
, triangles = _
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
val newUndo = newUndoHd :: undo
val newRedo =
case redo of
hd :: tl => tl
| empty => empty
in
{ mode = mode
, triangleStage = newTriangleStage
, triangles = newTriangles
, undo = newUndo
, redo = newRedo
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun graphVisibility (app: app_type, shouldShowGraph) =
let
val
{ mode
, triangleStage
, triangles
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, mouseX
, mouseY
, arrowX
, arrowY
, showGraph = _
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
in
{ mode = mode
, showGraph = shouldShowGraph
, triangleStage = triangleStage
, triangles = triangles
, undo = undo
, redo = redo
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun mode (app: app_type, newMode) =
let
val
{ mode = _
, triangleStage
, triangles
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, mouseX
, mouseY
, arrowX
, arrowY
, showGraph
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
in
{ mode = newMode
, showGraph = showGraph
, triangleStage = triangleStage
, triangles = triangles
, undo = undo
, redo = redo
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun useTrianglesAndSetNormalMode (app: app_type, triangles) =
let
val
{ mode = _
, xClickPoints
, yClickPoints
, numClickPointsX
, numClickPointsY
, windowWidth
, windowHeight
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, triangles = _
, triangleStage = _
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num
} = app
val triangleStage = NO_TRIANGLE
in
{ mode = AppType.NORMAL_MODE
, triangleStage = triangleStage
, triangles = triangles
, undo = []
, redo = []
, showGraph = showGraph
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun fileBrowserAndPath (app: app_type, fileBrowser, path) =
let
val
{ mode
, xClickPoints
, yClickPoints
, numClickPointsX
, numClickPointsY
, windowWidth
, windowHeight
, triangles
, triangleStage
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath = _
, fileBrowser = _
, fileBrowserIdx = _
, r
, g
, b
, num
} = app
in
{ mode = mode
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, triangles = triangles
, triangleStage = triangleStage
, windowWidth = windowWidth
, windowHeight = windowHeight
, undo = undo
, redo = redo
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = path
, fileBrowser = fileBrowser
, fileBrowserIdx = 0
, r = r
, g = g
, b = b
, num = num
}
end
fun fileBrowserIdx (app: app_type, newFileBrowserIdx) =
let
val
{ mode
, xClickPoints
, yClickPoints
, numClickPointsX
, numClickPointsY
, windowWidth
, windowHeight
, triangles
, triangleStage
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = _
, r
, g
, b
, num
} = app
in
{ mode = mode
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, triangles = triangles
, triangleStage = triangleStage
, windowWidth = windowWidth
, windowHeight = windowHeight
, undo = undo
, redo = redo
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = newFileBrowserIdx
, r = r
, g = g
, b = b
, num = num
}
end
fun num (app: app_type, newNum) : app_type =
let
val
{ triangleStage
, mode
, triangles
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b
, num = _
} = app
in
{ triangleStage = triangleStage
, undo = undo
, redo = []
, mode = mode
, triangles = triangles
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = b
, num = newNum
}
end
fun r (app: app_type) : app_type =
let
val
{ triangleStage
, mode
, triangles
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r = _
, g
, b
, num
} = app
val newR = Real32.fromInt num / 255.0
in
{ triangleStage = triangleStage
, undo = undo
, redo = []
, mode = mode
, triangles = triangles
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = newR
, g = g
, b = b
, num = 0
}
end
fun g (app: app_type) : app_type =
let
val
{ triangleStage
, mode
, triangles
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g = _
, b
, num
} = app
val newG = Real32.fromInt num / 255.0
in
{ triangleStage = triangleStage
, undo = undo
, redo = []
, mode = mode
, triangles = triangles
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = newG
, b = b
, num = 0
}
end
fun b (app: app_type) : app_type =
let
val
{ triangleStage
, mode
, triangles
, numClickPointsX
, numClickPointsY
, xClickPoints
, yClickPoints
, windowWidth
, windowHeight
, undo
, redo
, showGraph
, mouseX
, mouseY
, arrowX
, arrowY
, openFilePath
, fileBrowser
, fileBrowserIdx
, r
, g
, b = _
, num
} = app
val newB = Real32.fromInt num / 255.0
in
{ triangleStage = triangleStage
, undo = undo
, redo = []
, mode = mode
, triangles = triangles
, numClickPointsX = numClickPointsX
, numClickPointsY = numClickPointsY
, xClickPoints = xClickPoints
, yClickPoints = yClickPoints
, windowWidth = windowWidth
, windowHeight = windowHeight
, showGraph = showGraph
, mouseX = mouseX
, mouseY = mouseY
, arrowX = arrowX
, arrowY = arrowY
, openFilePath = openFilePath
, fileBrowser = fileBrowser
, fileBrowserIdx = fileBrowserIdx
, r = r
, g = g
, b = newB
, num = 0
}
end
end

View File

@@ -1,127 +0,0 @@
signature CLICK_POINTS =
sig
val generate: int * int * int -> Real32.real vector
val getClickPositionFromMouse: AppType.app_type -> (int * int) option
val getDrawDot: Real32.real * Real32.real * int * int -> Real32.real vector
val getDrawDotRgb:
Real32.real
* Real32.real
* Real32.real
* Real32.real
* Real32.real
* int
* int
-> Real32.real vector
(* two below functions convert pixel coordinates to normalised device coordinates *)
val xposToNdc: Real32.real * int * int * Real32.real -> Real32.real
val yposToNdc: Real32.real * int * int * Real32.real -> Real32.real
end
structure ClickPoints :> CLICK_POINTS =
struct
fun generate (start, finish, numPoints) =
let
val difference = finish - start
val increment = Real32.fromInt difference / Real32.fromInt numPoints
val start = Real32.fromInt start
in
Vector.tabulate (numPoints + 1, 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 getClickPos (clickPoints, mousePos, idx) =
if idx = Vector.length clickPoints then
NONE
else
let
val curPos = Vector.sub (clickPoints, idx)
in
if mousePos < curPos - range orelse mousePos > curPos + range then
getClickPos (clickPoints, mousePos, idx + 1)
else
SOME idx
end
fun getClickPositionFromMouse (app: AppType.app_type) =
case getClickPos (#xClickPoints app, #mouseX app, 0) of
SOME hIdx =>
(case getClickPos (#yClickPoints app, #mouseY app, 0) of
SOME vIdx => SOME (hIdx, vIdx)
| NONE => NONE)
| NONE => NONE
fun getDrawDot (xpos, ypos, windowWidth, windowHeight) =
let
(* calculate normalised device coordinates *)
val halfWidth = Real32.fromInt (windowWidth div 2)
val halfHeight = Real32.fromInt (windowHeight div 2)
val hpos = xpos - halfWidth
val vpos = ~(ypos - 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
in
Ndc.ltrbToVertex (left, top, right, bottom)
end
fun getDrawDotRgb (xpos, ypos, r, g, b, windowWidth, windowHeight) =
let
(* calculate normalised device coordinates *)
val halfWidth = Real32.fromInt (windowWidth div 2)
val halfHeight = Real32.fromInt (windowHeight div 2)
val hpos = xpos - halfWidth
val vpos = ~(ypos - 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
in
Ndc.ltrbToVertexRgb (left, top, right, bottom, r, g, b)
end
fun xposToNdc (xpos, windowWidth, windowHeight, halfWidth) =
let
val xpos = xpos - halfWidth
in
if windowWidth > windowHeight then
let
val difference = windowWidth - windowHeight
val offset = Real32.fromInt (difference div 2)
in
xpos / (halfWidth - offset)
end
else
xpos / halfWidth
end
fun yposToNdc (ypos, windowWidth, windowHeight, halfHeight) =
let
val ypos = ~(ypos - halfHeight)
in
if windowHeight > windowWidth then
let
val difference = windowHeight - windowWidth
val offset = Real32.fromInt (difference div 2)
in
ypos / (halfHeight - offset)
end
else
ypos / halfHeight
end
end

View File

@@ -1,214 +0,0 @@
signature GRAPH_LINES =
sig
val generate: AppType.app_type -> Real32.real vector
end
structure GraphLines :> GRAPH_LINES =
struct
(* this function generates graph lines which look like:
* . . .
* . . .
* . . .
* where the dots signify click points.
*
* I think this is not as useful for plotting points as the other method,
* where that other method is similar to graph paper,
* but there might be a run-time option to change to the grid genereated by this function
* in the future. *)
fun generateUnconnectedGrid (app: AppType.app_type) =
let
val {windowWidth, windowHeight, xClickPoints, yClickPoints, ...} = app
in
Vector.concat (List.tabulate (Vector.length xClickPoints, fn xIdx =>
let
val xpos = Vector.sub (xClickPoints, xIdx)
in
Vector.concat (List.tabulate (Vector.length yClickPoints, fn yIdx =>
ClickPoints.getDrawDot
(xpos, Vector.sub (yClickPoints, yIdx), windowWidth, windowHeight)))
end))
end
(*
* 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

View File

@@ -1,50 +0,0 @@
structure Ndc =
struct
(* ndc = normalised device coordinates *)
fun ltrbToVertex (left, top, right, bottom) =
#[ left, bottom
, right, bottom
, left, top
, left, top
, right, bottom
, right, top
]
fun ltrbToVertexRgb (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

View File

@@ -1,64 +0,0 @@
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.ltrbToVertexRgb
(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.ltrbToVertexRgb
(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.ltrbToVertexRgb (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

View File

@@ -1,57 +0,0 @@
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, r, g, b} :: 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
, r
, g
, b
, x2 / halfWidth
, y2 / halfHeight
, r
, g
, b
, x3 / halfWidth
, y3 / halfHeight
, r
, g
, b
]
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

View File

@@ -1,135 +0,0 @@
signature PARSE_FILE =
sig
val parseLine: string -> AppType.triangle option
end
structure ParseFile :> PARSE_FILE =
struct
datatype triangle_token =
X
| Y
| R
| G
| B
| COORD of Real32.real
| UNKNOWN of string
val zero: Real32.real = 0.0
fun extractTriangle lst =
case lst of
[ X
, COORD x1
, Y
, COORD y1
, X
, COORD x2
, Y
, COORD y2
, X
, COORD x3
, Y
, COORD y3
] =>
(* file format not specifying any colours *)
SOME
{ x1 = x1
, y1 = y1
, x2 = x2
, y2 = y2
, x3 = x3
, y3 = y3
, r = zero
, g = zero
, b = zero
}
| [ X
, COORD x1
, Y
, COORD y1
, X
, COORD x2
, Y
, COORD y2
, X
, COORD x3
, Y
, COORD y3
, R
, COORD r
, G
, COORD g
, B
, COORD b
] =>
(* file format specifying rgb *)
SOME
{ x1 = x1
, y1 = y1
, x2 = x2
, y2 = y2
, x3 = x3
, y3 = y3
, r = r
, g = g
, b = b
}
| _ => NONE
fun tokeniseString str =
if str = "x" then
X
else if str = "y" then
Y
else if str = "r" then
R
else if str = "g" then
G
else if str = "b" then
B
else
case Real32.fromString str of
SOME num => COORD num
| NONE => UNKNOWN str
fun helpParseLine (line, pos, acc, wordStartPos) =
if pos = String.size line then
List.rev acc
else
let
val chr = String.sub (line, pos)
in
if Char.isSpace chr then
if pos > 0 andalso Char.isSpace (String.sub (line, pos - 1)) then
(* if previous character is space, just proceed to next character *)
helpParseLine (line, pos + 1, acc, wordStartPos)
else
let
(* current character is space, but previous character is not,
* which means we have some text to substring and tokenise
* before proceeding to next character *)
val strToken =
String.substring (line, wordStartPos, pos - wordStartPos)
val token = tokeniseString strToken
in
helpParseLine (line, pos + 1, token :: acc, pos)
end
else if pos > 0 andalso Char.isSpace (String.sub (line, pos - 1)) then
(* previous character was space but current character is not,
* meaning that we have hit the start of a new word *)
helpParseLine (line, pos + 1, acc, pos)
else
(* just proceed to next character *)
helpParseLine (line, pos + 1, acc, wordStartPos)
end
fun parseLine line =
let val lst = helpParseLine (line, 0, [], 0)
in extractTriangle lst
end
end

View File

@@ -2,12 +2,12 @@ structure DrawMessage =
struct
datatype t =
DRAW_DOT of Real32.real vector
| DRAW_TRIANGLES_AND_DOTS of
{triangles: Real32.real vector, dots: Real32.real vector}
| DRAW_TRIANGLES_AND_RESET_DOTS of Real32.real vector
| DRAW_SQUARES_AND_DOTS of
{squares: Real32.real vector, dots: Real32.real vector}
| DRAW_SQUARES_AND_RESET_DOTS of Real32.real vector
| DRAW_GRAPH of Real32.real vector
| RESIZE_TRIANGLES_DOTS_AND_GRAPH of
{ triangles: Real32.real vector
| RESIZE_SQUARES_DOTS_AND_GRAPH of
{ squares: Real32.real vector
, graphLines: Real32.real vector
, dots: Real32.real vector
}

View File

@@ -1,9 +1,9 @@
structure FileMessage =
struct
datatype t =
SAVE_TRIANGLES of AppType.triangle list
| LOAD_TRIANGLES
| EXPORT_TRIANGLES of AppType.triangle list
SAVE_SQUARES of int vector vector
| LOAD_SQUARES
| EXPORT_SQUARES of int vector vector
| LOAD_FILES of string
| SELECT_PATH of string
end

View File

@@ -22,8 +22,9 @@ struct
| ARROW_DOWN
| KEY_ENTER
| KEY_SPACE
| USE_TRIANGLES of AppType.triangle list
| TRIANGLES_LOAD_ERROR
| USE_SQUARES of
{squares: int vector vector, canvasWidth: int, canvasHeight: int}
| SQUARES_LOAD_ERROR
| FILE_BROWSER_AND_PATH of
{fileBrowser: AppType.file_browser_item vector, path: string}
end

View File

@@ -1,16 +0,0 @@
structure DrawMessage =
struct
datatype t =
DRAW_DOT of Real32.real vector
| DRAW_SQUARES_AND_DOTS of
{squares: Real32.real vector, dots: Real32.real vector}
| DRAW_SQUARES_AND_RESET_DOTS of Real32.real vector
| DRAW_GRAPH of Real32.real vector
| RESIZE_SQUARES_DOTS_AND_GRAPH of
{ squares: Real32.real vector
, graphLines: Real32.real vector
, dots: Real32.real vector
}
| CLEAR_DOTS
| DRAW_MODAL_TEXT of Real32.real vector
end

View File

@@ -1,9 +0,0 @@
structure FileMessage =
struct
datatype t =
SAVE_SQUARES of int vector vector
| LOAD_SQUARES
| EXPORT_SQUARES of int vector vector
| LOAD_FILES of string
| SELECT_PATH of string
end

View File

@@ -1,30 +0,0 @@
structure InputMessage =
struct
datatype t =
MOUSE_MOVE of {x: Real32.real, y: Real32.real}
| MOUSE_LEFT_CLICK
| MOUSE_LEFT_RELEASE
| RESIZE_WINDOW of {width: int, height: int}
| UNDO_ACTION
| REDO_ACTION
| KEY_R
| KEY_G
| KEY_B
| KEY_T
| KEY_CTRL_S
| KEY_CTRL_L
| KEY_CTRL_E
| KEY_CTRL_O
| NUM of int
| ARROW_UP
| ARROW_LEFT
| ARROW_RIGHT
| ARROW_DOWN
| KEY_ENTER
| KEY_SPACE
| USE_SQUARES of
{squares: int vector vector, canvasWidth: int, canvasHeight: int}
| SQUARES_LOAD_ERROR
| FILE_BROWSER_AND_PATH of
{fileBrowser: AppType.file_browser_item vector, path: string}
end

View File

@@ -1,2 +0,0 @@
structure UpdateMessage =
struct datatype t = DRAW of DrawMessage.t | FILE of FileMessage.t end

View File

@@ -1,28 +0,0 @@
$(SML_LIB)/basis/basis.mlb
(* FUNCTIONAL CORE *)
fcore/app-type.sml
ann
"allowVectorExps true"
in
fcore/ndc.sml
fcore/graph-lines.sml
end
fcore/click-points.sml
fcore/app-init.sml
fcore/app-with.sml
message-types/draw-msg.sml
message-types/file-msg.sml
message-types/input-msg.sml
message-types/update-msg.sml
fcore/quad-tree.sml
fcore/common-update.sml
fcore/normal-mode.sml
fcore/browse-mode.sml
fcore/app-update.sml