add refactored message types to temp folder
This commit is contained in:
88
temp-squares/fcore/app-init.sml
Normal file
88
temp-squares/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
temp-squares/fcore/app-type.sml
Normal file
35
temp-squares/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
|
||||
703
temp-squares/fcore/app-with.sml
Normal file
703
temp-squares/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
|
||||
12
temp-squares/fcore/click-points.sml
Normal file
12
temp-squares/fcore/click-points.sml
Normal file
@@ -0,0 +1,12 @@
|
||||
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
|
||||
end
|
||||
142
temp-squares/fcore/graph-lines.sml
Normal file
142
temp-squares/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
|
||||
237
temp-squares/fcore/quad-tree.sml
Normal file
237
temp-squares/fcore/quad-tree.sml
Normal file
@@ -0,0 +1,237 @@
|
||||
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) =
|
||||
BinTree.insert (item, acc)
|
||||
|
||||
fun toList qtree =
|
||||
let
|
||||
val tree = foldWithDuplicates (insertItemIntoTree, qtree, BinTree.empty)
|
||||
in
|
||||
BinTree.toList (tree, [])
|
||||
end
|
||||
end
|
||||
Reference in New Issue
Block a user