diff --git a/dotscape b/dotscape index 3b37518..1da63a3 100755 Binary files a/dotscape and b/dotscape differ diff --git a/functional-core/app/app-init.sml b/functional-core/app/app-init.sml index ca9856e..d37ab10 100644 --- a/functional-core/app/app-init.sml +++ b/functional-core/app/app-init.sml @@ -35,6 +35,8 @@ struct , showGraph = true , arrowX = 0 , arrowY = 0 + , openFilePath = "" + , fileBrowser = Vector.fromList [] } end diff --git a/functional-core/app/app-type.sml b/functional-core/app/app-type.sml index 438d399..c19618f 100644 --- a/functional-core/app/app-type.sml +++ b/functional-core/app/app-type.sml @@ -1,6 +1,8 @@ signature APP_TYPE = sig - datatype app_mode = NORMAL_MODE | SAVE_MODE + datatype app_mode = NORMAL_MODE | BROWSE_MODE + + datatype file_browser_item = FILE of string | FOLDER of string datatype triangle_stage = NO_TRIANGLE @@ -33,12 +35,16 @@ sig , mouseY: Real32.real , arrowX: int , arrowY: int + , openFilePath: string + , fileBrowser: file_browser_item vector } end structure AppType :> APP_TYPE = struct - datatype app_mode = NORMAL_MODE | SAVE_MODE + datatype app_mode = NORMAL_MODE | BROWSE_MODE + + datatype file_browser_item = FILE of string | FOLDER of string type triangle = { x1: Real32.real @@ -79,5 +85,7 @@ struct , mouseY: Real32.real , arrowX: int , arrowY: int + , openFilePath: string + , fileBrowser: file_browser_item vector } end diff --git a/functional-core/app/app-update.sml b/functional-core/app/app-update.sml index 381e5d8..be26386 100644 --- a/functional-core/app/app-update.sml +++ b/functional-core/app/app-update.sml @@ -355,7 +355,7 @@ struct fun trianglesLoadError model = (model, NO_MAILBOX) - fun update (model: app_type, inputMsg) = + fun updateNormalMode (model: app_type, inputMsg) = case inputMsg of MOUSE_MOVE {x = mouseX, y = mouseY} => let val model = AppWith.mousePosition (model, mouseX, mouseY) @@ -378,4 +378,7 @@ struct | KEY_SPACE => enterOrSpaceCoordinates model | USE_TRIANGLES triangles => useTriangles (model, triangles) | TRIANGLES_LOAD_ERROR => trianglesLoadError model + + fun update (model: app_type, inputMsg) = + case #mode model of NORMAL_MODE => updateNormalMode (model, inputMsg) end diff --git a/functional-core/app/app-with.sml b/functional-core/app/app-with.sml index ce712f7..18489e8 100644 --- a/functional-core/app/app-with.sml +++ b/functional-core/app/app-with.sml @@ -78,6 +78,8 @@ struct , mouseY , arrowX = _ , arrowY = _ + , openFilePath + , fileBrowser } = app val newUndo = newUndoHd :: undo @@ -97,6 +99,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -120,6 +124,8 @@ struct , mouseY , arrowX = _ , arrowY = _ + , openFilePath + , fileBrowser } = app val newTriangle = {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3} @@ -141,6 +147,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -162,6 +170,8 @@ struct , mouseY , arrowX = _ , arrowY + , openFilePath + , fileBrowser } = app in { mode = mode @@ -179,6 +189,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -200,6 +212,8 @@ struct , mouseY , arrowX , arrowY = _ + , openFilePath + , fileBrowser } = app in { mode = mode @@ -217,6 +231,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -240,6 +256,8 @@ struct , mouseY , arrowX , arrowY + , openFilePath + , fileBrowser } = app val xClickPoints = ClickPoints.generate (wStart, wFinish, numClickPoints) @@ -260,6 +278,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -304,6 +324,8 @@ struct , showGraph , arrowX , arrowY + , openFilePath + , fileBrowser } = app in { mode = mode @@ -321,6 +343,8 @@ struct , showGraph = showGraph , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -343,6 +367,8 @@ struct , mouseY , arrowX , arrowY + , openFilePath + , fileBrowser } = app val newUndo = @@ -367,6 +393,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -389,6 +417,8 @@ struct , mouseY , arrowX , arrowY + , openFilePath + , fileBrowser } = app val newUndo = newUndoHd :: undo @@ -412,6 +442,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -433,6 +465,8 @@ struct , arrowX , arrowY , showGraph = _ + , openFilePath + , fileBrowser } = app in { mode = mode @@ -450,6 +484,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end @@ -471,6 +507,8 @@ struct , arrowY , triangles = _ , triangleStage = _ + , openFilePath + , fileBrowser } = app val triangleStage = NO_TRIANGLE @@ -490,6 +528,8 @@ struct , mouseY = mouseY , arrowX = arrowX , arrowY = arrowY + , openFilePath = openFilePath + , fileBrowser = fileBrowser } end end diff --git a/imperative-shell/file-thread.sml b/imperative-shell/file-thread.sml index 5551cb8..a3df583 100644 --- a/imperative-shell/file-thread.sml +++ b/imperative-shell/file-thread.sml @@ -18,28 +18,26 @@ struct let val num = (num + 1.0) / 2.0 val num = Real32.toString num - val num = + val num = (* Problem: It seems that Real32.toString may sometimes return a string * that is recognised as an integer, like "1" instead of "1.0". * If that happens, we just add a ".0" to the end * so it's recognised as a real. *) - if String.isSubstring "." num - then num + if String.isSubstring "." num then num else num ^ ".0" in - " (((startX * (1.0 - " ^ num ^ ")) + (endX * " ^ num ^ ")) / windowWidth) - 1.0" + " (((startX * (1.0 - " ^ num ^ ")) + (endX * " ^ num + ^ ")) / windowWidth) - 1.0" end fun ndcToLerpY num = let val num = (num + 1.0) / 2.0 val num = Real32.toString num - val num = - if String.isSubstring "." num - then num - else num ^ ".0" + val num = if String.isSubstring "." num then num else num ^ ".0" in - " (((startY * (1.0 - " ^ num ^ ")) + (endY * " ^ num ^ ")) / windowHeight) - 1.0" + " (((startY * (1.0 - " ^ num ^ ")) + (endY * " ^ num + ^ ")) / windowHeight) - 1.0" end fun helpExportTriangles (io, triangles) = @@ -55,10 +53,20 @@ struct val y3 = ndcToLerpY y3 val line = String.concat - [ x1, ",\n", y1, ", r, g, b,\n" - , x2, ",\n", y2, ", r, g, b,\n" - , x3, ",\n", y3 - , case tl of [] => ", r, g, b\n" | _ => ", r, g, b,\n" + [ x1 + , ",\n" + , y1 + , ", r, g, b,\n" + , x2 + , ",\n" + , y2 + , ", r, g, b,\n" + , x3 + , ",\n" + , y3 + , case tl of + [] => ", r, g, b\n" + | _ => ", r, g, b,\n" ] val _ = TextIO.output (io, line) @@ -128,14 +136,20 @@ struct {x1, y1, x2, y2, x3, y3} :: tl => let val triString = String.concat - [ "x ", Real32.toString x1 - , " y ", Real32.toString y1 + [ "x " + , Real32.toString x1 + , " y " + , Real32.toString y1 - , " x ", Real32.toString x2 - , " y ", Real32.toString y2 + , " x " + , Real32.toString x2 + , " y " + , Real32.toString y2 - , " x ", Real32.toString x3 - , " y ", Real32.toString y3 + , " x " + , Real32.toString x3 + , " y " + , Real32.toString y3 , "\n" ] @@ -154,6 +168,30 @@ struct () end + fun getDirList (dir, acc) = + case OS.FileSys.readDir dir of + SOME path => + let + val _ = print (path ^ "\n") + val acc = + if OS.FileSys.isDir path then (AppType.FOLDER path) :: acc + else if OS.FileSys.isLink path then acc + else (AppType.FILE path) :: acc + in + getDirList (dir, acc) + end + | NONE => let val acc = List.rev acc in Vector.fromList acc end + + fun loadFiles (path, inputMailbox) = + let + val path = if String.size path = 0 then OS.FileSys.getDir () else path + val dir = OS.FileSys.openDir path + val dirList = getDirList (dir, []) + val _ = OS.FileSys.closeDir dir + in + () + end + fun run (fileMailbox, inputMailbox) = let val _ = @@ -161,6 +199,7 @@ struct SAVE_TRIANGLES triangles => saveTriangles triangles | LOAD_TRIANGLES => loadTriangles inputMailbox | EXPORT_TRIANGLES triangles => exportTriangles triangles + | LOAD_FILES path => loadFiles (path, inputMailbox) in run (fileMailbox, inputMailbox) end diff --git a/message-types/file-msg.sml b/message-types/file-msg.sml index 963f7ab..2c71251 100644 --- a/message-types/file-msg.sml +++ b/message-types/file-msg.sml @@ -4,6 +4,7 @@ sig SAVE_TRIANGLES of AppType.triangle list | LOAD_TRIANGLES | EXPORT_TRIANGLES of AppType.triangle list + | LOAD_FILES of string end structure FileMessage :> FILE_MESSAGE = @@ -12,4 +13,5 @@ struct SAVE_TRIANGLES of AppType.triangle list | LOAD_TRIANGLES | EXPORT_TRIANGLES of AppType.triangle list + | LOAD_FILES of string end