refactor file thread

This commit is contained in:
2025-07-06 15:06:00 +01:00
parent 2e0549097e
commit dd291096d5
2 changed files with 10 additions and 160 deletions

View File

@@ -31,6 +31,7 @@ fcore/app-update.sml
fcore/parse-file.sml
(* IMPERATIVE SHELL *)
$(SML_LIB)/basis/mlton.mlb
$(SML_LIB)/cml/cml.mlb
ann

View File

@@ -8,7 +8,7 @@ struct
open FileMessage
open InputMessage
datatype parse_result = OK of AppType.triangle list | PARSE_ERROR
datatype parse_result = OK of unit | PARSE_ERROR
val structureName = "Green"
val filename = "green.dsc"
@@ -45,164 +45,13 @@ struct
in if String.isSubstring "." col then col else col ^ ".0"
end
fun helpExportTriangles (io, triangles) =
case triangles of
{x1, y1, x2, y2, x3, y3, r, g, b} :: tl =>
let
val x1 = ndcToLerpX x1
val x2 = ndcToLerpX x2
val x3 = ndcToLerpX x3
fun exportSquares squares = ()
val y1 = ndcToLerpY y1
val y2 = ndcToLerpY y2
val y3 = ndcToLerpY y3
fun parse (io, acc) = ()
val r = colToString r
val g = colToString g
val b = colToString b
fun loadSquares (path, inputMailbox) = ()
val line = String.concat
[ x1
, ",\n"
, y1
, ",\n"
, r
, ",\n"
, g
, ",\n"
, b
, ",\n"
, x2
, ",\n"
, y2
, ",\n"
, r
, ",\n"
, g
, ",\n"
, b
, ",\n"
, x3
, ",\n"
, y3
, ",\n"
, r
, ",\n"
, g
, ",\n"
, b
, case tl of
[] => "\n"
| _ => ",\n"
]
val _ = TextIO.output (io, line)
in
helpExportTriangles (io, tl)
end
| [] => ()
fun exportTriangles triangles =
let
val io = TextIO.openOut exportFilename
val fileStartString =
String.concat ["structure ", structureName, " =\nstruct\n"]
val _ = TextIO.output (io, fileStartString)
val functionStartString =
" fun lerp (startX, startY, drawWidth, drawHeight, windowWidth, windowHeight) : Real32.real vector =\n\
\ let\n\
\ val endY = windowHeight - startY\n\
\ val startY = windowHeight - (startY + drawHeight)\n\
\ val endX = startX + drawWidth\n\
\ val windowHeight = windowHeight / 2.0\n\
\ val windowWidth = windowWidth / 2.0\n\
\ in\n\
\ #["
val _ = TextIO.output (io, functionStartString)
val _ = helpExportTriangles (io, triangles)
val _ = TextIO.output (io, " ]\n end\nend")
val _ = TextIO.closeOut io
in
()
end
fun parse (io, acc) =
case TextIO.inputLine io of
SOME line =>
let
val line = ParseFile.parseLine line
in
(case line of
SOME tri => parse (io, tri :: acc)
| NONE => PARSE_ERROR)
end
| NONE => let val triangles = List.rev acc in OK triangles end
fun loadTriangles (path, inputMailbox) =
let
val io = TextIO.openIn path
val triangles = parse (io, [])
val _ = TextIO.closeIn io
val inputMsg =
case triangles of
OK triangles => USE_TRIANGLES triangles
| PARSE_ERROR =>
let val _ = print "parse error\n"
in TRIANGLES_LOAD_ERROR
end
in
Mailbox.send (inputMailbox, inputMsg)
end
fun helpSaveTriangles (triangles, io) =
case triangles of
{x1, y1, x2, y2, x3, y3, r, g, b} :: tl =>
let
val triString = String.concat
[ "x "
, Real32.toString x1
, " y "
, Real32.toString y1
, " x "
, Real32.toString x2
, " y "
, Real32.toString y2
, " x "
, Real32.toString x3
, " y "
, Real32.toString y3
, " r "
, Real32.toString r
, " g "
, Real32.toString g
, " b "
, Real32.toString b
, "\n"
]
val _ = TextIO.output (io, triString)
in
helpSaveTriangles (tl, io)
end
| [] => ()
fun saveTriangles triangles =
let
val io = TextIO.openOut filename
val _ = helpSaveTriangles (triangles, io)
val _ = TextIO.closeOut io
in
()
end
fun saveSquares squares = ()
fun getDirList (dir, acc, rootPath) =
case OS.FileSys.readDir dir of
@@ -232,15 +81,15 @@ struct
fun selectPath (path, inputMailbox) =
if OS.FileSys.isDir path then loadFiles (path, inputMailbox)
else loadTriangles (path, inputMailbox)
else loadSquares (path, inputMailbox)
fun run (fileMailbox, inputMailbox) =
let
val _ =
case Mailbox.recv fileMailbox of
SAVE_TRIANGLES triangles => saveTriangles triangles
| LOAD_TRIANGLES => loadTriangles (filename, inputMailbox)
| EXPORT_TRIANGLES triangles => exportTriangles triangles
SAVE_SQUARES triangles => saveSquares triangles
| LOAD_SQUARES => loadSquares (filename, inputMailbox)
| EXPORT_SQUARES triangles => exportSquares triangles
| LOAD_FILES path => loadFiles (path, inputMailbox)
| SELECT_PATH path => selectPath (path, inputMailbox)
in