/text 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

/margin 10 def

/margin2 margin 2 mul def

/line_gap 3 def

/value //nullstring def


%begin postscript section
/value persist %end postscript section

/has_bounding_box true def


%begin postscript section
/has_bounding_box persist %end postscript section

/line_wrap /word def


%begin postscript section
/line_wrap persist %end postscript section

/word_spaces (\(\){}[].,!?; \n\t) def

/tab_width 36 def

/text_show_proc /show_with_tabs def

/text_width_proc /width_with_tabs def

/display_map [0 0] def

/total_display_lines 0 def

/max_display_lines 0 def

/display_bottom_line 0 def

/display_top_line 0 def

/ypos_from_line {
	% int -- float
	h margin sub exch display_top_line sub 1 add
	textfont fontheight neg line_gap sub mul add
} def

/is_word_space {
	% char -- boolean
	word_spaces exch arraycontains?
} def

/textarea_width {
	% -- int
	w margin2 sub cvi
} def

/clip_textarea {
	% --
	margin margin textarea_width h margin2 sub
	rectpath clip newpath
} def

/boxarea_width {
	% -- int
	w cvi
} def

/clip_boxarea {
	% --
	0 0 boxarea_width h rectpath clip newpath
} def

/compute_no_display_lines {
	% --
	1 h margin2 sub cvi textfont fontheight
	line_gap add cvi idiv max
	/max_display_lines exch promote
} def

/wrap_word {
	% string int -- int
	dup true {
		1 index 0 ge {dup} false ifelse
		not {
			pop 3 -1 roll pop exit
		} if
		3 index 2 index get is_word_space {
			pop false
		} {
			exch 1 sub exch
		} ifelse
	} loop
	dup 0 lt {pop} {
		exch pop 1 add
	} ifelse
} def

/wrap_line {
	% string -- int
	(n) stringwidth pop cvi textarea_width
	2 index text_width_proc cvx exec 1 index lt
	{
		pop pop length
	} {
		2 index length 1 2 index 5 -1 roll idiv max
		min exch 2 index 2 index 0 exch GetInterval
		text_width_proc cvx exec 1 index lt {{
				2 index 2 index 1 add 0 exch GetInterval
				text_width_proc cvx exec 1 index ge {
					pop exit
				} if
				exch 1 add exch
			}} {{
				2 index 2 index 1 sub 0 exch GetInterval
				text_width_proc cvx exec 1 index lt {
					pop exit
				} if
				exch 1 sub exch
			}} ifelse
		loop
		line_wrap /word eq {wrap_word} {
			exch pop
		} ifelse
	} ifelse
} def

/compute_display_map_from {
	% int int string --
	false textfont setfont {
		dup {
			pop pop pop exit
		} if
		1 index (\n) search {
			3 array astore
		} {
			pop null
		} ifelse
		dup null eq {
			pop pop dup true exch
		} {
			3 -1 roll pop dup 0 get 3 1 roll 2 get
		} ifelse
		dup //nullstring eq {
			pop display_map 4 index 1 bitshift
			4 index put display_map 4 index 1
			bitshift 1 add 0 put 4 -1 roll 1 add
			4 1 roll 3 index 1 bitshift display_map
			length eq {
				display_map 20 array append
				/display_map exch promote
			} if
		} {
			line_wrap /none eq {
				display_map 5 index 1 bitshift 5 index
				put display_map 5 index 1 bitshift 1 add
				2 index length put 4 -1 roll exch length
				add 3 1 roll 4 -1 roll 1 add 4 1 roll
				3 index 1 bitshift display_map length eq
				{
					display_map 20 array append
					/display_map exch promote
				} if
			} {
				{
					dup //nullstring eq {
						pop exit
					} if
					dup wrap_line display_map 6 index 1
					bitshift 6 index put display_map
					6 index 1 bitshift 1 add 2 index put exch
					2 copy length 1 index sub GetInterval
					exch 5 -1 roll add 4 1 roll 5 -1 roll 1
					add 5 1 roll 4 index 1 bitshift
					display_map length eq {
						display_map 20 array append
						/display_map exch promote
					} if
				} loop
			} ifelse
		} ifelse
		3 -1 roll 1 add 3 1 roll
	} loop
	1 sub /total_display_lines exch promote
	total_display_lines 0 display_top_line
	max_display_lines add 1 sub max min
	/display_bottom_line exch promote
} def

/compute_updated_display_map {
	% int --
	value display_map 2 index 1 bitshift get
	value length display_map 4 index 1 bitshift
	get sub getinterval display_map 2 index 1
	bitshift get 3 -1 roll exch 3 -1 roll
	compute_display_map_from
} def

/compute_display_map {
	% --
	value length 0 eq {
		/display_top_line 0 promote
		/display_bottom_line 0 promote
		/total_display_lines 0 promote [0 0]
		/display_map exch promote
	} {
		0 0 value compute_display_map_from
	} ifelse
} def

/nexttab {
	% int -- int
	dup tab_width idiv 1 add tab_width mul exch
	sub
} def

