Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Player4 CommandID.f,1.1,1.2 Commands.f,1.1,1.2 MCIWnd.f,1.3,1.4 PLAYER4.F,1.51,1.52 PLAYER4.frm,1.5,1.6 Pl_MciWindow.f,1.19,1.20 Pl_Version.f,1.15,1.16
|
From: Dirk B. <db...@us...> - 2006-05-21 11:42:23
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29478/apps/Player4 Modified Files: CommandID.f Commands.f MCIWnd.f PLAYER4.F PLAYER4.frm Pl_MciWindow.f Pl_Version.f Log Message: Finished rewriting the command handling within Player4th. Index: Pl_Version.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_Version.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** Pl_Version.f 26 Oct 2005 15:19:15 -0000 1.15 --- Pl_Version.f 21 May 2006 11:42:10 -0000 1.16 *************** *** 3,7 **** anew -Pl_Version.f ! 10121 value player_version# \ Version numbers: v.ww.rr --- 3,7 ---- anew -Pl_Version.f ! 10123 value player_version# \ Version numbers: v.ww.rr *************** *** 96,100 **** Jos May 2nd, 2005 - Made Refresh again faster ! (The Treeview was loaded 2 times when it was refreshed) - Added a freelist, delete and undelete --- 96,100 ---- Jos May 2nd, 2005 - Made Refresh again faster ! (The Treeview was loaded 2 times when it was refreshed) - Added a freelist, delete and undelete *************** *** 135,139 **** \ changes for Version 1.01.21 Jos October 26th, 2005 ! - Changed the shellsort and added more vieuws ! \s --- 135,144 ---- \ changes for Version 1.01.21 Jos October 26th, 2005 ! - Changed the shellsort and added more views ! \ changes for Version 1.01.22 ! - A lot of undocumented changes... ! ! \ changes for Version 1.01.23 ! dbu Sonntag, Mai 21 2006 ! - Rewritten the Command handling by using an accelerator-key-table. Index: MCIWnd.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/MCIWnd.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** MCIWnd.f 16 May 2006 17:41:26 -0000 1.3 --- MCIWnd.f 21 May 2006 11:42:10 -0000 1.4 *************** *** 148,152 **** :class MciChildWindow <super child-window ! MciControl MCI int VideoSize --- 148,152 ---- :class MciChildWindow <super child-window ! int MCI int VideoSize *************** *** 160,163 **** --- 160,164 ---- :M Classinit: ( -- ) ClassInit: super + 0 to MCI 0 to VideoSize 0 to vWidth *************** *** 169,172 **** --- 170,177 ---- :M On_Init: ( -- ) On_Init: super \ initialize the class + + new> MciControl to MCI + self Start: MCI \ then startup child window + 100 to VideoSize 0 to vWidth *************** *** 174,178 **** false to FullScreen? false to Video? ! self Start: MCI \ then startup child window ;M --- 179,183 ---- false to FullScreen? false to Video? ! ;M Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.51 retrieving revision 1.52 diff -C2 -d -r1.51 -r1.52 *** PLAYER4.F 16 May 2006 17:41:26 -0000 1.51 --- PLAYER4.F 21 May 2006 11:42:10 -0000 1.52 *************** *** 20,34 **** decimal ! false value turnkey? true value MciDebug? - defer PLAYER ' noop is PLAYER - defer RefreshCatalog ' noop is RefreshCatalog - defer SortCatalog ' noop is SortCatalog - defer RequestRecord ' noop is RequestRecord - defer MenuChecks ' noop is MenuChecks - defer KeyHandler ' noop is KeyHandler - defer StopPlayer ' noop is StopPlayer - needs NoConsole.f needs excontrols.f --- 20,26 ---- decimal ! true value turnkey? true value MciDebug? needs NoConsole.f needs excontrols.f *************** *** 39,42 **** --- 31,41 ---- needs Resources.f needs multiopen.f + needs AcceleratorTables.f + + defer PLAYER ' noop is PLAYER + defer RefreshCatalog ' noop is RefreshCatalog + defer SortCatalog ' noop is SortCatalog + defer RequestRecord ' noop is RequestRecord + defer MenuChecks ' noop is MenuChecks needs Pl_Toolset.f *************** *** 47,50 **** --- 46,51 ---- needs Player4.frm \ "Control center" dialog + AcceleratorTable AccelTable + \ ----------------------------------------------------------------------------- \ define the child window for the right part of the main window *************** *** 179,185 **** ; - :M WM_KEYDOWN ( key l -- res ) - drop KeyHandler 0 ;M - :M Classinit: ( -- ) ClassInit: super \ init super class --- 180,183 ---- *************** *** 206,221 **** :M On_Init: ( -- ) On_Init: super COLOR_BTNFACE 1+ GCL_HBRBACKGROUND hwnd Call SetClassLong drop InitFileNames check/resize-config-file - GetHandle: Self dup SetParent: ControlCenter - SetParent: ViewForm catalog-exist? if map-config-file map-database vadr-config ExitFailed- c@ ! if MciDebug? ! if cr ." REBUILD " ! then ! generate-index-file build-free-list ! then true vadr-config ExitFailed- c! MciDebug? --- 204,216 ---- :M On_Init: ( -- ) On_Init: super + AccelTable EnableAccelerators \ init the accelerator table COLOR_BTNFACE 1+ GCL_HBRBACKGROUND hwnd Call SetClassLong drop InitFileNames check/resize-config-file catalog-exist? if map-config-file map-database vadr-config ExitFailed- c@ ! if MciDebug? if cr ." REBUILD " then ! generate-index-file build-free-list ! then true vadr-config ExitFailed- c! MciDebug? *************** *** 223,229 **** ." freelist: " vadr-config #free-list @ . then ! else map-config-file ! then ! SortByFlags self Start: Catalog --- 218,226 ---- ." freelist: " vadr-config #free-list @ . then ! else map-config-file ! then SortByFlags ! ! GetHandle: Self SetParent: ControlCenter ! GetHandle: Self SetParent: ViewForm self Start: Catalog *************** *** 245,248 **** --- 242,246 ---- :M WM_CLOSE ( h m w l -- res ) + AccelTable DisableAccelerators \ free the accelerator table Close: self WM_CLOSE WM: Super *************** *** 290,308 **** : Stop/Next ( -- ) ! if catalog-exist? ! if SetFocus: ControlCenter play-catalog-random: Player4W ! else Playing?: Player4W ! if Close: Player4W ! then ! then ! then ; 5000 value step : Forward ( -- ) ! Playing?: Player4W if step Forward: Player4W then ; : Rewind ( -- ) ! Playing?: Player4W if step Rewind: Player4W then ; ' Pause/Resume SetFunc: PauseButton --- 288,305 ---- : Stop/Next ( -- ) ! Playing?: Player4W if Close: Player4W then ; IDM_STOP_NEXT SetCommand ! \ if catalog-exist? ! \ if ( SetFocus: ControlCenter ) play-catalog-random: Player4W ! \ else Playing?: Player4W if Close: Player4W then ! \ then ! \ then ; IDM_STOP_NEXT SetCommand 5000 value step : Forward ( -- ) ! Playing?: Player4W if step Forward: Player4W then ; IDM_FORWARD SetCommand : Rewind ( -- ) ! Playing?: Player4W if step Rewind: Player4W then ; IDM_REWIND SetCommand ' Pause/Resume SetFunc: PauseButton *************** *** 317,338 **** \ ----------------------------------------------------------------------------- - \ ----------------------------------------------------------------------------- - - \ : SortRandom ( -- ) \ sort the catalog - \ catalog-exist? - \ if sort_by_RandomLevel RefreshCatalog - \ then ; - - \ : SortLeastPlayed ( -- ) \ sort the catalog - \ catalog-exist? - \ if sort_by_leastPlayed RefreshCatalog - \ then ; - - \ : SortSize ( -- ) \ sort the catalog - \ catalog-exist? - \ if sort_by_size RefreshCatalog - \ then ; - - \ ----------------------------------------------------------------------------- \ Simple command line handling \ --- 314,317 ---- *************** *** 387,390 **** --- 366,370 ---- MENUSEPARATOR MENUITEM "&Exit\tAlt+F4" IDM_QUIT DoCommand ; + POPUP "&Catalog" MENUITEM "&Add file(s)...\tCtrl+M" IDM_ADD_FILES DoCommand ; *************** *** 434,486 **** POPUP "&Help" ! MENUITEM "About Player 4th..." AboutPlayer ; ENDBAR ! :Noname ( - ) ! vadr-config AutoStart- c@ Check: mAutostart ! vadr-config AutoMinimized- c@ Check: mTray ! vadr-config IgnoreRequests c@ Check: mHandelReq ! vadr-config KeepRequests c@ Check: mKeepReq ! ; is MenuChecks \ enable/disable the menu items ! \ ----------------------------------------------------------------------------- ! \ Accelerator table ! \ ----------------------------------------------------------------------------- ! 0x21 constant vk_pgdn ! 0x22 constant vk_down ! 0x25 constant vk_left ! 0x27 constant vk_right ! :Noname ( Vkey -- ) ! case ! BL of Pause/Resume endof ! 'O' of OpenFile: Player4W endof ! 'F' of OpenFolder: Player4W endof ! 'L' of OpenPlayList: Player4W endof ! 'S' of FullScreen endof ! 'Q' of QuitPlayer endof \ Q only ! VK_F1 of AboutPlayer endof ! VK_ESCAPE of StopPlayer endof ! 'A' of AudioOn: Player4W endof ! 'A' +k_shift of AudioOff: Player4W endof ! 'W' of 0 SetVideoSize: Player4W endof ! '5' of 50 SetVideoSize: Player4W endof ! '1' of 100 SetVideoSize: Player4W endof ! '2' of 200 SetVideoSize: Player4W endof ! VK_PGDN of Stop/Next endof \ 21 ! VK_DOWN of Stop/Next endof \ 22 ! VK_LEFT of Rewind endof \ 25 ! VK_RIGHT of Forward endof \ 27 ! 'R' of start/resume endof ! 'M' of AddFilesFromSelector: Player4W endof ! 'I' of Import-to-catalog: Player4W RefreshCatalog endof ! \ 'C' +k_control of PlayAudioCD: Player4W endof \ doesn't work on my system (dbu) ! endcase ! ; is KeyHandler \ ----------------------------------------------------------------------------- --- 414,467 ---- POPUP "&Help" ! MENUITEM "About Player 4th..." IDM_ABOUT DoCommand ; ENDBAR ! :Noname ( -- ) ! vadr-config AutoStart- c@ Check: mAutostart ! vadr-config AutoMinimized- c@ Check: mTray ! vadr-config IgnoreRequests c@ Check: mHandelReq ! vadr-config KeepRequests c@ Check: mKeepReq ! ; is MenuChecks \ enable/disable the menu items ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Accelerator Table - support ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! AccelTable table ! \ falgs key-code command-id ! \ File menu ! FCONTROL 'O' IDM_OPEN_FILE ACCELENTRY ! FCONTROL 'F' IDM_OPEN_FOLDER ACCELENTRY ! FCONTROL 'L' IDM_OPEN_PLAYLIST ACCELENTRY ! FALT VK_F4 IDM_QUIT ACCELENTRY ! \ Catalog menu ! FCONTROL 'M' IDM_ADD_FILES ACCELENTRY ! FCONTROL 'I' IDM_IMPORT_FOLDER ACCELENTRY ! FCONTROL 'R' IDM_START/RESUME ACCELENTRY ! \ Options menu ! FCONTROL '5' IDM_VIEW_50 ACCELENTRY ! FCONTROL '1' IDM_VIEW_100 ACCELENTRY ! FCONTROL '2' IDM_VIEW_200 ACCELENTRY ! FCONTROL 'F' IDM_VIEW_FULLSCREEN ACCELENTRY ! FCONTROL 'A' IDM_AUDIO_ON ACCELENTRY ! FSHIFT 'A' IDM_AUDIO_OFF ACCELENTRY ! \ Help menu ! 0 VK_F1 IDM_ABOUT ACCELENTRY ! ! \ other commands ! FCONTROL 'Q' IDM_STOP ACCELENTRY ! 0 VK_ESCAPE IDM_STOPPLAYER ACCELENTRY ! ! 0 VK_LEFT IDM_REWIND ACCELENTRY ! 0 VK_RIGHT IDM_FORWARD ACCELENTRY ! 0 VK_PRIOR IDM_STOP_NEXT ACCELENTRY \ page up ! 0 VK_NEXT IDM_STOP_NEXT ACCELENTRY \ page down ! ! MainWindow HandlesThem \ ----------------------------------------------------------------------------- *************** *** 498,513 **** :noname ( -- ) ! WINPAUSE 10 MS ! Playing: Player4W ; is PLAYER ! : PLAYER-LOOP ( -- ) ! BEGIN PLAYER AGAIN ; : PLAYER4 ( -- ) InitPlayer HandleCmdLine ! PLAYER-LOOP ! turnkey? IF MessageLoop bye THEN ; --- 479,493 ---- :noname ( -- ) ! WINPAUSE \ here the windows messages are handled !!! ! 10 MS Playing: Player4W ; is PLAYER ! : Player-Loop ( -- ) ! turnkey? if begin player again then ; : PLAYER4 ( -- ) InitPlayer HandleCmdLine ! Player-Loop ; Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.19 retrieving revision 1.20 diff -C2 -d -r1.19 -r1.20 *** Pl_MciWindow.f 16 May 2006 17:41:26 -0000 1.19 --- Pl_MciWindow.f 21 May 2006 11:42:10 -0000 1.20 *************** *** 107,118 **** maxstring bytes string1$ - \ :M ExWindowStyle: ( -- style ) - \ ExWindowStyle: Super - \ [ WS_EX_CLIENTEDGE WS_EX_ACCEPTFILES or ] literal or ;M - \ - \ :M WndClassStyle: ( -- style ) - \ \ CS_DBLCLKS only to prevent flicker in window on sizing. - \ CS_DBLCLKS ;M - :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_ACCEPTFILES or ;M --- 107,110 ---- *************** *** 149,160 **** type-of-media >r GetShortPathName r> ! if SW_HIDE Show: MouseHandlerWindow ! OpenVideo: super ! else OpenAudio: super ! SW_SHOW Show: MouseHandlerWindow ! \ paint: MouseHandlerWindow ! then ! SW_SHOW Show: self ! ;M :M Play: ( n -- ) \ plays the current file from position n (ms) --- 141,150 ---- type-of-media >r GetShortPathName r> ! if SW_HIDE Show: MouseHandlerWindow ! OpenVideo: super ! else OpenAudio: super ! SW_SHOW Show: MouseHandlerWindow ! then \ SW_SHOW Show: self ! ;M :M Play: ( n -- ) \ plays the current file from position n (ms) *************** *** 169,178 **** 2dup file-status nip 0= ! if 2dup IsRealMedia? ! if 2drop \ don't play RealPlayer files, ! \ sometimes MCI crashes on my system, when trying (dbu) ! else \ 2dup ReTitle ! Open: self ! 0 Play: self then else 2drop --- 159,166 ---- 2dup file-status nip 0= ! if \ don't try play RealPlayer files, sometimes MCI crashes on my system, when trying (dbu) ! 2dup IsRealMedia? ! if 2drop ! else Open: self 0 Play: self then else 2drop *************** *** 211,215 **** if Iconic? 0= Audio?: self or if GetPosition: self GetLength: self >= ! if Close: self SW_HIDE Show: self then then then ; --- 199,203 ---- if Iconic? 0= Audio?: self or if GetPosition: self GetLength: self >= ! if Close: self ( SW_HIDE Show: self ) then then then ; *************** *** 288,335 **** database-mhndl #records-in-database vadr-config #free-list @ - 0> if AbortPlaying: self false to catalog-aborted? ! begin PLAYER catalog-aborted? #InCollection 0= or if exitm then ! Playing?: Self not ! if next-not-played dup -1 = ! if MciDebug? ! if cr cr ." All done. Reset randomlevel and shuffle..." ! then ! set-all-not-played random-shuffle ! else cr 2 spaces dup . 2 spaces n>record dup>r ! RecordDef File_name r@ Cnt_File_name c@ 2dup type-space ! r@ incr-#played ! r> mark-played ! PlayFile: Self ! then ! then again then ! ;M : add-to-catalog ( -- ) \ Delete the *.dat files to start a new catalog ! z" Folder(s) to catalog" ! vadr-config PathMediaFiles dup +null GetHandle: Self ! BrowseForFolder ! If vadr-config PathMediaFiles count GetLabel add_dir_tree ! then ! ; :M Import-to-catalog: ( -- ) ! add-to-catalog ! ;M ! :M AddFilesFromSelector: ( - ) \ add one or more files ! GetHandle: self Start: GetFilesDialog count nip 0> ! if vadr-config 0= ! if map-config-file ! then ! OpenAppendDatabase 0 GetFile: GetFilesDialog GetLabel ! #SelectedFiles: GetFilesDialog ! wait-cursor 0 ! do dup i GetFile: GetFilesDialog AddFile ! loop ! arrow-cursor CloseReMap RefreshCatalog ! then ! ;M \ ----------------------------------------------------------------------------- --- 276,313 ---- database-mhndl #records-in-database vadr-config #free-list @ - 0> if AbortPlaying: self false to catalog-aborted? ! begin catalog-aborted? #InCollection 0= or if exitm then ! Playing?: Self not ! if next-not-played dup -1 = ! if set-all-not-played random-shuffle ! else n>record dup>r ! RecordDef File_name r@ Cnt_File_name c@ 2dup type-space ! r@ incr-#played r> mark-played ! (PlayOneFile) ! then ! then again then ! ;M : add-to-catalog ( -- ) \ Delete the *.dat files to start a new catalog ! z" Folder(s) to catalog" ! vadr-config PathMediaFiles dup +null GetHandle: Self ! BrowseForFolder ! If vadr-config PathMediaFiles count GetLabel add_dir_tree ! then ; :M Import-to-catalog: ( -- ) ! add-to-catalog ;M :M AddFilesFromSelector: ( - ) \ add one or more files ! GetHandle: self Start: GetFilesDialog count nip 0> ! if vadr-config 0= if map-config-file then ! OpenAppendDatabase 0 GetFile: GetFilesDialog GetLabel ! #SelectedFiles: GetFilesDialog ! wait-cursor 0 ! do dup i GetFile: GetFilesDialog AddFile ! loop ! arrow-cursor CloseReMap RefreshCatalog ! then ;M \ ----------------------------------------------------------------------------- *************** *** 378,384 **** string1$ maxstring erase - \ 1 Setid: MouseHandlerWindow self Start: MouseHandlerWindow ! \ player4-popup-Bar SetPopupBar: MouseHandlerWindow ;M --- 356,361 ---- string1$ maxstring erase self Start: MouseHandlerWindow ! player4-popup-Bar SetPopupBar: MouseHandlerWindow ;M Index: CommandID.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/CommandID.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** CommandID.f 16 May 2006 17:41:26 -0000 1.1 --- CommandID.f 21 May 2006 11:42:10 -0000 1.2 *************** *** 34,37 **** --- 34,45 ---- NewID IDM_AUDIO_OFF + \ Other commands + NewID IDM_STOP + NewID IDM_ABOUT + NewID IDM_STOPPLAYER + NewID IDM_REWIND + NewID IDM_FORWARD + NewID IDM_STOP_NEXT + IdCounter constant IDM_LAST Index: Commands.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Commands.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Commands.f 16 May 2006 17:41:26 -0000 1.1 --- Commands.f 21 May 2006 11:42:10 -0000 1.2 *************** *** 37,40 **** --- 37,43 ---- Close: MainWindow bye ; IDM_QUIT SetCommand + defer StopPlayer ( -- ) ' noop is StopPlayer + IDM_STOPPLAYER SetCommand + \ -------------------------------------------------------------------------- \ Catalog menu *************** *** 129,132 **** --- 132,150 ---- then ; + \ : SortRandom ( -- ) \ sort the catalog + \ catalog-exist? + \ if sort_by_RandomLevel RefreshCatalog + \ then ; + + \ : SortLeastPlayed ( -- ) \ sort the catalog + \ catalog-exist? + \ if sort_by_leastPlayed RefreshCatalog + \ then ; + + \ : SortSize ( -- ) \ sort the catalog + \ catalog-exist? + \ if sort_by_size RefreshCatalog + \ then ; + \ -------------------------------------------------------------------------- \ Options menu *************** *** 179,181 **** Start: AboutPlayer4 ResumeVideo ! On_Paint: MainWindow ; --- 197,199 ---- Start: AboutPlayer4 ResumeVideo ! On_Paint: MainWindow ; IDM_ABOUT SetCommand Index: PLAYER4.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.frm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** PLAYER4.frm 16 May 2006 17:41:26 -0000 1.5 --- PLAYER4.frm 21 May 2006 11:42:10 -0000 1.6 *************** *** 43,54 **** ;M - :M WM_KEYDOWN ( key l -- res ) - drop KeyHandler 0 ;M - - :M Close: ( -- ) - \ Insert your code here - Close: super - ;M - :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont --- 43,46 ---- *************** *** 85,91 **** over LOWORD ( ID ) self \ object address on stack WMCommand-Func ?dup \ must not be zero ! if SetFocus: Self execute ! else 2drop \ drop ID and object address ! then 0 ;M :M SetCommand: ( cfa -- ) \ set WMCommand function --- 77,83 ---- over LOWORD ( ID ) self \ object address on stack WMCommand-Func ?dup \ must not be zero ! if ( SetFocus: Self ) execute ! else 2drop \ drop ID and object address ! then 0 ;M :M SetCommand: ( cfa -- ) \ set WMCommand function *************** *** 103,105 **** --- 95,100 ---- ;M + \ :M On_SetFocus: + \ SetFocus: parent ;M + ;Object |
