[ENH]MPEGPlayerMorph (first stumbeling steps)

Karl Ramberg karl.ramberg at chello.se
Tue Oct 24 17:56:09 UTC 2000


Attached is a very basic MPEGPlayerMorph
It has currently only two buttons: 
Open: opens a menu so you can locate a mpeg/mp3 file and
select it, and then starts executing what ever it is.
Stop: stops the stream (s)

Please enhance this more !

Karl
-------------- next part --------------
'From Squeak2.9alpha of 13 June 2000 [latest update: #2774] on 24 October 2000 at 7:49:41 pm'!
Morph subclass: #MPEGPlayerMorph
	instanceVariableNames: 'foo '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'MPEG3-Kernel'!

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:00'!
addButtons
	| open stop alignment |
	self addMorph: ( alignment _ AlignmentMorph new color: Color orange).
	open _ SimpleButtonMorph new 
					label:'Open';
					target: self; 
					actionSelector: #openMPEGFile.
	stop _ SimpleButtonMorph new 
					label:'Stop';
					target: self; 
					actionSelector: #stopPlaying.
     alignment addMorph: stop.
	alignment addMorph: open! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 18:59'!
initialize
	super initialize.
	self addButtons! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:09'!
openMPEGFile
| file |
	(file _ StandardFileMenu oldFile) ifNotNil:
		[self playWhatEver: (file name)]! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:40'!
playMPEG:aPath video:hasVideo audio:hasAudio x:x y:y
	| form morph |
	hasVideo
		ifTrue:[ form _ Form extent: x at y depth: 32.
				morph _ SketchMorph withForm: form.
				morph openInWorld.
				foo _ MPEGPlayer playFile: aPath onMorph: morph.
				foo morph: morph.
				
					hasAudio
					ifTrue:[ foo playStream: 0]
					ifFalse:[ foo playVideoStream:0]]
		 ifFalse:[foo _ MPEGPlayer playFile: aPath.
				foo playAudioStream:0]

	
! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:44'!
playWhatEver: aPath
	| x y whatIsThis |
	whatIsThis _ MPEGFile openFile: aPath.
	whatIsThis hasVideo
	ifTrue:[ x _ whatIsThis videoFrameWidth:0.
			y_	whatIsThis videoFrameHeight:0.
			whatIsThis hasAudio
				ifTrue:[self playMPEG:aPath video:true audio:true x:x y:y]
				ifFalse:[self playMPEG:aPath  video:true audio:false x:x y:y]]

	 ifFalse:[self playMPEG:aPath video:false audio:true x:nil y:nil]
	! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:46'!
stopPlaying
	foo stop.
	! !


!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:00'!
addButtons
	| open stop alignment |
	self addMorph: ( alignment _ AlignmentMorph new color: Color orange).
	open _ SimpleButtonMorph new 
					label:'Open';
					target: self; 
					actionSelector: #openMPEGFile.
	stop _ SimpleButtonMorph new 
					label:'Stop';
					target: self; 
					actionSelector: #stopPlaying.
     alignment addMorph: stop.
	alignment addMorph: open! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 18:59'!
initialize
	super initialize.
	self addButtons! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:09'!
openMPEGFile
| file |
	(file _ StandardFileMenu oldFile) ifNotNil:
		[self playWhatEver: (file name)]! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:40'!
playMPEG:aPath video:hasVideo audio:hasAudio x:x y:y
	| form morph |
	hasVideo
		ifTrue:[ form _ Form extent: x at y depth: 32.
				morph _ SketchMorph withForm: form.
				morph openInWorld.
				foo _ MPEGPlayer playFile: aPath onMorph: morph.
				foo morph: morph.
				
					hasAudio
					ifTrue:[ foo playStream: 0]
					ifFalse:[ foo playVideoStream:0]]
		 ifFalse:[foo _ MPEGPlayer playFile: aPath.
				foo playAudioStream:0]

	
! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:44'!
playWhatEver: aPath
	| x y whatIsThis |
	whatIsThis _ MPEGFile openFile: aPath.
	whatIsThis hasVideo
	ifTrue:[ x _ whatIsThis videoFrameWidth:0.
			y_	whatIsThis videoFrameHeight:0.
			whatIsThis hasAudio
				ifTrue:[self playMPEG:aPath video:true audio:true x:x y:y]
				ifFalse:[self playMPEG:aPath  video:true audio:false x:x y:y]]

	 ifFalse:[self playMPEG:aPath video:false audio:true x:nil y:nil]
	! !

!MPEGPlayerMorph methodsFor: 'as yet unclassified' stamp: 'kfr 10/24/2000 19:46'!
stopPlaying
	foo stop.
	! !


More information about the Squeak-dev mailing list