-- <<<-


------------------------------------------------------------------------


global actionChanged


------------------------------------------------------------------------


function defineClasses -> (
	defineClasses1()
	defineClasses2()
	defineClasses3()
	defineClasses4()
	function defineClasses -> ok
	function defineClasses1 -> ok
	function defineClasses2 -> ok
	function defineClasses3 -> ok
	function defineClasses4 -> ok
)

function defineClasses1 -> (


------------------------------------------------------------------------


-- Class ActionPresenter presents Action objects, such as the PerpetrateAction
-- on a timeline. If the actions have a variable duration (end time can change),
-- the ActionPresenter adds a draggable "nib", which is used to set the
-- duration. The manager instance variable is used for notification of changes
-- in state. When the action presenter is moved or its nib is dropped, it
-- invokes the actionChanged method on the manager instance variable. 
class ActionPresenter (TrackerTwoDSpace)
instance variables
	-- Public
	manager		-- Object which is notified about changes.
	updateAction	-- Method to dispatch when state changes.
	
	-- Private
	thumbnail
	status
	nib
	xOffset
	yOffset
	anchorLines
	anchorLine
	anchorLineUpper
	anchorLineLower
	variableDuration
end


method init self {class ActionPresenter} #rest args #key \
	images: \
	manager: \
	variableDuration:(false) ->
(
	apply nextMethod self args
	self.variableDuration := variableDuration
	self.manager := manager
	self.status := @normal
	self.anchorLines := new Array

	-- Create the icon by scaling the object's thumbnail.
	local iconHeight := 32
	local iconWidth := 32
	local thumbnail := getThumbnail self.target.perpetrator
	local thumbnailBoundary := thumbnail.bbox
	local mat := mutableCopy identityMatrix
	translate mat (-thumbnailBoundary.x1) (-thumbnailBoundary.y1)
	if (thumbnailBoundary.width > thumbnailBoundary.height) then (
		local sc := iconWidth / thumbnailBoundary.width
		scale mat sc sc
		translate mat 0 ((iconHeight - (thumbnailBoundary.height * sc)) / 2)
	) else (
		local sc := iconHeight / thumbnailBoundary.height
		scale mat sc sc
		translate mat ((iconWidth - (thumbnailBoundary.width * sc)) / 2) 0
	)
	local icon := new BitmapSurface \
		bbox: (new Rect x2: iconWidth y2: iconHeight) \
		colormap: theDefault8Colormap
	erase icon (new Brush color: (new RGBColor red: 128 green: 128 blue: 128))
	transfer icon (thumbnail as BitmapSurface) icon mat
	icon := icon as Bitmap
	local thumb := new TrackerTwoDShape \
					   boundary: icon \
					   stroke: blackBrush
	prepend self thumb
	self.thumbnail := thumb

	if variableDuration do
		addNib self images
)


method addNib self {class ActionPresenter} images -> (
	local nib := new TrackerTwoDShape \
					 boundary: images["nib"]
	nib.x := 25
	nib.y := 4
	prepend self nib
	self.nib := nib

	self.anchorLineUpper := new TwoDShape \
								boundary: (new Line \
											   x1:0 y1:-10 \
											   x2:15 y2:0) \
								stroke: blackBrush
	self.anchorLineUpper.x := self.thumbnail.width
	self.anchorLineUpper.y := self.height / 2
	append self self.anchorLineUpper
	append self.anchorLines self.anchorLineUpper

	self.anchorLineLower := new TwoDShape \
								boundary: (new Line \
											   x1:0 y1:10 \
											   x2:15 y2:0) \
								stroke: blackBrush
	self.anchorLineLower.x := self.thumbnail.width
	self.anchorLineLower.y := self.height / 2
	append self self.anchorLineLower
	append self.anchorLines self.anchorLineLower

	self.anchorLine := new TwoDShape \
						   boundary: (new Line \
						   				  x1:0 y1:0 \
						   				  x2:15 y2:0) \
						   stroke: blackBrush
	self.anchorLine.x := self.thumbnail.width
	self.anchorLine.y := self.height / 2
	append self self.anchorLine

	append self.anchorLines self.anchorLine
)


method updateAnchorLines self {class ActionPresenter} -> (
	local ab := self.anchorLine.boundary
	local allb := self.anchorLineLower.boundary
	local alub := self.anchorLineUpper.boundary
	allb.x2 := ab.x2
	allb.y2 := ab.y2
	alub.x2 := ab.x2
	alub.y2 := ab.y2
	local pb := self.presentedBy
	if (pb <> undefined) do (
		notifyChanged pb true
	)
)


-- Method set width is overridden to change the anchor line width 
-- and nib location
method set width self {class ActionPresenter} value -> (
	nextMethod self (max value (self.thumbnail.width))
	if self.variableDuration do
	(
		self.anchorLine.width := value - self.nib.width - self.thumbnail.width
		updateAnchorLines self
		self.nib.x := value - self.nib.width
	)
)


-- Method trackStart is called by the track service. If either the
-- thumb or the nib were clicked on, the track target is set to self, so that
-- the event marker receives subsequent tracking events. If tracking the nib,
-- move it and the anchor line one space out, so they can be composited outside
-- the current boundary.
method trackStart self {class ActionPresenter} service ev state -> (
	local result := nextMethod self service ev state
	if not result do return result
	if (isAKindOf state[@trackTarget] TrackerTwoDShape) do (
		state[@trackMatrix] := translate state[@trackMatrix] self.x self.y
		self.xOffset := ev.localCoords.x - state[@trackTarget].x
		self.yOffset := ev.localCoords.y - state[@trackTarget].y

		if (state[@trackTarget] = self.nib) then (
			-- Move the anchor lines one space out.
			for a in self.anchorLines do (
				deleteOne self a
				a.x := self.x + a.x
				a.y := self.y + a.y
				prepend self.presentedBy a
			)

			state[@trackTarget].y := self.y + state[@trackTarget].y
			prepend self.presentedBy state[@trackTarget]

			self.status := @stretching
		) else if (state[@trackTarget] = self.thumbnail) do (
			self.status := @moving
			self.xOffset := self.xOffset + self.thumbnail.x
		)
		-- Send all tracking stuff to self.
		state[@trackTarget] := self
	)
	result
)


-- Method trackMove is called by the track service. If status is @stretching,
-- move the nib and change the width of the anchor line. If status is @moving,
-- move self.
method trackMove self {class ActionPresenter} service ev -> (
	local pt := ev.localCoords
	if (self.status = @stretching) then (
		local a := self.anchorLine
		self.nib.x := max self.x (pt.x - self.xOffset)
		a.width := self.nib.x - self.thumbnail.width - self.x + 1
		updateAnchorLines self
	) else if (self.status = @moving) do (
		self.x := pt.x - self.xOffset
 		self.y := pt.y - self.yOffset
	)
)


-- Method trackUp is called by the track service. If status is @stretching,
-- move the line and the nib back into self, and set self's width to
-- accomodate.
method trackUp self {class ActionPresenter} service ev -> (
	nextMethod self service ev
	if (self.status = @stretching) do (
		for a in self.anchorLines do (
			deleteOne a.presentedBy a
			a.x := a.x - self.x
			a.y := a.y - self.y
			append self a
		)

		prepend self self.nib
		self.nib.x := self.nib.x - self.x
		self.nib.y := 4
		self.width := self.nib.x + self.nib.width
	)
	-- Set time and duration based on current position and length.
	actionChanged self.manager self

	self.status := @normal
)


------------------------------------------------------------------------


) -- defineClasses1