/show_with_tabs {
	% string --
	currentpoint 2 array astore 0 get margin sub
	cvi 1 index (\t) search {
		3 array astore
	} {
		pop null
	} ifelse
	3 1 roll {
		2 index null eq {
			pop exch pop exit
		} if
		exch pop 1 index 0 get exch 2 index 2 get show
		3 -1 roll 2 get stringwidth pop cvi add dup
		nexttab 3 1 roll 2 index 0 rmoveto
		3 -1 roll add 1 index (\t) search {
			3 array astore
		} {
			pop null
		} ifelse
		3 1 roll
	} loop
	show
} def

/width_with_tabs {
	% string -- int
	0 exch dup (\t) search {
		3 array astore
	} {
		pop null
	} ifelse
	exch {
		1 index null eq {
			exch pop exit
		} if
		pop dup 0 get 3 -2 roll 2 get stringwidth pop
		cvi add dup nexttab add exch dup (\t) search {
			3 array astore
		} {
			pop null
		} ifelse
		exch
	} loop
	stringwidth pop cvi add
} def

/width_with_spaces {
	% string -- int
	dup 0 exch (\t) search {
		3 array astore
	} {
		pop null
	} ifelse
	{
		dup null eq {
			pop exit
		} if
		0 get exch 1 add exch (\t) search {
			3 array astore
		} {
			pop null
		} ifelse
	} loop
	exch stringwidth pop exch ( ) stringwidth pop
	mul add cvi
} def

/show_with_spaces {
	% string --
	( ) stringwidth pop 0 9 4 -1 roll widthshow
} def

/set_tabs {
	% int --
	dup /tab_width exch softpromote
	justification /Left eq {
		0 eq {
			/text_show_proc /show_with_spaces
			promote /text_width_proc
			/width_with_spaces promote
		} {
			/text_show_proc unpromote
			/text_width_proc unpromote
		} ifelse
		compute_display_map paint
	} {pop} ifelse
} def

/justification_indent {
	% string -- int
	justification
	justification_indent$SwiTch0 exch 2 copy
	known not {
		pop /$deFaUlT
	} if
	get exec
} def

/justification_indent$SwiTch0 3 dict dup
begin
/Right {
	textarea_width exch text_width_proc cvx
	exec sub
} def
/Centered {
	textarea_width exch text_width_proc cvx
	exec sub -1 bitshift
} def
/$deFaUlT {
	pop 0
} def
end
def

/set_justification {
	% name --
	dup set_justification$SwiTch1 exch 2 copy
	known not {
		pop /$deFaUlT
	} if
	get exec /justification exch softpromote
	compute_display_map paint
} def

/set_justification$SwiTch1 3 dict dup begin
/Right {
	/text_show_proc /show_with_spaces
	promote /text_width_proc
	/width_with_spaces promote
} def
/Centered {
	/text_show_proc /show_with_spaces
	promote /text_width_proc
	/width_with_spaces promote
} def
/$deFaUlT {
	/text_show_proc unpromote
	/text_width_proc unpromote
} def
end
def

/paint_text_from_line_to {
	% int int --
	dup display_bottom_line eq 3 {
		dup ypos_from_line
	} ifelse
	cvi 2 index display_top_line
	max_display_lines add le {
		gsave clip_textarea 3 -1 roll
		display_top_line max 3 1 roll BG setcolor
		dup 3 exch boxarea_width 6 sub 5 index 1 sub
		ypos_from_line line_gap sub 5 -1 roll sub
		rectpath fill FG setcolor textfont setfont
		textfont fontheight line_gap add 2 index
		ypos_from_line 4 -1 roll {
			dup 4 index gt {
				pop pop pop pop exit
			} if
			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 index
			textfont fontdescent add moveto
			text_show_proc cvx exec exch 2 index neg
			add exch 1 add
		} loop
		grestore
	} {
		pop pop pop
	} ifelse
} def

/paint_text_from_line {
	% int --
	display_bottom_line
	paint_text_from_line_to
} def

/Paint {
	% --
	BG setcolor clippath fill 0
	paint_text_from_line has_bounding_box {
		false 0 0 boxarea_width h OLBox
	} if
} def

/set_bounding_box {
	% boolean --
	dup /has_bounding_box exch softpromote {
		/OLBox [false
	} {
		/undrawOLBox [
	} ifelse
	0 0 boxarea_width h] gexeca
} def

/set_value {
	% string --
	dup length string copy /value exch promote
	/display_top_line 0 promote
	compute_display_map paint
} def

/clearvalue {
	% --
	//nullstring set_value
} def

/set_line_wrap {
	% name --
	/line_wrap exch softpromote
	compute_display_map paint
} def

/set_font {
	% name int --
	exch findfont exch scalefont false
	printermatchfont /textfont exch promote
	compute_no_display_lines
	compute_display_map paint
} def

/Validate {
	% --
	//Validate exec compute_no_display_lines
	compute_display_map
} def

/minwidth {
	% -- float
	margin2 10 add
} def

/minheight {
	% -- float
	margin2 10 add
} def

/setfile {
	% string --
	loadfile set_value
} def


%begin postscript section
/loadfile {
	% string
	(PATH) (~) ?getenv filepathparse (r)
	filepathopen {
		/contents //nullstring def
		exch pop % file
		{
			dup 256 string readline not {
				/contents contents 3 -1 roll append
				store
				closefile contents exit
			} if
			/contents contents 3 -1 roll append (\n)
			append store
		} loop
	} {
		(Cannot open file : ) exch append
	} ifelse
} def
%end postscript section