home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Crawly Crypt Collection 1
/
crawlyvol1.bin
/
apps
/
misc
/
zx_sp207
/
source
/
zxf.gfa
(
.txt
)
< prev
next >
Wrap
GFA-BASIC Atari
|
1993-10-26
|
10KB
|
585 lines
' ## INLINE:
' $0000: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0010: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0030: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0040: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0050: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0060: 00 00 00 00
' 100 Bytes.
INLINE old_pfad%,100
' ## INLINE:
' $0000: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0010: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0030: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0040: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0050: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' $0060: 00 00 00 00
' 100 Bytes.
INLINE old_sel%,100
' ## INLINE:
' $0000: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
' 16 Bytes.
INLINE old_sna%,16
'
DEFMOUSE 0
HIDEM
IF BYTE{BASEPAGE+128}>0 AND BYTE{BASEPAGE+129}=ASC("©")
inmem!=TRUE!
@patch(BASEPAGE+256)
FOR j&=0 TO 5
x$=""
FOR i&=0 TO 7
x$=x$+CHR$(BYTE{BASEPAGE+130+j&*8+i&})
NEXT i&
x%=VAL("&h"+x$)
SELECT j&
CASE 0
setup%=x%+8
spfad$=CHAR{setup%+160*4+35+35+7}
IF spfad$=CHAR{old_pfad%}
IF CHAR{old_sel%}<>""
spfad$=CHAR{old_sel%}
ENDIF
ELSE
CHAR{old_pfad%}=spfad$
CHAR{old_sna%}=""
ENDIF
sna_sw|=BYTE{setup%+160*4+35+35+7+35+32+2}
CASE 1
zxpage%=x%
CASE 2
zxregs%=x%
CASE 3
sstore%=x%
CASE 4
sup_ret%=x%
CASE 5
aset_nr%=x%
set_nr%=4
ENDSELECT
NEXT j&
ELSE
inmem!=FALSE!
spfad$=CHR$(GEMDOS(25)+ASC("A"))+":"+DIR$(0)
t$="SPECCI.DAT"
IF EXIST(t$)
OPEN "i",#2,t$
SEEK #2,34+16384+8192+8+77
x$=INPUT$(35,#2)
CLOSE #2
x$=CHAR{VARPTR(x$)}
IF TRIM$(x$)<>""
spfad$=x$
ENDIF
ENDIF
ENDIF
max_sna%=300
DIM sna$(max_sna%)
DIM sna_inf%(max_sna%)
DIM r|(256)
FOR i&=0 TO 255
r|(i&)=i&
NEXT i&
r|(ASC("["))=255
r|(ASC("{"))=255
prop$="|/-\"
scan!=FALSE!
IF RIGHT$(spfad$,1)<>"\"
spfad$=spfad$+"\"
ENDIF
w&=INT{L~A+2}/INT{L~A}
aw&=w&/10
fh%=INT{L~A-46}
az%=(WORK_OUT(1)+1)/fh%
IF inmem!
h&=SUCC(az%/2)-4
ELSE
h&=az%-4
ENDIF
i$=CHR$(27)+"p"
n$=CHR$(27)+"q"+CHR$(27)+"b1"+CHR$(27)+"c4"
c1$=CHR$(27)+"b1"+CHR$(27)+"c4"
c2$=CHR$(27)+"b1"+CHR$(27)+"c6"
c3$=CHR$(27)+"b1"+CHR$(27)+"c>"
c4$=CHR$(27)+"b7"+CHR$(27)+"c4"
'
DO
IF inmem!
t$="Load or Save SNA-File"
ELSE
t$="Start ZX Spectrum with Snapshot"
ENDIF
PRINT AT(1,1);CHR$(27);"w";c1$;i$;SPACE$((w&-(LEN(t$)-1))/2);t$;SPACE$(70);n$;
@cls
t$="SNA"
IF sna_sw|
t$="SNX"
ENDIF
IF inmem!
t$="Return=LOAD, F5=SAVE(."+t$+"), ESC=Exit"
ELSE
t$="Return=LOAD into emulator, ESC=Exit"
ENDIF
PRINT AT(1,h&+2);c4$;"SELECTION: ";i$;" ";n$;
@h
@i
scan!=FALSE!
st&=1
QSORT sna$() WITH r|(),sna%+1,sna_inf%()
x$=CHAR{old_sna%}
CHAR{old_sna%}=""
IF x$<>""
j&=@jump(x$)
IF j&>0
st&=j&
ENDIF
ENDIF
@display
nr%=@select
EXIT IF nr%<0
IF exit_key|=13
IF sna_inf%(nr%)=&HFF
spfad$=MID$(sna$(nr%),2,2)+"\"
ELSE
IF sna_inf%(nr%)=&H10 OR scan!=TRUE!
IF scan!=FALSE!
IF sna$(nr%)=".."
s&=RINSTR(spfad$,"\",LEN(spfad$)-1)
IF s&>0
spfad$=LEFT$(spfad$,s&)
ENDIF
ELSE
spfad$=spfad$+sna$(nr%)+"\"
ENDIF
ENDIF
ELSE
sna$(nr%)=UPPER$(sna$(nr%))
IF inmem!=TRUE!
WORD{sup_ret%+2}=set_nr%
WORD{sup_ret%}=3
CHAR{sstore%}=spfad$+sna$(nr%)
CHAR{old_sel%}=LEFT$(spfad$,LEN(spfad$)-1)
CHAR{old_sna%}=@lc$(sna$(nr%))
ELSE
t$=spfad$+sna$(nr%)
PRINT AT(1,h&+2);c4$;"SELECTION: ";t$;SPACE$(11);
~SHEL_WRITE(1,1,1,CHR$(LEN(t$))+t$,"SPECCI.PRG")
ENDIF
END
ENDIF
ENDIF
ELSE
IF sname$="" AND sna%>0 AND sna_inf%(nr%)<>&H10 AND sna_inf%(nr%)<>&HFF
sname$=UPPER$(sna$(nr%))
ENDIF
IF sname$<>""
s&=RINSTR(sname$,".")
IF s&>0
IF s&>8
sname$=LEFT$(sname$,8)+MID$(sname$,s&,LEN(sname$)-s&+1)
ENDIF
IF RIGHT$(sname$)="."
sname$=LEFT$(sname$,LEN(sname$)-1)
ENDIF
ELSE
IF LEN(sname$)>8
sname$=LEFT$(sname$,LEN(sname$)-1)
ENDIF
IF sna_sw|=0
sname$=sname$+".SNA"
ELSE
sname$=sname$+".SNX"
ENDIF
ENDIF
IF sname$<>""
PRINT AT(1,h&+2);c4$;"SELECTION: ";spfad$+sname$;SPACE$(11);
IF EXIST(spfad$+sname$)
PRINT CHR$(7);
t$="Exists! Return=Overwrite, ESC=Cancel"
PRINT AT(1,h&+4);i$;SPACE$((w&-(LEN(t$)-1))/2);t$;SPACE$(70);n$;""
DO
k$=INKEY$
EXIT IF k$=CHR$(13) OR k$=CHR$(27)
LOOP
IF k$=CHR$(27)
sname$=""
ENDIF
ENDIF
IF sname$<>""
sname$=UPPER$(sname$)
IF inmem!=TRUE!
WORD{sup_ret%+2}=set_nr%
WORD{sup_ret%}=4
CHAR{sstore%}=spfad$+sname$
CHAR{old_sel%}=LEFT$(spfad$,LEN(spfad$)-1)
CHAR{old_sna%}=@lc$(sname$)
ELSE
PRINT AT(1,h&+2);c4$;"SELECTION: ";spfad$;sname$;SPACE$(11);
REPEAT
UNTIL INKEY$<>""
ENDIF
END
ENDIF
ENDIF
ENDIF
ENDIF
LOOP
IF inmem!=TRUE!
WORD{sup_ret%}=99
ENDIF
END
'
PROCEDURE cls
LOCAL i&
FOR i&=2 TO h&+2
PRINT AT(1,i&);CHR$(27);"K";
NEXT i&
RETURN
'
PROCEDURE display
LOCAL i&,x$
IF st&<=sna%
FOR i&=st& TO sna%
x$=@item$(i&)
EXIT IF x$=""
PRINT x$;
NEXT i&
lx&=i&-1
ENDIF
@m
RETURN
'
PROCEDURE m
IF st&>1
PRINT AT(80,2);
~BIOS(3,5,1)
ENDIF
IF lx&<sna%
PRINT AT(80,h&+1);
~BIOS(3,5,2)
ENDIF
RETURN
'
FUNCTION item$(i&)
LOCAL i$,s&,c&,l&,a&
i$=sna$(i&)
s&=RINSTR(i$,".")
IF s&>0 AND s&<>LEN(i$)
i$=LEFT$(i$,s&-1)
ENDIF
c&=0
l&=0
FOR a&=st& TO i&-1
INC c&
IF c&=aw&
c&=0
INC l&
ENDIF
EXIT IF l&=h&
NEXT a&
IF l&=h&
RETURN ""
ELSE
PRINT AT(c&*10+1,l&+2);
RETURN i$
ENDIF
ENDFUNC
'
FUNCTION lc$(a$)
LOCAL c$,c&
FOR c&=1 TO LEN(a$)
c$=MID$(a$,c&,1)
IF c$>="A" AND c$<="Z"
c$=CHR$(ASC(c$)+32)
MID$(a$,c&,1)=c$
ENDIF
NEXT c&
RETURN a$
ENDFUNC
'
FUNCTION select
LOCAL i&,j&,f$,x$,k$
i&=st&
DO
IF i&<=sna%
x$=@item$(i&)
PRINT c3$;i$;x$;SPACE$(8-LEN(x$));n$;
ENDIF
k$=""
WHILE k$=""
k$=INKEY$
IF i&<=sna%
@f
ENDIF
WEND
IF LEN(k$)=2
k$=CHR$(ASC(RIGHT$(k$,1))+128)
ENDIF
IF k$=CHR$(&H62+128) ! HELP: Scan for files
k$=CHR$(13)
scan!=TRUE!
ENDIF
IF k$=CHR$(&H61+128) ! UNDO: Full Screen
h&=az%-4
@cls
@h
@display
ENDIF
IF k$=CHR$(&H52+128) ! INSERT: Name kopieren in Eingabezeile
IF sna%>0
IF sna_inf%(i&)<>&HFF AND sna_inf%(i&)<>&H10
f$=sna$(i&)
ENDIF
ENDIF
ENDIF
IF k$=CHR$(&H47+128) ! CLR: Eingabezeile löschen
f$=""
ENDIF
EXIT IF k$=CHR$(27) OR k$=CHR$(13) OR (k$=CHR$(&HBF) AND inmem!)
IF i&<=sna%
x$=@item$(i&)
PRINT x$;SPACE$(8-LEN(x$));
SELECT ASC(k$)
CASE 8 ! BACKSPACE
IF f$<>""
f$=LEFT$(f$,LEN(f$)-1)
ELSE
PRINT CHR$(7);
ENDIF
CASE 32,&HCD,9 ! Cursor right, SPACE, TAB
INC i&
IF i&>lx&
IF lx&<sna%
st&=st&+aw&*h&
i&=st&
@cls
@display
ELSE
i&=st&
ENDIF
ENDIF
CASE &HCB ! Cursor left
DEC i&
IF i&<st&
IF st&>1
st&=MAX(st&-aw&*h&,1)
@cls
@display
ELSE
i&=lx&
ENDIF
ENDIF
CASE &HD0 ! Cursor down
IF i&+aw&<=lx&
i&=i&+aw&
ELSE
IF lx&<sna%
st&=st&+aw&*h&
i&=st&
@cls
@display
ELSE
i&=sna%
ENDIF
ENDIF
CASE &HC8 ! Cursor up
IF i&-aw&>=st&
i&=i&-aw&
ELSE
IF st&>1
st&=MAX(st&-aw&*h&,1)
@cls
@display
i&=MAX(1,i&-aw&)
ENDIF
ENDIF
ENDSELECT
ENDIF
IF k$>" " AND k$<="z"
IF LEN(f$)<12
f$=f$+k$
j&=@jump(f$)
IF j&>0
IF j&<st& OR j&>lx&
st&=j&
i&=j&
@cls
@display
ELSE
i&=j&
ENDIF
ENDIF
ELSE
PRINT CHR$(7);
ENDIF
ENDIF
PRINT AT(1,h&+2);c4$;"SELECTION: ";f$;i$;" ";n$;SPACE$(11);
LOOP
IF k$=CHR$(27)
RETURN -1
ENDIF
exit_key|=ASC(k$)
sname$=UPPER$(f$)
RETURN i&
ENDFUNC
'
FUNCTION jump(x$)
LOCAL i&
IF sna%>0
' x$=@lc$(x$)
FOR i&=1 TO sna%
EXIT IF LEFT$(sna$(i&),LEN(x$))>=x$
NEXT i&
IF i&<=sna%
RETURN i&
ENDIF
ENDIF
RETURN -1
ENDFUNC
'
PROCEDURE f
LOCAL x$
IF (LPEEK(&H462) DIV 20)<>f_time%
f_time%=LPEEK(&H462) DIV 20
x$=@item$(i&)
fmode!=NOT fmode!
IF fmode!
VSYNC
PRINT c3$;i$;x$;SPACE$(8-LEN(x$));n$;
ELSE
VSYNC
PRINT x$;SPACE$(8-LEN(x$));
ENDIF
ENDIF
RETURN
'
PROCEDURE i
LOCAL s$,dta%,r%,c&,d&,e&,f%
SHOWM
DEFMOUSE 2
sna%=0
r%=BIOS(10)
c&=ASC(LEFT$(spfad$,1))-ASC("A")
e&=DPEEK(&H4A6)
SELECT e&
CASE 0
f%=&X1111111111111100
CASE 1
f%=&X1111111111111101
CASE 2
f%=&X1111111111111111
DEFAULT
f%=&X1111111111111111
ENDSELECT
FOR d&=0 TO 15
IF BTST(r%,d&) AND d&<>c& AND BTST(f%,d&)
INC sna%
sna$(sna%)="["+CHR$(d&+ASC("A"))+":]"
sna_inf%(sna%)=&HFF
ENDIF
NEXT d&
dta%=GEMDOS(47)
s$=spfad$+"*.*"+CHR$(0)
r%=GEMDOS(78,L:VARPTR(s$),&H10)
WHILE r%=0
IF @valid_sna(dta%)=1
INC sna%
EXIT IF sna%>max_sna%
sna$(sna%)=CHAR{dta%+30}
sna_inf%(sna%)=BYTE{dta%+21} AND &H10
IF sna_inf%(sna%)<>&H10
sna$(sna%)=@lc$(sna$(sna%))
ENDIF
ENDIF
EXIT IF sna%>max_sna%
r%=GEMDOS(79)
WEND
IF sna%>max_sna%
DEC sna%
PRINT CHR$(7);AT(1,h&+2);"Only first ";max_sna%;" files!";
ENDIF
' @t
HIDEM
RETURN
'
PROCEDURE h
PRINT AT(1,h&+3);c2$;i$;spfad$;SPACE$(80);n$;
PRINT AT(1,h&+4);c1$;i$;SPACE$((w&-(LEN(t$)-1))/2);t$;SPACE$(70);n$;
RETURN
'
PROCEDURE t
LOCAL i&,i$
FOR i&=1 TO 100
i$=STR$(i&)
i$=STRING$(3-LEN(i$),"0")+i$
INC sna%
sna$(sna%)="file"+i$+".SNA"
sna_inf%(sna%)=0
NEXT i&
RETURN
'
FUNCTION valid_sna(d%)
LOCAL f$,x$,l%
f$=CHAR{d%+30}
IF BYTE{d%+21}=&H10
IF f$="."
RETURN 0
ENDIF
RETURN 1
ENDIF
IF INSTR(f$,".SNA")>0
RETURN 1
ENDIF
IF INSTR(f$,".SNX")>0
RETURN 1
ENDIF
l%=(BYTE{d%+26}*256+BYTE{d%+27})*65536+BYTE{d%+28}*256+BYTE{d%+29}
IF l%=49179
RETURN 1
ENDIF
IF scan!
' Dieser Teil ist ur-langsam
IF l%<7
RETURN 0
ENDIF
@p
OPEN "i",#2,spfad$+f$
x$=INPUT$(4,#2)
CLOSE #2
IF x$="XSNA"
RETURN 1
ENDIF
ENDIF
RETURN 0
ENDFUNC
'
PROCEDURE p
PRINT AT(1,h&+4);i$;MID$(prop$,prop&+1,1);n$;
prop&=(prop&+1) MOD 3
RETURN
'
PROCEDURE patch(s%)
'
' Diese Prozedur patcht GFA-Basic 3.6 Compilate, damit
' sie wiederaufruf-fähig werden, wenn sie resident im
' Speicher stehen (Start mit EXEC-Mode 4).
' s% -> Startadresse TEXT-Segment im Speicher
'
DO
EXIT IF DPEEK(s%)=&H4EB9 ! JSR init
ADD s%,2
LOOP
s%=LPEEK(s%+2) ! init
DO
EXIT IF DPEEK(s%)=&HA000 ! nach LINE-A Initialisierung
ADD s%,2
LOOP
IF DPEEK(s%+14)=&H6100 ! BSR InitAES aus-NOPen
s%=s%+14
DPOKE s%,&H4E71
DPOKE s%+2,&H4E71
ENDIF
RETURN