From 2e6d96bc22c434b78de44a14d64a91378950b5f7 Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeffrey.armstrong@approximatrix.com>
Date: Tue, 11 Aug 2020 15:17:58 -0400
Subject: Added support for mouse wheel scrolling

---
 ag_render.f90 | 37 ++++++++++++++++++++++++++++++++++---
 1 file changed, 34 insertions(+), 3 deletions(-)

(limited to 'ag_render.f90')

diff --git a/ag_render.f90 b/ag_render.f90
index 211c718..3d08f35 100644
--- a/ag_render.f90
+++ b/ag_render.f90
@@ -43,8 +43,9 @@ implicit none
     integer, parameter::ag_render_event_scroll     = 5
     integer, parameter::ag_render_event_resize     = 6
     integer, parameter::ag_render_event_mousemove  = 7
-    integer, parameter::ag_render_event_favorite   = 8
-    integer, parameter::ag_render_event_internal   = 9
+    integer, parameter::ag_render_event_wheel      = 8
+    integer, parameter::ag_render_event_favorite   = 9
+    integer, parameter::ag_render_event_internal   = 10
 
     type :: link
         integer, dimension(4)::location
@@ -198,6 +199,24 @@ contains
         
     end subroutine mouse_move_callback
     
+    subroutine mouse_wheel_callback(x, y)
+    use appgraphics, only: stopidle
+    implicit none
+    
+        integer::x, y
+    
+        scroll_position = scroll_position - (x/100)
+        if(scroll_position < 0) then
+            scroll_position = 0
+        else if(scroll_position > 100) then
+            scroll_position = 100
+        end if
+        
+        ag_render_event = ag_render_event_wheel
+        call stopidle()
+        
+    end subroutine mouse_wheel_callback
+    
     subroutine scrolled_callback(x)
     use appgraphics, only: stopidle
     implicit none
@@ -393,6 +412,7 @@ contains
         call setwindowclosecallback(window_closing_callback)
         call registermousehandler(MOUSE_LB_UP, mouse_button_callback)
         call registermousehandler(MOUSE_MOVE, mouse_move_callback)
+        call registermousehandler(MOUSE_WHEEL, mouse_wheel_callback)
         call enableresize(resize_callback)
         
         call setbkcolor(LIGHTGRAY)
@@ -425,6 +445,8 @@ contains
     
         self%title_guessed = .false.
     
+        call setdialoghotkeys(.true.)
+    
     end subroutine ag_initialize
     
     function get_link_at_mouse(self)
@@ -479,9 +501,11 @@ contains
         class(appgraphics_renderer)::self
         
         self%y = 0
+        scroll_position = 0
+        
         call setscrollposition(self%scroll_id, 0)
         ag_render_event = ag_render_event_none
-    
+        
         self%title_guessed = .false.
     
     end subroutine ag_new_page
@@ -833,6 +857,13 @@ contains
                 
                 call clearmouseclick(MOUSE_MOVE)
         
+            case(ag_render_event_wheel)
+                call setscrollposition(self%scroll_id, scroll_position)
+                
+                doclength = self%y - self%initial_y
+                self%y = (doclength * scroll_position) / (-100)
+                ag_action = render_action_layout
+        
             case(ag_render_event_scroll)
                 doclength = self%y - self%initial_y
                 self%y = (doclength * scroll_position) / (-100)
-- 
cgit v1.2.3