diff --git a/a.dsc b/a.dsc new file mode 100644 index 0000000..429cd07 --- /dev/null +++ b/a.dsc @@ -0,0 +1,2 @@ +x ~0.0499999858439 y 0.400000035763 x ~0.400000035763 y 0.350000023842 x ~0.100000038743 y 0.100000038743 +x 0.25 y ~0.449999958277 x 0.599999964237 y ~0.199999943376 x 0.0499999858439 y 0.0499999858439 diff --git a/dotscape b/dotscape index 6be7d93..2ddfc47 100755 Binary files a/dotscape and b/dotscape differ diff --git a/ffi/glfw-input.c b/ffi/glfw-input.c index b4762f0..bc9783c 100644 --- a/ffi/glfw-input.c +++ b/ffi/glfw-input.c @@ -13,6 +13,7 @@ int KEY_Z = GLFW_KEY_Z; int KEY_S = GLFW_KEY_S; int KEY_E = GLFW_KEY_E; int KEY_I = GLFW_KEY_I; +int KEY_L = GLFW_KEY_L; // Calls function exported from SML void mouseMoveCallback(GLFWwindow *window, double xpos, double ypos) { diff --git a/ffi/glfw-input.sml b/ffi/glfw-input.sml index a5e0827..a0c979f 100644 --- a/ffi/glfw-input.sml +++ b/ffi/glfw-input.sml @@ -44,4 +44,6 @@ struct _symbol "KEY_E" public : ( unit -> int ) * ( int -> unit ); val (KEY_I, _) = _symbol "KEY_I" public : ( unit -> int ) * ( int -> unit ); + val (KEY_L, _) = + _symbol "KEY_L" public : ( unit -> int ) * ( int -> unit ); end diff --git a/functional-core/app-update.sml b/functional-core/app-update.sml index bb7a790..2c4a659 100644 --- a/functional-core/app-update.sml +++ b/functional-core/app-update.sml @@ -182,7 +182,9 @@ struct in (model, DRAW drawMsg) end) - | [] => (* Nothing to redo. *) (model, NO_MAILBOX) + | [] => + (* Nothing to redo. *) + (model, NO_MAILBOX) fun toggleGraph (model: app_type) = if #showGraph model then @@ -209,6 +211,9 @@ struct (model, FILE fileMsg) end + fun getLoadTriangleMsg model = + (model, FILE LOAD_TRIANGLES) + fun update (model: app_type, inputMsg) = case inputMsg of MOUSE_MOVE {x = mouseX, y = mouseY} => @@ -222,4 +227,5 @@ struct | REDO_ACTION => redoAction model | KEY_G => toggleGraph model | KEY_CTRL_S => getSaveTrianglesMsg model + | KEY_CTRL_L => getLoadTriangleMsg model end diff --git a/imperative-shell/file-thread.sml b/imperative-shell/file-thread.sml index 7f5cc41..9eedf70 100644 --- a/imperative-shell/file-thread.sml +++ b/imperative-shell/file-thread.sml @@ -14,13 +14,13 @@ struct fun extractTriangle lst = case lst of - [ X , COORD x1 - , Y , COORD y1 - , X , COORD x2 + [ X, COORD x1 + , Y, COORD y1 + , X, COORD x2 - , Y , COORD y2 - , X , COORD x3 - , Y , COORD y3 + , Y, COORD y2 + , X, COORD x3 + , Y, COORD y3 ] => SOME {x1 = x1, y1 = y1, x2 = x2, y2 = y2, x3 = x3, y3 = y3} | _ => NONE @@ -41,16 +41,14 @@ struct let val chr = String.sub (line, pos) in - if chr = #" " then + if chr = #" " orelse chr = #"\n" then let - val strToken = - String.substring (line, lastSpacePos, pos - (lastSpacePos + 1)) + val strToken = String.substring + (line, lastSpacePos + 1, pos - (lastSpacePos + 1)) val token = tokeniseString strToken in helpParseLine (line, pos + 1, token :: acc, pos) end - else if chr = #"\n" then - List.rev acc else helpParseLine (line, pos + 1, acc, lastSpacePos) end @@ -62,17 +60,27 @@ struct datatype parse_resule = OK of AppType.triangle list | PARSE_ERROR - fun helpParse (io, acc) = + fun parse (io, acc) = case TextIO.inputLine io of SOME line => - (case parseLine line of - SOME tri => helpParse (io, tri :: acc) - | NONE => PARSE_ERROR) + let + val line = parseLine line + in + (case line of + SOME tri => parse (io, tri :: acc) + | NONE => PARSE_ERROR) + end | NONE => let val triangles = List.rev acc in OK triangles end - fun parse () = - let val io = TextIO.openIn filename - in helpParse (io, []) + fun loadTriangles () = + let + val io = TextIO.openIn filename + val triangles = parse (io, []) + val _ = TextIO.closeIn io + in + case triangles of + OK triangles => print "parse success\n" + | PARSE_ERROR => print "parse error\n" end fun helpSaveTriangles (triangles, io) = @@ -111,7 +119,7 @@ struct val _ = case Mailbox.recv fileMailbox of SAVE_TRIANGLES triangles => saveTriangles triangles - | LOAD_TRIANGLES => () + | LOAD_TRIANGLES => loadTriangles () | EXPORT_TRIANGLES triangles => () in run fileMailbox diff --git a/imperative-shell/input-callbacks.sml b/imperative-shell/input-callbacks.sml index bf06ed3..41d8f2b 100644 --- a/imperative-shell/input-callbacks.sml +++ b/imperative-shell/input-callbacks.sml @@ -46,6 +46,11 @@ struct key = Input.KEY_S () andalso action = Input.PRESS () andalso mods = 0x002 then Mailbox.send (mailbox, KEY_CTRL_S) + else if + (* ctrl-l *) + key = Input.KEY_L () andalso action = Input.PRESS () andalso mods = 0x002 + then + Mailbox.send (mailbox, KEY_CTRL_L) else () diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml index 223b37c..cf23ef1 100644 --- a/message-types/input-msg.sml +++ b/message-types/input-msg.sml @@ -9,6 +9,7 @@ sig | REDO_ACTION | KEY_G | KEY_CTRL_S + | KEY_CTRL_L end structure InputMessage :> INPUT_MESSAGE = @@ -22,4 +23,5 @@ struct | REDO_ACTION | KEY_G | KEY_CTRL_S + | KEY_CTRL_L end