Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Player4 Catalog.f,1.12,1.13 Mediatree.f,1.14,1.15 PLAYER4.F,1.23,1.24 Pl_MciWindow.f,1.10,1.11
|
From: Jos v.d.V. <jo...@us...> - 2005-10-16 10:24:55
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4456/apps/Player4 Modified Files: Catalog.f Mediatree.f PLAYER4.F Pl_MciWindow.f Log Message: Jos: Added volume info for the catalog and made it possible to extract the name of the artist and title of the album from the filename. Made it also possible to escape to the Forth-console when player4 is not used as a turnkey. Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** PLAYER4.F 9 Oct 2005 16:33:07 -0000 1.23 --- PLAYER4.F 16 Oct 2005 10:24:39 -0000 1.24 *************** *** 20,26 **** decimal ! true value turnkey? \ false value turnkey? ! true value MciDebug? defer PLAYER ' noop is PLAYER --- 20,26 ---- decimal ! true value turnkey? \ false value turnkey? ! true value MciDebug? defer PLAYER ' noop is PLAYER *************** *** 40,43 **** --- 40,44 ---- needs Pl_Toolset.f + needs volinfo.f needs sub_dirs.f needs number.f *************** *** 53,56 **** --- 54,58 ---- \ Define the Popup bar \ ----------------------------------------------------------------------------- + POPUPBAR player4-Popup-bar POPUP " " *************** *** 232,236 **** ." freelist: " vadr-config #free-list @ . then ! else datfile$ count file-exist? not check-config then --- 234,238 ---- ." freelist: " vadr-config #free-list @ . then ! else datfile$ count file-exist? check-config then *************** *** 465,468 **** --- 467,472 ---- On_Paint: MainWindow ; + defer StopPlayer + : QuitPlayer ( -- ) Close: MainWindow bye ; *************** *** 479,483 **** 'Q' +k_control of QuitPlayer endof k_F1 of AboutPlayer endof ! k_esc of QuitPlayer endof 'A' +k_control of AudioOn: Player4W endof --- 483,487 ---- 'Q' +k_control of QuitPlayer endof k_F1 of AboutPlayer endof ! k_esc of StopPlayer endof 'A' +k_control of AudioOn: Player4W endof *************** *** 542,552 **** turnkey? [if] false to MciDebug? ' player4 turnkey Player4.exe s" Player4.ico" s" Player4.exe" AddAppIcon - 1 pause-seconds [else] true to MciDebug? s" Player4.ico" s" Player4.exe" AddAppIcon PLAYER4 --- 546,557 ---- turnkey? [if] + ' QuitPlayer is StopPlayer false to MciDebug? ' player4 turnkey Player4.exe s" Player4.ico" s" Player4.exe" AddAppIcon 1 pause-seconds [else] true to MciDebug? + ' abort is StopPlayer \ Access to Forth ( Not fullproof ) s" Player4.ico" s" Player4.exe" AddAppIcon PLAYER4 Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Pl_MciWindow.f 9 Oct 2005 16:33:07 -0000 1.10 --- Pl_MciWindow.f 16 Oct 2005 10:24:39 -0000 1.11 *************** *** 34,37 **** --- 34,38 ---- ;Object + : GetLabel ( path cnt - ) VolumeLabel to /VolumeNameBuffer drop to _DriveType ; MultiFileOpenDialog GetFilesDialog "Select File" "Media Files (*.mp3,*.midi,*.mid,*.wav,*.mpeg,*.mpg,*.mp2,*.mp4,*.mpa,*.wma,*.wmv,*.avi,*.dat)|*.mp3;*.midi;*.mid;*.wav;*.mpeg;*.mpg;*.mp2;*.mp4;*.mpa;*.wma;*.wmv;*.avi;*.dat|" *************** *** 237,256 **** : add-to-catalog ( -- ) \ Delete the *.dat files to start a new catalog ! z" Folder(s) to catalog" ! config-mhndl map-hndl>vadr PathMediaFiles dup +null GetHandle: Self ! BrowseForFolder ! If add_dir_tree ! then ; :M Import-to-catalog: ( -- ) ! DatFile$ count file-exist? ! check-config ! add-to-catalog ;M :M AddFilesFromSelector: ( - ) \ add one or more files ! OpenAppendDatabase GetHandle: self Start: GetFilesDialog count nip 0> ! if #SelectedFiles: GetFilesDialog 0 do dup i GetFile: GetFilesDialog AddFile loop --- 238,258 ---- : 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 ! OpenAppendDatabase GetHandle: self Start: GetFilesDialog count nip 0> ! if 0 GetFile: GetFilesDialog GetLabel ! #SelectedFiles: GetFilesDialog 0 do dup i GetFile: GetFilesDialog AddFile loop Index: Mediatree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** Mediatree.f 9 Oct 2005 16:33:07 -0000 1.14 --- Mediatree.f 16 Oct 2005 10:24:39 -0000 1.15 *************** *** 44,48 **** \ -1 to statemask [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or TVIF_STATE or ] literal to mask ! 0 for-all-records-from# add-record ;M --- 44,48 ---- \ -1 to statemask [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or TVIF_STATE or ] literal to mask ! for-all-records add-record ;M *************** *** 75,78 **** --- 75,79 ---- ;Class + \ ----------------------------------------------------------------------------- \ define the child window for the left part of the main window *************** *** 96,99 **** --- 97,102 ---- 0 0 -1 hDrop Call DragQueryFile ?dup if datfile$ count file-exist? check-config + MAXCOUNTED drop$ 0 hDrop Call DragQueryFile + drop$ swap GetLabel OpenAppendDatabase to wHndl begin MAXCOUNTED drop$ #File hDrop Call DragQueryFile dup 0> Index: Catalog.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Catalog.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** Catalog.f 9 Oct 2005 16:33:07 -0000 1.12 --- Catalog.f 16 Oct 2005 10:24:39 -0000 1.13 *************** *** 1,3 **** ! anew catalog.f \ 4-4-2005 needs ExtStruct.f --- 1,4 ---- ! \ Error: GetxxxxFileName failed RC=0x3003 ! anew catalog.f \ 15-10-2005 needs ExtStruct.f *************** *** 14,19 **** create IndexFile$ ," \catalog.idx" ! maxstring create database$ allot ! maxstring create index$ allot \ Define the configuration of the database --- 15,21 ---- create IndexFile$ ," \catalog.idx" ! string: database$ ! string: index$ ! 0 value _DriveType \ Define the configuration of the database *************** *** 29,33 **** sizeof ConfigDef mkstruct: Config s" \" Config ConfigDef PathMediaFiles place create DatFileFile$ ," \PathMediaFiles.dat" ! create DatFile$ maxstring ConfigDef allot : InitFileNames ( - ) --- 31,35 ---- sizeof ConfigDef mkstruct: Config s" \" Config ConfigDef PathMediaFiles place create DatFileFile$ ," \PathMediaFiles.dat" ! create DatFile$ : InitFileNames ( - ) *************** *** 38,64 **** ; ! \ Record discription of the catalog ! 256 constant /file_name ! 40 constant /Artist ! 36 constant /Title :struct RecordDef \ catalog ! /file_name Field: File_name BYTE Cnt_File_name - /Artist Field: Artist - BYTE Cnt_Artist - /Title Field: Title - BYTE Cnt_Title - DWORD FileSize BYTE Deleted- ! BYTE Excluded- \ Was: LastPlayed BYTE Played- ! BYTE Not_used2 Offset Deleted-thread DWORD RandomLevel DWORD #played DWORD Not_used1 ! ;struct \ database part --- 40,74 ---- ; ! \ Record discription of the catalog. October 14th, 2005. ! \ This model assumes that the filename is the title of an album and ! \ that it is placed in a directory named after the artist. ! 255 constant /file_name ! 32 constant /MediaLabel ! 80 constant /artist ! 120 constant /Title :struct RecordDef \ catalog ! /file_name Field: File_name BYTE Cnt_File_name BYTE Deleted- ! BYTE Excluded- BYTE Played- ! BYTE DriveType ! DWORD FileSize ! /MediaLabel Field: MediaLabel ! BYTE Cnt_MediaLabel ! /artist Field: Artist \ Extracted from the filename ! BYTE Cnt_Artist ! /Title Field: Title \ Extracted from the filename ! BYTE Cnt_Title Offset Deleted-thread DWORD RandomLevel DWORD #played DWORD Not_used1 ! DWORD Not_used2 ! DWORD Not_used3 ! DWORD Not_used4 ! ;struct \ database part *************** *** 77,83 **** map-handle config-mhndl ! : map-index ( - ) index$ count idx-mhndl open-map-file throw ; ! : map-database-file ( - ) database$ count database-mhndl open-map-file throw ; ! : map-config-file ( - ) DatFile$ count config-mhndl open-map-file throw ; : create-index-file ( #records - f ) --- 87,93 ---- map-handle config-mhndl ! : map-index ( - ) index$ count idx-mhndl open-map-file throw ; ! : map-database-file ( - ) database$ count database-mhndl open-map-file throw ; ! : map-config-file ( - ) DatFile$ count config-mhndl open-map-file throw ; : create-index-file ( #records - f ) *************** *** 116,121 **** in-system ! : do_part ( - ) ! s" database-mhndl #records-in-database swap do i " evaluate ; : for-all-records-from# \ compiletime: ( -<word>- ) runtime: ( start - ) --- 126,132 ---- in-system ! : do_part ( n - ) ! s" database-mhndl #records-in-database swap do i " EVALUATE ; ! : for-all-records-from# \ compiletime: ( -<word>- ) runtime: ( start - ) *************** *** 125,133 **** ; immediate in-application \ Define key-len and key-start before using sort-database : sort-database ( - ) 0 n>aptr database-mhndl #records-in-database shell-rel ; ! : sort-database-bin ( - ) 0 n>aptr database-mhndl #records-in-database shell-rel-c ; : rebuild-index-hdrs ( - ) \ database must mapped --- 136,152 ---- ; immediate + : do_all_part ( - ) s" database-mhndl #records-in-database 0 do i " EVALUATE ; + + : for-all-records ( - ) \ compiletime: ( -<word>- ) runtime: ( - ) + do_all_part + ' compile, ( rec-adr - ) + postpone loop + ; immediate + in-application \ Define key-len and key-start before using sort-database : sort-database ( - ) 0 n>aptr database-mhndl #records-in-database shell-rel ; ! : sort-database-bin ( - ) 0 n>aptr database-mhndl #records-in-database shell-rel-c ; : rebuild-index-hdrs ( - ) \ database must mapped *************** *** 145,148 **** --- 164,168 ---- \ ==== Part that depends on a record definition + : vadr-config ( - vadr-config ) s" config-mhndl map-hndl>vadr " EVALUATE ; IMMEDIATE *************** *** 192,199 **** : build-free-list ( - ) 0 vadr-config #free-list ! ! 0 for-all-records-from# free-list-check ; ! : delete-record ( n - ) dup true swap n>record dup>r RecordDef Deleted- c! 0 r> RecordDef Excluded- c! --- 212,219 ---- : build-free-list ( - ) 0 vadr-config #free-list ! ! for-all-records free-list-check ; ! : delete-record ( n - ) dup true swap n>record dup>r RecordDef Deleted- c! 0 r> RecordDef Excluded- c! *************** *** 236,240 **** : delete-collection ( - flag ) s" Deleting the collection." WarningBox dup ! if 0 for-all-records-from# delete-record-in-collection then ; --- 256,260 ---- : delete-collection ( - flag ) s" Deleting the collection." WarningBox dup ! if for-all-records delete-record-in-collection then ; *************** *** 249,253 **** --- 269,279 ---- dup>r not-deleted? if cr r@ . + r@ RecordDef DriveType c@ . + r@ RecordDef MediaLabel r@ RecordDef Cnt_MediaLabel c@ type-space r@ RecordDef File_name r@ Cnt_File_name c@ type-space + cr 3 spaces + r@ RecordDef Artist r@ Cnt_Artist c@ type-space + r@ RecordDef Title r@ Cnt_Title c@ type-space + r@ RecordDef #played ? r@ RecordDef RandomLevel ? *************** *** 259,267 **** ; : record-not-played ( n - ) n>record 0 swap RecordDef Played- c! ; ! : set-all-not-played ( - ) 0 for-all-records-from# record-not-played ; : list-record ( n - ) n>record _list-record ; ! : list-records ( - ) 0 for-all-records-from# list-record cr ; : list-database ( - ) map-database list-records unmap-database ; --- 285,294 ---- ; + : record-not-played ( n - ) n>record 0 swap RecordDef Played- c! ; ! : set-all-not-played ( - ) for-all-records record-not-played ; : list-record ( n - ) n>record _list-record ; ! : list-records ( - ) for-all-records list-record cr ; : list-database ( - ) map-database list-records unmap-database ; *************** *** 281,285 **** : random-shuffle ( - ) ! vadr-config MaximumRandomLevel @ 0 for-all-records-from# change-randomlevel drop sort_by_RandomLevel ; --- 308,312 ---- : random-shuffle ( - ) ! vadr-config MaximumRandomLevel @ for-all-records change-randomlevel drop sort_by_RandomLevel ; *************** *** 290,293 **** --- 317,322 ---- internal + 0 value /VolumeNameBuffer + : add.dir->file-size ( -- file-size ) _win32-find-data @ FILE_ATTRIBUTE_DIRECTORY and *************** *** 296,307 **** then ; - : (add-file) ( wHndl addr len file-size - wHndl ) \ add a file to the catalog InlineRecord [ sizeof RecordDef ] literal erase ! struct, InlineRecord RecordDef FileSize ! ! >r ! struct, InlineRecord RecordDef File_name r@ cmove ! r@ struct, InlineRecord RecordDef Cnt_File_name c! ! 100 random struct, InlineRecord RecordDef RandomLevel ! r>drop dup write-record --- 325,348 ---- then ; : (add-file) ( wHndl addr len file-size - wHndl ) \ add a file to the catalog InlineRecord [ sizeof RecordDef ] literal erase ! struct, InlineRecord RecordDef FileSize ! ! ! >r dup r@ + r@ ascii \ -scan 2dup r@ swap - swap 1+ dup rot \ adr Title ! dup>r ascii . scan nip r> swap - dup \ count artist ! struct, InlineRecord RecordDef Cnt_Title c! ! struct, InlineRecord RecordDef Title swap cmove \ move Title ! swap 1- dup rot ascii \ -scan drop 2dup - swap 1+ over ! struct, InlineRecord RecordDef Cnt_Artist c! ! struct, InlineRecord RecordDef Artist rot cmove ! drop ! struct, InlineRecord RecordDef File_name r@ cmove ! ! r@ struct, InlineRecord RecordDef Cnt_File_name c! ! 100 random struct, InlineRecord RecordDef RandomLevel ! ! VolumeNameBuffer struct, InlineRecord RecordDef MediaLabel ! /VolumeNameBuffer /MediaLabel min cmove ! /VolumeNameBuffer struct, InlineRecord RecordDef Cnt_MediaLabel c! ! _DriveType struct, InlineRecord RecordDef DriveType c! r>drop dup write-record *************** *** 405,414 **** s" artist*album " init-dlg Start: searchDlg >r pad$_ok? over and r> 0> and ! if 0 for-all-records-from# search-record 2drop RefreshCatalog else 2drop then ; ! create tmp$ maxstring allot : n>tmp$ ( n - ) 0 (d.) tmp$ place ; --- 446,455 ---- s" artist*album " init-dlg Start: searchDlg >r pad$_ok? over and r> 0> and ! if for-all-records search-record 2drop RefreshCatalog else 2drop then ; ! string: tmp$ : n>tmp$ ( n - ) 0 (d.) tmp$ place ; *************** *** 425,428 **** ; - \s - |