garbageCollect()

function defineClasses2 -> (


------------------------------------------------------------------------


-- Class AudioPresenter is a TwoDMultipresenter subclass which displays an audio
-- player's wave form. The wave form is automatically centered, and is sampled as
-- far as possible, based on the width (may be shorter than the width, if it reaches
-- the end of the audio stream). The update method forces the audio presenter to
-- resample the audio stream based on the current state. The state includes the
-- scale, resolution and offset. The scale iv affects how much the wave form is 
-- scaled in amplitude. The default scale of 1 means the sample value is used as the
-- pixel value. The resolution iv affects how often the samples are "sampled", that 
-- is, how many actual samples are skipped between each plotted value. The offset iv
-- affects where the sampling starts. The offset is specified in seconds. The 
-- scrubbing option sets up event interests in mouse down and up, so that mouse
-- clicks on the presenter play the audio from that position. The AudioPresenter
-- currently only handles 8 bit audio.
class AudioPresenter (TwoDMultipresenter)
instance variables
	-- Public instance variables.
	scale			-- Multiplier for the amplitude.
	resolution		-- How often the digital audio samples are "sampled" 
					-- for the graph.
	soundFill		-- The brush used to fill the sound wave.
	soundStroke		-- The brush used to stroke the sound wave.
	markerRefreshRate: 15	-- How often to refresh the marker line 
					-- when playing.
	offset: 0		-- Time offset from the beginning of the target player.
	marker			-- White line marker of current location.
		
	-- Private instance variables.
	scrubbing		-- True if "scrubbing" feature is enabled.
	refreshCallback: undefined	-- Callback to refresh marker position.
	soundPath: undefined	-- TwoDShape representation of the sound wave.
	needsUpdate		-- Update needed
end


method init self {class AudioPresenter} #rest args #key \
	soundFill: (new Brush color: (new RGBColor red:153 green:102 blue:255)) \
	soundStroke: (new Brush color: (new RGBColor red:200 green:200 blue:200)) \
	resolution: (100) \
	scrubbing: (false) \
	offset: (0) \
	scale: (1) \
-> (
	apply nextMethod self args
	self.soundFill := soundFill
	self.soundStroke := soundStroke
	self.resolution := resolution
	self.scrubbing := scrubbing
	self.offset := offset
	self.scale := scale
	self.needsUpdate := true

	-- Setup scrubbing if requested. This allows the audio presenter to be
	-- clicked on to play the audio.
	if (scrubbing) do (
		setupScrubbing self
	)
)


-- Method setupScrubbing sets up a marker refresh callback and mouse event
-- receivers. The marker refresh callback sweeps a line across the audio
-- presenter while the target player is playing. The mouse event receivers
-- are used to start (mouse down) and stop (mouse up) the audio player.
method setupScrubbing self {class AudioPresenter} ->
(
	self.marker := new TwoDShape \
					   boundary: (new Line \
					   				  x1:0 y1:0 \
					   				  x2:0 y2:self.height) \
					   stroke: whiteBrush
	prepend self self.marker
	self.marker.x := -1

	setupRefreshCallback self

	-- Set up all of the event receivers.	
	local mouseD := new MouseDevice
	local downInterest := new MouseDownEvent
	downInterest.presenter := self
	downInterest.eventReceiver := processMouseDown
	downInterest.device := mouseD
	downInterest.buttons := @MouseButton1        
	downInterest.authorData := self 
	addEventInterest downInterest

	local upInterest := new MouseUpEvent
	upInterest.presenter := self
	upInterest.eventReceiver := processMouseUp
	upInterest.device := mouseD
	upInterest.buttons := @MouseButton1                
	upInterest.authorData := self
	addEventInterest upInterest	
)


-- Method pixelsPerSecond returns pixels per second based on the current target
-- player and resolution.
method pixelsPerSecond self {class AudioPresenter} ->
(
	return self.target.scale / self.resolution
)


-- Method setupRefreshCallback creates a callback on the target audio player 
-- which calls the updateMarker method at the rate specified in 
-- markerRefreshRate.
method setupRefreshCallback self {class AudioPresenter} ->
(
	-- If there is an old callback, cancel it.
	if (self.refreshCallback <> undefined) do (
		cancel self.refreshCallback
	)
	
	-- Create a new callback, which fires at the markerRefreshRate.
	self.refreshCallback := 
		addPeriodicCallback self.target \
		(self -> updateMarker self) 
		self #() \
		(round (self.target.scale / self.markerRefreshRate))
	self.refreshCallback.skipIfLate := true
)


-- Method processMouseDown is called when the mouse is clicked anywhere on 
-- the audio presenter. It calculates the time at the point of the mouse 
-- click, seeks the audio player to the time, and plays the audio player.
method processMouseDown self {class AudioPresenter} matchedInterest ev ->
(
	if (self.scrubbing) do (
		self.marker.x := ev.localCoords.x
	)
	local seconds := self.offset + (ev.localCoords.x / (pixelsPerSecond self))
	local dap := self.target
	dap.time := dap.scale * seconds
	play dap
)


-- Method processMouseUp simply stops the target audio player.
method processMouseUp self {class AudioPresenter} matchedInterest ev ->
(
	stop self.target
 	if self.scrubbing do
		self.marker.x := -1
)


-- Method resetPlayer stops the player and moves it to the beginning, and puts
-- the marker at 0.
method resetPlayer self {class AudioPresenter} ->
(
	stop self.target
	goToBegin self.target
	if self.scrubbing do
		self.marker.x := -1
)


-- Method updateMarker positions the marker based on the current time of
-- the target player.
method updateMarker self {class AudioPresenter} ->
(
	local plr := self.target
	-- Only move the marker if it is within the current boundary.
	local newPosition := 
		(plr.time as Integer - (self.offset * plr.scale)) / self.resolution
	if ((plr.time < plr.duration) and plr.rate <> 0 and \
		newPosition < self.width) then
	(
		self.marker.x := newPosition
	)
	else
		self.marker.x := -1
)


method draw self {class AudioPresenter} surf clip -> (
	if (self.needsUpdate and
		(self.target != undefined)) do (
		doUpdate self
		self.needsUpdate := false
	)
	nextMethod self surf clip
)


method update self {class AudioPresenter} -> (
	self.needsUpdate := true
)


-- Method doUpdate is the workhorse of the AudioPresenter class. It reads 
-- through the audio samples at the specified resolution and builds a Path, 
-- drawing lines for each "sampled sample". Hard-coded to 8 bit audio, for 
-- now. 16 bit left as an exercise.
method doUpdate self {class AudioPresenter} ->
(
	threadCriticalUp()
	
	-- Create a bitmap surface on which to render the graph.
	local b := new BitmapSurface \
				   colormap: theDefault8Colormap \
				   bbox: self.boundary
	local midPoint := self.height / 2
	local mediaStream := self.target.mediaStream
	local s := mediaStream.inputStream
	local oldCursor := cursor s

	-- Calculate the byte offset, keeping it "aligned" with the resolution. 
	-- This ensures that the waveform doesn't change when there are changes 
	-- in offset.
	local byteOffset := (self.resolution + 1) * \
		(round (self.offset * self.target.scale / (self.resolution + 1)))
	seekFromStart s byteOffset
	local sample
	local slack := (streamLength s) - self.resolution
	local i := 0
	local notDone := true
	local startX := 0
	local startY := midPoint
	local soundStroke := self.soundStroke
	local newX, newY
	local yOffset := midPoint - (127 * self.scale)
	local l := new Line
	local bb := b.bBox
	local res := self.resolution
	local myWidth := self.width
	local myScale := self.scale
	local readSample
	if (mediaStream.sampleType == @twosComplement) then (
		readSample := (s ->
			local samp := read s
			if (samp < 128) then (
				return (samp + 128)
			) else (
				return (128 - samp)
			)
		)
	) else (
		readSample := (s -> read s)
	)
	repeat while (notDone and (i < myWidth)) do
	(
		sample := readSample s
		newY := round ((sample * myScale) + yOffset)
		i := i + 1
		l.x1 := startX
		l.y1 := startY
		l.x2 := i
		l.y2 := newY
		startX := i
		startY := newY
		stroke b l bb identityMatrix soundStroke
		if ((i * (res + 1) + byteOffset) < slack) then (
			seekFromCursor s res
		) else (
			notDone := false
		)
	)

	-- If there is already an audio graph, delete it.
	if (self.soundPath <> undefined) do (
		deleteOne self self.soundPath
	)
	self.soundPath := new TwoDShape boundary: (b as Bitmap) 
	append self self.soundPath
	if self.scrubbing do
	(
		self.marker.height := self.soundPath.height
		setupRefreshCallback self
	)

	if ((systemQuery @SXVersion) < 1.1) then ( -- ScriptX 1.0:
		self.imageChanged := true
	) else ( -- ScriptX 1.1:
		notifyChanged self false
	) -- ScriptX 1.x

	seekFromStart s oldCursor

	threadCriticalDown()
)


------------------------------------------------------------------------


) -- defineClasses2

