1 type Scroller @mut = 2 var obs visible_y : (u32, u32) up down = (0, 0) 3 var obs content : Option<Control> @dst = None 4 var value : f32 = 0 5 var obs is_scroll_visible = false 6 7 let content_presenter = Presenter.new 8 let scroll_presenter = ScrollPresenter.new 9 let scroll_canvas = Canvas.new 10 let scroll_rectangle = Rectangle.new 11 12 let aligner = Aligner 13 scroll_presenter 14 content_presenter 15 content@obs = content@obs 16 scroll_canvas 17 align_h = AlignH/Right 18 exclude_height <- scroll_rectangle 19 scroll_rectangle 20 color = Vector3.gray 0.7 21 is_receive_mouse_move = true 22 run@ set_fixed_width 18 23 24 let update (scroller : Scroller) = 25 let content_presenter = scroller.content_presenter 26 let scroll_canvas = scroller.scroll_canvas 27 let scroll_rectangle = scroller.scroll_rectangle 28 29 let content_height = content_presenter.height 30 let presenter_height = scroller.scroll_presenter.height 31 32 let min_content_y = if content_height > presenter_height 33 then presenter_height as i32 - content_height as i32 34 else 0 35 36 scroller.is_scroll_visible = content_height > presenter_height 37 let prev_content_pos = content_presenter.position 38 let prev_content_y = prev_content_pos.y 39 let prev_value = scroller.value 40 let content_pos = if prev_content_y < min_content_y as f32 41 then prev_content_pos.with_y min_content_y.as<f32> 42 else prev_content_pos 43 44 if content_pos <> prev_content_pos then 45 content_presenter.position = content_pos 46 47 let ratio = if content_height <= presenter_height 48 then 1 49 else presenter_height as f32 / content_height as f32 50 51 let scroll_height = presenter_height as f32 * ratio |> round as u32 52 scroll_rectangle.set_fixed_height scroll_height 53 54 let value = if min_content_y == 0 55 then 1 56 else content_pos.y / min_content_y as f32 57 58 assert value >= 0 && value <= 1 59 if value <> prev_value then 60 scroller.value = value 61 62 let max_scroll_y = scroll_canvas.height as i32 - scroll_height as i32 63 let scroll_y = value * max_scroll_y as f32 64 let scroll_pos = scroll_rectangle.position 65 if scroll_y <> scroll_pos.y then 66 scroll_rectangle.position = scroll_pos.with_y scroll_y 67 68 let visible_up = -content_pos.y as u32 69 let visible_down = visible_up + presenter_height 70 scroller.value = value 71 visible_y = (visible_up, visible_down) 72 73 type Scroller 74 inherit Indirect 75 on_arranged = { update self } 76 77 module scroller 78 79 def move_to (scroller : Scroller 80 maybe_y : Option<i32> 81 maybe_content_y : Option<i32>) = 82 let content_presenter = scroller.content_presenter 83 let scroll_canvas = scroller.scroll_canvas 84 let scroll_rectangle = scroller.scroll_rectangle 85 86 let content_height = content_presenter.height 87 let presenter_height = scroller.scroll_presenter.height 88 let scroll_height = scroll_rectangle.height 89 90 let min_content_y = if content_height > presenter_height 91 then presenter_height as i32 - content_height as i32 92 else 0 93 94 let (scroll_y, value) = 95 let scroll_canvas_global = scroll_canvas.global_position 96 let min_scroll_y = scroll_canvas_global.y as i32 97 let max_scroll_y = min_scroll_y + scroll_canvas.height as i32 98 - scroll_height as i32 99 100 if maybe_y ? Some y then 101 let scroll_y = y.max min_scroll_y |> min max_scroll_y - min_scroll_y 102 let value = if max_scroll_y == min_scroll_y 103 then 1 104 else scroll_y as f32 / (max_scroll_y - min_scroll_y) as f32 105 106 (scroll_y, value) 107 else 108 if max_scroll_y == min_scroll_y then 109 (0, 1) 110 else 111 let content_y = maybe_content_y.unwrap 112 let value = content_y as f32 / min_content_y as f32 113 let scroll_y = value * (max_scroll_y - min_scroll_y) as f32 |> as<i32> 114 (scroll_y, value) 115 116 let scroll_pos = scroll_rectangle.position.with_y scroll_y.as<f32> 117 scroll_rectangle.position = scroll_pos 118 119 let content_y = min_content_y as f32 * value |> round 120 let content_pos = content_presenter.position.with_y content_y 121 content_presenter.position = content_pos 122 let visible_up = -content_y as u32 123 let visible_down = visible_up + presenter_height 124 scroller.value = value 125 visible_y = (visible_up, visible_down) 126 127 type Scroller 128 subscribe { _, event -> case event of 129 SizeEvent/MaxHeight h -> 130 scroll_presenter.max_height = h 131 132 is MouseEvent/Scroll -> 133 let y = visible_y.up as i32 - event.y as i32 * 60 |> max 0 134 move_to self None -y 135 136 else -> () } 137 138 scroll_rectangle.subscribe { _, event -> if event is MouseEvent/Move then 139 let y = event.y as i32 - event.begin_relative_y as i32 140 move_to self y None } 141 142 is_scroll_visible@atom.bind { scroll_rectangle.is_visible = _ } 143 |> push_token 144 145 is_scrollable = true 146 child = aligner 147