win32forth-cvs

[Jos v.d.V. <jo...@us...>]

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

Added Files:
	MciVideo.f NViewLib.dll PLAYER4.F player4titre4.jpg 
Log Message:
A mediaplayer under Win32Forth. Dirks update included

--- NEW FILE: PLAYER4.F ---
\    File: PLAYER4.F
\
\  Author: Bruno Gauthier (bga...@fr...) and
\          Dirk Busch (di...@wi...)
\
\ Created: Donnerstag, März 31 2005 - dbu
\ Updated: Donnerstag, März 31 2005 - dbu
\
\ A simple Videoplayer using the MciVideoWindow class.

cr .( Loading Player 4th...)

anew -PLAYER4.F
 
only forth also definitions

needs MciVideo.f

\ true value turnkey?
false value turnkey?

\ ---------------------------------------------------------------
\       Define the Popup bar
\ ---------------------------------------------------------------
POPUPBAR player4-Popup-bar
    POPUP " "
        MENUITEM      "&Open file..."   'O' +k_control pushkey ;
        MENUSEPARATOR
        MENUITEM      "&Exit"           'Q' +k_control pushkey ;
ENDBAR

\ ---------------------------------------------------------------
\       Define the Menu bar
\ ---------------------------------------------------------------
MENUBAR player4-Menu-bar
    POPUP "&File"
        MENUITEM     "&Open file...\tCtrl+O"      'O' +k_control pushkey ;
        MENUSEPARATOR
        MENUITEM     "&Exit\tAlt+F4"              'Q' +k_control pushkey ;
    POPUP "&Options"
        MENUITEM     "&FullScreen toggle\tCtrl+F" 'F' +k_control pushkey ;
    POPUP "&Help"
        MENUITEM     "About Player 4th..."        k_F1 pushkey ;
ENDBAR

\ ---------------------------------------------------------------
\ ---------------------------------------------------------------
FileNewDialog PlayView "Play View File" "MPEG Audio & Video |*.mpeg;*.mpg;*.mp2;*.mp3;*.mp4;*.mpa;*.dat|Windows Media (*.wma)|*.wma|Avi Files (*.avi)|*.avi|Midi Files (*.mid *.midi)|*.midi;*.mid|Waves Files (*.wav)|*.wav|Else (*.*)|*.*|"

\ ---------------------------------------------------------------
\       Define the Main Window
\ ---------------------------------------------------------------
:Object PLAYER4W  <super MciVideoWindow

int Pause?
int Playing?
int Video?
int Audio?
int Iconic?
int longueur

:M Classinit:   ( -- )          \ static initialization goes here, IF needed
        ClassInit: super
        ;M

:M On_Init:     ( -- )          \ initialize the class
        On_Init: super                  \ first init super class

        player4-menu-bar  SetMenuBar:  self
        player4-popup-Bar SetPopupBar: self

        false to Pause?
        false to Playing?
        false to Video?
        false to Audio?
        false to Iconic?
        0 to longueur

        ;M

:M WM_CLOSE     ( h m w l -- res )
        WM_CLOSE WM: Super
        bye 0 ;M

:M MinSize:     ( -- width height ) \ minimum window size
        392 280 ;M

:M WindowTitle: ( -- Zstring ) \ window caption
        z" Player 4th" ;M

:M On_Size:     ( h m w -- ) \ handle resize message
        Playing? video? FullScreen?: self 0= and and
        if On_Size: super then ;M

\ ---------------------------------------------------------------
\ Open a file
\ ---------------------------------------------------------------
: IsVideo       ( -- )
        true to video? false to audio? ;

: IsAudio       ( -- )
        false to video? true to audio? ;

: type-of-media ( addr len -- )
        s" .mp3" search if IsAudio exit then
        s" .mid" search if IsAudio exit then
        s" .wav" search if IsAudio exit then
        2drop IsVideo ;

maxstring bytes string0$
maxstring bytes string1$
: GetShortPathName      ( addr len -- addr1 len1 )
        string0$ place string0$ +null
        maxstring string1$ rel>abs string0$ 1+ rel>abs Call GetShortPathName drop
        string1$ zcount ;

:M Close:       ( -- )
        false to Playing?
        Close: super
        ;M

