Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Player4 PopupWindow.f,NONE,1.1 Catalog.f,1.25,1.26 Mediatree.f,1.23,1.24 PLAYER4.F,1.38,1.39 Pl_MciWindow.f,1.13,1.14 mshell_r.f,1.2,1.3
|
From: Jos v.d.V. <jo...@us...> - 2006-03-08 21:43:06
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv406/apps/Player4 Modified Files: Catalog.f Mediatree.f PLAYER4.F Pl_MciWindow.f mshell_r.f Added Files: PopupWindow.f Log Message: Jos: Added requests. And a tricky popupwindow. Index: mshell_r.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/mshell_r.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** mshell_r.f 26 Nov 2005 19:17:07 -0000 1.2 --- mshell_r.f 8 Mar 2006 21:42:56 -0000 1.3 *************** *** 1,24 **** ! anew mshell_rel.f \ October 24th, 2005 \ A flexible shellsort. ! \ Notes: ! \ The database and the pointers must be mapped. ! \ Minimum file size of the database must be 1 byte. ! \ When the database is resized, the database has to be re-mapped. \ Characteristics: ! \ This version saves its pointers as relative offsets in an index file. ! \ The sort is case-insensitive. ! \ Multiple keys can be used and can be sorted in one go. ! \ The number of keys is limited by the size of the stack. ! \ Each key can be ascending or descending sorted. ! ! ! needs w_search.f ! \ September 9th, 2001 - 14:38 ! \ :INLINE was posted in comp.lang.forth by Marcel Hendrix : next_char ( -- char ) \ next-char was used in float.f --- 1,24 ---- ! anew mshell_rel.f \ March 5th, 2006 for Win32Forth Version: 6.11.07 \ A flexible shellsort. ! \ Notes when mapped files are used: ! \ 1.The database and the pointers must be mapped. ! \ 2.Minimum file size of the database must be 1 byte. ! \ 3.When the database is resized, the database has to be re-mapped. \ Characteristics: ! \ This version uses relative as pointers. So there is no need ! \ to generate the same pointers again when they are saved in a file. ! \ Multiple keys can be used and sorted in one go. ! \ The number of keys is only limited by the unused size of the stack. ! \ Each key can be sorted in an ascending or descending way. ! \ A key may contain a number or a string. ! \ The sort is case-insensitive for stings. ! \ Easy to expand to sort doubles etc. ! needs w_search.f \ Included in Win32Forth Version: 6.11.07 ! \ :INLINE was posted in comp.lang.forth by Marcel Hendrix about September 9th, 2001 : next_char ( -- char ) \ next-char was used in float.f *************** *** 62,66 **** r> release does> 2@ evaluate ; - 23 value record-size --- 62,65 ---- *************** *** 84,105 **** 2dup = if 2drop 0 else < if 1 else true then then ; ! : cmp-cell { by } ( cand1 cand2 by - p1 p2 n ) ! >key @ swap >key @ <>= ! ; ! : cmp$ { by } ( cand1 cand2 by - p1 p2 n ) ! swap >key swap >key key-len tuck compareia ! ; ! : mod-cell ( n adr offset - ) >r swap r> cells+ ! ; ! : Ascending ( key - key ) dup 0 2 mod-cell ; : Descending ( key - key ) dup -1 2 mod-cell ; ! : $sort ( key - ) ['] cmp$ 3 mod-cell ; ! : bin-sort ( key - ) ['] cmp-cell 3 mod-cell ; :inline Descending? ( key - ) 2 cells+ @ ; \ Ascending and cmp$ are default in key: ! : key: \ Compiletime: ( start len -< name >- ) Runtime ( - adr-key ) create swap , , 0 , ['] cmp$ , ; --- 83,108 ---- 2dup = if 2drop 0 else < if 1 else true then then ; ! :inline f<>= ( f1 f2 - -1|0|1 ) ! f2dup f= if f2drop 0 else f< if 1 else true then then ; ! : cmp-cells ( cand1 cand2 by - n ) locals| by | >key @ swap >key @ <>= ; ! : cmp-words ( cand1 cand2 by - n ) locals| by | >key w@ swap >key w@ <>= ; ! : cmp-floats ( cand1 cand2 by - n ) locals| by | >key f@ >key f@ f<>= ; ! : cmp$ ( cand1 cand2 by - n ) ! locals| by | swap >key swap >key key-len tuck compareia ; ! ! : mod-cell ( n adr offset - ) >r swap r> cells+ ! ; ! : Ascending ( key - key ) dup 0 2 mod-cell ; : Descending ( key - key ) dup -1 2 mod-cell ; ! : $sort ( key - ) ['] cmp$ 3 mod-cell ; ! : bin-sort ( key - ) ['] cmp-cells 3 mod-cell ; ! : word-sort ( key - ) ['] cmp-words 3 mod-cell ; ! : float-sort ( key - ) ['] cmp-floats 3 mod-cell ; :inline Descending? ( key - ) 2 cells+ @ ; \ Ascending and cmp$ are default in key: ! : key: \ Compiletime: ( start len -< name >- ) Runtime: ( - adr-key ) create swap , , 0 , ['] cmp$ , ; *************** *** 108,113 **** :inline ]by ( - #stack-inc) ( R: #stack - ) depth r> - ; ! : CmpBy ( cand1 cand2 ByStackTop #keys - p1 p2 f ) ! true LOCALS| flag #keys ByStackTop cand2 cand1 | #keys 0 do cand1 cand2 ByStackTop i cells+ @ dup 3 cells+ @ execute --- 111,116 ---- :inline ]by ( - #stack-inc) ( R: #stack - ) depth r> - ; ! : CmpBy ( cand1 cand2 ByStackTop #keys - f ) ! true locals| flag #keys ByStackTop cand2 cand1 | #keys 0 do cand1 cand2 ByStackTop i cells+ @ dup 3 cells+ @ execute *************** *** 125,130 **** ; : mshell-rel ( keyx..key1 #keys aptrs #records -- ) ! sp@ 3 cells+ 3 roll LOCALS| #keys by | dup 2 < if 2drop --- 128,135 ---- ; + : xdrop ( nx..n1 #n - ) locals| #n | sp@ #n cells+ sp! ; + : mshell-rel ( keyx..key1 #keys aptrs #records -- ) ! sp@ 3 cells+ 3 roll locals| #keys by | dup 2 < if 2drop *************** *** 142,156 **** repeat 2drop drop then ! sp@ #keys cells+ sp! ; - : build-ptrs ( #records -- ) - to #records #records 1+ cells allocate throw to aptrs #records 1+ 0 - do records-pointer i records ( chars ) + aptrs i cells + ! - loop ; - - : free-ptrs ( -- ) aptrs FREE THROW ; - : free-records ( -- ) records-pointer FREE THROW ; - \ : check-keys ( -- ) \ space #records 1- --- 147,153 ---- repeat 2drop drop then ! #keys xdrop ; \ : check-keys ( -- ) \ space #records 1- *************** *** 172,178 **** ; ! : #records-in-database ( m_hndl - #records ) >hfileLength @ record-size / ; ! ! : add-file-ptrs ( #start #end - ) dup to #records swap do i records aptrs i cells + ! --- 169,173 ---- ; ! : add-ptrs ( #start #end - ) dup to #records swap do i records aptrs i cells + ! *************** *** 180,184 **** ; ! : build-file-ptrs ( #records -- ) 0 swap add-file-ptrs ; \s --- 175,179 ---- ; ! : build-ptrs ( #records -- ) 0 swap add-ptrs ; \s Index: Mediatree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** Mediatree.f 26 Nov 2005 19:17:07 -0000 1.23 --- Mediatree.f 8 Mar 2006 21:42:56 -0000 1.24 *************** *** 7,10 **** --- 7,11 ---- needs TreeView.F needs struct.f + needs PopupWindow.f 0 value hItem-last-selected *************** *** 101,104 **** --- 102,106 ---- sizeof PrevMember mkstruct: &PrevMusic sizeof PrevMember mkstruct: &PrevMovie + sizeof PrevMember mkstruct: &PrevRequest int hMovies *************** *** 114,120 **** 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 ! &PrevMovie ! dup &PrevMovie hArtist ! &PrevMovie hArtist ! (( z" First Artist" hPrev hMusic 1 AddItemHierarical to hArtist --- 116,122 ---- 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 ! (( z" First Artist" hPrev hMusic 1 AddItemHierarical to hArtist *************** *** 129,136 **** if dup PrevRecAdr ! true to OtherArtist? NotPlayable dup RecordDef Artist hPrev ! rot CountedFilename music? ! if hMusic ! else hMovies ! then 1 AddItemHierarical PrevRecAdr hArtist ! else drop false to OtherArtist? --- 131,141 ---- if dup PrevRecAdr ! true to OtherArtist? NotPlayable dup RecordDef Artist hPrev ! 2 pick RecordDef Request- c@ ! if rot drop hRequests ! else rot CountedFilename music? ! if hMusic ! else hMovies ! then ! then 1 AddItemHierarical PrevRecAdr hArtist ! else drop false to OtherArtist? *************** *** 148,152 **** : AddTitle ( rec-addr PrevRecAdr - ) - \ over swap ! >r RecordDef CountedTitle +InlineRecord InlineRecord +null --- 153,156 ---- *************** *** 159,167 **** if drop else ( 1306 +) >r ResetInlineRecord ! r@ n>record ! dup CountedFilename music? ! if &PrevMusic ! else &PrevMovie ! then \ ( n vadr-config rec-addr PrevRecAdr - ) 2dup AddArtist 2dup AddAlbum --- 163,173 ---- if drop else ( 1306 +) >r ResetInlineRecord ! r@ n>record dup Request- c@ ! if &PrevRequest ! else dup CountedFilename music? ! if &PrevMusic ! else &PrevMovie ! then ! then \ ( n vadr-config rec-addr PrevRecAdr - ) 2dup AddArtist 2dup AddAlbum *************** *** 198,201 **** --- 204,216 ---- ;M + : StartPopupWindow + last-selected-rec n>record CountedFilename music? + if hWnd dup get-mouse-xy + GetPositionCatalog + rot + to mousey + to mousex + Start: PopupWindow + then + ; + :M On_SelChanged: ( - ) TVIF_PARAM *************** *** 207,223 **** hItem to hItem-last-selected lParam dup to last-selected-rec -1 <> ! ! if last-selected-rec n>record dup>r ! RecordDef File_name r@ Cnt_File_name c@ ! r@ incr-#played ! r> mark-played ! turnkey? not ! if 2dup cr type-space ! then ! PlayFile: PLAYER4W ! false then ;M :M ~: ( -- ) GetHandle: self call DestroyWindow drop ;M --- 222,233 ---- hItem to hItem-last-selected lParam dup to last-selected-rec -1 <> ! if StartPopupWindow then ;M + :M On_RightClick: + StartPopupWindow + ;M + :M ~: ( -- ) GetHandle: self call DestroyWindow drop ;M *************** *** 308,311 **** --- 318,322 ---- ;M + :M WM_NOTIFY ( h m w l -- f ) dup @ GetHandle: TreeView = EnableNotify? and *************** *** 321,323 **** \s ! --- 332,334 ---- \s ! Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.38 retrieving revision 1.39 diff -C2 -d -r1.38 -r1.39 *** PLAYER4.F 13 Feb 2006 20:21:37 -0000 1.38 --- PLAYER4.F 8 Mar 2006 21:42:56 -0000 1.39 *************** *** 23,41 **** true value MciDebug? ! defer PLAYER ' noop is PLAYER ! defer RefreshCatalog ' noop is RefreshCatalog ! defer RandomizeCatalog ' noop is RandomizeCatalog ! defer SortCatalog ' noop is SortCatalog ! defer SearchCatalog ' noop is SearchCatalog ! defer DeleteItem ' noop is DeleteItem ! defer DeleteCollection ' noop is DeleteCollection ! defer Undelete ' noop is Undelete ! defer UndeleteAll ' noop is UndeleteAll ! defer ShowDeleted ' noop is ShowDeleted ! defer SetRandomLevel ' noop is SetRandomLevel ! defer SortRandom ' noop is SortRandom ! defer SortLeastPlayed ' noop is SortLeastPlayed ! defer SortSize ' noop is SortSize ! defer RefreshWindow ' noop is SortSize needs Pl_Toolset.f --- 23,42 ---- true value MciDebug? ! defer PLAYER ' noop is PLAYER ! defer RefreshCatalog ' noop is RefreshCatalog ! defer RandomizeCatalog ' noop is RandomizeCatalog ! defer SortCatalog ' noop is SortCatalog ! defer SearchCatalog ' noop is SearchCatalog ! defer DeleteItem ' noop is DeleteItem ! defer DeleteCollection ' noop is DeleteCollection ! defer Undelete ' noop is Undelete ! defer UndeleteAll ' noop is UndeleteAll ! defer ShowDeleted ' noop is ShowDeleted ! defer SetRandomLevel ' noop is SetRandomLevel ! defer SortRandom ' noop is SortRandom ! defer SortLeastPlayed ' noop is SortLeastPlayed ! defer SortSize ' noop is SortSize ! defer RefreshWindow ' noop is SortSize ! defer PlaySelectedFromTreeView ' noop is PlaySelectedFromTreeView needs Pl_Toolset.f *************** *** 52,75 **** needs view.f - - \ ----------------------------------------------------------------------------- - \ Define the Popup bar - \ ----------------------------------------------------------------------------- - - POPUPBAR player4-Popup-bar - POPUP " " - MENUITEM "&Play file...\tCtrl+O" 'O' +k_control pushkey ; - MENUITEM "Play &folder...\tCtrl+F" 'F' +k_control pushkey ; - MENUITEM "Play &list...\tShift+L" 'L' +k_control pushkey ; - MENUSEPARATOR - MENUITEM "&Pause/Resume\tSpace" BL pushkey ; - MENUSEPARATOR - MENUITEM "&Stop/Next\tArrow down" k_down pushkey ; - MENUITEM "&Rewind\tArrow left" k_left pushkey ; - MENUITEM "&Forward\tArrow right" k_right pushkey ; - MENUSEPARATOR - MENUITEM "&Exit\tAlt+F4" 'Q' +k_control pushkey ; - ENDBAR - : invert-check ( check - ) dup c@ not swap c! RefreshWindow ; --- 53,56 ---- *************** *** 93,102 **** MENUSEPARATOR SUBMENU "S&ort and view" ! MENUITEM "Define a view" StartViewForm ; MENUSEPARATOR MENUITEM "Se&t maximum random level" SetRandomLevel ; MENUITEM "&Generate random numbers" RandomizeCatalog ; ENDSUBMENU ! MENUSEPARATOR MENUITEM "Show &collection" RefreshCatalog ; --- 74,90 ---- MENUSEPARATOR SUBMENU "S&ort and view" ! MENUITEM "Define a view" StartViewForm ; MENUSEPARATOR MENUITEM "Se&t maximum random level" SetRandomLevel ; MENUITEM "&Generate random numbers" RandomizeCatalog ; ENDSUBMENU ! 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 ; ! ENDSUBMENU MENUSEPARATOR MENUITEM "Show &collection" RefreshCatalog ; *************** *** 128,131 **** --- 116,120 ---- ENDBAR + \ ----------------------------------------------------------------------------- \ ----------------------------------------------------------------------------- *************** *** 139,142 **** --- 128,142 ---- needs Pl_MciWindow.f + :noname + last-selected-rec n>record dup>r + RecordDef File_name r@ Cnt_File_name c@ + r@ incr-#played + r> mark-played + turnkey? not + if 2dup cr type-space + then + PlayFile: PLAYER4W + ; is PlaySelectedFromTreeView + \ ----------------------------------------------------------------------------- \ define the child window for the left part of the main window *************** *** 150,155 **** if DatFile$ count r/o open-file throw dup file-size throw d>s pad ! close-file throw pad @ ! sizeof ConfigDef = check-config unmap-configuration then ; --- 150,157 ---- if DatFile$ count r/o open-file throw dup file-size throw d>s pad ! close-file throw pad @ ! sizeof ConfigDef = ! else false then + check-config unmap-configuration ; *************** *** 179,186 **** --- 181,191 ---- ; + :noname GetWindowRect: Self 2drop ; is GetPositionCatalog ( - x y ) :M WM_INITMENU ( h m w l -- res ) \ enable/disable the menu items vadr-config AutoStart- c@ Check: mAutostart vadr-config AutoMinimized- c@ Check: mTray + vadr-config IgnoreRequests c@ Check: mHandelReq + vadr-config KeepRequests c@ Check: mKeepReq 0 ;M *************** *** 256,260 **** if cr ." REBUILD " then ! generate-index-file build-free-list then true vadr-config ExitFailed- c! --- 261,265 ---- if cr ." REBUILD " then ! generate-index-file build-free-list SortByFlags then true vadr-config ExitFailed- c! *************** *** 276,285 **** player4-menu-bar SetMenuBar: self - addr: self to player-base RefreshCatalog ;M - :M On_Done: ( h m w l -- res ) Close: self --- 281,288 ---- *************** *** 558,564 **** PLAYER-LOOP ; - \ Resize the configuration file when needed. - check/resize-config-file - \ ----------------------------------------------------------------------------- \ build an application on disk or run Player --- 561,564 ---- Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** Pl_MciWindow.f 29 Nov 2005 16:51:47 -0000 1.13 --- Pl_MciWindow.f 8 Mar 2006 21:42:56 -0000 1.14 *************** *** 229,232 **** --- 229,233 ---- RecordDef File_name r@ Cnt_File_name c@ 2dup type-space r@ incr-#played + r@ RequestDone r> mark-played PlayFile: Self *************** *** 315,319 **** self Start: MouseHandlerWindow ! player4-popup-Bar SetPopupBar: MouseHandlerWindow ;M --- 316,320 ---- self Start: MouseHandlerWindow ! \ player4-popup-Bar SetPopupBar: MouseHandlerWindow ;M --- NEW FILE: PopupWindow.f --- anew -PopupWindow.f defer GetPositionCatalog \ ----------------------------------------------------------------------------- \ Define the Popup bar for the mediatree in a new window \ ----------------------------------------------------------------------------- 0 value _hwnd : ClosePopupWindow ( - ) _hwnd call DestroyWindow drop ; POPUPBAR player4-Popup-bar 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 player4-Popup-bar SetPopupBar: Self ;M \ Needs the rbuttondown to do it right : 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: player4-Popup-bar StartPopup ;M ;Object \ start: PopupWindow Index: Catalog.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Catalog.f,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** Catalog.f 12 Feb 2006 16:34:56 -0000 1.25 --- Catalog.f 8 Mar 2006 21:42:56 -0000 1.26 *************** *** 46,49 **** --- 46,52 ---- BYTE AutoStart- BYTE AutoMinimized- + BYTE RequestLevel + BYTE IgnoreRequests + BYTE KeepRequests ;struct *************** *** 98,102 **** DWORD YearReleased DWORD Bitrate ! DWORD NotUsed1 DWORD NotUsed2 ;struct --- 101,107 ---- DWORD YearReleased DWORD Bitrate ! BYTE Request- ! BYTE RequestLevelRecord ! WORD NotUsed1 DWORD NotUsed2 ;struct *************** *** 104,113 **** \ database part ! \ Advantages of an inline record: \ An easy way to create and debug a fixed record 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 ; --- 109,118 ---- \ database part ! \ Advantage of an inline record: \ An easy way to create and debug a fixed record 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 ; *************** *** 154,157 **** --- 159,163 ---- : type-space ( adr cnt - ) type space ; : type-cr ( adr cnt - ) type cr ; + : #records-in-database ( m_hndl - #records ) >hfileLength @ record-size / ; in-system *************** *** 189,192 **** --- 195,206 ---- ; + : add-file-ptrs ( #start #end - ) + dup to #records swap + do i records aptrs i cells + ! + loop + ; + + : build-file-ptrs ( #records -- ) 0 swap add-file-ptrs ; + : rebuild-index-hdrs ( - ) \ database must mapped database-mhndl #records-in-database build-file-ptrs *************** *** 307,310 **** --- 321,325 ---- >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 ; *************** *** 317,324 **** ; ! : By_FileName ( - by ) by[ FileNameKey ]by ; ! : By_Random ( - by ) by[ RandomKey ]by ; ! : by_leastPlayed ( - by ) by[ leastPlayedKey Ascending ]by ; ! : by_FileSize ( - by ) by[ FileSizeKey ]by ; : not-deleted? ( rec-adr - flag ) s" RecordDef deleted- c@ 0= " EVALUATE ; IMMEDIATE --- 332,345 ---- ; ! : RequestKeyFagged ! vadr-config IgnoreRequests c@ not ! if RequestKey ! then ! ; ! ! : By_FileName ( - by ) by[ FileNameKey RequestKeyFagged ]by ; ! : By_Random ( - by ) by[ RandomKey RequestKeyFagged ]by ; ! : by_leastPlayed ( - by ) by[ leastPlayedKey Ascending RequestKeyFagged ]by ; ! : by_FileSize ( - by ) by[ FileSizeKey RequestKeyFagged ]by ; : not-deleted? ( rec-adr - flag ) s" RecordDef deleted- c@ 0= " EVALUATE ; IMMEDIATE *************** *** 329,343 **** 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 Album r@ Cnt_Album c@ type-space r@ RecordDef Title r@ Cnt_Title c@ type-space r@ RecordDef #played ? r@ RecordDef RandomLevel ? ! r@ RecordDef Played- c@ . r@ RecordDef Excluded- c@ . ! r@ RecordDef FileSize @ 12 U,.R then r>drop --- 350,365 ---- 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 Album r@ Cnt_Album c@ type-space r@ RecordDef Title r@ Cnt_Title c@ type-space r@ RecordDef #played ? r@ RecordDef RandomLevel ? ! r@ RecordDef Played- c@ . r@ RecordDef Excluded- c@ . ! r@ RecordDef FileSize @ 12 U,.R ! r@ RecordDef Request- w@ ." Req " . then r>drop *************** *** 409,417 **** r@ s_#Random- c@ of By_Random sort-database endof ! r@ s_Random_impopular- c@ of by[ by_record RandomKey ! leastPlayedKey Ascending ]by sort-database endof ! r@ s_Random_popular- c@ of by[ by_record RandomKey ! leastPlayedKey Descending ]by sort-database endof --- 431,439 ---- r@ s_#Random- c@ of By_Random sort-database endof ! r@ s_Random_impopular- c@ of by[ by_record RandomKey ! leastPlayedKey Ascending RequestKeyFagged ]by sort-database endof ! r@ s_Random_popular- c@ of by[ by_record RandomKey ! leastPlayedKey Descending RequestKeyFagged ]by sort-database endof *************** *** 433,437 **** then FlexKey &key-len @ 0> ! if by[ FlexKey ]by sort-database then --- 455,459 ---- then FlexKey &key-len @ 0> ! if by[ FlexKey RequestKeyFagged ]by sort-database then *************** *** 457,460 **** --- 479,498 ---- : 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 *************** *** 628,630 **** --- 666,686 ---- then ; + + : 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" "" + + : SetRequestLevel + vadr-config RequestLevel c@ n>tmp$ tmp$ count init-dlg Start: RequestLevelDlg drop + pad count number? + if d>s vadr-config RequestLevel c! + else 2drop + then + ; + \s |
