/scrollable_statictext superclass

 %begin postscript section

/undrawOLCaret {
	currentfont /olglyph findfont 12 scalefont
	setfont BG setcolor -3 2 rmoveto OLCaretW 0
	rlineto 0 OLCaretH neg rlineto OLCaretW neg 0
	rlineto closepath fill setfont
} def
/undrawOLBox {
	% x y w h 
	matrix currentmatrix 5 1 roll 4 2 roll
	translate 0 1 moveto dup 0 exch 1 sub rlineto
	1 index 1 sub 0 rlineto 1 2 moveto 1 index 3 sub
	0 rlineto dup 0 exch 3 sub rlineto 1 2 moveto dup
	0 exch 3 sub rlineto 1 index 2 sub 0 rlineto 1 1
	moveto exch 2 sub 0 rlineto 0 exch 2 sub rlineto
	BG setcolor stroke setmatrix
} def
%end postscript section

/visible_selection true def


%begin postscript section
/visible_selection persist %end postscript section

/selection_point [0 0] def

/start_selection [0 0] def

/end_selection [0 0] def

/prev_forward false def

/xpos_from_selection {
	% selection -- int
	value //nullstring eq {
		pop margin
	} {
		textfont setfont value display_map
		2 index 0 get 1 bitshift get display_map
		3 index 0 get 1 bitshift 1 add get
		getinterval dup 3 -1 roll 1 get 0 exch
		GetInterval exch margin 3 -1 roll
		text_width_proc cvx exec add exch
		justification_indent add
	} ifelse
} def

/stringpos_bin {
	% string float -- int
	1 index length dup 0 eq {
		pop pop pop 0
	} {
		dup 1 eq {
			pop exch text_width_proc cvx exec 2 div gt 1
			0
		} {
			1 index 3 index 0 3 index 2 div cvi dup
			5 1 roll getinterval dup 3 1 roll
			text_width_proc cvx exec dup 3 1 roll lt {
				pop exch pop exch pop 3 -1 roll pop exch
				stringpos_bin
			} {
				exch pop 1 index 6 -1 roll 3 index
				6 -2 roll sub getinterval 4 -2 roll sub
				stringpos_bin add
			}
		} ifelse
		ifelse
	} ifelse
} def

