diff --git a/a.sml b/a.sml deleted file mode 100644 index 94e5178..0000000 --- a/a.sml +++ /dev/null @@ -1,22 +0,0 @@ -structure LowerCaseA = -struct - fun lerp (startX, startY, drawWidth, drawHeight, windowWidth, windowHeight) = - let - val endX = startX + drawWidth - val endY = startY + drawHeight - in - [ ((startX * (1.0 - 0.47499999404)) + (endX * 0.47499999404)) / windowWidth, - ((startY * (1.0 - 0.700000047684)) + (endY * 0.700000047684)) / windowHeight, - ((startX * (1.0 - 0.299999982119)) + (endX * 0.299999982119)) / windowWidth, - ((startY * (1.0 - 0.675000011921)) + (endY * 0.675000011921)) / windowHeight, - ((startX * (1.0 - 0.449999988079)) + (endX * 0.449999988079)) / windowWidth, - ((startY * (1.0 - 0.550000011921)) + (endY * 0.550000011921)) / windowHeight, - ((startX * (1.0 - 0.625)) + (endX * 0.625)) / windowWidth, - ((startY * (1.0 - 0.275000035763)) + (endY * 0.275000035763)) / windowHeight, - ((startX * (1.0 - 0.799999952316)) + (endX * 0.799999952316)) / windowWidth, - ((startY * (1.0 - 0.400000035763)) + (endY * 0.400000035763)) / windowHeight, - ((startX * (1.0 - 0.524999976158)) + (endX * 0.524999976158)) / windowWidth, - ((startY * (1.0 - 0.524999976158)) + (endY * 0.524999976158)) / windowHeight - ] - end -end diff --git a/dotscape b/dotscape index f0e8124..af3ca5d 100755 Binary files a/dotscape and b/dotscape differ diff --git a/functional-core/app/app-update.sml b/functional-core/app/app-update.sml index c3e724b..ea30ec4 100644 --- a/functional-core/app/app-update.sml +++ b/functional-core/app/app-update.sml @@ -211,8 +211,15 @@ struct (model, FILE fileMsg) end - fun getLoadTriangleMsg model = - (model, FILE LOAD_TRIANGLES) + fun getLoadTrianglesMsg model = (model, FILE LOAD_TRIANGLES) + + fun getExportTrianglesMsg model = + let + val {triangles, ...} = model + val fileMsg = EXPORT_TRIANGLES (#triangles model) + in + (model, FILE fileMsg) + end fun useTriangles (model, triangles) = let @@ -238,7 +245,8 @@ struct | REDO_ACTION => redoAction model | KEY_G => toggleGraph model | KEY_CTRL_S => getSaveTrianglesMsg model - | KEY_CTRL_L => getLoadTriangleMsg model + | KEY_CTRL_L => getLoadTrianglesMsg model + | KEY_CTRL_E => getExportTrianglesMsg model | USE_TRIANGLES triangles => useTriangles (model, triangles) | TRIANGLES_LOAD_ERROR => trianglesLoadError model end diff --git a/imperative-shell/file-thread.sml b/imperative-shell/file-thread.sml index 2d5c480..ebf458f 100644 --- a/imperative-shell/file-thread.sml +++ b/imperative-shell/file-thread.sml @@ -143,7 +143,7 @@ struct case Mailbox.recv fileMailbox of SAVE_TRIANGLES triangles => saveTriangles triangles | LOAD_TRIANGLES => loadTriangles inputMailbox - | EXPORT_TRIANGLES triangles => () + | EXPORT_TRIANGLES triangles => exportTriangles triangles in run (fileMailbox, inputMailbox) end diff --git a/imperative-shell/input-callbacks.sml b/imperative-shell/input-callbacks.sml index 41d8f2b..6eeaf64 100644 --- a/imperative-shell/input-callbacks.sml +++ b/imperative-shell/input-callbacks.sml @@ -51,6 +51,11 @@ struct key = Input.KEY_L () andalso action = Input.PRESS () andalso mods = 0x002 then Mailbox.send (mailbox, KEY_CTRL_L) + else if + (* ctrl-l *) + key = Input.KEY_E () andalso action = Input.PRESS () andalso mods = 0x002 + then + Mailbox.send (mailbox, KEY_CTRL_E) else () diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml index d584961..7257d46 100644 --- a/message-types/input-msg.sml +++ b/message-types/input-msg.sml @@ -10,6 +10,7 @@ sig | KEY_G | KEY_CTRL_S | KEY_CTRL_L + | KEY_CTRL_E | USE_TRIANGLES of AppType.triangle list | TRIANGLES_LOAD_ERROR end @@ -26,6 +27,7 @@ struct | KEY_G | KEY_CTRL_S | KEY_CTRL_L + | KEY_CTRL_E | USE_TRIANGLES of AppType.triangle list | TRIANGLES_LOAD_ERROR end