[Samples][*]c_a_g: info form is added

ELENA-LANG · Apr 28, 2015 · f03260f · f03260f
1 parent 3cae36d
commit f03260f
Show file tree

Hide file tree

Showing 8 changed files with 149 additions and 59 deletions.
diff --git a/doc/todo.txt b/doc/todo.txt
@@ -35,7 +35,7 @@ Currently:
                        * example with buttons, edit on panel
 
               sdev - gui examples:  
-                       * migrate c_a_g
+                       * migrate c_a_g : save dialog
                        * migrate notepad
                        * migrate timer
 

diff --git a/examples/c_a_g/anot_wind.l b/examples/c_a_g/anot_wind.l
@@ -1,46 +1,41 @@
-//// --- default namespaces ---
-//#define std'dictionary'*.
-//#define gui'dictionary'*.
-//#define gui'dictionary'events'*.
-//#define gui'common'*.
-//
-//// --- namespace shortcuts ---
-//#define forms'*    = gui'forms'*.
-//#define controls'* = gui'controls'*.
-//#define basic'*    = std'basic'*.
-//#define io'*       = sys'io'*.
-//
-//#class InputBox (forms'Dialog)
-//{
-//    #field infoLabel.
-//    #field BtmOK.
-//    
-//    #method oninit : Args
-//    [
-//        super oninit:Args.
-//
-//        infoLabel := controls'staticlabel::self.
-//        BtmOk     := controls'button::self.
-//        
-//        self
-//            set &caption:"About the program"
-//            set &x:320 &y:320 set &width:400 &height:230.
-//        
-//        infoLabel
-//            set &x:20 &y:20 set &width:320 &height:20
-//            set &caption:"Special thanks to Alex Rakov, for the support."
-//            open.
-//        
-//        BtmOK
-//            set &x:30 &y:175 set &width:50 & height:22
-//            set &caption:"Ok"
-//            open.
-//        
-//        BtmOk~eevents += 
-//            { onclick'eval = self set &forms'dialog_result:basic'false.  }.
-//    ]
-//}
-//
+// --- default namespaces ---
+#define system.
+#define forms.
+
+#class InfoForm :: ChildForm
+{
+    #field infoLabel.
+    #field BtmOk.
+
+    #constructor new &parent:aParent
+        <= (new &parent:aParent)
+    [
+        // Form ------------------------------------------------------------------------
+        $self set &x:320 &y:320.
+        $self set &width:400 &height:230.
+        $self set &caption:"About the program".
+
+        BtmOk := Button new.
+        theControls append:BtmOk.
+
+        // Labels
+        infoLabel := Label new.
+        theControls append:infoLabel.
+
+        infoLabel set &x:20 &y:20.
+        infoLabel set &width:320 &height:20.
+        infoLabel set &caption:"Special thanks to Alex Rakov, for the support.".            
+
+        BtmOk set &x:30 &y:175.
+        BtmOk set &width:50 & height:22.
+        BtmOk set &caption:"OK".            
+
+        #var aForm := $self.
+        BtmOk set &onClick:args
+            [ aForm close. ].        
+    ]
+}
+
 //#class SaveBox (forms'Dialog)
 //{
 //    // Panels

diff --git a/examples/c_a_g/calc_area_gui.l b/examples/c_a_g/calc_area_gui.l
@@ -335,6 +335,11 @@
 
                 valor set &caption:("Res: " + aResult literal + " m^2").                    
             ]
+
+            $onButtonClickInfo : aForm
+            [
+                calc_area_gui'InfoForm new &parent:aForm run.
+            ]
         }.
 
 //        theResult := basic'String.
@@ -544,8 +549,9 @@
         BtmCalc set &onClick:args
             [ theController $onButtonClick. ].
 
-//        BtmInfo~eevents +=
-//            { onclick'eval = self $onButtonClickInfo. }.
+        #var aForm := $self. // !! should be possible to pass self
+        BtmInfo set &onClick:args
+            [ theController $onButtonClickInfo:aForm. ].
 //            
 //        BtmSalv~eevents +=
 //            { onclick'eval = self $onButtonClickSave. }.
@@ -554,11 +560,6 @@
             [ 'program stop. ].
     ]
 
-////    #method $onButtonClickInfo
-////    [
-////        anot_wind'InputBox::self open &forms'modal.
-////    ]
-////
 ////    #method $onButtonClickSave
 ////    [
 ////        #var asForm := anot_wind'SaveBox::self.

diff --git a/src30/forms/win32_forms.l b/src30/forms/win32_forms.l
@@ -9,6 +9,13 @@
         <= (new)
     [
     ]
+
+    #method close
+    [
+        $super close.
+
+        theHandle free.
+    ]
 }
 
 // --- SDI ---
@@ -115,6 +122,23 @@
 
     #method form = $self.
 
