very basic saving (hardcoded file name, which is fine fow now)

functional-core/app-update.sml

@@ -9,6 +9,7 @@ struct
   open AppType
 
   open DrawMessage
+  open FileMessage
   open InputMessage
   open UpdateMessage
 
@@ -200,6 +201,14 @@ struct
         (model, DRAW drawMsg)
       end
 
+  fun getSaveTrianglesMsg model =
+    let
+      val {triangles, ...} = model
+      val fileMsg = SAVE_TRIANGLES triangles
+    in
+      (model, FILE fileMsg)
+    end
+
   fun update (model: app_type, inputMsg) =
     case inputMsg of
       MOUSE_MOVE {x = mouseX, y = mouseY} =>
@@ -212,4 +221,5 @@ struct
     | UNDO_ACTION => undoAction model
     | REDO_ACTION => redoAction model
     | KEY_G => toggleGraph model
+    | KEY_CTRL_S => getSaveTrianglesMsg model
 end

imperative-shell/file-thread.sml

@@ -5,14 +5,50 @@ end
 
 structure FileThread :> FILE_THREAD =
 struct
+  open AppType
   open FileMessage
 
+  val filename = "a.dsc"
+
+  fun helpSaveTriangles (triangles, io) =
+    case triangles of
+      {x1, y1, x2, y2, x3, y3} :: tl =>
+        let
+          val triString = String.concat
+            [ "x1:"
+            , Real32.toString x1
+            , " y1:"
+            , Real32.toString y1
+
+            , " x2:"
+            , Real32.toString x2
+            , " y2:"
+            , Real32.toString y2
+
+            , " x3:"
+            , Real32.toString x3
+            , " y3:"
+            , Real32.toString y3
+            , "\n"
+            ]
+
+          val _ = TextIO.output (io, triString)
+        in
+          helpSaveTriangles (tl, io)
+        end
+    | [] => ()
+
+  fun saveTriangles triangles =
+    let val io = TextIO.openOut filename
+    in helpSaveTriangles (triangles, io)
+    end
+
   fun run fileMailbox =
     let
       val _ =
         case Mailbox.recv fileMailbox of
-          SAVE_TRIANGLES triangles => ()
-        | LOAD_TRIANGLES triangles => ()
+          SAVE_TRIANGLES triangles => saveTriangles triangles
+        | LOAD_TRIANGLES => ()
         | EXPORT_TRIANGLES triangles => ()
     in
       run fileMailbox

imperative-shell/input-callbacks.sml

@@ -32,15 +32,20 @@ struct
         (* no action recognised *)
         ()
     else if
+      (* ctrl-y *)
       key = Input.KEY_Y () andalso action <> Input.RELEASE ()
       andalso mods = 0x0002
     then
-      (* ctrl-y *)
       Mailbox.send (mailbox, REDO_ACTION)
     else if
       key = Input.KEY_G () andalso action <> Input.RELEASE () andalso mods = 0x0
     then
       Mailbox.send (mailbox, KEY_G)
+    else if
+      (* ctrl-s *)
+      key = Input.KEY_S () andalso action = Input.PRESS () andalso mods = 0x002
+    then
+      Mailbox.send (mailbox, KEY_CTRL_S)
     else
       ()
 

message-types/input-msg.sml

@@ -8,6 +8,7 @@ sig
   | UNDO_ACTION
   | REDO_ACTION
   | KEY_G
+  | KEY_CTRL_S
 end
 
 structure InputMessage :> INPUT_MESSAGE =
@@ -20,4 +21,5 @@ struct
   | UNDO_ACTION
   | REDO_ACTION
   | KEY_G
+  | KEY_CTRL_S
 end