Category : Forth Source Code
Archive   : SMILY46H.ZIP
Filename : FILESEL.SEQ

\ FILESEL.SEQ Window file selection for select files 9Jan89mds
\ into a given file handle area
\ version 2.2

\ 09Jan89
\ This version works with F-PC v 2.25, if the Beheaded words in
\ the file WFL are first restored, then the system is re-compiled.

comment:
\ Modified from WFL.SEQ, window file selection, by Tom Zimmer

by

ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º Dr. Mark Smiley º
º Department of Mathematics/CS º
º Goucher College º
º Towson, MD 21204 º
ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
º (410)-337-6285 (W) º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ

WFL.SEQ must be loaded first (un-behead WFL first!)

\ The screen is no longer saved before calling up the file selection
screen. 29Dec88mds
\ Now when viewing two files, after the first one has been chosen,
it is removed from the list and cannot be chosen again. Also,
the handles IMAGE_FILE and IMAGE_FILE2 are now defined in the
file FILESEL.SEQ. 26Dec88mds

comment;

ANEW FILE.SELECTOR

HANDLE IMAGE_FILE
HANDLE IMAGE_FILE2

: >BLKYLW BLACK >BG YELLOW >FG ;

VARIABLE 'IMAGE_HANDLE \ 'IMAGE_HANDLE 0!
IMAGE_FILE 'IMAGE_HANDLE !
\ 'IMAGE_HANDLE holds the address of a handle area 70 bytes long,
\ i.e. a handle address

: IMAGE_HANDLE ( -- addr )
'IMAGE_HANDLE @
DUP 0= ABORT" Uninitialized Image Handle" ;

: $HOPEN
IMAGE_HANDLE $>HANDLE
IMAGE_HANDLE HOPEN
IBRESET ;

ONLY FORTH ALSO HIDDEN DEFINITIONS ALSO

create .PICdirspec$ ," *.PIC" b/hcb allot
create .IMGdirspec$ ," *.IMG" b/hcb allot

FORTH DEFINITIONS

: >DIRSPEC ( addr -- )
dirspec$ 6 move
-1 dirspec$ >hndle !
dirspec$ count + off ;

: .PIC>DIRSPEC
.PICdirspec$
>DIRSPEC ;
.PIC>DIRSPEC

: .IMG>DIRSPEC
.IMGdirspec$
>DIRSPEC ;
\ .IMG>DIRSPEC

HIDDEN DEFINITIONS

comment:
: $getdir ( a1 --- )
dup pathset drop
seqhandle+ $>handle \ get directory spec
off> curfl
off> foff
off> #fls
dirseg 0= ?exit \ leave if no directory space
\ above added for use w/ F-PC 3.55
pad SET-DTA
seqhandle+ >nam findfirst
begin 255 and 0= #fls maxdir > 0= and
while name>buf incr> #fls
findnext
repeat ;

: getdir ( --- )
dirspec$ $getdir sortdir ;
comment;

: delfl ( --- ) \ delete the current file
curfl >fadr dup>r 1- c@l dirattrib and
forgx forgy 19 11 d+ 2dup at 50 spaces at
if ." Can't delete directory !\b\:10"
else ." Delete \`" dirseg r@ dir>pad type ." \` <- Y/N [N] "
cursor-on key cursor-off bl or 'y' =
if dirspec$ >pathend dirspec$ 1+ - dup IMAGE_HANDLE c!
dirspec$ 1+ IMAGE_HANDLE 1+ rot cmove
dirseg r@ dir>pad >r IMAGE_HANDLE count + r@ cmove
r> IMAGE_HANDLE c+!
IMAGE_HANDLE count + off
IMAGE_HANDLE hdelete 5 =
if ." Access denied !\b\:10"
then
then curfl foff
getdir
!> foff !> curfl
then r>drop showpath ;


: keytests ( n1 --- )
dup false = if ( do nothing ) else
( up arrow ) dup 200 = over 56 = or if pfl else
( down arrow ) dup 208 = over 50 = or if nfl else
( PgUp ) dup 201 = over 57 = or if dlen 2/ 0 ?do pfl loop else
( PgDn ) dup 209 = over 51 = or if dlen 2/ 0 ?do nfl loop else
( \ ) dup 92 = if ndir else
( 0 to 9) dup '0' '9' between over bl or
( A to Z) 'a' 'z' between or if find_letter else
( Del ) dup 211 = over 46 = or if delfl else
( Home ) dup 199 = over 55 = or if 0fl else
( End ) dup 207 = over 49 = or if efl else beep
then then then then then then then then then then
drop ;