/char_from_point {
	% float float -- selection
	textfont setfont 0 h margin sub 3 -1 roll sub
	cvi textfont fontheight line_gap add cvi
	idiv display_top_line add max dup
	display_bottom_line gt {
		pop pop [display_bottom_line display_map
		display_bottom_line 1 bitshift 1 add get
	} {
		value display_map 2 index 1 bitshift get
		display_map 3 index 1 bitshift 1 add get
		getinterval [3 -1 roll textfont 3 index
		6 -1 roll margin sub 6 -1 roll
		justification_indent sub stringpos
	} ifelse
	]
} def

/selection_to_index {
	% selection -- int
	display_map 1 index 0 get 1 bitshift get exch
	1 get add
} def

/index_to_selection {
	% int -- selection
	1 {
		dup total_display_lines gt {
			pop [total_display_lines 3 -1 roll
			display_map total_display_lines 1
			bitshift get sub] exit
		} if
		display_map 1 index 1 bitshift get 2 index
		gt {
			dup [exch 1 sub 4 -1 roll display_map
			5 -1 roll 1 sub 1 bitshift get sub] exit
		} if
		1 add
	} loop
} def

/reset_range {
	% --
	[0 0] /start_selection exch promote [0 0]
	/end_selection exch promote
} def

/gt_range {
	% selection selection -- boolean
	1 index 0 get 1 index 0 get eq {
		exch 1 get exch 1
	} {
		exch 0 get exch 0
	} ifelse
	get gt
} def

/eq_range {
	% selection selection -- boolean
	1 index 0 get 1 index 0 get eq {
		exch 1 get exch 1 get eq
	} {
		pop pop false
	} ifelse
} def

/selection_range {
	% -- boolean
	start_selection end_selection eq_range
	not
} def

/normalize_selection {
	% --
	start_selection end_selection gt_range {
		start_selection end_selection
		/start_selection exch promote
		/end_selection exch promote
		start_selection set_selection
	} if
} def

/start_of_word_at {
	% int -- int
	true value length value 3 index get
	is_word_space {
		{
			2 index 1 index lt {
				2 index 0 ge
			} false ifelse
			{1 index} false ifelse
			not {
				exch pop exit
			} if
			value 3 index get is_word_space true {
				value 3 index get 0 eq
			} ifelse
			{
				3 -1 roll 1 sub 3 1 roll
			} {
				exch pop false exch
			} ifelse
		} loop
		true exch
	} if
	{
		2 index 1 index lt {
			2 index 0 gt
		} false ifelse
		{1 index} false ifelse
		not {
			pop exit
		} if
		value 3 index get is_word_space {
			exch pop false exch
		} {
			3 -1 roll 1 sub 3 1 roll
		} ifelse
	} loop
	not {
		1 add
	} if
} def

/end_of_word_at {
	% int -- int
	true value length value 3 index get
	is_word_space {
		{
			2 index 1 index lt {1 index} false ifelse
			not {
				exch pop exit
			} if
			value 3 index get is_word_space {
				3 -1 roll 1 add 3 1 roll
			} {
				exch pop false exch
			} ifelse
		} loop
		true exch
	} if
	{
		2 index 1 index lt {1 index} false ifelse
		not {
			pop pop exit
		} if
		value 3 index get is_word_space {
			exch pop false exch
		} {
			3 -1 roll 1 add 3 1 roll
		} ifelse
	} loop
} def

/start_of_line_at {
	% int -- int
	{
		dup 0 gt {
			value display_map 2 index 1 bitshift get 1
			sub get 10 ne
		} false ifelse
		not {exit} if
		1 sub
	} loop
} def

/end_of_line_at {
	% int -- int
	{
		dup total_display_lines lt {
			value display_map 2 index 1 bitshift get
			display_map 3 index 1 bitshift 1 add get
			add get 10 ne
		} false ifelse
		not {exit} if
		1 add
	} loop
} def

/draw_part_text_line {
	% int int int colortype --
	[4 index 4 index] 4 index
	display_top_line ge {
		4 index display_bottom_line le
	} false ifelse
	{
		value //nullstring ne
	} false ifelse
	{
		exch setcolor textfont setfont 2 index -1
		eq {
			3 -1 roll pop 0 3 1 roll dup 1 0 put
		} if
		xpos_from_selection 1 index -1 eq {
			exch pop display_map 3 index 1 bitshift 1
			add get exch
		} if
		3 index ypos_from_line textfont
		fontdescent add moveto value display_map
		5 -1 roll 1 bitshift get 3 index add
		3 -1 roll 4 -1 roll sub getinterval
		text_show_proc cvx exec
	} {
		pop pop pop pop pop
	} ifelse
} def

/draw_text_line {
	% int colortype --
	1 index display_top_line ge {
		1 index display_bottom_line le
	} false ifelse
	{
		setcolor textfont setfont value
		display_map 2 index 1 bitshift get
		display_map 3 index 1 bitshift 1 add get
		getinterval margin 1 index
		justification_indent add 3 -1 roll
		ypos_from_line textfont fontdescent add
		moveto text_show_proc cvx exec
	} {
		pop pop
	} ifelse
} def

/draw_text_range {
	% selection selection colortype --
	textfont setfont dup setcolor gsave
	clip_textarea 2 index 0 get 2 index 0 get eq {
		2 index 0 get 4 -1 roll 1 get
	} {
		2 index 0 get 3 index 1 get -1 3 index
		draw_part_text_line 3 -1 roll 0 get 1 add {
			dup 3 index 0 get ge {
				pop exit
			} if
			2 copy exch draw_text_line 1 add
		} loop
		1 index 0 get -1
	} ifelse
	4 -1 roll 1 get 4 -1 roll
	draw_part_text_line grestore
} def

/select_part_line {
	% int int int colortype --
	[4 index 0] 4 index display_top_line ge {
		4 index display_bottom_line le
	} false ifelse
	{
		dup 1 5 index put 4 -1 roll -1 eq {margin} {
			dup xpos_from_selection
		} ifelse
		exch dup 1 5 index put 4 -1 roll -1 eq {
			pop textarea_width margin add
		} {xpos_from_selection} ifelse
		1 index 5 -1 roll ypos_from_line
		3 -1 roll 4 -1 roll sub textfont
		fontheight line_gap add rectpath setcolor
		fill
	} {
		pop pop pop pop pop
	} ifelse
} def

/select_line {
	% int colortype --
	1 index display_top_line ge {
		1 index display_bottom_line le
	} false ifelse
	{
		setcolor margin exch ypos_from_line
		textarea_width textfont fontheight
		line_gap add rectpath fill
	} {
		pop pop
	} ifelse
} def

/select_range {
	% selection selection colortype --
	gsave clip_textarea 2 index 0 get 2 index 0
	get eq {
		2 index 0 get 4 -1 roll 1 get
	} {
		2 index 0 get 3 index 1 get -1 3 index
		select_part_line 3 -1 roll 0 get 1 add {
			dup 3 index 0 get ge {
				pop exit
			} if
			2 copy exch select_line 1 add
		} loop
		1 index 0 get -1
	} ifelse
	4 -1 roll 1 get 4 -1 roll select_part_line
	grestore
} def

/fix_caret_damage {
	% --
	gsave clip_textarea selection_point 0 get 0
	selection_point 1 get 1 sub max display_map
	selection_point 0 get 1 bitshift 1 add get
	selection_point 1 get 1 add min FG
	draw_part_text_line grestore
} def

/clip_cursorarea {
	% --
	OLCaretW 2 div OLCaretH 2 div boxarea_width
	OLCaretW sub h OLCaretH sub rectpath clip
	newpath
} def

/draw_cursor {
	% boolean --
	visible_selection not {pop} {
		selection_range {
			start_selection end_selection 2 index {
				selBGcolor} {BG} ifelse
			select_range start_selection
			end_selection 3 -1 roll {selFGcolor} {
				FG} ifelse
			draw_text_range
		} {
			selection_point 0 get display_top_line
			ge {
				selection_point 0 get
				display_bottom_line le
			} false ifelse
			{
				gsave clip_cursorarea selection_point
				xpos_from_selection selection_point 0
				get ypos_from_line cvi 1 add moveto {
					focus_state /active eq OLCaret
				} {
					undrawOLCaret fix_caret_damage
				} ifelse
				grestore
			} {pop} ifelse
		} ifelse
	} ifelse
} def

/set_selection {
	% selection --
	/selection_point exch promote
} def

/select_word {
	% float float --
	char_from_point selection_to_index dup
	start_of_word_at exch end_of_word_at exch
	index_to_selection /start_selection exch
	promote index_to_selection
	/end_selection exch promote
	normalize_selection start_selection
	set_selection
} def

/select_text_line {
	% float float --
	char_from_point 0 get dup [exch
	start_of_line_at 0] /start_selection exch
	promote end_of_line_at dup [exch
	display_map 4 -1 roll 1 bitshift 1 add get]
	/end_selection exch promote
	start_selection set_selection
} def

/select_all {
	% --
	[0 0] /start_selection exch promote [
	total_display_lines display_map
	total_display_lines 1 bitshift 1 add get]
	/end_selection exch promote
	start_selection set_selection
} def

/do_selection {
	% float float --
	mouselevel do_selection$SwiTch0 exch
	2 copy known not {
		pop /$deFaUlT
	} if
	get exec
} def

/do_selection$SwiTch0 5 dict dup begin
4 {
	pop pop select_all true draw_cursor
} def
3 {
	select_text_line true draw_cursor
} def
2 {
	select_word true draw_cursor
} def
1 {
	pop pop
} def
/$deFaUlT currentdict 1 get def
end
def

/OnSelect {
	% --
	mouseevent /XLocation get mouseevent
	/YLocation get focus_state /none eq {
		request_focus} if
	visible_selection not {
		pop pop
	} {
		false draw_cursor 2 copy char_from_point
		set_selection selection_point
		/start_selection exch promote
		start_selection /end_selection exch
		promote track_state /mouse_click eq {
			do_selection true draw_cursor
		} {
			pop pop track_state /mouse_drag eq {
				/prev_forward true promote
				/extend_selection_proc track pop
				normalize_selection selection_range
				not {
					true draw_cursor
				} if
			} if
		} ifelse
	} ifelse
} def

/round_range {
	% selection boolean -- selection
	mouselevel round_range$SwiTch1 exch
	2 copy known not {
		pop /$deFaUlT
	} if
	get exec
} def

/round_range$SwiTch1 5 dict dup begin
4 {
	exch pop {
		[0 0
	} {
		[total_display_lines display_map
		total_display_lines 1 bitshift 1 add get
	} ifelse
	]
} def
3 {
	{
		[exch 0 get start_of_line_at 0
	} {
		0 get end_of_line_at dup [exch display_map
		4 -1 roll 1 bitshift 1 add get
	} ifelse
	]
} def
2 {
	exch selection_to_index exch {
		start_of_word_at} {end_of_word_at}
	ifelse
	index_to_selection
} def
1 {pop} def
/$deFaUlT currentdict 1 get def
end
def

/extend_selection {
	% selection --
	dup start_selection gt_range 1 index
	end_selection eq_range {
		pop pop
	} {
		prev_forward 1 index eq {
			1 index end_selection gt_range {
				end_selection 2 index 2 index {
					selBGcolor} {BG} ifelse
				select_range end_selection 2 index
				2 index {selFGcolor} {FG}
			} {
				1 index end_selection 2 index {BG} {
					selBGcolor} ifelse
				select_range 1 index end_selection
				2 index {FG} {selFGcolor}
			} ifelse
			ifelse
		} {
			start_selection 2 index gt_range {
				1 index start_selection selBGcolor
				select_range 1 index start_selection
			} {
				start_selection 2 index selBGcolor
				select_range start_selection 2 index
			} ifelse
			selFGcolor draw_text_range
			start_selection end_selection gt_range
			{
				end_selection start_selection BG
				select_range end_selection
				start_selection
			} {
				start_selection end_selection BG
				select_range start_selection
				end_selection
			} ifelse
			FG
		} ifelse
		draw_text_range /prev_forward exch
		promote /end_selection exch promote
	} ifelse
} def

/extend_selection_proc {
	% --
	trackx tracky char_from_point
	extend_selection
} def

/OnAdjust {
	% --
	focus_state /none eq {request_focus} if
	visible_selection not not {
		selection_range not {
			false draw_cursor
		} if
		track_state /mouse_click eq {
			mouseevent /XLocation get mouseevent
			/YLocation get char_from_point
			extend_selection
		} if
		normalize_selection start_selection
		set_selection selection_range not {
			true draw_cursor
		} if
	} if
} def

/focus_change {
	% --
	selection_range not {
		/draw_cursor [false] gexeca /draw_cursor
		[true] gexeca
	} if
} def

/do_move_to {
	% name --
	false draw_cursor reset_range
	do_move_to$SwiTch2 exch 2 copy known not {
		pop /$deFaUlT
	} if
	get exec true draw_cursor
} def

/do_move_to$SwiTch2 11 dict dup begin
/end_line {
	selection_point 0 get end_of_line_at dup [
	exch display_map 4 -1 roll 1 bitshift 1 add
	get] set_selection selection_point 0 get
	display_bottom_line gt {scroll_down_line
	} if
} def
/start_line {
	[selection_point 0 get start_of_line_at 0]
	set_selection display_top_line
	selection_point 0 get gt {scroll_up_line}
	if
} def
/end_word {
	selection_point selection_to_index
	end_of_word_at index_to_selection
	set_selection selection_point 0 get
	display_bottom_line gt {scroll_down_line
	} if
} def
/start_word {
	0 selection_point selection_to_index 1 sub
	max start_of_word_at index_to_selection
	set_selection display_top_line
	selection_point 0 get gt {scroll_up_line}
	if
} def
/down {
	selection_point 0 get total_display_lines
	lt {
		[selection_point 0 get 1 add
		selection_point 1 get display_map
		selection_point 0 get 1 add 1 bitshift 1 add
		get min] set_selection
	} if
	selection_point 0 get display_bottom_line
	gt {scroll_down_line} if
} def
/up {
	selection_point 0 get 0 gt {
		[selection_point 0 get 1 sub
		selection_point 1 get display_map
		selection_point 0 get 1 sub 1 bitshift 1 add
		get min] set_selection
	} if
	display_top_line selection_point 0 get gt {
		scroll_up_line} if
} def
/right {
	selection_point 1 get display_map
	selection_point 0 get 1 bitshift 1 add get lt {
		[selection_point 0 get selection_point 1
		get 1 add] set_selection
	} {
		selection_point 0 get
		total_display_lines lt {
			[selection_point 0 get 1 add 0]
			set_selection selection_point 0 get
			display_bottom_line gt {
				scroll_down_line} if
		} if
	} ifelse
} def
/left {
	selection_point 1 get 0 gt {
		[selection_point 0 get selection_point 1
		get 1 sub] set_selection
	} {
		selection_point 0 get 0 gt {
			[selection_point 0 get 1 sub display_map
			selection_point 0 get 1 sub 1 bitshift 1 add
			get] set_selection display_top_line
			selection_point 0 get gt {scroll_up_line
			} if
		} if
	} ifelse
} def
/end_text {
	[total_display_lines display_map
	total_display_lines 1 bitshift 1 add get]
	set_selection display_bottom_line
	total_display_lines lt {scroll_to_bottom
	} if
} def
/start_text {
	[0 0] set_selection display_top_line 0 ne {
		scroll_to_top} if
} def
/$deFaUlT currentdict /start_text get def
end
def

/move_to {
	% name --
	/do_move_to [3 -1 roll] gexeca
} def

/set_visible_selection {
	% boolean --
	dup {
		visible_selection not
	} false ifelse
	{
		dup /visible_selection exch softpromote
		/draw_cursor [true] gexeca
	} if
	dup not {visible_selection} false ifelse
	{
		/draw_cursor [false] gexeca
		/visible_selection exch softpromote
	} {pop} ifelse
} def

/paint_text_from_line {
	% int --
	false draw_cursor //paint_text_from_line
	exec true draw_cursor
} def

/compute_display_map_from {
	% int int string --
	start_selection selection_to_index
	end_selection selection_to_index
	selection_point selection_to_index
	6 -3 roll //compute_display_map_from
	exec 3 -1 roll index_to_selection
	/start_selection exch promote exch
	index_to_selection /end_selection exch
	promote index_to_selection
	/selection_point exch promote
} def

/append_string {
	% string --
	total_display_lines value 3 -1 roll
	append /value exch promote dup
	compute_updated_display_map
	/paint_text_from_line [3 -1 roll] gexeca
	/end_text move_to
} def

/set_value {
	% string --
	reset_range start_selection
	set_selection //set_value exec
} def

/do_set_top_line {
	% int --
	false draw_cursor //do_set_top_line exec
	true draw_cursor
} def

/do_select_line_at {
	% int --
	dup 0 ge {
		dup total_display_lines le
	} false ifelse
	{
		false draw_cursor dup [exch
		start_of_line_at 0] /start_selection
		exch promote dup end_of_line_at dup [exch
		display_map 4 -1 roll 1 bitshift 1 add get]
		/end_selection exch promote
		start_selection set_selection true
		draw_cursor dup display_top_line lt true {
			dup display_bottom_line gt
		} ifelse
		{set_top_line} {pop} ifelse
	} {pop} ifelse
} def

/select_line_at {
	% int --
	/do_select_line_at [3 -1 roll] gexeca
} def