garbageCollect()

function defineClasses3 -> (


------------------------------------------------------------------------


-- The NumberLine class is a presenter which displays a number line,
-- with tick marks and labels for the values.
class NumberLine (TwoDMultiPresenter)
instance variables

	-- PUBLIC
	scale
	minimumMultiple
	maximumMultiple
	multiple
	resolution
	offset
	orientation	-- Which side the ticks are on (@top or @bottom)

	-- PRIVATE
	labels
	shortTickMark
	longTickMark
	grayBrush
end


method init self {class NumberLine} #rest args #key \
	scale:(12) \
	minimumMultiple:(0.1) \
	maximumMultiple:(1) \
	multiple:(1) \
	resolution:(3) \
	offset:(0) \
	orientation:(@bottom) ->
(
	apply nextMethod self args
	self.labels := new Array
	self.scale := scale
	self.minimumMultiple := minimumMultiple
	self.maximumMultiple := maximumMultiple
	self.multiple := multiple
	self.resolution := resolution
	self.offset := offset
	self.grayBrush := new Brush \
						  color: (new RGBColor red:100 green:100 blue:100)
	if orientation = @bottom then
	(
		self.shortTickMark := new Line \
								  x1:0 y1:(self.height - 3) \
								  x2:0 y2:self.height
		self.longTickMark := new Line \
								 x1:0 y1:(self.height - 5) \
								 x2:0 y2:self.height
	) else
	(
		self.shortTickMark := new Line \
								  x1:0 y1:0 \
								  x2:0 y2:3
		self.longTickMark := new Line \
								 x1:0 y1:0 \
								 x2:0 y2:5
	)
	calculateLabels self @create
	return self
)


-- Method update recalculates the labels for the time line.
method update self {class NumberLine} ->
(
	-- Turn the compositor off while getting new values.
	if (self.window <> undefined) do
	(
		local comp := self.window.compositor
		local ena := comp.enabled
		comp.enabled := false
		calculateLabels self @create
		if ((systemQuery @SXVersion) < 1.1) then ( -- ScriptX 1.0:
			self.changed := true
		) else ( -- ScriptX 1.1:
			notifyChanged self true
		) -- ScriptX 1.x
		comp.enabled := ena
	)
	return value
)


-- Method zoomIn zooms in by a factor of 2.
method zoomIn self {class NumberLine} ->
(
	self.multiple := self.multiple / 2
	-- If the multiple is above the minimum, halve the scale and double 
	-- the resolution.
	if ((self.multiple >= self.minimumMultiple) and 
		(self.multiple < self.maximumMultiple)) do
	(
		if false do (
		self.resolution := self.resolution * 2
		self.scale := self.scale / 2
		)
	)
	update self
)


-- Method zoom out zooms out by a factor of 2.
method zoomOut self {class NumberLine} ->
(
	self.multiple := self.multiple * 2
	-- If the multiple is below the maximum, double the scale and halve the 
	-- resolution..
	if ((self.multiple <= self.maximumMultiple) and 
		(self.multiple > self.minimumMultiple)) do
	(
		if false do (
		self.resolution := self.resolution / 2
		self.scale := self.scale * 2
		)
	)
	update self
)


-- Method pageLeft moves the number line offset left one "page" (width of self).
method pageLeft self {class NumberLine } ->
(
	local x := pixelsToTicks self self.width
	local tmp := self.offset
	self.offset := max 0 (self.offset - (floor x))
 	if (tmp <> self.offset) do
		update self
)


-- Method pageRight moves the number line offset right one "page" 
-- (width of self).
method pageRight self {class NumberLine } ->
(
	local x := pixelsToTicks self self.width
	local tmp := self.offset
	self.offset := self.offset + (floor x)
	if (tmp <> self.offset) do (
		update self
	)
)


-- Method pixelsPerUnit.
method pixelsPerUnit self {class NumberLine} ->
(
	return ((self.scale * self.resolution) / self.multiple)
)


-- Method unitsToPixels calculates the width in pixels on the number line 
-- for a given number of units.
method unitsToPixels self {class NumberLine} units ->
(
	return round ((pixelsPerUnit self) * units)
)


-- Method offsetCorrection returns the offset, converted to pixels.
method offsetCorrection self {class NumberLine} ->
(
	return (self.offset * (pixelsPerUnit self))
)


-- Method unitsToPixels converts a unit value to pixels.
method unitsToPixels self {class NumberLine} units ->
(
	return (units * (pixelsPerUnit self))
)


-- Method pixelsToTicks converts a pixel value to units.
method pixelsToUnits self {class NumberLine} pixels ->
(
	return (pixels / (pixelsPerUnit self))
)


if ((systemQuery @SXVersion) < 1.1) then ( -- ScriptX 1.0:

-- Method calculateLabels calculates the values for each text presenter in the 
-- time line. The mode flag can be @create or @update. In @create mode, the old 
-- labels are deleted and new ones are created. In @update mode, the existing 
-- labels are updated with new values.
method calculateLabels self {class NumberLine} mode ->
(
	-- Clear out the old labels in @create mode only.
	if (mode = @create) do
	(
		for i in self.labels do
			deleteOne self i
	)

	-- Add new labels
	local i := 0
	local totalSpace := 0
	local t
	repeat while (totalSpace < self.width) do
	(
		if ((mod i self.scale) = 0) do
		(
			local value := self.offset + (i / self.scale * self.multiple)
			-- Take off extra padding (and prevent scientific notation 
			-- on Windows)
			value := ((round (value * 1000)) / 1000) as String

			if (mode = @create) then
			(
				t := new TextPresenter \
						 boundary: (new Rect x2:30 y2:10) \
						 target: value
				t.attributes[@font] := theDefaultFont
				t.attributes[@brush] := whiteBrush
				t.attributes[@size] := 9
				t.attributes[@leading] := 9
				prepend self t
				append self.labels t
			) else (
				t := self.labels[(i  / self.scale) + 1]
				t.target := value
			)
			t.x := totalSpace
			if (self.orientation = @up) then
				t.y := self.longTickMark.height + 2
			else
				t.y := self.height - self.longTickMark.height - 10
		)
		i := i + 1
		totalSpace := totalSpace + self.resolution
	)
)

) else ( -- ScriptX 1.1:

-- Method calculateLabels calculates the values for each text presenter in the 
-- time line. The mode flag can be @create or @update. In @create mode, the old 
-- labels are deleted and new ones are created. In @update mode, the existing 
-- labels are updated with new values.
method calculateLabels self {class NumberLine} mode ->
(
	-- Clear out the old labels in @create mode only.
	if (mode = @create) do
	(
		for i in self.labels do
			deleteOne self i
	)

	-- Add new labels
	local i := 0
	local totalSpace := 0
	local t
	repeat while (totalSpace < self.width) do
	(
		if ((mod i self.scale) = 0) do
		(
			local value := self.offset + (i / self.scale * self.multiple)
			-- Take off extra padding (and prevent scientific notation 
			-- on Windows)
			value := ((round (value * 1000)) / 1000) as String

			if (mode = @create) then
			(
				local ts := new TextStencil \
								font: theDefaultFont \
						 		size: 9 \
						 		string: value
				transform ts (new TwoDMatrix ty: 10) @mutate
				t := new TwoDShape \
						 boundary: ts \
						 fill: whiteBrush
				prepend self t
				append self.labels t
			) else (
				t := self.labels[(i  / self.scale) + 1]
				t.boundary.string := value
			)
			t.x := totalSpace
			if (self.orientation = @up) then
				t.y := self.longTickMark.height + 2
			else
				t.y := self.height - self.longTickMark.height - 10
		)
		i := i + 1
		totalSpace := totalSpace + self.resolution
	)
)

) -- ScriptX 1.x


-- Method draw calls nextMethod and draws the tick marks.
method draw self {class NumberLine} surface clip ->
(
	nextMethod self surface clip

	-- Draw the tick marks.
	local tm
	local tickMatrix := copy self.globalTransform
	local totalSpace := 0
	local i := 0
	repeat while (totalSpace < self.width) do
	(
		-- If we are at a scale mark, use the long tick mark.
		if ((mod i self.scale) = 0) then
			tm := self.longTickMark
		else
			tm := self.shortTickMark

		-- Stroke two lines for shading.
		stroke surface \
			   tm \
			   self.globalBoundary \
			   (translate tickMatrix totalSpace 1) \
			   self.grayBrush
		stroke surface \
			   tm \
			   self.globalBoundary \
			   (translate tickMatrix (totalSpace + 1) 1) \
			   whiteBrush
		totalSpace := totalSpace + self.resolution
		i := i + 1
	)
)


------------------------------------------------------------------------


) -- defineClasses3

