/text superclass
 /items //nullarray def

/defaultchoice -1 def

/choicemode /ExclusiveVariation def

/selection //nullarray def

/topitem 0 def


%begin postscript section
/items persist %end postscript section


%begin postscript section
/defaultchoice persist %end postscript section


%begin postscript section
/choicemode persist %end postscript section


%begin postscript section
/scrolllinedelay persist %end postscript section


%begin postscript section
/scrollthreshold persist %end postscript section


%begin postscript section
/scrollautorepeat persist %end postscript section

/itemtopy {
	% -- int
	h 8 sub cvi
} def

/itemheight {
	% -- float
	textfont fontheight 8 add
} def

/viewsize {
	% -- int
	0 itemtopy 8 sub itemheight div max cvi
} def

/itemareawidth {
	% -- int
	w //OLScrollW sub 4 sub cvi
} def

/itemrectwidth {
	% -- int
	w //OLScrollW sub 20 sub cvi
} def

/itemrectx {
	% -- int
	8
} def

/itemrecty {
	% int -- int
	itemtopy exch topitem sub 1 add itemheight
	neg mul add cvi
} def

/itemx {
	% -- int
	12
} def

/itemwidth {
	% -- int
	w //OLScrollW sub 28 sub cvi
} def

/minwidth {
	% -- float
	//OLScrollW 38 add
} def

/minheight {
	% -- float
	itemheight 16 add
} def

/preferredheight {
	% -- float
	nritems itemheight mul 16 add
} def

/preferredwidth {
	% -- float
	40 gsave textfont setfont 0 exch {
		1 index nritems ge {
			exch pop exit
		} if
		1 index itemlabel DISize pop 10 add max cvi
		exch 1 add exch
	} loop
	grestore //OLScrollW add 28 add
} def

/nritems {
	% -- int
	items length
} def

/itemselected {
	% int -- boolean
	dup nritems lt {
		selection exch arraycontains?
	} {
		pop false
	} ifelse
} def

/itemlabel {
	% int -- any
	dup nritems lt {
		items exch get
	} {
		pop null
	} ifelse
} def

/PaintBackground {
	% --
	false 0 0 itemareawidth h OLRect
	itemareawidth 0 4 h rectpath BG setcolor fill
} def

/PaintItem {
	% int --
	dup topitem lt true {
		dup topitem sub viewsize ge
	} ifelse
	{pop} {
		dup itemrecty 1 index nritems ge {
			exch pop itemrectx exch itemrectwidth
			itemheight rectpath BG setcolor fill
		} {
			1 index itemselected {
				true itemrectx 2 index itemrectwidth
				itemheight OLRect
			} {
				itemrectx 1 index itemrectwidth
				itemheight rectpath BG setcolor fill
				1 index defaultchoice eq {
					1 [itemrectx 3 index itemrectwidth
					itemheight] insetstroke aload pop
					rectpath BG2 setcolor stroke
				} if
			} ifelse
			textfont setfont FG setcolor exch
			itemlabel itemx 3 -1 roll 2 add itemwidth
			itemheight 4 sub OLShow
		} ifelse
	} ifelse
} def

/PaintItems {
	% --
	topitem viewsize {
		dup 1 sub exch 0 eq {
			pop pop exit
		} if
		exch dup 1 add 3 1 roll PaintItem
	} loop
} def

/Paint {
	% --
	PaintBackground PaintItems
} def

/preview {
	% --
	[selected_items] /Preview self Send
} def

/action {
	% --
	[selected_strings] /Action self Send
} def

/action2 {
	% --
	[selected_strings] /Action2 self Send
} def

/setselection0 {
	% int * --
	selection /selection unpromote exch {
		dup 0 ge {
			dup nritems lt
		} false ifelse
		{
			selection 1 index arraycontains? not
		} false ifelse
		{
			selection [3 -1 roll] append /selection
			exch promote
		} {pop} ifelse
	} forall nritems 0 ne {
		choicemode setselection0$SwiTch0 exch
		2 copy known not {
			pop /$deFaUlT
		} if
		get exec
	} if
	dup selection cmp {pop} {
		dup {
			selection 1 index arraycontains? not {
				PaintItem} {pop} ifelse
		} forall selection {
			2 copy arraycontains? not {PaintItem} {
				pop} ifelse
		} forall pop preview
	} ifelse
} def

/setselection0$SwiTch0 3 dict dup begin
/$deFaUlT {} def
/ExclusiveVariation {
	selection length 1 gt {
		[selection 0 get] /selection exch promote
	} if
} def
/Exclusive {
	selection length 0 eq {
		[defaultchoice] /selection exch promote
	} {
		selection length 1 gt {
			[selection 0 get] /selection exch promote
		} if
	} ifelse
} def
end
def