ONLY FORTH DEFINITIONS ALSO HIDDEN ALSO

: ( --- f1 ) \ return a1 filename addr and boolean
rows forgy - 4 - =: dlen \ for F-PC 3.55
dirseg 0= if false exit then \ if it didn't work, then leave
['] wflbutton save!> dobutton \ init mouse support
\ savecursor
\ savescr \ save cursor and screen
forgx 2- forgy 2- over 74 + rows 3 - box&fill
forgx forgy 36 1 d+ at \ then my message
>BLKYLW
." Select a File to View "
>NORM
\ ." \r Tom's Window File Selection Tool "
forgx forgy 20 7 d+ at
." \2 Reading Directory Files... "
cursor-off getdir \ clear screen, and get dir
0fl showkeys showpath \ show the keys and dir path
forgx forgy 17 16 d+ at \ and som help information
." Use  to pick a file, or press the first letter of"
forgx forgy 17 17 d+ at
." the file you want, then press Return to select it."
begin showdir 0 0 at \ show the directory
key dup 13 = dup \ wait for a key, if Enter
if drop ?setdir ( c1 --- c2 f1 ) \ try to set dir
then over 27 = or 0= \ else check for escape or null
while keytests \ if neither then try to find a file
repeat 13 = dup \ if it was Enter, then get the file name
\ we are on and move it to PAD. Prepend
\ the DIR spec.
if dirspec$ >pathend dirspec$ 1+ - >r
dirspec$ pad r@ 1+ cmove r> pad c!
curfl >fadr 2dup c@l >r 1+
?cs: pad count + r@ cmovel r> pad c+!
pad handle>ext c@ '.' <> \ append '.' if no extension
if '.' pad count + c!
1 pad c+!
then pad swap
then
\ restscr \ restore screen
\ restcursor \ restore cursor position
restore> dobutton
\ #fls 0<> and ; \ return boolean for file selected
\ above for F-PC 3.53
#fls 0= \ for F-PC 3.55
if dup
if 2drop false \ discard addr even if found if
\ no files in list
then
then dirseg_release ; \ return boolean for file selected


\ ' is getfile \ patch in window get file.


: REMOVE.FILE \ remove chosen file from directory list
CURFL
#FLS 1- <> IF
DIRSEG
CURFL 1+ 14 *
2DUP 14 -
#FLS CURFL - 1- 14 *
CMOVEL
THEN
\ if the current file is the
#FLS 1- =: #FLS \ last file, just decrease #FLS
;

: <1getfile> ( --- f1 ) \ return a1 filename addr and boolean
rows forgy - 4 - =: dlen \ for F-PC 3.55
dirseg 0= if false exit then \ if it didn't work, then leave
['] wflbutton save!> dobutton \ init mouse support
\ savecursor
\ savescr \ save cursor and screen
forgx 2- forgy 2- over 74 + rows 3 - box&fill
forgx forgy 36 1 d+ at \ then my message
\ ." \r Tom's Window File Selection Tool "
>BLKYLW
." Select the First File to View "
>NORM
forgx forgy 20 7 d+ at
." \2 Reading Directory Files... "
cursor-off getdir \ clear screen, and get dir
0fl showkeys showpath \ show the keys and dir path
forgx forgy 17 16 d+ at \ and some help information
." Use  to pick a file, or press the first letter of"
forgx forgy 17 17 d+ at
." the file you want, then press Return to select it."
begin showdir 0 0 at \ show the directory
key dup 13 = dup \ wait for a key, if Enter
if drop ?setdir ( c1 --- c2 f1 ) \ try to set dir
then over 27 = or 0= \ else check for escape or null
while keytests \ if neither then try to find a file
repeat 13 = dup \ if it was Enter, then get the file name
\ we are on and move it to PAD. Prepend
\ the DIR spec.
if dirspec$ >pathend dirspec$ 1+ - >r
dirspec$ pad r@ 1+ cmove r> pad c!
curfl >fadr 2dup c@l >r 1+
?cs: pad count + r@ cmovel r> pad c+!
pad handle>ext c@ '.' <> \ append '.' if no extension
if '.' pad count + c!
1 pad c+!
then pad swap
REMOVE.FILE
then
\ restscr \ restore screen
\ restcursor \ restore cursor position
restore> dobutton
\ #fls 0<> and ; \ return boolean for file selected
#fls 0= \ for F-PC 3.55
if dup
if 2drop false \ discard addr even if found if
\ no files in list
then
then dirseg_release ; \ return boolean for file selected


: <2getfile> ( --- f1 ) \ return a1 filename addr and boolean
rows forgy - 4 - =: dlen \ for F-PC 3.55
dirseg 0= if false exit then \ if it didn't work, then leave
['] wflbutton save!> dobutton \ init mouse support
\ savecursor
\ savescr \ save cursor and screen
forgx 2- forgy 2- over 74 + rows 3 - box&fill
forgx forgy 36 1 d+ at \ then my message
>BLKYLW
." Now Choose the Second File to View"
>NORM
forgx forgy 20 7 d+ at
." \2 Reading Directory Files... "
cursor-off getdir \ clear screen, and get dir
0fl showkeys showpath \ show the keys and dir path
forgx forgy 17 16 d+ at \ and som help information
." Use  to pick a file, or press the first letter of"
forgx forgy 17 17 d+ at
." the file you want, then press Return to select it."
begin showdir 0 0 at \ show the directory
key dup 13 = dup \ wait for a key, if Enter
if drop ?setdir ( c1 --- c2 f1 ) \ try to set dir
then over 27 = or 0= \ else check for escape or null
while keytests \ if neither then try to find a file
repeat 13 = dup \ if it was Enter, then get the file name
\ we are on and move it to PAD. Prepend
\ the DIR spec.
if dirspec$ >pathend dirspec$ 1+ - >r
dirspec$ pad r@ 1+ cmove r> pad c!
curfl >fadr 2dup c@l >r 1+
?cs: pad count + r@ cmovel r> pad c+!
pad handle>ext c@ '.' <> \ append '.' if no extension
if '.' pad count + c!
1 pad c+!
then pad swap
then
cursor-on \ restore cursor
\ restscr \ restore screen
\ restcursor \ restore cursor position
restore> dobutton
\ #fls 0<> and ; \ return boolean for file selected
#fls 0= \ for F-PC 3.55
if dup
if 2drop false \ discard addr even if found if
\ no files in list
then
then dirseg_release ; \ return boolean for file selected



DEFER GET.DAT.FILE ( -- addr flag )
' IS GET.DAT.FILE

: REST>NORM ( flag -- flag )
DUP
IF ['] >NONE IS >NORM
>NORM
THEN ;

comment:
: GFL ( --- ) \ optionally prompt for file if non
\ is currently in the TIB.
more? 0=
if GET.DAT.FILE 0= abort" No filename specified"
dup count type space
file>tib
then ;
comment;

\ comment:
: GFL ( --- ) \ always prompt for file
GET.DAT.FILE 0= abort" No filename specified"
dup count type space
file>tib ;
\ comment;

: >CYANRED cyan >bg red >fg ;

: >BLUWHT BLUE >BG WHITE >FG ;

\ : >BLKYLW BLACK >BG YELLOW >FG ;

: >BLKGRN BLACK >BG GREEN >FG ;

: >GRYRED LTGRAY >BG RED >FG ;

\ Open a specified filename from ANY FPATH directory
: FILE ( | --- )
gfl bl word $file ?open.error
." of " seqhandle endfile d. ." bytes."
\ 0 0 seqhandle movepointer ; \ reset to biginning of file
0 0 IMAGE_HANDLE movepointer ; \ reset to biginning of file

: DFILE ( --- )
\ DARK
>CYANRED
['] >BLUWHT IS >ATTRIB1
['] >RDWT IS >NORM
gfl bl word $hopen
REST>NORM
abort" File open Error!"
." of " IMAGE_HANDLE endfile d. ." bytes."
0 0 IMAGE_HANDLE movepointer \ reset to beginning of file
\ errorline off \ reset last line variable
\ loadline off \ reset file offset
\ listoff off
\ 0 %!> screenchar
['] >BUGN IS >ATTRIB1
['] >NONE IS >NORM
>NORM ;

: 2FILES
IMAGE_FILE 'IMAGE_HANDLE !
['] <1GETFILE> IS GET.DAT.FILE
DFILE
IMAGE_FILE2 'IMAGE_HANDLE !
['] <2GETFILE> IS GET.DAT.FILE
DFILE ;

: 1FILE
IMAGE_FILE 'IMAGE_HANDLE !
['] IS GET.DAT.FILE
DFILE ;