Menu
▾
▴
[Win32forth-cvs] win32forth/src/lib FolderView.f, NONE, 1.1 FileLister.f, 1.6, 1.7 TabControl.f, 1.4, 1.5 eStruct.f, 1.2, 1.3
|
From: Ezra B. <ezr...@us...> - 2007-12-30 03:41:13
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14044/src/lib Modified Files: FileLister.f TabControl.f eStruct.f Added Files: FolderView.f Log Message: Updated filewindow class using a listview object with associated icons. EAB Index: TabControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/TabControl.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** TabControl.f 29 Aug 2006 08:52:25 -0000 1.4 --- TabControl.f 30 Dec 2007 03:41:08 -0000 1.5 *************** *** 153,162 **** :M GetTabInfo: ( index -- ) \ *G Retrieves information about a tab in the tab control. ! tc_item swap TCM_GETITEM SendMessage:Self ?win-error ;M :M SetTabInfo: ( index -- ) \ *G Sets some or all of a tab's attributes. \ *P \i mask \d and other members of the TCITEM struct must be set. ! tc_item swap TCM_SETITEM SendMessage:Self ?win-error ;M :M GetTabCount: ( -- n ) --- 153,164 ---- :M GetTabInfo: ( index -- ) \ *G Retrieves information about a tab in the tab control. ! tc_item swap TCM_GETITEM SendMessage:SelfDrop \ (?WinError) ! ;M :M SetTabInfo: ( index -- ) \ *G Sets some or all of a tab's attributes. \ *P \i mask \d and other members of the TCITEM struct must be set. ! tc_item swap TCM_SETITEM SendMessage:SelfDrop \ (?WinError) ! ;M :M GetTabCount: ( -- n ) *************** *** 166,174 **** :M DeleteTab: ( index -- ) \ *G Removes an item from the tab control. ! 0 swap TCM_DELETEITEM SendMessage:Self ?win-error ;M :M DeleteAllTabs: ( -- ) \ *G Removes all items from the tab control. ! 0 0 TCM_DELETEALLITEMS SendMessage:Self ?win-error ;M :M AdjustRect: ( rect flag -- ) --- 168,178 ---- :M DeleteTab: ( index -- ) \ *G Removes an item from the tab control. ! 0 swap TCM_DELETEITEM SendMessage:SelfDrop \ (?WinError) ! ;M :M DeleteAllTabs: ( -- ) \ *G Removes all items from the tab control. ! 0 0 TCM_DELETEALLITEMS SendMessage:SelfDrop \ (?WinError) ! ;M :M AdjustRect: ( rect flag -- ) --- NEW FILE: FolderView.f --- \ FolderView.f \ Adapted from FileLister.f Wednesday, July 04 2007 Ezra Boyce anew -FolderView.f needs linklist.f needs listview.f needs apps\forthform\quiksort.f \- ?exitm macro ?exitm " if exitm then" 0 value ThisViewer PopUpBar ViewPopupBar PopUp "" MenuItem "Up one level" Ascend: ThisViewer ; MenuItem "Change Folder or drive" ChooseFolder: ThisViewer ; MenuItem "Refresh" UpdateFiles: ThisViewer ; MenuSeparator false MENUMESSAGE "View Mode" MenuSeparator :MenuItem mnuli "Large Icons" LVS_ICON SetViewMode: ThisViewer ; :MenuItem mnusi "Small Icons" LVS_SMALLICON SetViewMode: ThisViewer ; :MenuItem mnulst "List" LVS_LIST SetViewMode: ThisViewer ; :MenuItem mnurpt "Report" LVS_REPORT SetViewMode: ThisViewer ; Endbar \ #IFNDEF compareia \ \ code compareia ( adr1 len1 adr2 len2 -- n ) \ sub ebp, # 8 \ mov 0 [ebp], edi \ mov 4 [ebp], esi \ pop eax \ eax = adr2 \ pop ecx \ ecx = len1 \ pop esi \ esi = adr1 \ add esi, edi \ absolute address \ add edi, eax \ edi = adr2 (abs) \ sub eax, eax \ default is 0 (strings match) \ cmp ecx, ebx \ compare lengths \ je short @@2 \ ja short @@1 \ dec eax \ if len1 < len2, default is -1 \ jmp short @@2 \ @@1: \ inc eax \ if len1 > len2, default is 1 \ mov ecx, ebx \ and use shorter length \ @@2: \ mov bl, BYTE [esi] \ mov bh, BYTE [edi] \ inc esi \ inc edi \ cmp bx, # $2F2F \ skip chars beteen 0 and 2F ( now lower case ) \ jle short @@7 \ or bx, # $2020 \ May 21st, 2003 or is better then xor \ @@7: \ cmp bh, bl \ loopz @@2 \ \ je short @@4 \ if equal, return default \ jnb short @@3 \ ** jnb for an unsigned test ( was jns ) \ mov eax, # 1 \ if str1 > str2, return 1 \ jmp short @@4 \ @@3: \ mov eax, # -1 \ if str1 < str2, return -1 \ @@4: \ mov ebx, eax \ mov edi, 0 [ebp] \ mov esi, 4 [ebp] \ add ebp, # 8 \ next c; \ #ENDIF :Class FindFile <Super Object max-path bytes findpath 32 bytes findspecs :M FindFirstFile: ( addr cnt -- ior ) \ ior = 0 = success find-first-file nip ;M :M FindNextFile: ( -- ior ) \ ior = 0 = success find-next-file nip ;M :M FindClose: ( -- ior ) \ ior = 0 = success find-close drop ;M :M GetFileAttributes: ( -- n ) _Win32-Find-Data @ ;M :M GetFileName: ( -- adr cnt ) get-file-name zcount ;M :M GetFileSize: ( -- d ) get-file-size ;M :M ClassInit: ( -- ) ClassInit: super findpath max-path erase s" *.*" findspecs place \ default ;M : .or..? ( -- f ) \ is found file directories . or ..? GetFileName: self drop c@ '.' = ; :M IsDirectory?: ( -- f ) \ exclude . and .. GetFileAttributes: self FILE_ATTRIBUTE_DIRECTORY and 0<> .or..? not and ;M :M IsFile?: ( -- f ) GetFileAttributes: self FILE_ATTRIBUTE_DIRECTORY and 0= ;M :M SetUp: ( pathstr len spec$ cnt -- ) \ pathstr len = pointer to path to search \ spec$ cnt = file specs to search for dup 0= if 2drop s" *.*" then 31 min 0max findspecs place findpath place ;M :M FindFiles: ( -- f ) \ specs should be already setup new$ >r findpath count r@ place findspecs count dup if r@ ?+\ then r@ +place r> count FindFirstFile: self ;M :M FullPath: ( -- addr cnt ) \ return full path of directory found findpath count new$ dup>r place GetFileName: self dup if r@ ?+\ then r@ +place r> count ;M ;Class :Class FolderItem <super Object max-path 1+ bytes itemname int iconhandle cell bytes index \ save information for each individual file Record: Win32_Find_Data int FileAttributes int FileCreationTimeLow int FileCreationTimeHigh int FileLastAccessTimeLow int FileLastAccessTimeHigh int FileLastWriteTimeLow int FileLastWriteTimeHigh int FileSizeHigh int FileSizeLow int Reserved0 int Reserved1 max-path bytes FileName 14 bytes AlternateFileName ;RecordSize: sizeof(Win32_Find_Data) :M GetFileAttributes: ( -- n ) FileAttributes ;M :M GetFileName: ( -- adr cnt ) FileName zcount ;M :M GetModifiedTime: ( -- ) \ return info in file-time-buf FileLastWriteTimeLow file-time-buf ! FileLastWriteTimeHigh file-time-buf cell+ ! ;M :M GetFileSize: ( -- d ) FileSizeLow ;M : .or..? ( -- f ) \ is found file directories . or ..? GetFileName: self drop c@ '.' = ; :M IsFile?: ( -- f ) GetFileAttributes: self FILE_ATTRIBUTE_DIRECTORY and 0= ;M :M IsDirectory?: ( -- f ) \ exclude . and .. IsFile?: self not .or..? not and ;M :M Classinit: ( -- ) Classinit: super Win32_Find_Data sizeof(Win32_Find_Data) erase 0 to iconhandle -1 index ! ;M :M GetData: ( -- addr cnt ) \ access for any additional information needed Win32_Find_Data sizeof(Win32_Find_Data) ;M :M setup: ( addr cnt -- ) \ assumes name is set for FindFirstFile, FindNextFile etc. itemname max-path erase max-path min 0max itemname swap move \ transfer the info _Win32-Find-Data Win32_Find_Data sizeof(Win32_Find_Data) move index itemname conhndl Call ExtractAssociatedIcon to iconhandle ;M :M GetName: ( -- addrz ) itemname ;M :M GetName$: ( -- addr cnt ) itemname zcount ;M :M iconhandle: ( -- n ) iconhandle ;M ;Class :Class TreeList <super linked-list :M DeleteItem: { item \ flag -- } Data@: self 0= ?exitm false to flag #Links: self 1+ 1 ?do i >Link#: self Data@: self item = if 0 Data!: self DeleteLink: self item dispose true to flag \ mark as found leave then loop flag 0= abort" Item not found in list!" ;M :M total: ( -- n ) Data@: self if #links: self else 0 then ;M :M GetItem: { n -- obj | -1 } -1 total: self 0= ?exitm n 1 total: self between not ?exitm drop n >Link#: self Data@: self ;M ;Class :Class FolderListView <super ListView :M WindowStyle: ( -- style ) WindowStyle: super [ LVS_REPORT LVS_SHOWSELALWAYS OR ] literal or ;M ;Class :Class FolderViewer <Super Child-Window LV_COLUMN lvc LV_ITEM LvItem FolderListView TheView FindFile FileFinder int itemindex int FolderList int ThisItem \ temp pointer to new item int hwndSmallIcons \ handle to imagelist for small icons int hwndLargeIcons int sortorder int OnSelect \ called when an item is clicked int On_Update \ called when folder tree is refreshed int On_DblClick int SelectedItem \ list item object int show-files? \ do we want to display files? int show-dirs? \ show directories? int #dirs \ number of directories found when updating int #fls \ ditto files int hwndlabel \ handle to window to display path int popup? \ number of files shown is limited only by available memory \ however only first 4k will be sorted. Of course the buffer size could always be increased 16 1024 * constant recbuffer-size recbuffer-size cell / constant max-recs \ about 4000 files and directories for sorting int recbuffer \ pointer to memory used for sorting max-path 1+ bytes Treepath \ path: thespecs 2 cells Class-allot max-path 1+ bytes thespecs : rootdir? { pathstr cnt -- f } \ f = true if path is at root pathstr cnt + 2 - w@ s" :\" drop w@ = ?dup ?exit pathstr cnt + 1- c@ ':' = ; : free-recbuffer ( -- ) recbuffer ?dup if release 0 to recbuffer then ; : InitTheViewColumns ( -- ) LVCF_FMT LVCF_WIDTH LVCF_TEXT LVCF_SUBITEM or or or Setmask: lvc LVCFMT_LEFT Setfmt: lvc 180 Setcx: lvc z" Name" SetpszText: lvc Addr: lvc 0 InsertColumn: TheView LVCF_FMT LVCF_WIDTH LVCF_TEXT LVCF_SUBITEM or or or Setmask: lvc LVCFMT_RIGHT Setfmt: lvc 120 Setcx: lvc z" Size" SetpszText: lvc Addr: lvc swap 1+ InsertColumn: TheView LVCF_FMT LVCF_WIDTH LVCF_TEXT LVCF_SUBITEM or or or Setmask: lvc LVCFMT_RIGHT Setfmt: lvc 120 Setcx: lvc z" Date" SetpszText: lvc Addr: lvc swap 1+ InsertColumn: TheView LVCF_FMT LVCF_WIDTH LVCF_TEXT LVCF_SUBITEM or or or Setmask: lvc LVCFMT_RIGHT Setfmt: lvc 80 Setcx: lvc z" Time" SetpszText: lvc Addr: lvc swap 1+ InsertColumn: TheView drop ; : CreateSmallImageList ( -- ) \ create small image list for list control total: folderlist \ maximum images dup \ number of images to use ILC_COLOR16 \ color depth SM_CYSMICON Call GetSystemMetrics \ height of small icon SM_CXSMICON Call GetSystemMetrics \ width of small icon Call ImageList_Create to hwndSmallIcons \ do the following BEFORE adding any icons Color: WHITE hwndSmallIcons Call ImageList_SetBkColor drop ; : CreateLargeImageList ( -- ) \ create large image list for listview control total: folderlist \ maximum images dup \ number of images to use ILC_COLOR16 \ color depth SM_CYICON Call GetSystemMetrics \ height of large icon SM_CXICON Call GetSystemMetrics \ width of large icon Call ImageList_Create to hwndLargeIcons \ do the following BEFORE adding any icons Color: WHITE hwndLargeIcons Call ImageList_SetBkColor drop ; : DestroyImageLists ( -- ) hwndSmallIcons ?dup if Call ImageList_Destroy drop 0 to hwndSmallIcons then hwndLargeIcons ?dup if Call ImageList_Destroy drop 0 to hwndLargeIcons then ; : add-small-icons { \ item -- } \ add icon for each file CreateSmallImageList total: folderlist 1+ 1 ?do i >Link#: FolderList Data@: FolderList to item IconHandle: item hwndSmallIcons Call ImageList_AddIcon drop loop ; : add-large-icons { \ item -- } \ add icon for each file CreateLargeImageList total: folderlist 1+ 1 ?do i >Link#: FolderList Data@: FolderList to item IconHandle: item hwndLargeIcons Call ImageList_AddIcon drop loop ; : AddFile ( str cnt -- ) Data@: FolderList if AddLink: FolderList then New> FolderItem dup Data!: FolderList to ThisItem ( str cnt ) SetUp: ThisItem ; : get-date-and-time ( obj -- timestr cnt datestr cnt ) GetModifiedTime: [ ] pad file-time-buf Call FileTimeToLocalFileTime drop time-buf pad Call FileTimeToSystemTime drop 31 time$ z" h':'mm':'tt" time-buf null LOCALE_USER_DEFAULT call GetTimeFormat time$ swap 1- \ timestr cnt 31 date$ z" MM'/'dd'/'yyyy" time-buf null LOCALE_USER_DEFAULT call GetDateFormat date$ swap 1- \ datestr cnt ; : AddViewItem { ndx \ obj -- } ndx 1+ GetItem: FolderList to obj \ first add the name LVIF_TEXT LVIF_PARAM or LVIF_IMAGE or SetMask: LvItem ndx SetiItem: LvItem obj SetlParam: LvItem ndx SetIImage: Lvitem GetFileName: obj drop SetpszText: LvItem Addr: LvItem InsertItem: TheView drop \ now we add subitems. \ size LVIF_TEXT SetMask: LvItem ndx SetiItem: LvItem 1 SetiSubItem: LVItem IsFile?: obj if GetFileSize: obj 0 (ud,.) asciiz else z" " \ show no size for directories then SetpszText: LvItem Addr: LvItem ndx SetItemText: TheView drop obj get-date-and-time \ date LVIF_TEXT SetMask: LvItem ndx SetiItem: LvItem 2 SetiSubItem: LVItem ( date ) asciiz SetpszText: LvItem Addr: LvItem ndx SetItemText: TheView drop \ time LVIF_TEXT SetMask: LvItem ndx SetiItem: LvItem 3 SetiSubItem: LVItem ( time ) asciiz SetpszText: LvItem Addr: LvItem ndx SetItemText: TheView drop ; : show-files ( -- ) \ add file and stats to the listviewbox DeleteAllItems: TheView drop DestroyImageLists add-small-icons hwndSmallIcons LVSIL_SMALL SetImageList: TheView drop add-large-icons hwndLargeIcons LVSIL_NORMAL SetImageList: TheView drop Total: FolderList dup SetItemCount: TheView drop 0 ?do i AddViewItem loop ; :M start: ( parent -- ) start: super new> treelist to folderlist recbuffer-size malloc to recbuffer ;M :M On_Init: ( -- ) self Start: TheView InitTheViewColumns ViewPopupBar SetPopupBar: self ;M :M On_Size: ( -- ) 0 0 GetSize: self Move: TheView ;M :M Classinit: ( -- ) Classinit: super treepath off -1 thespecs 2 cells - ! 0 thespecs cell- ! s" *.*" thespecs place ['] drop to OnSelect ['] drop to On_Update ['] drop to On_DblClick 0 to SelectedItem 0 to hwndSmallIcons 0 to hwndLargeIcons true to show-files? true to show-dirs? true to popup? -1 to itemindex 0 to #dirs 0 to #fls 0 to hwndlabel 0 to recbuffer NextID to id SortAscending: [ self ] ;M : DisposeTheList ( -- ) FolderList if Folderlist DisposeList FolderList Dispose 0 to FolderList then ; :M ~: ( -- ) DisposeTheList free-recbuffer ;M :M Close: ( -- ) DisposeTheList free-recbuffer DestroyImageLists ;M : finddirs ( -- ) 0 to #dirs TreePath count s" *.*" Setup: FileFinder FindFiles: FileFinder begin 0= while IsDirectory?: FileFinder if FullPath: FileFinder AddFile 1 +to #dirs then FindNextFile: FileFinder repeat FindClose: FileFinder ; : findfiles ( -- ) 0 to #fls thespecs first-path" begin dup 0> while TreePath count 2swap SetUp: FileFinder FindFiles: FileFinder begin 0= while IsFile?: FileFinder if FullPath: FileFinder AddFile 1 +to #fls then FindNextFile: FileFinder repeat FindClose: FileFinder thespecs next-path" repeat 2drop ; : FindAllFiles ( -- ) show-dirs? if finddirs then show-files? if findfiles then ; : recbuffer() ( n -- addr ) recbuffer +cells ; : dosortorder ( n -- f ) sortorder null-check execute ; : compare-recs ( n1 n2 -- f ) GetFileName: [ swap ] GetFileName: [ rot ] caps-compare ( compareia ) dosortorder ; : readrecbuffer ( -- ) \ load temporary buffer with record pointers >FirstLink: FolderList total: FolderList max-recs min 0max 0 ?do Data@: FolderList i recbuffer() ! >NextLink: FolderList loop ; : writerecbuffer ( -- ) \ rewrite sorted records to database >FirstLink: FolderList total: FolderList max-recs min 0max 0 ?do i recbuffer() @ Data!: FolderList >NextLink: FolderList loop ; : sortfiles ( -- ) recbuffer 0= ?exit \ if not allocated abort sorting ['] compare-recs is precedes \ set sort comparator total: folderlist 2 < ?exit readrecbuffer \ load buffer #dirs 1 > if 0 recbuffer() #dirs sort \ sort the directories then #fls 1 > if #dirs recbuffer() #fls sort \ and the files then writerecbuffer ; :M Setpath: { addr cnt -- } \ check for valid path addr cnt + 2 - w@ 0x5C3A = \ are the last chars ':\' i.e root dir? if addr cnt treepath place treepath +null exitm then addr cnt 2dup + 1- c@ '\' = if 1- then find-first-file if drop exitm \ does not exist so exit then @ FILE_ATTRIBUTE_DIRECTORY and \ something was found if addr cnt treepath place \ it is a directory treepath +null then find-close drop ;M :M Getpath: ( -- addr cnt ) treepath count ;M :M SetSpecs: ( addr cnt -- ) \ can be multiple e.g "*.f;*.htm;*.txt" thespecs place ;M :M GetSpecs: ( -- addr cnt ) thespecs count ;M : show-path ( -- ) hwndlabel 0= ?exit hwndlabel Call IsWindow 0= ?exit treepath count asciiz 0 WM_SETTEXT hwndlabel send-window ; :M UpdateFiles: ( -- ) \ primary word, rebuild files list in view treepath c@ 0= if current-dir$ count SetPath: self then _Win32-Find-Data [ 11 cells max-path + 14 + ] LITERAL erase FolderList DisposeList 0 to SelectedItem FindAllFiles SortFiles show-files show-path self On_Update null-check execute \ user function ;M :M Update: ( addr cnt -- ) \ combination SetPath: self UpdateFiles: self ;M :M IsLabelHandle: ( hwnd -- ) \ a window that will display the current path after update to hwndlabel ;M :M SetViewMode: ( mode -- ) \ view mode ( LVS_ICON, LVS_SMALLICON, LVS_LIST, LVS_REPORT ) GetStyle: TheView LVS_TYPEMASK invert and \ reset style or GWL_STYLE SetWindowLong: TheView drop ;M :M SortAscending: ( -- ) ['] 0< to sortorder ;M :M SortDescending: ( -- ) ['] 0> to sortorder ;M :M DeleteFile: ( -- ) \ delete selected file I think Selecteditem 0= ?exitm IsDirectory?: SelectedItem ?exitm \ can't delete folder or root s" Delete " new$ dup>r place GetName$: SelectedItem r@ +place s" ?" r@ +place r@ +NULL r> 1+ ( sztext ) z" Are you sure?" ( ztitle ) MB_YESNO ( style ) MessageBox: parent IDNO = ?exitm GetName$: SelectedItem delete-file dup s" Delete file failed" ?MessageBox ?exitm 0 to SelectedItem UpdateFiles: self ;M :M SelectedItem: ( -- n ) SelectedItem ;M :M #Dirs: ( -- n ) \ number of directories found during update #dirs ;M :M #Files: ( -- n ) \ number of files found during update #fls ;M :M Showfiles: ( f -- ) \ flag=true if showing files to show-files? ;M :M ShowDirs: ( f -- ) \ flag=true if showing directories in tree to show-dirs? ;M :M IsOn_Update: ( cfa -- ) \ user function to execute after update of files to On_Update ;M :M IsOnSelect: ( cfa -- ) \ user function to execute when a file or folder selected to OnSelect ;M :M IsOn_DblClick: ( cfa -- ) \ user function to execute when file is double clicked to On_DblClick ;M :M ShowPopup: ( f -- ) \ do we want popup window on right click? to popup? ;M :M ChooseFolder: ( -- ) \ change folder programatically, also available by right clicking hwnd 0= ?exitm z" Select a drive or folder" \ use a copy of path because if cancelled path info is changed to null GetPath: self pad place pad hwnd BrowseForFolder if pad count Update: Self then ;M : ?descend ( --) SelectedItem 0= ?exitm IsDirectory?: SelectedItem if GetName$: SelectedItem Update: self else SelectedItem On_DblClick null-check execute then ; :M ascend: ( -- ) \ move up one level in the directory tree GetPath: self 2dup rootdir? if 2drop exitm then 2dup + swap '\' -scan drop over - Update: Self ;M : check-view ( -- ) GetStyle: TheView LVS_TYPEMASK and dup LVS_ICON = Check: mnuli dup LVS_REPORT = Check: mnurpt dup LVS_LIST = Check: mnulst LVS_SMALLICON = Check: mnusi ; : show-popup ( -- ) CurrentPopup if self to ThisViewer check-view hwnd get-mouse-xy hwnd Track: CurrentPopup then ; :M WM_NOTIFY { h m w l \ ncode -- f } l @ GetHandle: TheView <> if false exitm then l 2 cells+ @ to ncode ncode case LVN_ITEMCHANGED of l LVN_GetNotifyParam to SelectedItem l LVN_GetNotifyItem dup itemindex <> if to itemindex SelectedItem OnSelect null-check execute \ call only once else drop then endof NM_RCLICK of popup? if show-popup then endof NM_DBLCLK of ?descend endof endcase false ;M :M GetListView: ( -- obj ) Addr: TheView ;M ;Class \s Index: FileLister.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/FileLister.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** FileLister.f 13 Oct 2006 03:50:29 -0000 1.6 --- FileLister.f 30 Dec 2007 03:41:08 -0000 1.7 *************** *** 339,343 **** total: folderlist 2 + \ maximum images dup 2 max \ number of images to use ! ILC_COLOR4 \ color depth 18 16 \ bitmap size height,width Call ImageList_Create to hwndimage ; --- 339,343 ---- total: folderlist 2 + \ maximum images dup 2 max \ number of images to use ! ILC_COLOR16 \ color depth 18 16 \ bitmap size height,width Call ImageList_Create to hwndimage ; Index: eStruct.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/eStruct.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** eStruct.f 11 Jul 2005 10:37:11 -0000 1.2 --- eStruct.f 30 Dec 2007 03:41:09 -0000 1.3 *************** *** 269,273 **** zeroID ; ! : size> ( <name> -- ) ' >body cell+ @ @ state @ --- 269,273 ---- zeroID ; ! : size> ( <name> -- n ) ' >body cell+ @ @ state @ *************** *** 275,279 **** then ; immediate ! : addrof> ( <name> -- ) ' >body @ state @ --- 275,279 ---- then ; immediate ! : addrof> ( <name> -- addr ) ' >body @ state @ *************** *** 336,339 **** --- 336,342 ---- then zeroID ; + : %get ( addr -- addr ) \ pointer to structure, allow setting structure memory block + member-id 0> not abort" Structures only!" ; + : put ( n1 n2 addr -- ) ( f: n -- ) member-id 0 >= s" Needs member function!" ?abort *************** *** 457,459 **** tst() dum() - |