garbageCollect()

function defineClasses4 -> (


------------------------------------------------------------------------


-- Class TimelineTool is a tool for editing TimeLine objects.
class TimelineTool (TrackerTwoDSpace, TimelineToolProtocol)
instance variables
	timeLine        -- An instance of Timeline, for scheduling actions.
	mouse           -- Mouse device for changing the cursor.
	images           -- The images table.
	marker          -- Indicator of the current time.
	snapper         -- Interpolator for snapping actions into tracks.
	trackSpacing    -- Space in pixels between each "track" on the chalkbaord.
	refreshCallback -- Callback to refresh the marker.
	markerRefreshRate	-- Rate at which to refresh the marker.
	actions         -- List of current actions.
	numberLine		-- The time line for the tool.
	chalkboard      -- The background area where events live.
	endIndicator    -- The indicator for the end of the time line.
	overView        -- A representation of the entire duration of the sound.
	thumb           -- The thumb representing the visible part of the overview.
	leftMargin      -- The amount in pixels before the time line starts.
	mouse           -- Mouse device for changing the mouse cursor.
	colors          -- KeyedLinkedList of colors.
	tBar			-- Title bar
	zoomControl		-- Magnification zoom slider
	dapPresenters	-- Keyed list, maps daps to presenters.
	needsUpdate		-- Flag, when to update view.
end


-- Method handleMouseDown is called when the mouse is clicked anywhere on the
-- chalkboard. It calculates the time at the point of the mouse click, seeks 
-- the time line to the time, and plays it.
method handleMouseDown self {class TimelineTool} ev ->
(
	local seconds := self.numberLine.offset + \
		(ev.localCoords.x / (pixelsPerUnit self.numberLine))
	local p := self.timeLine
	local newTime := p.scale * seconds
	if (newTime < p.duration) do
	(
		self.marker.x := ev.localCoords.x
		stop p
		p.time := p.scale * seconds
		play p
	)
)


method init self {class TimelineTool} #rest args #key \
	images: \
	timeLine: \
-> (
	apply nextMethod self \
					 boundary: images["timetool"] \
					 onIcon: images["onicon"] \
					 offIcon: images["officon"] \
					 name: @timeline \
					 args
	self.images := images
	self.fill := blackBrush
	self.dapPresenters := #(:)
	self.needsUpdate := true
	self.trackSpacing := 32
	self.actions := new Array
	self.mouse := new MouseDevice
	local colors := new KeyedLinkedList
	add colors @Fill blackBrush
	add colors @BorderFill undefined
	add colors @ChalkboardFill whiteBrush
	add colors @OverviewFill undefined
	add colors @ThumbFill (createBrush 204 153 0)
	add colors @ThumbStroke blackBrush
	add colors @Sound (createBrush 0 255 0)
	add colors @TitlebarFill (createBrush 50 50 50)
	self.colors := colors

	-- Add the title bar.
	local tBar := new TitleBar \
					  boundary: (new Rect x2:self.width y2:28)
	prepend self tBar
	self.tBar := tBar

	-- Add the left border.
	local leftMargin := 28
	local rightMargin := 88
	self.leftMargin := leftMargin

	-- Add the number line.
	local nl := new NumberLine \
					scale: 5 \
					resolution: 20 \
					multiple:5 \
					boundary: (new Rect x2:256 y2:16)
	nl.position := new Point x:leftMargin y:3
	prepend self nl
	self.numberLine := nl

	local t := new TwoDShape \
				   boundary: (new Line \
				   				  x2:256 y2:0) \
				   stroke:whiteBrush
	t.x := nl.x + 1
	t.y := nl.y + nl.height
	prepend self t

	-- Add the overview bar.
	local overView := new TwoDSpace \
						  boundary: (new Rect x2:256 y2:6) \
						  fill: self.colors[@OverviewFill]
	overView.x := leftMargin + 1
	overView.y := 149
	prepend self overView
	self.overView := overView

	-- Add the chalkboard, and define tracker methods on the chalkboard.
	self.chalkboard := new TrackerTwoDSpace \
						   boundary: (new Rect x2:256 y2:129)

	method trackStartMulti obj {object self.chalkboard} service ev foo -> (
		true
	)

	method trackDown obj {object self.chalkboard} service ev -> (
		handleMouseDown self ev
	)

	method trackDrop obj {object self.chalkboard} service x y data doit -> (
		handleDrop self service x y data doit
	)

	self.chalkboard.x := self.leftMargin + 1
	self.chalkboard.y := nl.y + nl.height + 1
	prepend self self.chalkboard
	self.snapper := new Interpolator \
						space: self.chalkboard \
						clock: self.clock

	-- Add chalkboard track lines.
	for i := 1 to (round (self.chalkboard.height / self.trackSpacing)) do
	(
		local t := new TwoDShape \
					   boundary: (new Line \
					   				  x2: self.chalkboard.width y2:0)
		t.y := i * self.trackSpacing
		t.stroke := createBrush 200 200 200
		append self.chalkboard t
	)

	-- Add the end time indicator.
	local endIndicator := new DraggableShape \
							  boundary: images["loop time"]
	endIndicator.x := (10 * pixelsPerUnit nl) - endIndicator.width - 9
	endIndicator.z := 1
	endIndicator.trackConstraint := @horizontal
	endIndicator.minimumX := 0
	endIndicator.maximumX := self.chalkboard.width - 12
	prepend self.chalkboard endIndicator
	endIndicator.manager := self
	endIndicator.dropAction := (manager obj -> setEnd manager obj)
	self.endIndicator := endIndicator
	
	-- Add the marker.
	self.marker := new TwoDShape \
					   boundary: (new Line \
					   				  x1:0 y1:0 \
					   				  x2:0 y2:self.chalkboard.height) \
					   stroke: whiteBrush
	prepend self.chalkboard self.marker
	self.marker.x := -1
	self.markerRefreshRate := 12

	-- Add the thumb.
	local thumb := new DraggableShape \
					   boundary: (new Rect x2:0 y2:6) \
					   fill: self.colors[@ThumbFill] \
					   stroke: self.colors[@ThumbStroke]
	thumb.manager := self
	thumb.trackConstraint := @horizontal
	thumb.minimumX := 0
	thumb.maximumX := 0
	thumb.dropAction := (manager obj -> seekTo manager obj.x)
	prepend overView thumb
	self.thumb := thumb
	append theTrackService thumb

	-- Add the zoom control.
	local zoomControl := new DraggableShape boundary:images["zoom"]
	self.zoomControl := zoomControl
	zoomControl.x := 306
	zoomControl.y := 85
	zoomControl.minimumY := 85
	zoomControl.maximumY := 125
	zoomControl.manager := self
	zoomControl.dropAction := (manager obj -> zoomTo manager (100 * (obj.y - 85) / 40))

	-- Override trackMove to do diagonal dragging..
	method trackMove obj {object zoomControl} service ev ->
	(
		local pt := ev.localCoords
		local y := max obj.minimumY (min obj.maximumY (pt.y - obj.grabOffset.y))
		local x := (y * (- 13) / 36) + 337
		obj.x := x
		obj.y := y
	)
	prepend self zoomControl

	-- Add a close button.
	local t := createCloseBox self
	t.x := 9
	t.y := 10
	prepend self t

	registerTool theNavigator self
)


if ((systemQuery @SXVersion) < 1.1) then ( -- ScriptX 1.0:

method updateTool self {class TimelineTool} -> (
	self.needsUpdate := true
	self.changed := true
)

) else ( -- ScriptX 1.1:

method updateTool self {class TimelineTool} -> (
	self.needsUpdate := true
	notifyChanged self true
)

) -- ScriptX 1.x


method draw self {class TimelineTool} surf clip -> (
	if (self.needsUpdate) do (
		updateTimeline self
		self.needsUpdate := false
	)
	nextMethod self surf clip
)


method dapPresenter self {class TimelineTool} dap -> (
	local dapPresenters := self.dapPresenters
	local pr := dapPresenters[dap]
	if (pr == empty) do (
		self.mouse.pointerType := @Wait

		-- Create an audio presenter for the player.
		pr := new AudioPresenter \
				  boundary: (new Rect \
				   				 x2: (self.overView.width) \
								 y2: (self.trackSpacing - 1)) \
				  target: dap \
				  scale: 0.5 \
				  resolution: (calculateResolution self dap) \
				  soundStroke: self.colors[@Sound]

		-- Position the presenter in the appropriate track.
		local track := size self.dapPresenters
		pr.y := track * self.trackSpacing

		self.dapPresenters[dap] := pr

		self.mouse.pointerType := @Arrow
	)
	pr
)


method updateTimeline self {class TimelineTool} -> (
	local t := self.timeline
	local dapPresenters := self.dapPresenters
	local cb := self.chalkboard
	local newDaps := copy t.slaves
	local oldDapPresenters := #()
	local itChanged := false
	forEachBinding dapPresenters (dap pr xxx ->
		if (isMember newDaps dap) then (
			deleteOne newDaps dap
		) else (
			append oldDapPresenters pr
			itChanged := true
		)
	) ok -- forEachBinding

	if ((size oldDapPresenters) != 0) do (
		itChanged := true
		forEach oldDapPresenters (pr xxx ->
			deleteOne cb pr
			deleteOne dapPresenters pr
		) ok -- forEach
	) -- if
	
	if ((size newDaps) != 0) do (
		itChanged := true
		forEach newDaps (dap xxx ->
			local pr := dapPresenter self dap
			append cb pr
		) ok -- forEach
	) -- if
	if (itChanged) do (
		updateDuration self
	)
)


-- Method connect establishes a link to a scene. Action presenters are 
-- created for each action in the time line, and the tool is updated.
method connect self {class TimelineTool} rm ->
(
	-- Set up time line.
	local timeLine := rm.timeLine
	self.timeLine := timeLine

	updateTool self

	-- Iterate through the actions and add an action presenter for each one.
	forEach timeLine.actions (act a ->
		local ap := addAction self act
		ap.y := (act.track - 1) * self.trackSpacing
	) undefined

	update self

	updateDuration self

	play self
)


-- Method play sets up the refreshCallback and starts the time line.
method play self {class TimelineTool} ->
(
	local l := self.timeLine
	if (l != undefined) do
	(
		scheduleUpdateMarker self
		play l
	)
)


-- Method stop cancels the refresh callback and stops the time line.
-- to the current time line.
method stop self {class TimelineTool} ->
(
	local l := self.timeLine
	if (l != undefined) do
	(
		cancelUpdateMarker self
		l.rate := 0
	)
)


-- Method disconnect breaks the connection between the current timeline 
-- and the tool. All action presenters are deleted from the chalkbaord.
method disconnect self {class TimelineTool} ->
(
	local tl := self.timeLine

	if (tl != undefined) do
	(
		stop self
		emptyOut self.actions

		-- Remove all action presenters from the chalkboard.
		local deleteList := new Array
		for p in self.chalkboard do
		(
			if ((isAKindOf p ActionPresenter) or
				(isAKindOf p AudioPresenter)) do
			(
				append deleteList p
			)
		)
		for p in deleteList do
		(
			deleteOne self.chalkboard p
		)

		emptyOut self.dapPresenters

		self.timeLine := undefined
	)
)


-- Method setEnd changes the duration of the target time line.
method setEnd self {class TimelineTool} indicator ->
(
	local t := timeAt self (indicator.x + 12)
	local duration := t * self.timeLine.scale
	self.timeLine.duration := duration as Integer
	updateThumb self
)


-- Private method scheduleUpdateMarker creates a callback on the super clock 
-- which calls the updateMarker method at the rate specified in 
-- markerRefreshRate.
method scheduleUpdateMarker self {class TimelineTool} ->
(
	-- If there is an old callback, cancel it.
	if (self.refreshCallback <> undefined) do
		cancel self.refreshCallback
	
	-- Create a new callback, which fires at the markerRefreshRate.
	self.refreshCallback := 
		addPeriodicCallback self.timeLine \
							(self -> updateMarker self) \
							self #() \
							(round (self.timeLine.scale / 
									self.markerRefreshRate))
	self.refreshCallback.skipIfLate := true
)


-- Method purge cancels callbacks and frees memory.
method purge self {class TimelineTool} ->
(
	cancelUpdateMarker self
)


-- Private method updateMarker positions the marker based on the current time
-- of the target player.
method updateMarker self {class TimelineTool} ->
(
	local plyr := self.timeLine
	if plyr = undefined do return

	-- Only move the marker if it is within the current boundary.
	local newPosition := 
		((plyr.time as Integer) -
		 (self.numberLine.offset * plyr.scale)) / 
		(calculateResolution self plyr)
	if ((plyr.rate <> 0) and 
		(newPosition < self.chalkboard.width)) then
	(
		self.marker.x := newPosition
	)
	else
		self.marker.x := -1
)


-- Private method cancelUpdateMarker cancels the callback which refreshes 
-- the marker.
method cancelUpdateMarker self {class TimelineTool} ->
(
	if (self.refreshCallback <> undefined) do
	(
		cancel self.refreshCallback
		self.refreshCallback := undefined
	)
)


method handleDrop self {class TimelineTool} service x y obj doit ->
(
	if (isAKindOf obj Perpetrator) then
	(
		if (doit) do
		(
			local a := createDefaultAction obj
			createAction self a x y
		)
		true
	) else
	(
		false
	)
)


-- Method actionChanged updates action based on changes to the action
-- presenter.
method actionChanged self {class TimelineTool} ap ->
(
	local act := ap.target

	-- Set the time and duration based on current position on the timeline.
	if (canObjectDo act durationSetter) do
		act.duration := (ap.width / pixelsPerUnit self.numberLine) * 
						self.timeLine.scale
	act.time := ((timeAt self ap.x) * self.timeLine.scale) as Integer

	-- Reschedule the action for the new time.
	local track := findTrack self ap
	ap.target.track := track
	scheduleAction self.timeLine act

	-- Slide the action into place.
	local destY :=  (track - 1) * self.trackSpacing
	local destPosition := new Point x:ap.x y:destY

	-- If the action presenter isn't already being snapped, snap it.
	if (not (isMember self.snapper ap)) do
	(
		append self.snapper ap
		setDestination self.snapper destPosition (self.clock.time + 6)
		addTimeCallback self.clock \
						(i -> emptyOut i) \
						self.snapper #() \
						(self.clock.time + 7) \
						true
	)
)


-- Method createActionPresenter creates an action presenter for the specified
-- action.
method createActionPresenter self {class TimelineTool} act ->
(
	local variableDuration := canObjectDo act durationGetter
	local ap := new ActionPresenter \
					manager: self \
					target: act \
					images: self.images \
					boundary: (new Rect x2:100 y2:32) \
					variableDuration: variableDuration
	ap.updateAction := actionChanged
	-- Create a pick list to select an action.
	local perp := act.perpetrator
	local l := new PickList \
				   boundary: (new Rect x2:50 y2:12) fill:whiteBrush \
				   stroke: blackBrush
	setChoices l (getActions perp)
	local actName := (act.name as String) as StringConstant
	setSelection l actName
	l.position := new Point x:22 y:18
	l.target := act
	l.selectionAction := (target selection -> 
		target.name := (selection as StringConstant))
	prepend ap l

	return ap
)


-- Method createAction creates an action presenter and adds it to 
-- the chalkboard. It then schedules the action on the time line.
method createAction self {class TimelineTool} act x y ->
(
	-- Create the action presenter for the action.
	local perp := act.perpetrator
	local ap := createActionPresenter self act
	
	-- Put the action presenter where the perpetrator was dropped.
	ap.x := x
	ap.y := y
	perp.dx := 0
	perp.dy := 5
	perp.stationary := false

	-- Add the action presenter to the chalkboard and track service.
	prepend self.chalkboard ap
	composite self.window.compositor
	append theTrackService ap
	append self.actions ap

	-- Update the action and schedule the action on the time line.
	actionChanged self ap
	act.track := findTrack self ap
	scheduleAction self.timeLine act
)


-- Method addAction adds an action presenter to the chalkboard for the
-- specified action.
method addAction self {class TimelineTool} act ->
(
	-- Create the action presenter for the action.
	local ap := createActionPresenter self act
	updateAction self ap

	-- Add the action presenter to the chalkboard and track service.
	prepend self.chalkboard ap
	append theTrackService ap
	append self.actions ap
	return ap
)


-- Method timeAt returns the time in seconds at position x on the chalkboard.
method timeAt self {class TimelineTool} x ->
(
	local nl := self.numberLine
	return (max 0 \
				((x / (pixelsPerUnit nl)) + 
				 nl.offset))
)


-- Method findTrack returns the track of the specified action presenter.
method findTrack self {class TimelineTool} ap ->
(
	local track := floor ((ap.y + (self.trackSpacing / 2)) / 
						  self.trackSpacing)
	track := min 3 (max 0 track)
	return track + 1
)


-- Method updateAction updates the width and location of an action.
method updateAction self {class TimelineTool} ap ->
(
	local act := ap.target
	local timeLine := self.timeLine
	local t := act.time / timeLine.scale
	local xPosition := (t * (pixelsPerUnit self.numberLine)) - 
					   (offsetCorrection self.numberLine)
	ap.x := xPosition
	ap.y := ((findTrack self ap) - 1) * self.trackSpacing
	if (canObjectDo ap.target durationGetter) do
	(
		local duration := ap.target.duration / timeLine.scale
		local w := duration * pixelsPerUnit self.numberLine
		ap.width := w
	)
)


-- Method addSound adds a sound to the tool. An audio presenter is
-- created for the sound, and added to the chalkboard.
method addSound self {class TimelineTool} dap ->
(
	local tl := self.timeLine
	if (tl != undefined) do (

		local pr := dapPresenter self dap
		append self.chalkboard pr
		
		addSlave tl dap

		updateDuration self
		
		dap.time := tl.time
		dap.offset := 0
		play dap
	)
)


method updateDuration self {class TimelineTool} -> (
	local tl := self.timeLine
	local sc := tl.scale
	local dur := 0
	forEachBinding self.dapPresenters (dap pr xxx ->
		dur := max dur ((dap.duration * (sc / dap.scale)) as Integer)
	) ok
	if (dur == 0) do (
		dur := 10 * tl.scale
	)
	tl.duration := dur
	tl.time := min tl.time dur
	updateThumb self
	updateIndicator self
	self.marker.x := -1
)


-- Method removeSound removes the specified audio player from the time line.
method removeSound self {class TimelineTool} dap ->
(
	-- Delete audio presenter from the chalkboard.
	stop dap
	local tl := self.timeline
	if (tl != undefined) do (
		local dapPresenters := self.dapPresenters
		local pr := dapPresenters[dap]
		if (pr != empty) do (
			deleteOne self.chalkboard pr
			deleteKeyOne dapPresenters dap
		)

		removeSlave tl dap

		-- Reschedule update marker and start the timeline.
		scheduleUpdateMarker self

		tl.rate := 1
	)
)


-- Method updateColors applies all of the colors in self.colors to the
-- various parts of this object.
method updateColors self {class TimelineTool} ->
(
	self.fill := self.colors[@Fill]
	self.chalkboard.fill := self.colors[@ChalkboardFill]
	self.numberLine.fill := self.colors[@BorderFill]
	self.overView.fill := self.colors[@OverviewFill]

	-- Update sound color of player presenters.
	forEach self.dapPresenters (pr a ->
		-- If the sound stroke has changed, update the presenter.
		if (pr.soundStroke <> self.colors[@Sound]) do
		(
			pr.soundStroke := self.colors[@Sound]
			update pr
		)
	) undefined
	self.thumb.fill := self.colors[@ThumbFill]
	self.thumb.stroke := self.colors[@ThumbStroke]
)


method seekTo self {class TimelineTool} x ->
(
	self.mouse.pointerType := @Wait
	local soundSeconds := self.duration
	local timeOffset := x / self.overView.width
	local timeInSeconds := max 0 (timeOffset * soundSeconds)

	self.numberLine.offset := timeInSeconds
	forEach self.dapPresenters (pr a ->
		pr.offset := timeInSeconds
		update pr
	) undefined
	update self.numberLine
	updateChalkboard self
	if (self.window <> undefined) do (
		composite self.window.compositor
	)
	self.mouse.pointerType := @Arrow
)


method calculateResolution self {class TimelineTool} plyr ->
(
	return plyr.scale / (pixelsPerUnit self.numberLine)
)


-- Method get duration is a "virtual" instance variable that returns the
-- current duration, in seconds.
method get duration self {class TimelineTool} ->
(
	local l := self.timeLine
	(l.duration as Integer) / l.scale
)


-- Private method updateThumb updates the thumb based on the current view.
method updateThumb self {class TimelineTool} ->
(
	local viewSeconds := self.numberLine.width / 
						 (pixelsPerUnit self.numberLine)
	local duration := max 1 self.duration
	local thumbWidth := viewSeconds * self.overView.width / duration
	local thumb := self.thumb
	thumb.width := min thumbWidth self.overView.width
	thumb.maximumX := ceiling (self.chalkboard.width - thumb.width)
)


-- Private method updateChalkboard updates the end indicator and 
-- action presenters.
method updateChalkboard self {class TimelineTool} ->
(
	updateIndicator self
	for ap in self.actions do (
		updateAction self ap
	)
)


-- Private method updateIndicator updates the position of the end indicator.
method updateIndicator self {class TimelineTool} ->
(
	local seconds := self.duration
	local x := (seconds * (pixelsPerUnit self.numberLine)) -
			   (offsetCorrection self.numberLine)
	self.endIndicator.x := (round x) - 12
)


-- Method update updates the tool based on current state.
method update self {class TimelineTool} ->
(
	forEach self.dapPresenters (pr arg ->
		local r := pr.resolution
		pr.resolution := calculateResolution self pr.target
		if (r <> pr.resolution) do (
			update pr
		)
	) undefined
	updateThumb self
	updateChalkboard self
	if (self.window <> undefined) do (
		composite self.window.compositor
	)
)


-- Method zoomTo moves the view of the timeline to the specified point.
method zoomTo self {class TimelineTool} percentage ->
(
--	local newMultiple := 1 + (percentage / 2)
	local newMultiple := 5 + (percentage / 4)
	if (self.numberLine.multiple <> newMultiple) do
	(
		local r := self.timeLine.rate
		stop self.timeLine
		self.mouse.pointerType := @Wait
		self.numberLine.multiple := newMultiple
		update self.numberLine
		update self
		self.timeLine.rate := r
		self.mouse.pointerType := @Arrow
	)
)


------------------------------------------------------------------------


) -- defineClasses4