:M PlayFile:    ( addr len -- )
        Close: self

        2dup type-of-media
        GetShortPathName Open: super
        0 Play: super
        GetLength: super to longueur

        false to Pause?
        true to Playing?
        ;M

:M OpenFile:    ( -- )
        GetHandle: self Start: PlayView 
        dup c@ \ ( -- a1 n1 )
        IF   count PlayFile: self
        ELSE DROP
        THEN ;M

\ ---------------------------------------------------------------
\ ---------------------------------------------------------------
:M Pause?:      ( -- f) 
        Pause? ;M

:M PauseToggle: ( -- )
        Pause? 0= dup to Pause?
        if   Pause: super
        else Resume: super
        then ;M

:M Playing:     ( -- )

        Iconic? GetHandle: self Call IsIconic dup to Iconic? <>
        if   Iconic? 
             if   Pause? 0= if Pause: super then
             else Pause? 0= if Resume: super then
             then 
        then

        Playing? Pause? 0= Iconic? 0= and and
        if   GetPosition: self longueur >=
             if Close: self then
        then ;M

:M On_Done:     ( h m w l -- res )
        Close: self
        0 call PostQuitMessage drop
        On_Done: super 0 ;M

;Object

\ ---------------------------------------------------------------
\ about dialog
\ ---------------------------------------------------------------
:Object AboutPlayer4 <SUPER dialog

IDD_ABOUT_FORTH forthdlg find-dialog-id constant template

create about-head
         z," Player 4th Version: 1.1"

create about-msg1
         z," Written 2005 by:\n"
        +z,"   Bruno  Gauthier\n"
        +z,"   eMail: bga...@fr...\n"
        +z,"   http:\\bgauthier.free.fr"

create about-msg2
         z," and\n"
        +z,"   Dirk Busch\n"
        +z,"   eMail: di...@wi...\n"
        +z,"   http:\\www.win32forth.de.vu"

create about-msg3
         z," This is a simple Videoplayer based on the winmm.dll."

:M On_Init:     ( hWnd-focus -- f )
                about-head zcount IDD_ABOUT_HEAD  SetDlgItemText: self
                about-msg1 zcount IDD_ABOUT_TEXT  SetDlgItemText: self
                about-msg2 zcount IDD_ABOUT_TEXT2 SetDlgItemText: self
                about-msg3 zcount IDD_ABOUT_TEXT3 SetDlgItemText: self
                1 ;M

:M On_Command:  ( hCtrl code ID -- f1 )
                CASE
                IDCANCEL OF     0 end-dialog    ENDOF
                                false swap ( default result )
                ENDCASE ;M

:M Start:       ( -- f )
                Addr: Player4W template run-dialog ;M

;Object

\ ---------------------------------------------------------------
\ ---------------------------------------------------------------

: uninit-player4   ( -- )
        DestroyWindow: Player4W ;
        unload-chain chain-add-before uninit-player4

\ ---------------------------------------------------------------
\ PLAYER4 the main word
\ ---------------------------------------------------------------

: FullScreenToggle ( -- )
        FullScreenToggle: Player4W ;

: AboutPlayer   ( -- )
        Pause: Player4W
        Start: AboutPlayer4
        Resume: Player4W
        On_Paint: Player4W ;

: QuitPlayer    ( -- )
        Close: Player4W bye ;

: KeyHandler    ( -- )
        ekey?
        if   ekey
             case
                BL               of PauseToggle: Player4W endof
                'O'   +k_control of OpenFile: Player4W    endof
                'F'   +k_control of FullScreenToggle      endof
                'Q'   +k_control of QuitPlayer            endof
                k_F1             of AboutPlayer           endof
                k_esc            of QuitPlayer            endof
             endcase
        then ;

: InitPlayer    ( -- )
        Start: Player4W
        ['] FullScreenToggle SetDblClickFunc: Player4W
        ;

: PLAYER4       ( -- )
        InitPlayer
        BEGIN WINPAUSE 10 MS
              Playing: Player4W
              KeyHandler
        AGAIN ;

turnkey? [if]
        ' player4 turnkey PLAYER4       \ build an application on disk
        5 pause-seconds
[else]
        PLAYER4
[then]