diff --git a/dotscape b/dotscape index 2ddfc47..8f119fd 100755 Binary files a/dotscape and b/dotscape differ diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index 2c4a659..c3e724b 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -214,6 +214,17 @@ struct fun getLoadTriangleMsg model = (model, FILE LOAD_TRIANGLES) + fun useTriangles (model, triangles) = + let + val model = AppWith.useTriangles (model, triangles) + val drawVec = Triangles.toVector model + val drawMsg = DRAW_TRIANGLES_AND_RESET_DOTS drawVec + in + (model, DRAW drawMsg) + end + + fun trianglesLoadError model = (model, NO_MAILBOX) + fun update (model: app_type, inputMsg) = case inputMsg of MOUSE_MOVE {x = mouseX, y = mouseY} => @@ -228,4 +239,6 @@ struct | KEY_G => toggleGraph model | KEY_CTRL_S => getSaveTrianglesMsg model | KEY_CTRL_L => getLoadTriangleMsg model + | USE_TRIANGLES triangles => useTriangles (model, triangles) + | TRIANGLES_LOAD_ERROR => trianglesLoadError model end diff --git a/functional-core/app-with.sml b/functional-core/app-with.sml index d784dda..169cf51 100644 --- a/functional-core/app-with.sml +++ b/functional-core/app-with.sml @@ -40,6 +40,8 @@ sig * Real32.real * (Real32.real * Real32.real) -> AppType.app_type + + val useTriangles: AppType.app_type * AppType.triangle list -> AppType.app_type end structure AppWith :> APP_WITH = @@ -306,4 +308,36 @@ struct , mouseY = mouseY } end + + fun useTriangles (app: app_type, triangles) = + let + val + { xClickPoints + , yClickPoints + , windowWidth + , windowHeight + , undo + , redo + , mouseX + , mouseY + , showGraph + , triangles = _ + , triangleStage = _ + } = app + + val triangleStage = NO_TRIANGLE + in + { triangleStage = triangleStage + , triangles = triangles + , undo = [] + , redo = [] + , showGraph = showGraph + , xClickPoints = xClickPoints + , yClickPoints = yClickPoints + , windowWidth = windowWidth + , windowHeight = windowHeight + , mouseX = mouseX + , mouseY = mouseY + } + end end diff --git a/imperative-shell/file-thread.sml b/imperative-shell/file-thread.sml index 9eedf70..822df0e 100644 --- a/imperative-shell/file-thread.sml +++ b/imperative-shell/file-thread.sml @@ -1,12 +1,13 @@ signature FILE_THREAD = sig - val run: FileMessage.t Mailbox.mbox -> unit + val run: FileMessage.t Mailbox.mbox * InputMessage.t Mailbox.mbox -> unit end structure FileThread :> FILE_THREAD = struct open AppType open FileMessage + open InputMessage val filename = "a.dsc" @@ -72,15 +73,18 @@ struct end | NONE => let val triangles = List.rev acc in OK triangles end - fun loadTriangles () = + fun loadTriangles inputMailbox = let val io = TextIO.openIn filename val triangles = parse (io, []) val _ = TextIO.closeIn io + + val inputMsg = + case triangles of + OK triangles => USE_TRIANGLES triangles + | PARSE_ERROR => TRIANGLES_LOAD_ERROR in - case triangles of - OK triangles => print "parse success\n" - | PARSE_ERROR => print "parse error\n" + Mailbox.send (inputMailbox, inputMsg) end fun helpSaveTriangles (triangles, io) = @@ -114,14 +118,14 @@ struct () end - fun run fileMailbox = + fun run (fileMailbox, inputMailbox) = let val _ = case Mailbox.recv fileMailbox of SAVE_TRIANGLES triangles => saveTriangles triangles - | LOAD_TRIANGLES => loadTriangles () + | LOAD_TRIANGLES => loadTriangles inputMailbox | EXPORT_TRIANGLES triangles => () in - run fileMailbox + run (fileMailbox, inputMailbox) end end diff --git a/imperative-shell/shell.sml b/imperative-shell/shell.sml index 67c2560..07017cc 100644 --- a/imperative-shell/shell.sml +++ b/imperative-shell/shell.sml @@ -47,7 +47,7 @@ struct , 0 )) - val _ = CML.spawn (fn () => FileThread.run fileMailbox) + val _ = CML.spawn (fn () => FileThread.run (fileMailbox, inputMailbox)) in () end diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml index cf23ef1..d584961 100644 --- a/message-types/input-msg.sml +++ b/message-types/input-msg.sml @@ -10,6 +10,8 @@ sig | KEY_G | KEY_CTRL_S | KEY_CTRL_L + | USE_TRIANGLES of AppType.triangle list + | TRIANGLES_LOAD_ERROR end structure InputMessage :> INPUT_MESSAGE = @@ -24,4 +26,6 @@ struct | KEY_G | KEY_CTRL_S | KEY_CTRL_L + | USE_TRIANGLES of AppType.triangle list + | TRIANGLES_LOAD_ERROR end