home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-05-07 | 1.6 KB | 45 lines | [TEXT/McSk] |
- ( DataFiles for Pocket Forth 0.6 )
- ( Choose and read data files ) 0 28 +md !
- forget task : task ; decimal
-
- : 00>R ( rstack: -- 0 0 ) ,$ 42A7 ; macro ( clr.l -[rs] )
-
- variable FCB 78 allot ( our File's Control Block )
- : +FCB ( offset -- addr ) fcb + ; ( offset into fcb )
- : 0FCB ( -- ) fcb 80 0 fill ;
- : FTRAP ( -- ) fcb >abs ,$ 205E ; ( movea.l [ps]+,a0 )
-
- : CLOSE ( -- ) ftrap ,$ A001 ftrap ,$ A013 ; ( close & flush )
- : ?DERROR ( -- ) 16 +fcb @ ?dup IF ( if result not zero )
- ." DiskError" . close abort THEN ; ( report & abort )
-
- : EOF ( -- dbytes ) ftrap ,$ A011 30 +fcb @ ; ( _GetEOF )
- : !SIZE ( bytes -- ) 38 +fcb ! ; ( set bytes-to-read or write )
- : !FILE ( -- ) ( set data in fcb to open file from sfreply )
- 0fcb pad 6 + @ 22 +fcb ! ( set vrefnum )
- pad 10 + >abs 18 +fcb 2! ( set name )
- 01 27 +fcb c! ; ( read only )
-
- 2variable $TEXT ,s TEXT $text 2!
- : OPEN ( -- ) ( select and open a file )
- 55 75 2>r ( top left corner )
- 00>r 00>r 1 >r $text a>r 00>r pad a>r ( reply at here )
- 2 >r ,$ A9EA ( _SFGetFile )
- pad @ IF ( check good field )
- !file ftrap ,$ A000 ?derror ( _Open the file )
- ELSE beep quit THEN ;
-
- : READ ( dabs.addr -- ) ( allows read outside of dictionary )
- 32 +fcb 2! ( set read buffer pointer )
- ftrap ,$ A002 ?derror ; ( _Read )
-
- : LIST ( -- )
- open eof dup 0< IF abs THEN ( determine file length )
- room 44 - min dup !size ( set bytes to be read )
- pad dup >abs read close swap type ; ( read & type data )
-
- -1 28 +md ! page
- ( Choose a text file from the standard get file dialog. )
- ( A portion of the file will be listed in this window. )
- list
-