garbageCollect()


------------------------------------------------------------------------


#(
	@images: #(
		"timetool": #(
			@invisibleColor: whiteColor,
			@name: "timetool.bmp"
		),
		"timeicon": #(
			@invisibleColor: whiteColor,
			@name: "timeicon.bmp"
		),
		"zoom": #(
			@invisibleColor: undefined,
			@name: "zoom.bmp"
		),
		"loop time": #(
			@invisibleColor: whiteColor,
			@name: "looptime.bmp"
		),
		"nib": #(
			@invisibleColor: whiteColor,
			@name: "nib.bmp"
		),
		"onicon": #(
			@invisibleColor: whiteColor,
			@name: "timeon.bmp"
		),
		"officon": #(
			@invisibleColor: whiteColor,
			@name: "timeoff.bmp"
		)
	),

	@products: #(
		#(
			@name: #(" System", "Timeline", theProductId),
			@icon: "timeicon",
			
			@factory: (prodDesc #rest args ->
				defineClasses()
				local result := undefined

				result := apply new TimelineTool \
									images: prodDesc[@container][@images] \
					  				args
				if (theRoom != undefined) do (
					connect result theRoom
					play result
				)
				result
			),
			
			@args: #(
				@x: 50,
				@y: 100,
				@visible: false
			)
		)
	)
)


-- >>>