diff --git a/dotscape b/dotscape index 79adc5a..0b1faee 100755 Binary files a/dotscape and b/dotscape differ diff --git a/fcore/app-init.sml b/fcore/app-init.sml index 97488e5..dd80bf3 100644 --- a/fcore/app-init.sml +++ b/fcore/app-init.sml @@ -46,6 +46,7 @@ struct , r = 0.0 , g = 0.0 , b = 0.0 + , a = 1.0 , modalNum = 0 } end diff --git a/fcore/app-type.sml b/fcore/app-type.sml index aa6b01d..48e8b16 100644 --- a/fcore/app-type.sml +++ b/fcore/app-type.sml @@ -30,6 +30,7 @@ struct , r: Real32.real , g: Real32.real , b: Real32.real + , a: Real32.real , modalNum: int } end diff --git a/fcore/app-with.sml b/fcore/app-with.sml index dd849fc..af22f78 100644 --- a/fcore/app-with.sml +++ b/fcore/app-with.sml @@ -25,6 +25,7 @@ struct , r , g , b + , a , modalNum } = app @@ -56,6 +57,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -83,6 +85,7 @@ struct , r , g , b + , a , modalNum } = app in @@ -106,6 +109,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -133,6 +137,7 @@ struct , r , g , b + , a , modalNum } = app in @@ -156,6 +161,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -183,6 +189,7 @@ struct , r , g , b + , a , modalNum } = app @@ -210,6 +217,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -237,6 +245,7 @@ struct , r , g , b + , a , modalNum } = app in @@ -260,6 +269,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -287,6 +297,7 @@ struct , r , g , b + , a , modalNum } = app in @@ -310,6 +321,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -337,6 +349,7 @@ struct , r , g , b + , a , modalNum } = app in @@ -360,6 +373,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -387,6 +401,7 @@ struct , r , g , b + , a , modalNum } = app in @@ -410,6 +425,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -437,6 +453,7 @@ struct , r , g , b + , a , modalNum } = app in @@ -460,6 +477,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -487,6 +505,7 @@ struct , r , g , b + , a , modalNum = _ } = app in @@ -510,6 +529,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = newNum } end @@ -539,6 +559,7 @@ struct , r = _ , g , b + , a , modalNum } = app @@ -564,6 +585,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -591,6 +613,7 @@ struct , r , g = _ , b + , a , modalNum } = app @@ -616,6 +639,7 @@ struct , r = r , g = g , b = b + , a = a , modalNum = modalNum } end @@ -643,6 +667,7 @@ struct , r , g , b = _ + , a , modalNum } = app @@ -668,6 +693,61 @@ struct , r = r , g = g , b = b + , a = a + , modalNum = modalNum + } + end + + fun a (app: app_type) : app_type = + let + val + { mode + , mouseX + , mouseY + , xClickPoints + , yClickPoints + , windowWidth + , windowHeight + , squares + , arrowX + , arrowY + , canvasWidth + , canvasHeight + + , showGraph + , openFilePath + , fileBrowser + , fileBrowserIdx + , r + , g + , b + , a = _ + , modalNum + } = app + + val a = modalNumToFloat modalNum + in + { mode = mode + , mouseX = mouseX + , mouseY = mouseY + , squares = squares + , arrowX = arrowX + , arrowY = arrowY + , canvasWidth = canvasWidth + , canvasHeight = canvasHeight + , windowWidth = windowWidth + , windowHeight = windowHeight + , xClickPoints = xClickPoints + , yClickPoints = yClickPoints + + , showGraph = showGraph + , openFilePath = openFilePath + , fileBrowser = fileBrowser + , fileBrowserIdx = fileBrowserIdx + , r = r + , g = g + , b = b + , a = a , modalNum = modalNum } end diff --git a/fcore/normal-mode.sml b/fcore/normal-mode.sml index 56e8314..2175bdc 100644 --- a/fcore/normal-mode.sml +++ b/fcore/normal-mode.sml @@ -259,6 +259,7 @@ struct fun updateRed model = (AppWith.r model, []) fun updateGreen model = (AppWith.g model, []) fun updateBlue model = (AppWith.b model, []) + fun updateAlpha model = (AppWith.a model, []) fun enterBrowseMode model = let @@ -287,6 +288,7 @@ struct | KEY_R => updateRed model | KEY_G => updateGreen model | KEY_B => updateBlue model + | KEY_A => updateAlpha model | RESIZE_WINDOW {width, height} => resizeWindow (model, width, height) | UNDO_ACTION => undoAction model | REDO_ACTION => redoAction model diff --git a/ffi/glfw-input.c b/ffi/glfw-input.c index cbd0e9e..ace6a3a 100644 --- a/ffi/glfw-input.c +++ b/ffi/glfw-input.c @@ -19,6 +19,7 @@ int KEY_E = GLFW_KEY_E; int KEY_I = GLFW_KEY_I; int KEY_L = GLFW_KEY_L; int KEY_O = GLFW_KEY_O; +int KEY_A = GLFW_KEY_A; int KEY_ENTER = GLFW_KEY_ENTER; int KEY_SPACE = GLFW_KEY_SPACE; diff --git a/ffi/glfw-input.sml b/ffi/glfw-input.sml index da0f34a..78b7b3d 100644 --- a/ffi/glfw-input.sml +++ b/ffi/glfw-input.sml @@ -55,6 +55,8 @@ struct _symbol "KEY_L" public : ( unit -> int ) * ( int -> unit ); val (KEY_O, _) = _symbol "KEY_O" public : ( unit -> int ) * ( int -> unit ); + val (KEY_A, _) = + _symbol "KEY_A" public : ( unit -> int ) * ( int -> unit ); val (KEY_ENTER, _) = _symbol "KEY_ENTER" public : ( unit -> int ) * ( int -> unit ); diff --git a/imperative-shell/input-callbacks.sml b/imperative-shell/input-callbacks.sml index 5fa0f7a..0703a15 100644 --- a/imperative-shell/input-callbacks.sml +++ b/imperative-shell/input-callbacks.sml @@ -68,6 +68,10 @@ struct key = Input.KEY_E () andalso action = Input.PRESS () andalso mods = 0x002 then Mailbox.send (mailbox, KEY_CTRL_E) + else if + key = Input.KEY_A () andalso action = Input.PRESS () andalso mods = 0 + then + Mailbox.send (mailbox, KEY_A) else if key = Input.KEY_UP () andalso action <> Input.RELEASE () andalso mods = 0x0 diff --git a/message-types/input-msg.sml b/message-types/input-msg.sml index 417a501..53cc378 100644 --- a/message-types/input-msg.sml +++ b/message-types/input-msg.sml @@ -11,6 +11,7 @@ struct | KEY_G | KEY_B | KEY_T + | KEY_A | KEY_CTRL_S | KEY_CTRL_L | KEY_CTRL_E