Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Player4 Mediatree.f,1.22,1.23 PLAYER4.F,1.28,1.29 Pl_Toolset.f,1.4,1.5 mshell_r.f,1.1,1.2
|
From: Jos v.d.V. <jo...@us...> - 2005-11-26 19:17:19
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6404/apps/Player4 Modified Files: Mediatree.f PLAYER4.F Pl_Toolset.f mshell_r.f Log Message: Jos: Made a hierarical view possible Index: mshell_r.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/mshell_r.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** mshell_r.f 26 Oct 2005 15:16:46 -0000 1.1 --- mshell_r.f 26 Nov 2005 19:17:07 -0000 1.2 *************** *** 19,22 **** --- 19,67 ---- 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 + source >in @ <= if drop -1 exit endif + >in @ chars + c@ ; + + : skip-line ( -- ) + begin next_char -1 <> + while 1 >in +! + repeat ; + + : @+ ( adr -- adr n ) dup cell+ swap @ ; + + -- Embedded linebreaks are allowed. Maximum length is 4096 characters. + -- Not allowed: EXIT LOCALS| DLOCALS| FLOCALS| , DOES> R> DROP etc. + -- It needs a space as the first character on each line + + : multi-line ( quote "ccc<quote>" tmp-buffer -- str len ) + 0 locals| ch buff quote | + buff off + begin + next_char to ch + ch '\' = if skip-line -1 to ch endif + ch -1 = if bl to ch refill else true endif + while + ch quote <> + while + ch buff @+ + c! 1 buff +! 1 >in +! + buff @ 4096 >= + until then then + buff @+ refill drop ; + + + : :inline ( ccc; -- ) + create immediate + ';' + 4096 cell+ chars malloc dup>r + multi-line ( addr u tmp-buffer ) + dup , here cell+ , + here over allot swap move + r> release + does> 2@ evaluate ; + + 23 value record-size 112 value #records *************** *** 24,41 **** 0 value records-pointer ! : n>aptr ( n -- a ) S" aptrs +cells " EVALUATE ; IMMEDIATE ! : r>record ( n -- a ) S" records-pointer ( CHARS) + " EVALUATE ; IMMEDIATE ! : record>r ( a -- n ) S" records-pointer ( CHARS) - " EVALUATE ; IMMEDIATE ! : n>record ( n -- a ) S" n>aptr @ r>record " EVALUATE ; IMMEDIATE ! \ : n>key ( n -- a ) S" n>record >key " EVALUATE ; IMMEDIATE ! : records ( n -- ra ) S" record-size * " EVALUATE ; IMMEDIATE ! : >record ( n -- a ) S" records r>record " EVALUATE ; IMMEDIATE ! : xchange ( a1 a2 -- ) S" dup>r @ over @ r> ! swap ! " EVALUATE ; IMMEDIATE ! : &key-len ( key - &key-len ) s" cell+ " EVALUATE ; IMMEDIATE ! : >key ( ra - key-start ) s" by @ + " EVALUATE ; IMMEDIATE ! : key-len ( ra - cnt ) s" by &key-len @ " EVALUATE ; IMMEDIATE ! : <>= ( n1 n2 - -1|0|1 ) ! s" 2dup = if 2drop 0 else < if 1 else true then then " EVALUATE ; IMMEDIATE : cmp-cell { by } ( cand1 cand2 by - p1 p2 n ) --- 69,86 ---- 0 value records-pointer ! :inline n>aptr ( n -- a ) aptrs +cells ; ! :inline r>record ( n -- a ) records-pointer ( CHARS) + ; ! :inline record>r ( a -- n ) records-pointer ( CHARS) - ; ! :inline n>record ( n -- a ) n>aptr @ r>record ; ! \ :inline n>key ( n -- a ) n>record >key ; ! :inline records ( n -- ra ) record-size * ; ! :inline >record ( n -- a ) records r>record ; ! :inline xchange ( a1 a2 -- ) dup>r @ over @ r> ! swap ! ; ! :inline &key-len ( key - &key-len ) cell+ ; ! :inline >key ( ra - key-start ) by @ + ; ! :inline key-len ( ra - cnt ) by &key-len @ ; ! :inline <>= ( n1 n2 - -1|0|1 ) ! 2dup = if 2drop 0 else < if 1 else true then then ; : cmp-cell { by } ( cand1 cand2 by - p1 p2 n ) *************** *** 53,57 **** : bin-sort ( key - ) ['] cmp-cell 3 mod-cell ; ! : Descending? ( key - ) s" 2 cells+ @ " EVALUATE ; IMMEDIATE \ Ascending and cmp$ are default in key: --- 98,102 ---- : bin-sort ( key - ) ['] cmp-cell 3 mod-cell ; ! :inline Descending? ( key - ) 2 cells+ @ ; \ Ascending and cmp$ are default in key: *************** *** 60,65 **** ; ! : by[ ( R: - #stack ) s" depth >r " EVALUATE ; IMMEDIATE ! : ]by ( - #stack-inc) ( R: #stack - ) s" depth r> - " EVALUATE ; IMMEDIATE : CmpBy ( cand1 cand2 ByStackTop #keys - p1 p2 f ) --- 105,110 ---- ; ! :inline by[ ( R: - #stack ) depth >r ; ! :inline ]by ( - #stack-inc) ( R: #stack - ) depth r> - ; : CmpBy ( cand1 cand2 ByStackTop #keys - p1 p2 f ) Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** PLAYER4.F 26 Oct 2005 15:19:15 -0000 1.28 --- PLAYER4.F 26 Nov 2005 19:17:07 -0000 1.29 *************** *** 1,2 **** --- 1,3 ---- + \ Play flat Music? => adr lastmusic/vid \ File: PLAYER4.F \ *************** *** 20,25 **** decimal ! true value turnkey? ! \ false value turnkey? true value MciDebug? --- 21,26 ---- decimal ! \ true value turnkey? ! false value turnkey? true value MciDebug? Index: Mediatree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** Mediatree.f 16 Nov 2005 19:47:22 -0000 1.22 --- Mediatree.f 26 Nov 2005 19:17:07 -0000 1.23 *************** *** 6,15 **** needs catalog.f needs TreeView.F 0 value hItem-last-selected - \ *************************************************** - \ S ******** Below please find a small example ******** - \ *************************************************** :Class MediaTree <super TreeViewControl --- 6,13 ---- needs catalog.f needs TreeView.F + needs struct.f 0 value hItem-last-selected :Class MediaTree <super TreeViewControl *************** *** 17,21 **** :M WindowStyle: ( -- style ) WindowStyle: super ! [ TVS_DISABLEDRAGDROP TVS_SHOWSELALWAYS or ] literal or ;M --- 15,24 ---- :M WindowStyle: ( -- style ) WindowStyle: super ! \ [ TVS_DISABLEDRAGDROP TVS_SHOWSELALWAYS or ] literal or ! WS_BORDER or WS_CHILD or WS_VISIBLE or ! LVS_REPORT or ! TVS_HASLINES or ! TVS_SHOWSELALWAYS or ! TVS_LINESATROOT or ;M *************** *** 23,35 **** : +(l.int) ( n ) (l.int) +InlineRecord ; ! : add-record ( n - ) \ Add when not deleted and found in a collection ! dup n>record dup RecordDef Deleted- c@ 0= show-deleted = swap RecordDef Excluded- c@ or ! if drop ! else 1 +to #InCollection vadr-config over to lParam 0 InlineRecord ! ! dup l_Index- c@ ! if over +(l.int) ! then ! swap n>record \ ( vadr-config rec-addr - ) over l_Drivetype- c@ if dup RecordDef DriveType c@ DriveType$ +InlineRecord --- 26,45 ---- : +(l.int) ( n ) (l.int) +InlineRecord ; ! ! : NotIncollection? ( n - f ) ! n>record dup RecordDef Deleted- c@ 0= show-deleted = swap RecordDef Excluded- c@ or ! ; ! ! : ResetInlineRecord ( n - n vadr-config ) ! 1 +to #InCollection vadr-config 0 InlineRecord ! ! ; ! ! : CountedArtist ( adr - adr count ) dup RecordDef Artist swap Cnt_Artist c@ ; ! : CountedFilename ( adr - adr count ) dup RecordDef File_name swap Cnt_File_name c@ ; ! : CountedAlbum ( adr - adr count ) dup RecordDef Album swap Cnt_Album c@ ; ! : CountedTitle ( adr - adr count ) dup RecordDef Title swap Cnt_Title c@ ; ! ! : OptionalElements ( vadr-config rec-addr - vadr-config rec-addr ) over l_Drivetype- c@ if dup RecordDef DriveType c@ DriveType$ +InlineRecord *************** *** 47,64 **** if dup RecordDef #played @ +(l.int) then swap l_Filename- c@ ! if dup RecordDef File_name swap Cnt_File_name c@ ! else dup RecordDef Artist over Cnt_Artist c@ +InlineRecord s" --" +InlineRecord ! dup RecordDef Album over Cnt_Album c@ +InlineRecord s" --" +InlineRecord ! dup RecordDef Title swap Cnt_Title c@ then ! InlineRecord +place ! InlineRecord +null InlineRecord 1+ to pszText tvitem->tvins tvins 0 TVM_INSERTITEMA hWnd Call SendMessage to hInsertAfter then ; :M FillTreeView: ( -- ) 0 to #InCollection --- 57,179 ---- if dup RecordDef #played @ +(l.int) then + ; + + : AddRecordFlat ( n - ) \ Add when not deleted and found in a collection + dup NotIncollection? + if drop + else ResetInlineRecord + dup l_Index- c@ + if over +(l.int) + then + swap dup to lParam n>record \ ( vadr-config rec-addr - ) + OptionalElements swap l_Filename- c@ ! if CountedFilename ! else dup CountedArtist +InlineRecord s" --" +InlineRecord ! dup CountedAlbum +InlineRecord s" --" +InlineRecord ! CountedTitle then ! InlineRecord +place InlineRecord +null ! InlineRecord 1+ to pszText tvitem->tvins tvins 0 TVM_INSERTITEMA hWnd Call SendMessage to hInsertAfter then ; + int hPrev + + : AddItemHierarical ( sztext hAfter hParent nChildren -- hPrev ) + ( nChildren) to cChildren + ( hParent) to hParent + ( hAfter) to hInsertAfter + to pszText tvitem->tvins + tvins 0 TVM_INSERTITEMA hWnd Call SendMessage + dup to hPrev + ; + + struct{ \ PrevMusic + DWORD PrevMusicRecord + DWORD hArtist + DWORD hAlbum + }struct PrevMember + + sizeof PrevMember mkstruct: &PrevMusic + sizeof PrevMember mkstruct: &PrevMovie + + int hMovies + int hMusic + int hRequests + int OtherArtist? + + sizeof RecordDef dup create dummy allot dummy swap 01 fill + + : NotPlayable ( - ) -1 to lParam ; + + : 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 ! &PrevMovie ! + dup &PrevMovie hArtist ! &PrevMovie hArtist ! + (( z" First Artist" hPrev hMusic 1 AddItemHierarical to hArtist + z" Second Music" hPrev hArtist 0 AddItemHierarical drop + z" Third Music" hPrev hArtist 0 AddItemHierarical drop )) + ; + + : music? ( adr len - f ) valid-sound-ext count (IsValidFileType?) ; + + : AddArtist { PrevRecAdr } ( rec-addr PrevRecAdr - ) + dup CountedArtist 1 max PrevRecAdr @ CountedArtist 1 max compareia 0<> + 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? + then + ; + + : AddAlbum { PrevRecAdr } ( rec-addr PrevRecAdr - ) + dup CountedAlbum 1 max PrevRecAdr @ CountedAlbum 1 max compareia 0<> OtherArtist? or + if dup PrevRecAdr ! NotPlayable + RecordDef Album hPrev PrevRecAdr hArtist @ + 1 AddItemHierarical PrevRecAdr hAlbum ! + else drop + then + ; + + : AddTitle ( rec-addr PrevRecAdr - ) + \ over swap ! + >r + RecordDef CountedTitle +InlineRecord InlineRecord +null + InlineRecord 1+ hPrev r> hAlbum @ + 0 AddItemHierarical drop + ; + + : AddRecordHierarical ( n - ) + dup NotIncollection? + 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 + 2 pick l_Index- c@ + if r> dup +(l.int) + else r> + then + to lParam + >r OptionalElements r> + AddTitle drop + then + ; + :M FillTreeView: ( -- ) 0 to #InCollection *************** *** 67,74 **** tvitem /tvitem erase TVI_ROOT to hParent - 1 to cChildren TVI_LAST to hInsertAfter - \ -1 to statemask [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or TVIF_STATE or ] literal to mask ! for-all-records add-record ;M --- 182,194 ---- tvitem /tvitem erase TVI_ROOT to hParent [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or TVIF_STATE or ] literal to mask ! vadr-config l_Filename- c@ ! if 1 to cChildren TVI_LAST to hInsertAfter ! for-all-records AddRecordFlat ! else root-items to hPrev ! for-all-records AddRecordHierarical ! \ 1318 1305 do I AddRecordHierarical loop ! ! then ;M *************** *** 86,97 **** tvitem 0 TVM_GETITEMA hWnd Call SendMessage drop hItem to hItem-last-selected ! lParam to last-selected-rec ! last-selected-rec n>record dup>r RecordDef File_name r@ Cnt_File_name c@ ! r@ incr-#played ! r> mark-played ! 2dup cr type-space ! PlayFile: PLAYER4W ! false ;M --- 206,221 ---- tvitem 0 TVM_GETITEMA hWnd Call SendMessage drop 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 Index: Pl_Toolset.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_Toolset.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 Binary files /tmp/cvsoDvt96 and /tmp/cvsNpHK2F differ |