/setselection {
	% int * --
	/setselection0 [3 -1 roll] gexeca
} def

/Validate {
	% --
	[topitem viewsize nritems 1 sub]
	/setparameters /@scroll Send
} def

/scrollitems {
	% int --
	viewsize itemheight mul cvi itemrectx
	itemtopy 2 index sub itemrectwidth
	4 -1 roll rectpath clip dup 0 exch topitem
	sub itemheight mul copyarea dup topitem gt {
		dup topitem viewsize add max 1 index
		viewsize add
	} {
		dup dup viewsize add topitem min
	} ifelse
	exch 2 index /topitem exch promote {
		2 copy lt {
			pop pop exit
		} if
		dup PaintItem 1 add
	} loop
	[exch] /setvalue /@scroll Send
} def

/settop {
	% int --
	0 exch nritems 1 sub min max dup topitem ne {
		/scrollitems [3 -1 roll] gexeca
	} {pop} ifelse
} def

/tracksel //nullarray def

/track_exclusive {
	% --
	track_is_timed {scrollautorepeat} false
	ifelse
	{
		tracky h gt {
			topitem 1 sub settop
		} {
			tracky 0 lt {
				topitem viewsize add nritems lt
			} false ifelse
			{
				topitem 1 add settop
			} if
		} ifelse
	} {
		trackx itemrectx lt true {
			trackx itemrectx itemrectwidth add gt
		} ifelse
		{tracksel} {
			nritems 1 sub 0 topitem itemtopy tracky sub
			itemheight div add max min cvi [exch]
		} ifelse
		setselection
	} ifelse
} def

/track_nonexclusive {
	% --
	track_is_timed {scrollautorepeat} false
	ifelse
	{
		tracky h gt {
			topitem 1 sub settop
		} {
			tracky 0 lt {
				topitem viewsize add nritems lt
			} false ifelse
			{
				topitem 1 add settop
			} if
		} ifelse
	} {
		trackx itemrectx lt true {
			trackx itemrectx itemrectwidth add gt
		} ifelse
		{tracksel} {
			nritems 1 sub 0 topitem itemtopy tracky sub
			itemheight div add max min cvi tracksel
			1 index arrayindex not -1 if
			dup 0 ge {
				exch pop tracksel dup length array copy
				exch arraydelete
			} {
				pop [exch] tracksel append
			} ifelse
		} ifelse
		setselection
	} ifelse
} def

/OnSelect {
	% --
	selection /tracksel exch promote
	choicemode OnSelect$SwiTch1 exch 2 copy
	known not {
		pop /$deFaUlT
	} if
	get exec tracksel selection cmp not {action}
	if
	/tracksel unpromote
} def

/OnSelect$SwiTch1 2 dict dup begin
/$deFaUlT {
	scrollthreshold scrolllinedelay
	/track_nonexclusive track_time pop
} def
/Exclusive {
	mouselevel 2 eq {
		track_state /mouse_click eq
	} false ifelse
	{
		topitem itemtopy mouseevent /YLocation
		get sub itemheight div add cvi [exch]
		setselection action2
	} {
		scrollthreshold scrolllinedelay
		/track_exclusive track_time pop
	} ifelse
} def
end
def

/setdefaultchoice {
	% int --
	choicemode /Exclusive eq 0 -1 ifelse
	exch nritems 1 sub min max defaultchoice
	1 index ne {
		defaultchoice /defaultchoice 3 -1 roll
		softpromote [defaultchoice] /selection
		exch promote /PaintItem [3 -1 roll]
		gexeca /PaintItem [defaultchoice] gexeca
	} {pop} ifelse
} def

/setitems {
	% any * --
	/topitem 0 promote /items exch promote
	choicemode /Exclusive eq {
		/defaultchoice 0 defaultchoice nritems 1
		sub min max softpromote [defaultchoice]
		/selection exch promote
	} {
		/selection unpromote
	} ifelse
	/PaintItems gexec Validate preview
} def

/setchoicemode {
	% name --
	dup choicemode ne {
		/choicemode exch promote choicemode
		/Exclusive eq {
			defaultchoice setdefaultchoice
		} if
		selection setselection
	} {pop} ifelse
} def

/selected_strings {
	% -- string *
	//nullarray selection {
		exch [3 -1 roll itemlabel DIString]
		append
	} forall
} def

/selected_items {
	% -- int *
	selection selection length array copy
} def

/OnInit {
	% --
	/@scroll promoted not {
		/olscrollbar newmember /@scroll /rename
		2 index send
		pop //nullstring (/Preview {[exch] /settop @parent Send} def\n/Action /pop load def)
		/setscript 3 index send
		pop null 0 0 0 /setposition 5 index send
		/map exch send
	} if
} def