+    #method run
+    [
+        $self open.
+        theParent set &enabled:false.
+
+        'program run &hwnd:theHandle.
+
+        theParent set &enabled:true.
+    ]    
+
+    #method close 
+    [
+        $self set &visible:false.
+
+        $super close.
+    ]
+
     #method $createHandle
     [
         #var(type:int)Styles := WS_POPUPWINDOW || WS_DLGFRAME.
@@ -133,6 +157,6 @@
                         &int:anX &int:anY &int:aWidth &int:aHeight 
                         &hwnd:(theParent hwnd)
                         &hinstance:CurrentInstance 
-                        &object:(SDIWindowCallback new &win_listener:(ChildWindowListener new &form:$self)).
+                        &object:(ChildWindowCallback new &win_listener:(ChildWindowListener new &form:$self)).
     ]
 }
diff --git a/src30/system/winforms/win32_app.l b/src30/system/winforms/win32_app.l
@@ -41,7 +41,31 @@
             aResult := system'external'USER32 GetMessageW &win_msg:aMsg &handle:theHandle &int:0 &int:0.
         ].
     ]
-
+
+    #method run &hwnd:aHandle
+    [
+        #var(type:win_msg)aMsg.
+        #var(type:int)proceeded.
+        #var(type:int)aResult.
+
+        #loop (aHandle isVisible)?
+        [
+            aResult := system'external'USER32 PeekMessageW &win_msg:aMsg &int:0 &int:0 &int:0 &int:1.
+                (aResult != 0)
+                    ? [
+                        proceeded := system'external'USER32 IsDialogMessageW &handle:aHandle &win_msg:aMsg.
+                        (proceeded == 0) ?
+                            [
+                                system'external'USER32 TranslateMessage &win_msg:aMsg.
+                                system'external'USER32 DispatchMessageW &win_msg:aMsg.
+                            ].
+                    ]
+                    ! [
+                        system'external'USER32 WaitMessage.
+                    ].
+        ].
+    ]
+
     #method stop
     [
         theHandle := WindowHandle min.

diff --git a/src30/system/winforms/win32_controls.l b/src30/system/winforms/win32_controls.l
@@ -90,7 +90,7 @@
         system'external'USER32 ShowWindow &handle:theHandle &int:aValue.
     ]
 
-    #method isVisible
+    #method(type:bool) isVisible
     [
         #var(type:int)visible := system'external'USER32 IsWindowVisible &handle:theHandle.
 
@@ -164,8 +164,8 @@
 
         anHDC << dc.
     ]
-                  
-    #method close
+
+    #method free
     [
         system'external'USER32 DestroyWindow &handle:theHandle.
     ]

diff --git a/src30/system/winforms/win32_windows.l b/src30/system/winforms/win32_windows.l
@@ -116,7 +116,7 @@
     [
         (aMessage == WM_CLOSE)
             ? [
-                anHWND close.
+                anHWND free.
 
                 aRetVal << 0.
 
@@ -152,6 +152,52 @@
 //    ]
 }
 
+// --- ChildWindowCallback ---
+
+#class ChildWindowCallback :: WindowCallback
+{
+    #constructor new &win_listener:aListener
+    [
+        theListener := aListener.
+    ]
+
+    #method eval &hwnd:anHWND &int:aMessage &vint:aRetVal
+    [
+        (aMessage == WM_CLOSE)
+            ? [
+                anHWND free.
+
+                aRetVal << 0.
+
+                ^ $self.
+            ].
+
+        (aMessage == WM_DESTROY)
+            ? [
+                theListener ondestroy &hwnd:anHWND &vint:aRetVal.
+
+                ^ $self.
+            ].
+
+        $super eval &hwnd:anHWND &int:aMessage &vint:aRetVal.
+    ]
+
+    #method wm_command &hwnd:anHWND &int:aMessage &int:aCode &hwnd:aControl &vint:aRetVal
+    [
+        (aControl == 0)
+            ? [ ^ $self. ]. // !! temporal
+
+        // !! note low word may contains the control ID, so only high word should be checked
+        (aCode == 0)
+            ? [ theListener onclick &hwnd:aControl &vint:aRetVal. ].
+    ]
+
+//    #method eval &handle:anHWND &int:aMessage &int:aWParam &int:aLParam &vint:aRetVal
+//    [
+//        $super eval &handle:anHWND &int:aMessage &int:aWParam &int:aLParam &vint:aRetVal.
+//    ]
+}
+
 // --- PaintboxCallback ---
 
 #class PaintboxCallback :: WindowCallback

diff --git a/whatsnew.txt b/whatsnew.txt
@@ -27,11 +27,11 @@
 [LIB]
 [!] literal type, LiteralValue, String are UTF-8, CharValue is Unicode (UTF-32)
 [+] wliteral, WideLiteralValue and WideString
-[+] linux: support basic console operations
+[+] linux: support basic i/o operations (console, files)
 [+] system'winforms module implementing basic WIN32 GUI functionality
 
 Samples:
-[+] agenda, graphs
+[+] agenda, graphs, c_a_g
 
 [IDE]
 [*] fixed "step over" implementations inside symbol