begin merging files which were previously in temp-squares directory into main
This commit is contained in:
88
fcore/app-init.sml
Normal file
88
fcore/app-init.sml
Normal file
@@ -0,0 +1,88 @@
|
||||
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
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
) : app_type =
|
||||
let
|
||||
val xClickPoints = ClickPoints.generate (wStart, wFinish, canvasWidth)
|
||||
val yClickPoints = ClickPoints.generate (hStart, hFinish, canvasHeight)
|
||||
|
||||
val maxPoints = Int.max (canvasWidth, canvasHeight) + 1
|
||||
val squares = Vector.tabulate (maxPoints, fn _ =>
|
||||
Vector.tabulate (maxPoints, fn _ => 0))
|
||||
in
|
||||
{ mode = AppType.NORMAL_MODE
|
||||
, squares = squares
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, 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
|
||||
, modalNum = 0
|
||||
}
|
||||
end
|
||||
|
||||
fun fromWindowWidthAndHeight
|
||||
(windowWidth, windowHeight, canvasWidth, canvasHeight) =
|
||||
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
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
)
|
||||
end
|
||||
else
|
||||
let
|
||||
val difference = windowHeight - windowWidth
|
||||
val hStart = difference div 2
|
||||
val hFinish = hStart + windowWidth
|
||||
in
|
||||
helpFromWidthAndHeight
|
||||
( windowWidth
|
||||
, windowHeight
|
||||
, 0
|
||||
, windowWidth
|
||||
, hStart
|
||||
, hFinish
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
)
|
||||
end
|
||||
end
|
||||
35
fcore/app-type.sml
Normal file
35
fcore/app-type.sml
Normal file
@@ -0,0 +1,35 @@
|
||||
structure AppType =
|
||||
struct
|
||||
datatype app_mode = NORMAL_MODE | BROWSE_MODE
|
||||
|
||||
datatype file_browser_item = IS_FILE of string | IS_FOLDER of string
|
||||
|
||||
type app_type =
|
||||
{ mode: app_mode
|
||||
, squares: int vector vector
|
||||
, canvasWidth: int
|
||||
, canvasHeight: int
|
||||
, windowWidth: int
|
||||
, windowHeight: int
|
||||
, xClickPoints: Real32.real vector
|
||||
, yClickPoints: Real32.real vector
|
||||
|
||||
(* undo and redo commented out temporarily
|
||||
, 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
|
||||
, modalNum: int
|
||||
}
|
||||
end
|
||||
9
fcore/app-update.sml
Normal file
9
fcore/app-update.sml
Normal file
@@ -0,0 +1,9 @@
|
||||
structure AppUpdate =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
fun update (model: app_type, inputMsg) =
|
||||
case #mode model of
|
||||
NORMAL_MODE => NormalMode.update (model, inputMsg)
|
||||
| BROWSE_MODE => BrowseMode.update (model, inputMsg)
|
||||
end
|
||||
703
fcore/app-with.sml
Normal file
703
fcore/app-with.sml
Normal file
@@ -0,0 +1,703 @@
|
||||
structure AppWith =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
fun addSquare (app, newX, newY, arrowX, arrowY) : app_type =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, squares
|
||||
, arrowX = _
|
||||
, arrowY = _
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
|
||||
, showGraph
|
||||
, mouseX
|
||||
, mouseY
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
|
||||
val squares =
|
||||
Vector.mapi
|
||||
(fn (idx, el) =>
|
||||
if idx = newX then
|
||||
Vector.mapi (fn (iidx, iel) => if iidx = newY then 1 else iel) el
|
||||
else
|
||||
el) squares
|
||||
in
|
||||
{ mode = mode
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun arrowX (app, arrowX) =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, squares
|
||||
, arrowX = _
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
|
||||
, showGraph
|
||||
, mouseX
|
||||
, mouseY
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
in
|
||||
{ mode = mode
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun arrowY (app, arrowY) =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY = _
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
|
||||
, showGraph
|
||||
, mouseX
|
||||
, mouseY
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
in
|
||||
{ mode = mode
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun helpWindowResize
|
||||
(app: app_type, windowWidth, windowHeight, wStart, wFinish, hStart, hFinish) :
|
||||
app_type =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, xClickPoints = _
|
||||
, yClickPoints = _
|
||||
, windowWidth = _
|
||||
, windowHeight = _
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, mouseX
|
||||
, mouseY
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
|
||||
val maxPoints = Int.max (canvasWidth, canvasHeight) + 1
|
||||
val xClickPoints = ClickPoints.generate (wStart, wFinish, maxPoints)
|
||||
val yClickPoints = ClickPoints.generate (hStart, hFinish, maxPoints)
|
||||
in
|
||||
{ mode = mode
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
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 = _
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
in
|
||||
{ mode = mode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun graphVisibility (app: app_type, shouldShowGraph) =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, mouseX
|
||||
, mouseY
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph = _
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
in
|
||||
{ mode = mode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = shouldShowGraph
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun mode (app: app_type, newMode) =
|
||||
let
|
||||
val
|
||||
{ mode = _
|
||||
, mouseX
|
||||
, mouseY
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
in
|
||||
{ mode = newMode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun fileBrowserAndPath (app: app_type, fileBrowser, path) =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, mouseX
|
||||
, mouseY
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, openFilePath = _
|
||||
, fileBrowser = _
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
in
|
||||
{ mode = mode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, openFilePath = path
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = 0
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun fileBrowserIdx (app: app_type, newFileBrowserIdx) =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, mouseX
|
||||
, mouseY
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx = _
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
in
|
||||
{ mode = mode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = newFileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun modalNum (app: app_type, newNum) : app_type =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, mouseX
|
||||
, mouseY
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b
|
||||
, modalNum = _
|
||||
} = app
|
||||
in
|
||||
{ mode = mode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = newNum
|
||||
}
|
||||
end
|
||||
|
||||
fun modalNumToFloat num = Real32.fromInt num / 255.0
|
||||
|
||||
fun r (app: app_type) : app_type =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, mouseX
|
||||
, mouseY
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r = _
|
||||
, g
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
|
||||
val r = modalNumToFloat modalNum
|
||||
in
|
||||
{ mode = mode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun g (app: app_type) : app_type =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, mouseX
|
||||
, mouseY
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g = _
|
||||
, b
|
||||
, modalNum
|
||||
} = app
|
||||
|
||||
val g = modalNumToFloat modalNum
|
||||
in
|
||||
{ mode = mode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
fun b (app: app_type) : app_type =
|
||||
let
|
||||
val
|
||||
{ mode
|
||||
, mouseX
|
||||
, mouseY
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, windowWidth
|
||||
, windowHeight
|
||||
, squares
|
||||
, arrowX
|
||||
, arrowY
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
|
||||
, showGraph
|
||||
, openFilePath
|
||||
, fileBrowser
|
||||
, fileBrowserIdx
|
||||
, r
|
||||
, g
|
||||
, b = _
|
||||
, modalNum
|
||||
} = app
|
||||
|
||||
val b = modalNumToFloat modalNum
|
||||
in
|
||||
{ mode = mode
|
||||
, mouseX = mouseX
|
||||
, mouseY = mouseY
|
||||
, squares = squares
|
||||
, arrowX = arrowX
|
||||
, arrowY = arrowY
|
||||
, canvasWidth = canvasWidth
|
||||
, canvasHeight = canvasHeight
|
||||
, windowWidth = windowWidth
|
||||
, windowHeight = windowHeight
|
||||
, xClickPoints = xClickPoints
|
||||
, yClickPoints = yClickPoints
|
||||
|
||||
, showGraph = showGraph
|
||||
, openFilePath = openFilePath
|
||||
, fileBrowser = fileBrowser
|
||||
, fileBrowserIdx = fileBrowserIdx
|
||||
, r = r
|
||||
, g = g
|
||||
, b = b
|
||||
, modalNum = modalNum
|
||||
}
|
||||
end
|
||||
|
||||
(* todo:
|
||||
fun useSquaresAndSetNormalMode (app: app_type, squares, canvasWidth, canvasHeight) =
|
||||
*)
|
||||
end
|
||||
167
fcore/browse-mode.sml
Normal file
167
fcore/browse-mode.sml
Normal file
@@ -0,0 +1,167 @@
|
||||
structure BrowseMode =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
open DrawMessage
|
||||
open FileMessage
|
||||
open InputMessage
|
||||
open UpdateMessage
|
||||
|
||||
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 update (model: app_type, inputMsg) =
|
||||
case inputMsg of
|
||||
ARROW_UP => browseModeArrowUp model
|
||||
| ARROW_DOWN => browseModeArrowDown 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)
|
||||
| SQUARES_LOAD_ERROR => CommonUpdate.squaresLoadError model
|
||||
| USE_SQUARES squares =>
|
||||
CommonUpdate.useSquaresInNormalMode (model, squares)
|
||||
| _ => (model, [])
|
||||
end
|
||||
70
fcore/click-points.sml
Normal file
70
fcore/click-points.sml
Normal file
@@ -0,0 +1,70 @@
|
||||
structure ClickPoints =
|
||||
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
|
||||
|
||||
fun getClickPos (clickPoints, mousePos, idx) =
|
||||
let
|
||||
val nextIdx = idx + 1
|
||||
in
|
||||
if nextIdx >= Vector.length clickPoints then
|
||||
NONE
|
||||
else
|
||||
let
|
||||
val curPos = Vector.sub (clickPoints, idx)
|
||||
val nextPos = Vector.sub (clickPoints, nextIdx)
|
||||
in
|
||||
if mousePos >= curPos andalso mousePos <= nextPos then SOME idx
|
||||
else getClickPos (clickPoints, mousePos, idx + 1)
|
||||
end
|
||||
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
|
||||
end
|
||||
13
fcore/common-update.sml
Normal file
13
fcore/common-update.sml
Normal file
@@ -0,0 +1,13 @@
|
||||
structure CommonUpdate =
|
||||
struct
|
||||
(* unimplemented *)
|
||||
fun getSaveSquaresMsg model = (model, [])
|
||||
|
||||
fun getLoadSquaresMsg model = (model, [])
|
||||
|
||||
fun getExportSquaresMsg model = (model, [])
|
||||
|
||||
fun useSquaresInNormalMode (model, squares) = (model, [])
|
||||
|
||||
fun squaresLoadError model = (model, [])
|
||||
end
|
||||
142
fcore/graph-lines.sml
Normal file
142
fcore/graph-lines.sml
Normal file
@@ -0,0 +1,142 @@
|
||||
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 vec =
|
||||
#[ (* x = _.1 *)
|
||||
pos - 0.001, ~1.0
|
||||
, pos + 0.001, ~1.0
|
||||
, pos + 0.001, 1.0
|
||||
|
||||
, pos + 0.001, 1.0
|
||||
, pos - 0.001, 1.0
|
||||
, pos - 0.001, ~1.0
|
||||
|
||||
(* y = _.1 *)
|
||||
, ~1.0, pos - 0.001
|
||||
, ~1.0, pos + 0.001
|
||||
, 1.0, pos + 0.001
|
||||
|
||||
, 1.0, pos + 0.001
|
||||
, 1.0, pos - 0.001
|
||||
, ~1.0, pos - 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 acc =
|
||||
#[
|
||||
ndc - 0.001, yMin
|
||||
, ndc + 0.001, yMin
|
||||
, ndc + 0.001, yMax
|
||||
|
||||
, ndc + 0.001, yMax
|
||||
, ndc - 0.001, yMax
|
||||
, ndc - 0.001, yMin
|
||||
] :: 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 acc =
|
||||
#[
|
||||
xMin, ndc - 0.001
|
||||
, xMin, ndc + 0.001
|
||||
, xMax, ndc + 0.001
|
||||
|
||||
, xMax, ndc + 0.001
|
||||
, xMax, ndc - 0.001
|
||||
, xMin, ndc - 0.001
|
||||
] :: 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
|
||||
56
fcore/ndc.sml
Normal file
56
fcore/ndc.sml
Normal file
@@ -0,0 +1,56 @@
|
||||
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
|
||||
]
|
||||
|
||||
fun fromPixelX (xpos, windowWidth, windowHeight) =
|
||||
let
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
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 fromPixelY (ypos, windowWidth, windowHeight) =
|
||||
let
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
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
|
||||
284
fcore/normal-mode.sml
Normal file
284
fcore/normal-mode.sml
Normal file
@@ -0,0 +1,284 @@
|
||||
structure NormalMode =
|
||||
struct
|
||||
open AppType
|
||||
|
||||
open DrawMessage
|
||||
open FileMessage
|
||||
open InputMessage
|
||||
open UpdateMessage
|
||||
|
||||
fun getDotVecFromIndices (model: app_type, hIdx, vIdx) =
|
||||
let
|
||||
val {windowWidth, windowHeight, xClickPoints, yClickPoints, ...} = model
|
||||
val xpos = Vector.sub (xClickPoints, hIdx)
|
||||
val ypos = Vector.sub (yClickPoints, vIdx)
|
||||
|
||||
val endXpos =
|
||||
if hIdx + 1 = Vector.length xClickPoints then xpos
|
||||
else Vector.sub (xClickPoints, hIdx + 1)
|
||||
|
||||
val endYpos =
|
||||
if vIdx + 1 = Vector.length yClickPoints then ypos
|
||||
else Vector.sub (yClickPoints, vIdx + 1)
|
||||
|
||||
val tl = ClickPoints.getDrawDotRgb
|
||||
(xpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
|
||||
val tr = ClickPoints.getDrawDotRgb
|
||||
(endXpos, ypos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
|
||||
val bl = ClickPoints.getDrawDotRgb
|
||||
(xpos, endYpos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
|
||||
val br = ClickPoints.getDrawDotRgb
|
||||
(endXpos, endYpos, 0.0, 0.0, 1.0, windowWidth, windowHeight)
|
||||
in
|
||||
Vector.concat [tl, tr, bl, br]
|
||||
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 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 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 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 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 - 2 then
|
||||
let
|
||||
val newArrowX = arrowX + 1
|
||||
val model = AppWith.arrowX (model, newArrowX)
|
||||
|
||||
val dotVec = getDotVecFromIndices (model, newArrowX, arrowY)
|
||||
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 - 2 then
|
||||
let
|
||||
val newArrowY = arrowY + 1
|
||||
val model = AppWith.arrowY (model, newArrowY)
|
||||
|
||||
val dotVec = getDotVecFromIndices (model, arrowX, newArrowY)
|
||||
val drawMsg = DRAW_DOT dotVec
|
||||
val drawMsg = [DRAW drawMsg]
|
||||
in
|
||||
(model, drawMsg)
|
||||
end
|
||||
else
|
||||
getDrawDotMsgWhenArrowIsAtBoundary model
|
||||
end
|
||||
|
||||
fun realToInt x = Real32.toInt IEEEReal.TO_NEAREST x
|
||||
|
||||
fun addCoordinates (model: app_type, hIdx, vIdx) =
|
||||
let
|
||||
val
|
||||
{ windowWidth
|
||||
, windowHeight
|
||||
, xClickPoints
|
||||
, yClickPoints
|
||||
, canvasWidth
|
||||
, canvasHeight
|
||||
, ...
|
||||
} = model
|
||||
|
||||
val xpos = Vector.sub (xClickPoints, hIdx)
|
||||
val ypos = Vector.sub (yClickPoints, vIdx)
|
||||
|
||||
val model = AppWith.addSquare
|
||||
(model, realToInt xpos, realToInt ypos, hIdx, vIdx)
|
||||
val squares = #squares model
|
||||
|
||||
val dotVec = getDotVecFromIndices (model, hIdx, vIdx)
|
||||
|
||||
val halfWidth = Real32.fromInt (windowWidth div 2)
|
||||
val halfHeight = Real32.fromInt (windowHeight div 2)
|
||||
|
||||
val maxSide = Int.max (canvasWidth, canvasHeight)
|
||||
val squares =
|
||||
CollisionTree.toTriangles (windowWidth, windowHeight, squares, maxSide)
|
||||
val drawMsg = DRAW_SQUARES_AND_DOTS {squares = squares, dots = dotVec}
|
||||
in
|
||||
(model, [DRAW drawMsg])
|
||||
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 {squares, canvasWidth, canvasHeight, showGraph, arrowX, arrowY, ...} =
|
||||
model
|
||||
val maxSide = Int.max (canvasWidth, canvasHeight)
|
||||
|
||||
val squares = CollisionTree.toTriangles (width, height, squares, maxSide)
|
||||
|
||||
val graphLines =
|
||||
if showGraph then GraphLines.generate model else Vector.fromList []
|
||||
|
||||
val dots = getDotVecFromIndices (model, arrowX, arrowY)
|
||||
|
||||
val drawMsg =
|
||||
RESIZE_SQUARES_DOTS_AND_GRAPH
|
||||
{squares = squares, graphLines = graphLines, dots = dots}
|
||||
val drawMsg = [DRAW drawMsg]
|
||||
in
|
||||
(model, drawMsg)
|
||||
end
|
||||
|
||||
fun undoAction model = (model, [])
|
||||
|
||||
fun redoAction model = (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 = #modalNum model
|
||||
val newNum = oldNum * 10 + inputNum
|
||||
val newNum = if newNum > 255 then 0 else newNum
|
||||
in
|
||||
(AppWith.modalNum (model, newNum), [])
|
||||
end
|
||||
|
||||
fun updateRed model = (AppWith.r model, [])
|
||||
fun updateGreen model = (AppWith.g model, [])
|
||||
fun updateBlue model = (AppWith.b 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 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
|
||||
| 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 => CommonUpdate.getSaveSquaresMsg model
|
||||
| KEY_CTRL_L => CommonUpdate.getLoadSquaresMsg model
|
||||
| KEY_CTRL_E => CommonUpdate.getExportSquaresMsg model
|
||||
| USE_SQUARES squares =>
|
||||
CommonUpdate.useSquaresInNormalMode (model, squares)
|
||||
| SQUARES_LOAD_ERROR => CommonUpdate.squaresLoadError 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
|
||||
| FILE_BROWSER_AND_PATH {fileBrowser, path} =>
|
||||
handleFileBrowserAndPathInNormalMode (model, fileBrowser, path)
|
||||
end
|
||||
5
fcore/parse-file.sml
Normal file
5
fcore/parse-file.sml
Normal file
@@ -0,0 +1,5 @@
|
||||
structure ParseFile =
|
||||
struct
|
||||
(* unimplemented *)
|
||||
fun parseLine line = NONE
|
||||
end
|
||||
272
fcore/quad-tree.sml
Normal file
272
fcore/quad-tree.sml
Normal file
@@ -0,0 +1,272 @@
|
||||
structure BinTree =
|
||||
struct
|
||||
datatype 'a bintree =
|
||||
NODE of
|
||||
{ x: int
|
||||
, y: int
|
||||
, ex: int
|
||||
, ey: int
|
||||
, data: 'a
|
||||
, left: 'a bintree
|
||||
, right: 'a bintree
|
||||
}
|
||||
| LEAF
|
||||
|
||||
val empty = LEAF
|
||||
|
||||
fun insert (newItem as {x, y, ex, ey, data}, tree) =
|
||||
case tree of
|
||||
LEAF =>
|
||||
NODE
|
||||
{ x = x
|
||||
, y = y
|
||||
, ex = ex
|
||||
, ey = ey
|
||||
, data = data
|
||||
, left = LEAF
|
||||
, right = LEAF
|
||||
}
|
||||
| NODE {x = ox, y = oy, ex = oex, ey = oey, data = oldData, left, right} =>
|
||||
let
|
||||
val dir =
|
||||
if x < ox then LESS
|
||||
else if x > ox then GREATER
|
||||
else if y < oy then LESS
|
||||
else if y > oy then GREATER
|
||||
else if ex < oex then LESS
|
||||
else if ex > oex then GREATER
|
||||
else if ey < oey then LESS
|
||||
else if ey > oey then GREATER
|
||||
else EQUAL
|
||||
in
|
||||
case dir of
|
||||
LESS =>
|
||||
NODE
|
||||
{ left = insert (newItem, left)
|
||||
, right = right
|
||||
, x = ox
|
||||
, y = oy
|
||||
, ex = oex
|
||||
, ey = oey
|
||||
, data = oldData
|
||||
}
|
||||
| GREATER =>
|
||||
NODE
|
||||
{ right = insert (newItem, right)
|
||||
, left = left
|
||||
, x = ox
|
||||
, y = oy
|
||||
, ex = oex
|
||||
, ey = oey
|
||||
, data = oldData
|
||||
}
|
||||
| EQUAL =>
|
||||
NODE
|
||||
{ left = left
|
||||
, right = right
|
||||
, x = x
|
||||
, y = y
|
||||
, ex = ex
|
||||
, ey = ey
|
||||
, data = data
|
||||
}
|
||||
end
|
||||
|
||||
fun toList (tree, acc) =
|
||||
case tree of
|
||||
NODE {x, y, ex, ey, data, left, right} =>
|
||||
let
|
||||
val acc = toList (right, acc)
|
||||
val acc = {x = x, y = y, ex = ex, ey = ey, data = data} :: acc
|
||||
in
|
||||
toList (left, acc)
|
||||
end
|
||||
| LEAF => acc
|
||||
end
|
||||
|
||||
structure CollisionTree =
|
||||
struct
|
||||
(* functions to check individual collisions *)
|
||||
fun isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy) =
|
||||
ix < cfx andalso ifx > cx andalso iy < cfy andalso ify > cy
|
||||
|
||||
fun isCollidingPlus (ix, iy, iw, ih, cx, cy, cw, ch) =
|
||||
let
|
||||
val ifx = ix + iw
|
||||
val ify = iy + ih
|
||||
val cfx = cx + cw
|
||||
val cfy = cy + ch
|
||||
in
|
||||
isColliding (ix, iy, ifx, ify, cx, cy, cfx, cfy)
|
||||
end
|
||||
|
||||
fun isCollidingItem (iX, iY, iW, iH, checkWith) =
|
||||
let val {x = cX, y = cY, w = cW, h = cH} = checkWith
|
||||
in isCollidingPlus (iX, iY, iW, iH, cX, cY, cW, cH)
|
||||
end
|
||||
|
||||
fun visitTopLeft (iX, iY, qX, qY, size) =
|
||||
let
|
||||
val half = size div 2
|
||||
|
||||
val qmx = qX + half
|
||||
val qmy = qY + half
|
||||
in
|
||||
iX >= qX andalso iX <= qmx andalso iY >= qY andalso iY <= qmy
|
||||
end
|
||||
|
||||
fun visitTopRight (iX, iY, qX, qY, size) =
|
||||
let
|
||||
val half = size div 2
|
||||
|
||||
val qmx = qX + half
|
||||
val qmy = qY + half - 1
|
||||
|
||||
val qfx = qX + size
|
||||
in
|
||||
iX >= qmx andalso iX <= qfx andalso iY >= qY andalso iY <= qmy
|
||||
end
|
||||
|
||||
fun visitBottomLeft (iX, iY, qX, qY, size) =
|
||||
let
|
||||
val half = size div 2
|
||||
|
||||
val qmx = qX + half - 1
|
||||
val qmy = qY + half
|
||||
|
||||
val qfy = qY + size
|
||||
in
|
||||
iX >= qX andalso iX <= qmx andalso iY >= qmy andalso iY <= qfy
|
||||
end
|
||||
|
||||
fun visitBottomRight (iX, iY, qX, qY, size) =
|
||||
let
|
||||
val half = size div 2
|
||||
|
||||
val qmx = qX + half
|
||||
val qmy = qY + half
|
||||
|
||||
val qfx = qX + size
|
||||
val qfy = qY + size
|
||||
in
|
||||
iX >= qmx andalso iX <= qfx andalso iY >= qmy andalso iY <= qfy
|
||||
end
|
||||
|
||||
(* types for tree *)
|
||||
datatype 'a tree =
|
||||
NODE of {tl: 'a tree, tr: 'a tree, bl: 'a tree, br: 'a tree}
|
||||
| LEAF of {x: int, y: int, ex: int, ey: int, data: 'a}
|
||||
|
||||
type 'a t = {tree: 'a tree, size: int}
|
||||
|
||||
local
|
||||
fun loopYAxis (x, y, eX, eY, yAxis, col) =
|
||||
if y > eY then
|
||||
true
|
||||
else
|
||||
let
|
||||
val newCol = Vector.sub (yAxis, y)
|
||||
in
|
||||
if col = newCol then loopYAxis (x, y + 1, eX, eY, yAxis, col)
|
||||
else false
|
||||
end
|
||||
|
||||
fun loopColour (x, y, eX, eY, grid, col) =
|
||||
if x > eX then
|
||||
true
|
||||
else
|
||||
let
|
||||
val yAxis = Vector.sub (grid, x)
|
||||
in
|
||||
if loopYAxis (x, y, eX, eY, yAxis, col) then
|
||||
loopColour (x + 1, y, eX, eY, grid, col)
|
||||
else
|
||||
false
|
||||
end
|
||||
in
|
||||
fun quadHasSameColour (startX, startY, endX, endY, grid) =
|
||||
let
|
||||
val yAxis = Vector.sub (grid, startX)
|
||||
val col = Vector.sub (yAxis, startY)
|
||||
in
|
||||
loopColour (startX, startY, endX, endY, grid, col)
|
||||
end
|
||||
end
|
||||
|
||||
(* tree creation/insertion/query functions *)
|
||||
fun build (x, y, size, grid) =
|
||||
if quadHasSameColour (x, y, x + size, y + size, grid) then
|
||||
let
|
||||
val yAxis = Vector.sub (grid, x)
|
||||
val data = Vector.sub (yAxis, y)
|
||||
in
|
||||
LEAF {x = x, y = y, ex = x + size, ey = y + size, data = data}
|
||||
end
|
||||
else
|
||||
let
|
||||
val halfSize = size div 2
|
||||
val tl = build (x, y, halfSize, grid)
|
||||
val tr = build (x + halfSize, y, halfSize, grid)
|
||||
val bl = build (x, y + halfSize, halfSize, grid)
|
||||
val br = build (x + halfSize, y + halfSize, halfSize, grid)
|
||||
in
|
||||
NODE {tl = tl, bl = bl, tr = tr, br = br}
|
||||
end
|
||||
|
||||
fun foldWithDuplicates (f, tree, acc) =
|
||||
case tree of
|
||||
LEAF item => f (item, acc)
|
||||
| NODE {tl, tr, bl, br} =>
|
||||
let
|
||||
val acc = foldWithDuplicates (f, tl, acc)
|
||||
val acc = foldWithDuplicates (f, tr, acc)
|
||||
val acc = foldWithDuplicates (f, bl, acc)
|
||||
in
|
||||
foldWithDuplicates (f, br, acc)
|
||||
end
|
||||
|
||||
fun insertItemIntoTree (item, acc) =
|
||||
if #data item = 0 then
|
||||
(* ignore specific data by not inserting it into tree.
|
||||
* May later functorise this quad tree,
|
||||
* and allow different types of data
|
||||
* to be ignored/stored in #data field. *)
|
||||
acc
|
||||
else
|
||||
BinTree.insert (item, acc)
|
||||
|
||||
fun toList qtree =
|
||||
let val tree = foldWithDuplicates (insertItemIntoTree, qtree, BinTree.empty)
|
||||
in BinTree.toList (tree, [])
|
||||
end
|
||||
|
||||
local
|
||||
fun loop (windowWidth, windowHeight, squares, acc) =
|
||||
case squares of
|
||||
{x, y, ex, ey, data = _} :: tl =>
|
||||
let
|
||||
val x = Real32.fromInt x
|
||||
val y = Real32.fromInt y
|
||||
val ex = Real32.fromInt ex
|
||||
val ey = Real32.fromInt ey
|
||||
|
||||
val startX = Ndc.fromPixelX (x, windowWidth, windowHeight)
|
||||
val endX = Ndc.fromPixelX (ex, windowWidth, windowHeight)
|
||||
val startY = Ndc.fromPixelY (y, windowWidth, windowHeight)
|
||||
val endY = Ndc.fromPixelY (ey, windowWidth, windowHeight)
|
||||
|
||||
val acc = Ndc.ltrbToVertex (startX, startY, endX, endY) :: acc
|
||||
in
|
||||
loop (windowWidth, windowHeight, tl, acc)
|
||||
end
|
||||
| [] => Vector.concat acc
|
||||
in
|
||||
fun toTriangles (windowWidth, windowHeight, squares, size) =
|
||||
let
|
||||
val qtree = build (0, 0, size, squares)
|
||||
val squares = toList qtree
|
||||
in
|
||||
loop (windowWidth, windowHeight, squares, [])
|
||||
end
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user