Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Player4 Catalog.f,1.30,1.31 Mediatree.f,1.28,1.29 PLAYER4.F,1.42,1.43 Pl_MciWindow.f,1.16,1.17 PopupWindow.f,1.2,1.3
|
From: Jos v.d.V. <jo...@us...> - 2006-04-12 19:44:29
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11421/apps/Player4 Modified Files: Catalog.f Mediatree.f PLAYER4.F Pl_MciWindow.f PopupWindow.f Log Message: Jos: Improved the request handling. Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.42 retrieving revision 1.43 diff -C2 -d -r1.42 -r1.43 *** PLAYER4.F 5 Apr 2006 16:26:47 -0000 1.42 --- PLAYER4.F 12 Apr 2006 19:44:24 -0000 1.43 *************** *** 20,23 **** --- 20,24 ---- decimal + true value turnkey? true value MciDebug? *************** *** 39,42 **** --- 40,44 ---- defer RefreshWindow ' noop is SortSize defer PlaySelectedFromTreeView ' noop is PlaySelectedFromTreeView + defer RequestRecord ' noop is RequestRecord needs Pl_Toolset.f *************** *** 75,79 **** SUBMENU "S&ort and view" MENUITEM "Define a view and sort" StartViewForm ; ! MENUITEM "&Sort" SortCatalog ; MENUSEPARATOR MENUITEM "Se&t maximum random level" SetRandomLevel ; --- 77,81 ---- SUBMENU "S&ort and view" MENUITEM "Define a view and sort" StartViewForm ; ! MENUITEM "&Sort / Refresh" SortCatalog ; MENUSEPARATOR MENUITEM "Se&t maximum random level" SetRandomLevel ; *************** *** 82,89 **** SUBMENU "Re&quest handling" :MENUITEM mHandelReq "Ignore requests" ! vadr-config IgnoreRequests invert-check ; :MENUITEM mKeepReq "Keep requests" vadr-config KeepRequests invert-check ; ! MENUITEM "&Enable all kept requests" EnableKeptRequests ; MENUITEM "Se&t request level" player-base SetRequestLevel ; MENUITEM "Set a&ll requests to the same level" Level-requests SortCatalog ; --- 84,94 ---- SUBMENU "Re&quest handling" :MENUITEM mHandelReq "Ignore requests" ! vadr-config IgnoreRequests dup invert-check c@ not ! if SortCatalog ! then ! ; :MENUITEM mKeepReq "Keep requests" vadr-config KeepRequests invert-check ; ! \ MENUITEM "&Enable all kept requests" EnableKeptRequests ; MENUITEM "Se&t request level" player-base SetRequestLevel ; MENUITEM "Set a&ll requests to the same level" Level-requests SortCatalog ; *************** *** 386,390 **** :noname ( -- ) \ sort catalog by file names catalog-exist? ! if SortByFlags RefreshCatalog then ; is SortCatalog --- 391,395 ---- :noname ( -- ) \ sort catalog by file names catalog-exist? ! if EnableKeptRequests SortByFlags RefreshCatalog then ; is SortCatalog Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** Pl_MciWindow.f 12 Mar 2006 18:01:27 -0000 1.16 --- Pl_MciWindow.f 12 Apr 2006 19:44:24 -0000 1.17 *************** *** 278,287 **** Playing?: Self not if next-not-played dup -1 = ! if cr cr ." All done. Reset randomlevel and shuffle..." 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@ RequestDone r> mark-played PlayFile: Self --- 278,288 ---- 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 Index: PopupWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PopupWindow.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** PopupWindow.f 12 Mar 2006 17:00:40 -0000 1.2 --- PopupWindow.f 12 Apr 2006 19:44:24 -0000 1.3 *************** *** 8,25 **** 0 value _hwnd ! : ClosePopupWindow ( - ) _hwnd call DestroyWindow drop ; POPUPBAR PopupOnRecord POPUP " " ! MENUITEM "Play file" PlaySelectedFromTreeView ClosePopupWindow ; ! MENUITEM "Request record" RequestRecord ClosePopupWindow ; ! MENUITEM "Exit menu" ClosePopupWindow ; ENDBAR :Object PopupWindow <super Window ColorObject FrmColor \ the background color ! ! :M ClassInit: ( -- ) ClassInit: super PopupOnRecord SetPopupBar: Self ;M --- 8,27 ---- 0 value _hwnd ! ! defer ClosePopupWindow ' noop is ClosePopupWindow POPUPBAR PopupOnRecord POPUP " " ! MENUITEM "Play file" ClosePopupWindow PlaySelectedFromTreeView ; ! MENUITEM "Request record" ClosePopupWindow RequestRecord ; ! MENUITEM "Exit menu" ClosePopupWindow ; ENDBAR :Object PopupWindow <super Window + int focus ColorObject FrmColor \ the background color ! :M ClassInit: ( -- ) ClassInit: super PopupOnRecord ! SetPopupBar: Self true to Focus ;M *************** *** 27,44 **** : StartPopup ( -- ) 0 WM_RBUTTONDOWN GetHandle: self Call PostMessage drop ; - :M On_Init: ( -- ) COLOR_BTNFACE Call GetSysColor NewColor: FrmColor ;M :M WindowStyle: ( -- style ) WS_POPUP ;M :M StartSize: ( -- width height ) 70 30 ;M :M StartPos: ( -- x y ) mousex mousey ;M :M WM_LBUTTONDOWN ( h m w l -- res ) 2drop 0 close: Self 0 ;M ! :M On_KillFocus: ( h m w l -- ) 2drop 0 SetFocus: self ;M :M On_Paint: ( -- ) ! hwnd to _hwnd ! \ SetActiveWindow: Self ! 0 0 GetSize: self Addr: FrmColor FillArea: dc ! _hwnd start: PopupOnRecord ! StartPopup ;M ;Object --- 29,52 ---- : StartPopup ( -- ) 0 WM_RBUTTONDOWN GetHandle: self Call PostMessage drop ; :M WindowStyle: ( -- style ) WS_POPUP ;M :M StartSize: ( -- width height ) 70 30 ;M :M StartPos: ( -- x y ) mousex mousey ;M :M WM_LBUTTONDOWN ( h m w l -- res ) 2drop 0 close: Self 0 ;M ! :M On_KillFocus: ( h m w l -- ) 2drop focus if SetFocus: self then ;M :M On_Paint: ( -- ) ! focus ! if hwnd to _hwnd ! 0 0 GetSize: self Addr: FrmColor FillArea: dc ! _hwnd start: PopupOnRecord ! StartPopup ! then ;M + + :M On_Done: ( h m w l -- res ) On_Done: super 0 ;M + + :noname ( - ) false to focus + _hwnd call DestroyWindow drop + ; is ClosePopupWindow ;Object Index: Catalog.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Catalog.f,v retrieving revision 1.30 retrieving revision 1.31 diff -C2 -d -r1.30 -r1.31 *** Catalog.f 5 Apr 2006 16:50:07 -0000 1.30 --- Catalog.f 12 Apr 2006 19:44:24 -0000 1.31 *************** *** 56,59 **** --- 56,61 ---- string: DatFile$ + also configdef + : InitFileNames ( - ) current-dir$ count 2dup database$ place 2dup index$ place DatFile$ place *************** *** 115,119 **** sizeof RecordDef dup to record-size mkstruct: InlineRecord - : >RecordDef ( - rel ) s" 0 RecordDef " EVALUATE ; IMMEDIATE : file-exist? ( adr len -- true-if-file-exist ) file-status nip 0= ; : file-size>s ( fileid -- len ) file-size drop d>s ; --- 117,120 ---- *************** *** 271,275 **** ; - : delete-record ( n - ) dup true swap n>record dup>r RecordDef Deleted- c! --- 272,275 ---- *************** *** 318,327 **** ! >RecordDef File_name /file_name key: FileNameKey ! >RecordDef MediaLabel 255 key: FlexKey ! >RecordDef RandomLevel 1 cells key: RandomKey RandomKey bin-sort ! >RecordDef #played 1 cells key: leastPlayedKey leastPlayedKey bin-sort ! >RecordDef FileSize 1 cells key: FileSizeKey FileSizeKey bin-sort ! >RecordDef Request- 1 cells 2/ key: RequestKey RequestKey Descending word-sort : &FlexKeyLen ( - &FlexKeyLen ) FlexKey &key-len ; --- 318,327 ---- ! 0 RecordDef File_name previous /file_name key: FileNameKey ! 0 RecordDef MediaLabel previous 255 key: FlexKey ! 0 RecordDef RandomLevel previous 1 cells key: RandomKey RandomKey bin-sort ! 0 RecordDef #played previous 1 cells key: leastPlayedKey leastPlayedKey bin-sort ! 0 RecordDef FileSize previous 1 cells key: FileSizeKey FileSizeKey bin-sort ! 0 RecordDef Request- previous 1 cells 2/ key: RequestKey RequestKey Descending word-sort : &FlexKeyLen ( - &FlexKeyLen ) FlexKey &key-len ; *************** *** 331,335 **** : by_record ( - FlexKey ) ! /Record &FlexKeyLen ! FlexKey @ >RecordDef Artist MinFlexKey! FlexKey ; --- 331,335 ---- : by_record ( - FlexKey ) ! /Record &FlexKeyLen ! FlexKey @ 0 RecordDef Artist MinFlexKey! FlexKey ; *************** *** 382,386 **** : Level-request ( n - ) dup request? ! if n>record 1 swap RequestLevelRecord c! else drop then --- 382,386 ---- : Level-request ( n - ) dup request? ! if n>record 1 swap RecordDef RequestLevelRecord c! else drop then *************** *** 445,449 **** : sort_by_size ( - ) by_FileSize sort-database ; - : SortByFlags ( - ) vadr-config >r 1 --- 445,448 ---- *************** *** 465,477 **** r@ s_Drivetype- c@ if [ /Drivetype /MediaLabel + /Record + ] literal &FlexKeyLen ! ! FlexKey @ >RecordDef DriveType MinFlexKey! then r@ s_Label- c@ if [ /MediaLabel /Record + ] literal &FlexKeyLen ! ! FlexKey @ >RecordDef MediaLabel MinFlexKey! then r@ s_Artist_Title- c@ if [ /Record ] literal &FlexKeyLen ! ! FlexKey @ >RecordDef Artist MinFlexKey! then FlexKey &key-len @ 0> --- 464,476 ---- r@ s_Drivetype- c@ if [ /Drivetype /MediaLabel + /Record + ] literal &FlexKeyLen ! ! FlexKey @ 0 RecordDef DriveType MinFlexKey! then r@ s_Label- c@ if [ /MediaLabel /Record + ] literal &FlexKeyLen ! ! FlexKey @ 0 RecordDef MediaLabel MinFlexKey! then r@ s_Artist_Title- c@ if [ /Record ] literal &FlexKeyLen ! ! FlexKey @ 0 RecordDef Artist MinFlexKey! then FlexKey &key-len @ 0> *************** *** 486,492 **** By_Random sort-database \ 1 cells to key-len ! \ >RecordDef RandomLevel to key-start sort-database-bin ! \ >RecordDef #played to key-start sort-database-bin ! \ \ >RecordDef Deleted- to key-start sort-database-bin ; --- 485,491 ---- By_Random sort-database \ 1 cells to key-len ! \ 0 RecordDef RandomLevel to key-start sort-database-bin ! \ 0 RecordDef #played to key-start sort-database-bin ! \ \ 0 RecordDef Deleted- to key-start sort-database-bin ; *************** *** 500,518 **** : mark-played ( adr - ) -1 swap RecordDef Played- c! ; : RequestDone ( adr - ) vadr-config KeepRequests c@ if drop ! else 0 swap RecordDef Request- w! then ; : EnableKeptRequest ( n - ) ! n>record dup RecordDef Request- w@ ! if 0 swap RecordDef Played- c! ! else drop then ; ! : EnableKeptRequests ( - ) for-all-records EnableKeptRequest ; internal --- 499,520 ---- : mark-played ( adr - ) -1 swap RecordDef Played- c! ; + 0 value #requests + : RequestDone ( adr - ) vadr-config KeepRequests c@ if drop ! else 0 swap RecordDef Request- w! -1 +to #requests then ; : EnableKeptRequest ( n - ) ! n>record dup RecordDef Request- c@ ! if 0 swap RecordDef Played- c! ! else drop then ; ! : EnableKeptRequests ( - ) for-all-records EnableKeptRequest ! ; internal *************** *** 586,592 **** 0 value #InCollection ! : next-not-played ( - n ) \ -1 means done. -1 database-mhndl #records-in-database last-selected-rec 0 max \ Starting from the last-selected record ! do i n>record dup>r RecordDef Excluded- c@ not r@ RecordDef Played- c@ 0= and r> RecordDef Deleted- c@ 0= and if drop i leave --- 588,606 ---- 0 value #InCollection ! : NoRequests? ( adr - flag ) #requests 0> vadr-config IgnoreRequests c@ not and ; ! : Requested? ( adr - flag ) RecordDef Request- c@ ; ! ! : next-not-played ( - n ) \ -1 means done. >>> -1 database-mhndl #records-in-database last-selected-rec 0 max \ Starting from the last-selected record ! do i n>record >r NoRequests? ! if r@ Requested? dup ! if r@ RequestDone ! then ! else ! r@ RecordDef Excluded- c@ not ! r@ Requested? not and ! ! then ! r@ RecordDef Played- c@ 0= and r> RecordDef Deleted- c@ 0= and if drop i leave *************** *** 696,706 **** ; - : RequestRecord ( - ) - vadr-config RequestLevel c@ - last-selected-rec dup EnableKeptRequest - n>record dup>r RecordDef RequestLevelRecord c! - 1 r> RecordDef Request- c! - ; - NewEditDialog RequestLevelDlg "Request level" "Enter the level to use:" "Ok" "Cancel" "" --- 710,713 ---- *************** *** 713,715 **** --- 720,724 ---- ; + previous previous previous + \s Index: Mediatree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** Mediatree.f 5 Apr 2006 16:26:47 -0000 1.28 --- Mediatree.f 12 Apr 2006 19:44:24 -0000 1.29 *************** *** 11,15 **** 0 value hItem-last-selected - :Class MediaTree <super TreeViewControl --- 11,14 ---- *************** *** 114,120 **** : root-items ( - hPrev ) NotPlayable TVI_LAST TVI_ROOT 2>r ! TVI_ROOT TVI_LAST z" Movies" 2r@ 1 AddItemHierarical to hMovies ! TVI_ROOT TVI_LAST z" Music" 2r@ 1 AddItemHierarical dup to hMusic ! TVI_ROOT TVI_LAST z" Requests" 2r> 1 AddItemHierarical dup to hRequests dummy dup &PrevMusic ! dup &PrevMovie ! &PrevRequest ! dup &PrevMovie hArtist ! &PrevMovie hArtist ! --- 113,119 ---- : root-items ( - hPrev ) NotPlayable TVI_LAST TVI_ROOT 2>r ! z" Movies" 2r@ 1 AddItemHierarical to hMovies ! z" Music" 2r@ 1 AddItemHierarical dup to hMusic ! z" Requests" 2r> 1 AddItemHierarical dup to hRequests dummy dup &PrevMusic ! dup &PrevMovie ! &PrevRequest ! dup &PrevMovie hArtist ! &PrevMovie hArtist ! *************** *** 166,174 **** : AddRecordHierarical ( n - ) ! dup NotIncollection? over n>record Request- c@ not and if drop else ( 1306 +) >r ResetInlineRecord ! r@ n>record dup Request- c@ ! if &PrevRequest else dup CountedFilename music? if &PrevMusic --- 165,173 ---- : AddRecordHierarical ( n - ) ! dup NotIncollection? over n>record RecordDef Request- c@ not and if drop else ( 1306 +) >r ResetInlineRecord ! r@ n>record dup RecordDef Request- c@ ! if 1 +to #requests &PrevRequest else dup CountedFilename music? if &PrevMusic *************** *** 190,193 **** --- 189,193 ---- :M FillTreeView: ( -- ) 0 to #InCollection + 0 to #requests 0 to last-selected-rec tvins /tvins erase *************** *** 236,239 **** --- 236,240 ---- ;M + :M ~: ( -- ) GetHandle: self call DestroyWindow drop ;M *************** *** 241,245 **** ;Class - \ ----------------------------------------------------------------------------- \ define the child window for the left part of the main window --- 242,245 ---- *************** *** 316,326 **** to EnableNotify? - SW_RESTORE Show: self - arrow-cursor MciDebug? ! if .elapsed ! then ;M --- 316,324 ---- to EnableNotify? SW_RESTORE Show: self arrow-cursor MciDebug? ! if .elapsed ! then ;M *************** *** 331,336 **** --- 329,346 ---- then ;M + :noname ( - ) + vadr-config RequestLevel c@ + last-selected-rec dup EnableKeptRequest + n>record dup>r RecordDef RequestLevelRecord c! + 1 r> RecordDef Request- c! + 1 +to #requests + 0 to last-selected-rec + \ SortCatalog + ; is RequestRecord + ;Object + + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ End of File |
