FIX: add scroller! for base

red · Sep 11, 2020 · 6e040a0 · 6e040a0
1 parent 062973f
commit 6e040a0
Show file tree

Hide file tree

Showing 2 changed files with 68 additions and 3 deletions.
diff --git a/modules/view/backends/gtk3/gui.reds b/modules/view/backends/gtk3/gui.reds
@@ -197,7 +197,10 @@ get-face-layout: func [
 		h		[handle!]
 ][
 	case [
-		sym = rich-text [
+		any [
+			sym = rich-text
+			sym = base
+		][
 			h: GET-CONTAINER(widget)
 			if null? h [h: widget]
 			h
@@ -955,7 +958,10 @@ change-size: func [
 		layout: get-face-layout widget sym
 		y: size/y
 		if layout <> widget [
-			if type = rich-text [	;-- is scrollable
+			if any [
+				type = rich-text
+				type = base
+			][	;-- is scrollable
 				adj: gtk_scrollable_get_vadjustment widget
 				min: gtk_adjustment_get_lower adj
 				max: gtk_adjustment_get_upper adj
@@ -1444,6 +1450,9 @@ update-scroller: func [
 		bar			[handle!]
 		int			[red-integer!]
 		values		[red-value!]
+		pvalues		[red-value!]
+		ntype		[red-word!]
+		sym			[integer!]
 		widget		[handle!]
 		container	[handle!]
 		pos			[float!]
@@ -1464,7 +1473,10 @@ update-scroller: func [
 	vertical?: as red-logic! values + SCROLLER_OBJ_VERTICAL?
 	int: as red-integer! block/rs-head as red-block! (object/get-values parent) + FACE_OBJ_STATE
 	widget: as handle! int/value
-	container: get-face-layout widget rich-text
+	pvalues: get-face-values widget
+	ntype: as red-word! pvalues + FACE_OBJ_TYPE
+	sym: symbol/resolve ntype/symbol
+	container: get-face-layout widget sym
 
 	int: as red-integer! values + flag
 	if flag = SCROLLER_OBJ_VISIBLE? [
@@ -1749,6 +1761,21 @@ OS-make-view: func [
 		sym = base [
 			widget: gtk_layout_new null null
 			gtk_layout_set_size widget size/x size/y
+			if bits and FACET_FLAGS_SCROLLABLE <> 0 [
+				container: gtk_scrolled_window_new null null
+				gtk_container_add container widget
+				gtk_scrolled_window_set_policy container 1 1
+				len: 0
+				loop 2 [
+					either zero? len [vadjust: gtk_scrollable_get_vadjustment widget][
+						vadjust: gtk_scrollable_get_hadjustment widget
+					]
+					len: len + 1
+					g_signal_handlers_disconnect_by_data(vadjust widget)	;-- remove default event handler
+					gtk_adjustment_configure vadjust 0.0 0.0 1.0 0.0 0.0 1.0
+					gobj_signal_connect(vadjust "value_changed" :vbar-value-changed widget)
+				]
+			]
 		]
 		sym = rich-text [
 			widget: gtk_layout_new null null

diff --git a/tests/vid-scroll.red b/tests/vid-scroll.red
@@ -0,0 +1,38 @@
+Red [Needs: View]
+
+view [
+    size 390x220
+    across space 0x0
+    base 367x200 with [
+        flags: 'scrollable
+        pane: layout/only [
+            origin 0x0 space 0x0
+            p: panel 350x800 [
+                origin 0x0 space 0x0
+                below
+                area "A" 350x200
+                area "B" 350x200
+                area "C" 350x200
+                area "D" 350x200
+            ]
+        ]
+    ]
+    on-created [
+        put get-scroller face 'horizontal 'visible? no
+        sc: get-scroller face 'vertical
+        sc/position: 0
+        sc/page-size: 200
+        sc/max-size: 800
+    ]
+    on-scroll [
+        sc/position: max 0 min 600 switch event/key [
+            down [sc/position + 20]
+            up [sc/position - 20]
+            page-down [sc/position + sc/page-size]
+            page-up [sc/position - sc/page-size]
+            track [event/picked - 1]
+            end [sc/position]
+        ]
+        p/offset: as-pair 0 negate sc/position
+    ] 
+]