'
' GEMDOS/Datei-Library f�r GFA-BASIC 3.x
'
' Die vorliegenden Funktionen ersetzen die GFA-BASIC Datei-Funktionen durch
' entsprechende GEMDOS-Routinen. Hierbei wird im Gegensatz zu den GFA-Funktionen
' _immer_ eine Fehlercode zur�ckgegeben, auf den dann angemessen reagiert werden
' kann/muž. Eine bombentr„chtige Abfang-Routine �ber ON ERROR/RESUME wird damit
' nicht mehr ben”tigt. Allerdings leider nat�rlich auch der Komfort und teil-
' weise auch die Geschwindigkeit.
'
> PROCEDURE f_diverse
  '
  DEFFN f_close(fh&)=GEMDOS(62,fh&)                     ! CLOSE #1
  '
  DEFFN f_out(fh&,a|)=GEMDOS(64,fh&,L:1,L:V:a|)         ! OUT #1,a|
  DEFFN f_outw(fh&,a&)=GEMDOS(64,fh&,L:2,L:V:a&)        ! OUT& #1,a&
  DEFFN f_outl(fh&,a%)=GEMDOS(64,fh&,L:4,L:V:a%)        ! OUT% #1,a%
  '
  DEFFN f_bput(fh&,a%,l%)=GEMDOS(64,fh&,L:l%,L:a%)      ! BPUT #1,a%,l%
  DEFFN f_bget(fh&,a%,l%)=GEMDOS(63,fh&,L:l%,L:a%)      ! BGET #1,a%,l%
  '
  DEFFN f_print(fh&,a$)=GEMDOS(64,fh&,L:LEN(a$),L:V:a$) ! PRINT #1,a$;
  '
  DEFFN f_seek(fh&,pos%)=GEMDOS(66,L:pos%,fh&,0)        ! SEEK #1,pos%
  DEFFN f_loc(fh&)=GEMDOS(66,L:0,fh&,1)                 ! LOC(#1)
  '
RETURN
'
> FUNCTION f_rename(a$,b$)
$F%
'
' RENAME a$ AS b$
'
a$=a$+CHR$(0)
b$=b$+CHR$(0)
'
RETURN GEMDOS(86,0,L:V:a$,L:V:b$)
ENDFUNC
> FUNCTION f_kill(a$)
$F%
'
' KILL a$
'
a$=a$+CHR$(0)
'
RETURN GEMDOS(65,L:V:a$)
ENDFUNC
> FUNCTION f_rmdir(a$)
$F%
'
' RMDIR a$
'
a$=a$+CHR$(0)
'
RETURN GEMDOS(58,L:V:a$)
ENDFUNC
> FUNCTION f_mkdir(a$)
$F%
'
' MKDIR a$
'
a$=a$+CHR$(0)
'
RETURN GEMDOS(57,L:V:a$)
ENDFUNC
'
> FUNCTION f_create(a$)
$F%
'
' OPEN "O"
'
a$=a$+CHR$(0)
'
RETURN GEMDOS(60,L:V:a$,0)
ENDFUNC
> FUNCTION f_open(a$)
$F%
'
' OPEN "I"
'
a$=a$+CHR$(0)
'
RETURN GEMDOS(61,L:V:a$,0)
ENDFUNC
> FUNCTION f_update(a$)
$F%
'
' OPEN "U"
'
a$=a$+CHR$(0)
'
RETURN GEMDOS(61,L:V:a$,2)
ENDFUNC
> FUNCTION f_append(a$)
$F%
LOCAL fh&,a%
'
' OPEN "A"
'
a$=a$+CHR$(0)
'
fh&=GEMDOS(61,L:V:a$,2)               ! OPEN "U"
'
IF fh&=-33                            ! Existiert nicht...
fh&=GEMDOS(60,L:V:a$,0)             ! OPEN "O"
ENDIF
'
IF fh&>0
a%=GEMDOS(66,L:0,fh&,2)             ! SEEK #1,lof%
IF a%<0
RETURN a%                         ! Error beim Seeken
ENDIF
ENDIF
'
RETURN fh&
ENDFUNC
'
> FUNCTION f_lof(fh&)
$F%
LOCAL pos%,lof%
'
' LOF(#1)
'
pos%=GEMDOS(66,L:0,fh&,1)                             ! LOC(#1)
lof%=GEMDOS(66,L:0,fh&,2)                             ! SEEK #1,LOF(#1)
'
~GEMDOS(66,L:pos%,fh&,0)                              ! SEEK #1,LOC(#1)
'
RETURN lof%
ENDFUNC
> FUNCTION f_eof(fh&)
$F%
LOCAL pos%,lof%
'
' EOF(#1)
'
pos%=GEMDOS(66,L:0,fh&,1)                             ! LOC(#1)
lof%=GEMDOS(66,L:0,fh&,2)                             ! SEEK #1,LOF(#1)
'
~GEMDOS(66,L:pos%,fh&,0)                              ! SEEK #1,LOC(#1)
'
RETURN pos%>=lof%                                     ! EOF(#1)
ENDFUNC
'
> FUNCTION f_println(fh&,a$)
$F%
'
' PRINT #1,a$
'
a$=a$+CHR$(13)+CHR$(10)
'
RETURN GEMDOS(64,fh&,L:LEN(a$),L:V:a$)
ENDFUNC
> FUNCTION f_input$(fh&)
LOCAL a|,e%,a$,b$
'
' LINE INPUT #1,a$
'
b$=CHR$(13)+CHR$(10)                ! Linefeed
'
WHILE RIGHT$(a$,2)<>b$
e%=GEMDOS(63,fh&,L:1,L:V:a|)      ! INP #1,a|
'
EXIT IF e%<>1                     ! EOF(#1)
'
a$=a$+CHR$(a|)
WEND
'
IF RIGHT$(a$,2)=b$
a$=LEFT$(a$,SUB(LEN(a$),2))       ! LF abh„ngen
ENDIF
'
RETURN a$
ENDFUNC
'
> FUNCTION f_bload(file$,adr%)
$F%
LOCAL fh&,lof%,pos%
'
' BLOAD file$,adr%
'
file$=file$+CHR$(0)
'
~GRAF_MOUSE(2,0)
'
fh&=GEMDOS(61,L:V:file$,0)      ! f_open
IF fh&>0
'
pos%=GEMDOS(66,L:0,fh&,1)     ! LOC(#1)
lof%=GEMDOS(66,L:0,fh&,2)     ! f_seek(LOF(#1))
~GEMDOS(66,L:pos%,fh&,0)      ! f_seek(LOC(#1))
'
~GEMDOS(63,fh&,L:lof%,L:adr%) ! f_read
~GEMDOS(62,fh&)               ! f_close
'
ENDIF
'
~GRAF_MOUSE(0,0)
'
RETURN lof%                     ! L„nge der Datei
ENDFUNC
> FUNCTION f_bsave(file$,adr%,lof%)
$F%
LOCAL fh&
'
' BSAVE file$,adr%,lof%
'
~GRAF_MOUSE(2,0)
'
fh&=GEMDOS(60,L:V:file$,0)      ! f_create
IF fh&>0
'
~GEMDOS(64,fh&,L:lof%,L:adr%) ! f_write
~GEMDOS(62,fh&)               ! f_close
'
ENDIF
'
~GRAF_MOUSE(0,0)
'
RETURN fh&
ENDFUNC
' ------------------------------------------------------------------------------
' L”schen des Clipboards und Auslesen des Inhalts...
'
> FUNCTION scrp_clear
$F%
LOCAL stat&,file$
'
' L”scht das Klembrett...
'
~GRAF_MOUSE(2,0)
'
file$=@scrp_file$                 ! Erste Datei suchen
'
WHILE file$<>""                   ! Solange bis keine mehr da...
'
file$=clipbrd$+file$            ! Ganzer Pfad
'
stat&=@f_kill(file$)            ! ...l”schen
EXIT IF stat&                   ! Fehlgeschlagen?
'
file$=@scrp_file$               ! N„chste Datei suchen
'
WEND
'
~GRAF_MOUSE(0,0)
'
IF stat&                          ! Wenn Fehler...
stat&=130                       ! ...dann dieser Fehler-Code
ENDIF
'
RETURN stat&
ENDFUNC
> FUNCTION scrp_file$
LOCAL stat&,file$
'
' Liest eine Datei vom Klemmbrett...
'
~FSETDTA(ADD(BASEPAGE,128))       ! Adresse sicherheitshalber setzen
'
file$=clipbrd$+"SCRAP.*"          ! Datei...
'
stat&=FSFIRST(file$,&X0)          ! ...suchen
'
IF stat&=0                        ! Gefunden...
file$=CHAR{ADD(BASEPAGE,158)}   ! ...Namen auslesen
RETURN file$
'
ENDIF
'
RETURN ""                         ! Nichts drin
ENDFUNC
' ------------------------------------------------------------------------------
' Funktionen, um diverse Teile aus Pfadangaben zu extrahieren...
'
> FUNCTION filename$(a$)
LOCAL a&
'
' Extrahiert Dateinamen: "D:\TEST\TEST.GFA" --> "TEST.GFA"
'
IF a$<>""
a&=RINSTR(a$,"\")          ! Backslash suchen
'
IF a&                      ! Wenn ja...
a$=MID$(a$,SUCC(a&))     ! Extrahiere Dateinamen...
RETURN TRIM$(a$)         ! ...ohne Spaces
ELSE
RETURN a$
ENDIF
'
ENDIF
'
RETURN ""                    ! Sonst kein Filename
ENDFUNC
> FUNCTION filename.$(a$)
LOCAL a&
'
' Extrahiert Dateinamen ohne '.': "D:\TEST\TEST.GFA" --> "TEST"
'
a$=@file$(a$)
'
a&=INSTR(a$,".")
IF a&
RETURN LEFT$(a$,PRED(a&))
ENDIF
'
RETURN a$
ENDFUNC
> FUNCTION ext$(a$)
LOCAL a&
'
' Extrahiert Dateiextender: "D:\TEST.GFA" --> "GFA"
'
a&=RINSTR(a$,".")          ! Punkt suchen
'
IF a&                      ! Wenn vorhanden...
RETURN MID$(a$,SUCC(a&)) ! ...extrahiere Extender
ENDIF
'
RETURN ""
ENDFUNC
DEFFN pfad$(a$)=LEFT$(a$,RINSTR(a$,"\"))  ! Extr. Pfadnamen: "D:\TEST.GFA" --> "D:\"
DEFFN pfad.$(a$)=LEFT$(a$,RINSTR(a$,".")) ! Extr. Pfadnamen: "D:\TEST.GFA" --> "D:\TEST."
' ------------------------------------------------------------------------------