Added handling of callbacks in a Fortran-esque manner

5 files changed, 117 insertions, 11 deletions

diff --git a/libClpFortran.dll.prj b/libClpFortran.dll.prj
index a004f9f..0fc6601 100644
--- a/libClpFortran.dll.prj
+++ b/libClpFortran.dll.prj
@@ -4,26 +4,31 @@
         "Folders":[],
         "Name":"+src",
         "Files":[{
-            "filename":".\\src\\clp.f90",
+            "filename":"src/clp.f90",
             "enabled":"1",
             "panel":1,
             "open":"1"
           },{
-            "filename":".\\src\\clp_constants.F90",
+            "filename":"src/clp_callback.f90",
             "enabled":"1",
             "panel":1,
             "open":"1"
           },{
-            "filename":".\\src\\clp_interface_utils.f90",
+            "filename":"src/clp_constants.F90",
             "enabled":"1",
             "panel":1,
             "open":"1"
           },{
-            "filename":".\\src\\clp_types.f90",
+            "filename":"src/clp_interface_utils.f90",
+            "enabled":"1",
+            "panel":1,
+            "open":"1"
+          },{
+            "filename":"src/clp_types.f90",
             "enabled":"1"
           }]
       }],
-    "Name":"+libClpFortran.dll (clp-dll\\libClpFortran.dll)",
+    "Name":"+libClpFortran.dll (clp-dll/libClpFortran.dll)",
     "Files":[]
   },
   "Name":"libClpFortran.dll (clp-dll/libClpFortran.dll)",
@@ -40,10 +45,10 @@
     "File Options":{
       "Library Directories":["Default Add-On Directory"],
       "Build Directory":"build",
-      "Module Directory":"clp-dll\\modules",
+      "Module Directory":"clp-dll/modules",
       "Include Directories":["Default Add-On Include Directory"]
     },
