done with scaffolding for file mailbox; next, send message to file mailbox to export and import, and handle these messages properly from the file mailbox
This commit is contained in:
@@ -46,6 +46,7 @@ end
|
|||||||
imperative-shell/input-callbacks.sml
|
imperative-shell/input-callbacks.sml
|
||||||
|
|
||||||
imperative-shell/update-thread.sml
|
imperative-shell/update-thread.sml
|
||||||
|
imperative-shell/file-thread.sml
|
||||||
imperative-shell/draw-thread.sml
|
imperative-shell/draw-thread.sml
|
||||||
|
|
||||||
imperative-shell/shell.sml
|
imperative-shell/shell.sml
|
||||||
|
|||||||
20
imperative-shell/file-thread.sml
Normal file
20
imperative-shell/file-thread.sml
Normal file
@@ -0,0 +1,20 @@
|
|||||||
|
signature FILE_THREAD =
|
||||||
|
sig
|
||||||
|
val run: FileMessage.t Mailbox.mbox -> unit
|
||||||
|
end
|
||||||
|
|
||||||
|
structure FileThread :> FILE_THREAD =
|
||||||
|
struct
|
||||||
|
open FileMessage
|
||||||
|
|
||||||
|
fun run fileMailbox =
|
||||||
|
let
|
||||||
|
val _ =
|
||||||
|
case Mailbox.recv fileMailbox of
|
||||||
|
SAVE_TRIANGLES triangles => ()
|
||||||
|
| EXPORT_TRIANGLES triangles => ()
|
||||||
|
| IMPORT_TRIANGLES => ()
|
||||||
|
in
|
||||||
|
run fileMailbox
|
||||||
|
end
|
||||||
|
end
|
||||||
@@ -28,11 +28,13 @@ struct
|
|||||||
|
|
||||||
val inputMailbox = Mailbox.mailbox ()
|
val inputMailbox = Mailbox.mailbox ()
|
||||||
val drawMailbox = Mailbox.mailbox ()
|
val drawMailbox = Mailbox.mailbox ()
|
||||||
|
val fileMailbox = Mailbox.mailbox ()
|
||||||
|
|
||||||
|
val _ = InputCallbacks.registerCallbacks (window, inputMailbox)
|
||||||
|
|
||||||
val _ = CML.spawn (fn () =>
|
val _ = CML.spawn (fn () =>
|
||||||
InputCallbacks.registerCallbacks (window, inputMailbox))
|
UpdateThread.run (inputMailbox, drawMailbox, fileMailbox, initialModel))
|
||||||
val _ = CML.spawn (fn () =>
|
|
||||||
UpdateThread.run (inputMailbox, drawMailbox, initialModel))
|
|
||||||
val _ = CML.spawn (fn () =>
|
val _ = CML.spawn (fn () =>
|
||||||
DrawThread.run
|
DrawThread.run
|
||||||
( drawMailbox
|
( drawMailbox
|
||||||
@@ -44,6 +46,8 @@ struct
|
|||||||
, triangleDrawObject
|
, triangleDrawObject
|
||||||
, 0
|
, 0
|
||||||
))
|
))
|
||||||
|
|
||||||
|
val _ = CML.spawn (fn () => FileThread.run fileMailbox)
|
||||||
in
|
in
|
||||||
()
|
()
|
||||||
end
|
end
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ sig
|
|||||||
val run:
|
val run:
|
||||||
InputMessage.t Mailbox.mbox
|
InputMessage.t Mailbox.mbox
|
||||||
* DrawMessage.t Mailbox.mbox
|
* DrawMessage.t Mailbox.mbox
|
||||||
|
* FileMessage.t Mailbox.mbox
|
||||||
* AppType.app_type
|
* AppType.app_type
|
||||||
-> unit
|
-> unit
|
||||||
end
|
end
|
||||||
@@ -12,21 +13,21 @@ struct
|
|||||||
open CML
|
open CML
|
||||||
open UpdateMessage
|
open UpdateMessage
|
||||||
|
|
||||||
fun handleMsg (drawMailbox, updateMsg) =
|
fun handleMsg (drawMailbox, fileMailbox, updateMsg) =
|
||||||
case updateMsg of
|
case updateMsg of
|
||||||
DRAW drawMsg => Mailbox.send (drawMailbox, drawMsg)
|
DRAW drawMsg => Mailbox.send (drawMailbox, drawMsg)
|
||||||
| FILE fileMsg => ()
|
| FILE fileMsg => Mailbox.send (fileMailbox, fileMsg)
|
||||||
| NO_MAILBOX => ()
|
| NO_MAILBOX => ()
|
||||||
|
|
||||||
fun loop (inputMailbox, drawMailbox, model) =
|
fun loop (inputMailbox, drawMailbox, fileMailbox, model) =
|
||||||
let
|
let
|
||||||
val inputMsg = Mailbox.recv inputMailbox
|
val inputMsg = Mailbox.recv inputMailbox
|
||||||
val (model, updateMsg) = AppUpdate.update (model, inputMsg)
|
val (model, updateMsg) = AppUpdate.update (model, inputMsg)
|
||||||
val _ = handleMsg (drawMailbox, updateMsg)
|
val _ = handleMsg (drawMailbox, fileMailbox, updateMsg)
|
||||||
in
|
in
|
||||||
loop (inputMailbox, drawMailbox, model)
|
loop (inputMailbox, drawMailbox, fileMailbox, model)
|
||||||
end
|
end
|
||||||
|
|
||||||
fun run (inputMailbox, drawMailbox, initial) =
|
fun run (inputMailbox, drawMailbox, fileMailbox, initial) =
|
||||||
loop (inputMailbox, drawMailbox, initial)
|
loop (inputMailbox, drawMailbox, fileMailbox, initial)
|
||||||
end
|
end
|
||||||
|
|||||||
@@ -2,14 +2,14 @@ signature FILE_MESSAGE =
|
|||||||
sig
|
sig
|
||||||
datatype t =
|
datatype t =
|
||||||
SAVE_TRIANGLES of AppType.triangle list
|
SAVE_TRIANGLES of AppType.triangle list
|
||||||
| EXPORT_FILE of AppType.triangle list
|
| EXPORT_TRIANGLES of AppType.triangle list
|
||||||
| IMPORT_FILE
|
| IMPORT_TRIANGLES
|
||||||
end
|
end
|
||||||
|
|
||||||
structure FileMessage :> FILE_MESSAGE =
|
structure FileMessage :> FILE_MESSAGE =
|
||||||
struct
|
struct
|
||||||
datatype t =
|
datatype t =
|
||||||
SAVE_TRIANGLES of AppType.triangle list
|
SAVE_TRIANGLES of AppType.triangle list
|
||||||
| EXPORT_FILE of AppType.triangle list
|
| EXPORT_TRIANGLES of AppType.triangle list
|
||||||
| IMPORT_FILE
|
| IMPORT_TRIANGLES
|
||||||
end
|
end
|
||||||
|
|||||||
Reference in New Issue
Block a user