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