-    "Target":"clp-dll\\libClpFortran.dll",
+    "Target":"clp-dll/libClpFortran.dll",
     "Fortran Options":{
       "Use C Preprocessor":"false",
       "Runtime Diagnostics":"false",
@@ -64,12 +69,13 @@
     },
     "Build Dependencies":1,
     "Launch Options":{
+      "Build Before Launch":"true",
       "Working Directory":"",
       "Launch Using MPI":"false",
       "Keep Console":"true",
-      "External Console":"false",
+      "Executable":"",
       "Command Line Arguments":"",
-      "Build Before Launch":"true"
+      "External Console":"false"
     },
     "Build Options":{
       "Makefile":"Makefile",
diff --git a/libClpFortran.prj b/libClpFortran.prj
index 8c4a184..f9c86c0 100644
--- a/libClpFortran.prj
+++ b/libClpFortran.prj
@@ -9,6 +9,11 @@
             "panel":1,
             "open":"1"
           },{
+            "filename":"src/clp_callback.f90",
+            "enabled":"1",
+            "panel":1,
+            "open":"1"
+          },{
             "filename":"src/clp_constants.F90",
             "enabled":"1",
             "panel":1,
diff --git a/src/clp.f90 b/src/clp.f90
index 2c8692a..cd34b95 100644
--- a/src/clp.f90
+++ b/src/clp.f90
@@ -1,5 +1,7 @@
 module clp
     use iso_c_binding
+    use clp_callback, only: fortran_cb
+    use clp_constants
     implicit none
     
         interface
@@ -498,10 +500,10 @@ module clp
                 use iso_c_binding
                     type(c_ptr) :: model
             end subroutine
-            subroutine Clp_registerCallBack(model,userCallBack) bind(C,name="Clp_registerCallBack")
+            subroutine Clp_registerCallBack_C(model,userCallBack) bind(C,name="Clp_registerCallBack")
                 use iso_c_binding
                     type(c_ptr), value :: model
-                    type(c_ptr), value :: userCallBack
+                    type(c_funptr), value :: userCallBack
             end subroutine
             subroutine Clp_clearCallBack(model) bind(C,name="Clp_clearCallBack")
                 use iso_c_binding
@@ -1700,4 +1702,23 @@ contains
         
     end subroutine Clp_integerInformation
 
+    subroutine Clp_registerCallback(model, cb)
+    use iso_c_binding
+    use clp_callback
+    implicit none
+    
+        type(c_ptr) :: model
+        procedure(fortran_cb) :: cb
+        
+        if(associated(current_callback)) then
+            Write(*,*) "*** WARNING: Clp Fortran Library supports only a single callback"
+            Write(*,*) "***          Reassigning current callback"
+        end if 
+        
+        current_callback => cb
+        
+        call Clp_Registercallback_C(model, c_funloc(Clp_boundCallbackInterface))
+        
+    end subroutine Clp_registerCallback
+
 end module clp
diff --git a/src/clp_callback.f90 b/src/clp_callback.f90
new file mode 100644
index 0000000..d403be7
--- /dev/null
+++ b/src/clp_callback.f90
@@ -0,0 +1,71 @@
+module clp_callback
+use iso_c_binding
+implicit none
+
+    interface fortran_cb
+        subroutine fortran_cb(mdl, msg, dbls, ints, strings)
+        use iso_c_binding
+        use clp_constants
+        implicit none
+            type(c_ptr) :: mdl
+            integer :: msg
+            real(kind=c_double), dimension(:), pointer :: dbls
+            integer(kind=c_int), dimension(:), pointer :: ints
+            character(len=clp_default_message_len), dimension(:), pointer :: strings
+        end subroutine fortran_cb
+    end interface
+    
+    procedure(fortran_cb), pointer:: current_callback
+    
+contains
+
+    subroutine Clp_boundCallbackInterface(model, messageNumber, &
+                                          nDouble, vDouble, &
+                                          nInt, vInt, &
+                                          nString, vString) bind(C)
+    use iso_c_binding
+    use clp_constants
+    implicit none
+    
+        type(c_ptr), value :: model
+        integer(c_int), value :: messageNumber
+        integer(c_int), value :: nDouble, nInt, nString
+        type(c_ptr), value :: vDouble, vInt, vString
+        
+        real(kind=c_double), dimension(:), pointer :: fdouble
+        integer(kind=c_int), dimension(:), pointer :: fint
+        character(len=clp_default_message_len), dimension(:), pointer :: fstrs
+        
+        ! For converting C strings
+        type(c_ptr), dimension(:), pointer :: c_strings
+        integer::i
+    
+        if(nDouble > 0 .and. c_associated(vDouble)) then
+            call c_f_pointer(vDouble, fdouble, (/ nDouble /))
+        end if
+        
+        if(nInt > 0 .and. c_associated(vInt)) then
+            call c_f_pointer(vInt, fint, (/ nInt /))
+        end if
+        
+        if(nString > 0 .and. c_associated(vString)) then
+            allocate(fstrs(nString))
+            fstrs = ' '
+            call c_f_pointer(vString, c_strings, (/ nString /))
+            do i = 1, nString
+                call populate_fortran_string(c_strings(i), fstrs(i))
+            end do
+        end if
+        
+        ! Now that Fortran arrays are built, call the Fortran callback
+        if(associated(current_callback)) then
+            call current_callback(model, messageNumber, fdouble, fint, fstrs)
+        end if
+        
+        if(associated(fstrs)) then
+            deallocate(fstrs)
+        end if
+    
+    end subroutine Clp_boundCallbackInterface
+    
+end module clp_callback
\ No newline at end of file
diff --git a/src/clp_constants.F90 b/src/clp_constants.F90
index 5a44089..5451bba 100644
--- a/src/clp_constants.F90
+++ b/src/clp_constants.F90
@@ -11,6 +11,9 @@ module clp_constants
     integer, parameter :: CoinBigIndex_t = c_long_long
 #endif
     
+    ! Default message string length
+    integer, parameter::clp_default_message_len = 128
+    
     enum, bind(c)
         enumerator :: Status_isFree = 0
         enumerator :: Status_basic