add code to let user change alpha valua

fcore/app-init.sml

@@ -46,6 +46,7 @@ struct
       , r = 0.0
       , g = 0.0
       , b = 0.0
+      , a = 1.0
       , modalNum = 0
       }
     end

fcore/app-type.sml

@@ -30,6 +30,7 @@ struct
     , r: Real32.real
     , g: Real32.real
     , b: Real32.real
+    , a: Real32.real
     , modalNum: int
     }
 end

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

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

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;

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 );

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

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