win32forth-cvs

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Player4
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28249/apps/Player4

Modified Files:
	MCIWnd.f MciInterface.f Mediatree.f PLAYER4.F PLAYER4.frm 
	Pl_MciWindow.f PopupWindow.f 
Added Files:
	CommandID.f Commands.f 
Log Message:
Started rewriting the command handling within Player4th (work in progress).

--- NEW FILE: CommandID.f ---
\ $Id: CommandID.f,v 1.1 2006/05/16 17:41:26 dbu_de Exp $
\    File: CommandID.f
\
\  Author: Dirk Busch (dbu)
\   Email: dir...@wi...
\
cr .( Loading Menu Command ID's...)

: NewID ( <name> -- )
	defined
        IF   drop
        ELSE count "header NextId DOCON , ,
        THEN ;

IdCounter constant IDM_FIRST

\ File menu
NewID IDM_OPEN_FILE
NewID IDM_OPEN_FOLDER
NewID IDM_OPEN_PLAYLIST
NewID IDM_QUIT

\ Catalog menu
NewID IDM_ADD_FILES
NewID IDM_IMPORT_FOLDER
NewID IDM_START/RESUME

\ Options menu
NewID IDM_VIEW_50
NewID IDM_VIEW_100
NewID IDM_VIEW_200
NewID IDM_VIEW_FULLSCREEN
NewID IDM_AUDIO_ON
NewID IDM_AUDIO_OFF

IdCounter constant IDM_LAST

: allot-erase	( n -- )
		here over allot swap erase ;

Create CommandTable IDM_LAST IDM_FIRST - cells allot-erase

: IsCommand?	( ID -- f )
		IDM_FIRST IDM_LAST within ;

: >CommandTable	( ID -- addr )
		dup IsCommand?
		if   IDM_FIRST - cells CommandTable +
		else drop abort" error - command ID out of range"
		then ;

: DoCommand	( ID -- )
		>CommandTable @ ?dup IF execute THEN ;

: SetCommand	( ID -- )
		last @ name> swap >CommandTable ! ;

Index: PLAYER4.frm
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.frm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
Binary files /tmp/cvsMPaAWH and /tmp/cvszWCNI9 differ

Index: MciInterface.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Player4/MciInterface.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** MciInterface.f	15 May 2005 17:21:52 -0000	1.5
--- MciInterface.f	16 May 2006 17:41:26 -0000	1.6
***************
*** 125,132 ****
          0= if drop 0 then ;
  
! : GetLength     ( -- ) \ get video length 
          s" length" GetStatus to Length ;
  
! :M GetLength: ( -- n ) \ get video length 
          Length ;M
  
--- 125,132 ----
          0= if drop 0 then ;
  
! : GetLength     ( -- ) \ get video length
          s" length" GetStatus to Length ;
  
! :M GetLength: ( -- n ) \ get video length
          Length ;M
  
***************
*** 160,164 ****
  : (open)        ( f -- )
          to Video?
!         SendCommandBuf 
          GetHeightAndWidth
          s" ms" SetTimeFormat: self ;
--- 160,164 ----
  : (open)        ( f -- )
          to Video?
!         SendCommandBuf
          GetHeightAndWidth
          s" ms" SetTimeFormat: self ;
***************
*** 180,191 ****
  :M PlayAudioCD: ( -- ) \ doesn't work on my system (dbu)
          false to Video?
!         s" open cdaudio" PlaceCommand 
!         SendCommandBuf 
!         s" set cdaudio time format tmsf" PlaceCommand 
!         SendCommandBuf 
          s" play cdaudio from 1" PlaceCommand
!         SendCommandBuf 
  \         s" close cdaudio" PlaceCommand
! \         SendCommandBuf 
          ;M
  
--- 180,191 ----
  :M PlayAudioCD: ( -- ) \ doesn't work on my system (dbu)
          false to Video?
!         s" open cdaudio" PlaceCommand
!         SendCommandBuf
!         s" set cdaudio time format tmsf" PlaceCommand
!         SendCommandBuf
          s" play cdaudio from 1" PlaceCommand
!         SendCommandBuf
  \         s" close cdaudio" PlaceCommand
! \         SendCommandBuf
          ;M
  
***************
*** 228,232 ****
          if   fullscreen?
               if   PlayFullScreen: self
!              else PlayWindow: self 
               then
          else PlayAudio: self
--- 228,232 ----
          if   fullscreen?
               if   PlayFullScreen: self
!              else PlayWindow: self
               then
          else PlayAudio: self
***************
*** 241,245 ****
          SendCommandBuf ;M
  
! :M Close:       ( -- ) \ close video 
          s" close " PlaceCommand +PlaceDeviceID
          SendCommandBuf ;M
--- 241,245 ----
          SendCommandBuf ;M
  
! :M Close:       ( -- ) \ close video
          s" close " PlaceCommand +PlaceDeviceID
          SendCommandBuf ;M
***************
*** 306,310 ****
  
  :M On_Init:     ( -- )          \ initialize the class
!         On_Init: super 
  
          GetHandle: self SetHandle: MCI
--- 306,310 ----
  
  :M On_Init:     ( -- )          \ initialize the class
!         On_Init: super
  
          GetHandle: self SetHandle: MCI
***************
*** 334,338 ****
  :M GetLength:   ( -- n )
          GetLength: MCI ;M
!         
  :M GetPosition: ( -- n )
          GetPosition: MCI ;M
--- 334,338 ----
  :M GetLength:   ( -- n )
          GetLength: MCI ;M
! 
  :M GetPosition: ( -- n )
          GetPosition: MCI ;M
***************
*** 340,350 ****
  :M AudioOn:     ( -- )
          AudioOn: MCI ;M
!         
  :M AudioOff:    ( -- )
          AudioOff: MCI ;M
!         
  :M VideoOn:     ( -- )
          VideoOn: MCI ;M
!         
  :M VideoOff:    ( -- )
          VideoOff: MCI ;M
--- 340,350 ----
  :M AudioOn:     ( -- )
          AudioOn: MCI ;M
! 
  :M AudioOff:    ( -- )
          AudioOff: MCI ;M
! 
  :M VideoOn:     ( -- )
          VideoOn: MCI ;M
! 
  :M VideoOff:    ( -- )
          VideoOff: MCI ;M
***************
*** 392,402 ****
          VideoSize 0=
          if   MinSize: super
!         else CalcSize 
               32 + \ should calc menu and window title height here...
          then ;M
  
  :M On_Size:     ( h m w -- ) \ handle resize message
!         On_Size: super 
!         Video?: self if (SetVideoSize) then ;M 
  
  :M OpenVideo:   ( addr len -- )
--- 392,402 ----
          VideoSize 0=
          if   MinSize: super
!         else CalcSize
               32 + \ should calc menu and window title height here...
          then ;M
  
  :M On_Size:     ( h m w -- ) \ handle resize message
!         On_Size: super
!         Video?: self if (SetVideoSize) then ;M
  
  :M OpenVideo:   ( addr len -- )
***************
*** 424,427 ****
--- 424,428 ----
  \ MciWindow - class
  \ ---------------------------------------------------------------
+ ((
  :class MciWindow  <super window
  
***************
*** 434,438 ****
  
  :M On_Init:     ( -- )          \ initialize the class
!         On_Init: super 
  
          new> MciChildWindow to MCI
--- 435,439 ----
  
  :M On_Init:     ( -- )          \ initialize the class
!         On_Init: super
  
          new> MciChildWindow to MCI
***************
*** 461,465 ****
  :M GetLength:   ( -- n )
          GetLength: MCI ;M
!         
  :M GetPosition: ( -- n )
          GetPosition: MCI ;M
--- 462,466 ----
  :M GetLength:   ( -- n )
          GetLength: MCI ;M
! 
  :M GetPosition: ( -- n )
          GetPosition: MCI ;M
***************
*** 467,477 ****
  :M AudioOn:     ( -- )
          AudioOn: MCI ;M
!         
  :M AudioOff:    ( -- )
          AudioOff: MCI ;M
!         
  :M VideoOn:     ( -- )
          VideoOn: MCI ;M
!         
  :M VideoOff:    ( -- )
          VideoOff: MCI ;M
--- 468,478 ----
  :M AudioOn:     ( -- )
          AudioOn: MCI ;M
! 
  :M AudioOff:    ( -- )
          AudioOff: MCI ;M
! 
  :M VideoOn:     ( -- )
          VideoOn: MCI ;M
! 
  :M VideoOff:    ( -- )
          VideoOff: MCI ;M
***************
*** 493,498 ****
  
  :M On_Size:     ( h m w -- ) \ handle resize message
!         On_Size: super 
!         On_Size: MCI ;M 
  
  :M OpenVideo:   ( addr len -- )
--- 494,499 ----
  
  :M On_Size:     ( h m w -- ) \ handle resize message
!         On_Size: super
!         On_Size: MCI ;M
  
  :M OpenVideo:   ( addr len -- )
***************
*** 514,518 ****
  
  ;class
  
  module
-