home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / apps / misc / zx_sp207 / source / zxf.gfa (.txt) < prev    next >
GFA-BASIC Atari  |  1993-10-26  |  10KB  |  585 lines
  1. ' ## INLINE:
  2. ' $0000: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  3. ' $0010: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  4. ' $0020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  5. ' $0030: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  6. ' $0040: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  7. ' $0050: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  8. ' $0060: 00 00 00 00 
  9. ' 100  Bytes.
  10. INLINE old_pfad%,100
  11. ' ## INLINE:
  12. ' $0000: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  13. ' $0010: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  14. ' $0020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  15. ' $0030: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  16. ' $0040: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  17. ' $0050: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  18. ' $0060: 00 00 00 00 
  19. ' 100  Bytes.
  20. INLINE old_sel%,100
  21. ' ## INLINE:
  22. ' $0000: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  23. ' 16  Bytes.
  24. INLINE old_sna%,16
  25. '
  26. DEFMOUSE 0
  27. HIDEM
  28. IF BYTE{BASEPAGE+128}>0 AND BYTE{BASEPAGE+129}=ASC("©")
  29.   inmem!=TRUE!
  30.   @patch(BASEPAGE+256)
  31.   FOR j&=0 TO 5
  32.     x$=""
  33.     FOR i&=0 TO 7
  34.       x$=x$+CHR$(BYTE{BASEPAGE+130+j&*8+i&})
  35.     NEXT i&
  36.     x%=VAL("&h"+x$)
  37.     SELECT j&
  38.     CASE 0
  39.       setup%=x%+8
  40.       spfad$=CHAR{setup%+160*4+35+35+7}
  41.       IF spfad$=CHAR{old_pfad%}
  42.         IF CHAR{old_sel%}<>""
  43.           spfad$=CHAR{old_sel%}
  44.         ENDIF
  45.       ELSE
  46.         CHAR{old_pfad%}=spfad$
  47.         CHAR{old_sna%}=""
  48.       ENDIF
  49.       sna_sw|=BYTE{setup%+160*4+35+35+7+35+32+2}
  50.     CASE 1
  51.       zxpage%=x%
  52.     CASE 2
  53.       zxregs%=x%
  54.     CASE 3
  55.       sstore%=x%
  56.     CASE 4
  57.       sup_ret%=x%
  58.     CASE 5
  59.       aset_nr%=x%
  60.       set_nr%=4
  61.     ENDSELECT
  62.   NEXT j&
  63. ELSE
  64.   inmem!=FALSE!
  65.   spfad$=CHR$(GEMDOS(25)+ASC("A"))+":"+DIR$(0)
  66.   t$="SPECCI.DAT"
  67.   IF EXIST(t$)
  68.     OPEN "i",#2,t$
  69.     SEEK #2,34+16384+8192+8+77
  70.     x$=INPUT$(35,#2)
  71.     CLOSE #2
  72.     x$=CHAR{VARPTR(x$)}
  73.     IF TRIM$(x$)<>""
  74.       spfad$=x$
  75.     ENDIF
  76.   ENDIF
  77. ENDIF
  78. max_sna%=300
  79. DIM sna$(max_sna%)
  80. DIM sna_inf%(max_sna%)
  81. DIM r|(256)
  82. FOR i&=0 TO 255
  83.   r|(i&)=i&
  84. NEXT i&
  85. r|(ASC("["))=255
  86. r|(ASC("{"))=255
  87. prop$="|/-\"
  88. scan!=FALSE!
  89. IF RIGHT$(spfad$,1)<>"\"
  90.   spfad$=spfad$+"\"
  91. ENDIF
  92. w&=INT{L~A+2}/INT{L~A}
  93. aw&=w&/10
  94. fh%=INT{L~A-46}
  95. az%=(WORK_OUT(1)+1)/fh%
  96. IF inmem!
  97.   h&=SUCC(az%/2)-4
  98. ELSE
  99.   h&=az%-4
  100. ENDIF
  101. i$=CHR$(27)+"p"
  102. n$=CHR$(27)+"q"+CHR$(27)+"b1"+CHR$(27)+"c4"
  103. c1$=CHR$(27)+"b1"+CHR$(27)+"c4"
  104. c2$=CHR$(27)+"b1"+CHR$(27)+"c6"
  105. c3$=CHR$(27)+"b1"+CHR$(27)+"c>"
  106. c4$=CHR$(27)+"b7"+CHR$(27)+"c4"
  107. '
  108. DO
  109.   IF inmem!
  110.     t$="Load or Save SNA-File"
  111.   ELSE
  112.     t$="Start ZX Spectrum with Snapshot"
  113.   ENDIF
  114.   PRINT AT(1,1);CHR$(27);"w";c1$;i$;SPACE$((w&-(LEN(t$)-1))/2);t$;SPACE$(70);n$;
  115.   @cls
  116.   t$="SNA"
  117.   IF sna_sw|
  118.     t$="SNX"
  119.   ENDIF
  120.   IF inmem!
  121.     t$="Return=LOAD, F5=SAVE(."+t$+"), ESC=Exit"
  122.   ELSE
  123.     t$="Return=LOAD into emulator, ESC=Exit"
  124.   ENDIF
  125.   PRINT AT(1,h&+2);c4$;"SELECTION: ";i$;" ";n$;
  126.   @h
  127.   @i
  128.   scan!=FALSE!
  129.   st&=1
  130.   QSORT sna$() WITH r|(),sna%+1,sna_inf%()
  131.   x$=CHAR{old_sna%}
  132.   CHAR{old_sna%}=""
  133.   IF x$<>""
  134.     j&=@jump(x$)
  135.     IF j&>0
  136.       st&=j&
  137.     ENDIF
  138.   ENDIF
  139.   @display
  140.   nr%=@select
  141.   EXIT IF nr%<0
  142.   IF exit_key|=13
  143.     IF sna_inf%(nr%)=&HFF
  144.       spfad$=MID$(sna$(nr%),2,2)+"\"
  145.     ELSE
  146.       IF sna_inf%(nr%)=&H10 OR scan!=TRUE!
  147.         IF scan!=FALSE!
  148.           IF sna$(nr%)=".."
  149.             s&=RINSTR(spfad$,"\",LEN(spfad$)-1)
  150.             IF s&>0
  151.               spfad$=LEFT$(spfad$,s&)
  152.             ENDIF
  153.           ELSE
  154.             spfad$=spfad$+sna$(nr%)+"\"
  155.           ENDIF
  156.         ENDIF
  157.       ELSE
  158.         sna$(nr%)=UPPER$(sna$(nr%))
  159.         IF inmem!=TRUE!
  160.           WORD{sup_ret%+2}=set_nr%
  161.           WORD{sup_ret%}=3
  162.           CHAR{sstore%}=spfad$+sna$(nr%)
  163.           CHAR{old_sel%}=LEFT$(spfad$,LEN(spfad$)-1)
  164.           CHAR{old_sna%}=@lc$(sna$(nr%))
  165.         ELSE
  166.           t$=spfad$+sna$(nr%)
  167.           PRINT AT(1,h&+2);c4$;"SELECTION: ";t$;SPACE$(11);
  168.           ~SHEL_WRITE(1,1,1,CHR$(LEN(t$))+t$,"SPECCI.PRG")
  169.         ENDIF
  170.         END
  171.       ENDIF
  172.     ENDIF
  173.   ELSE
  174.     IF sname$="" AND sna%>0 AND sna_inf%(nr%)<>&H10 AND sna_inf%(nr%)<>&HFF
  175.       sname$=UPPER$(sna$(nr%))
  176.     ENDIF
  177.     IF sname$<>""
  178.       s&=RINSTR(sname$,".")
  179.       IF s&>0
  180.         IF s&>8
  181.           sname$=LEFT$(sname$,8)+MID$(sname$,s&,LEN(sname$)-s&+1)
  182.         ENDIF
  183.         IF RIGHT$(sname$)="."
  184.           sname$=LEFT$(sname$,LEN(sname$)-1)
  185.         ENDIF
  186.       ELSE
  187.         IF LEN(sname$)>8
  188.           sname$=LEFT$(sname$,LEN(sname$)-1)
  189.         ENDIF
  190.         IF sna_sw|=0
  191.           sname$=sname$+".SNA"
  192.         ELSE
  193.           sname$=sname$+".SNX"
  194.         ENDIF
  195.       ENDIF
  196.       IF sname$<>""
  197.         PRINT AT(1,h&+2);c4$;"SELECTION: ";spfad$+sname$;SPACE$(11);
  198.         IF EXIST(spfad$+sname$)
  199.           PRINT CHR$(7);
  200.           t$="Exists!  Return=Overwrite, ESC=Cancel"
  201.           PRINT AT(1,h&+4);i$;SPACE$((w&-(LEN(t$)-1))/2);t$;SPACE$(70);n$;""
  202.           DO
  203.             k$=INKEY$
  204.             EXIT IF k$=CHR$(13) OR k$=CHR$(27)
  205.           LOOP
  206.           IF k$=CHR$(27)
  207.             sname$=""
  208.           ENDIF
  209.         ENDIF
  210.         IF sname$<>""
  211.           sname$=UPPER$(sname$)
  212.           IF inmem!=TRUE!
  213.             WORD{sup_ret%+2}=set_nr%
  214.             WORD{sup_ret%}=4
  215.             CHAR{sstore%}=spfad$+sname$
  216.             CHAR{old_sel%}=LEFT$(spfad$,LEN(spfad$)-1)
  217.             CHAR{old_sna%}=@lc$(sname$)
  218.           ELSE
  219.             PRINT AT(1,h&+2);c4$;"SELECTION: ";spfad$;sname$;SPACE$(11);
  220.             REPEAT
  221.             UNTIL INKEY$<>""
  222.           ENDIF
  223.           END
  224.         ENDIF
  225.       ENDIF
  226.     ENDIF
  227.   ENDIF
  228. LOOP
  229. IF inmem!=TRUE!
  230.   WORD{sup_ret%}=99
  231. ENDIF
  232. END
  233. '
  234. PROCEDURE cls
  235.   LOCAL i&
  236.   FOR i&=2 TO h&+2
  237.     PRINT AT(1,i&);CHR$(27);"K";
  238.   NEXT i&
  239. RETURN
  240. '
  241. PROCEDURE display
  242.   LOCAL i&,x$
  243.   IF st&<=sna%
  244.     FOR i&=st& TO sna%
  245.       x$=@item$(i&)
  246.       EXIT IF x$=""
  247.       PRINT x$;
  248.     NEXT i&
  249.     lx&=i&-1
  250.   ENDIF
  251.   @m
  252. RETURN
  253. '
  254. PROCEDURE m
  255.   IF st&>1
  256.     PRINT AT(80,2);
  257.     ~BIOS(3,5,1)
  258.   ENDIF
  259.   IF lx&<sna%
  260.     PRINT AT(80,h&+1);
  261.     ~BIOS(3,5,2)
  262.   ENDIF
  263. RETURN
  264. '
  265. FUNCTION item$(i&)
  266.   LOCAL i$,s&,c&,l&,a&
  267.   i$=sna$(i&)
  268.   s&=RINSTR(i$,".")
  269.   IF s&>0 AND s&<>LEN(i$)
  270.     i$=LEFT$(i$,s&-1)
  271.   ENDIF
  272.   c&=0
  273.   l&=0
  274.   FOR a&=st& TO i&-1
  275.     INC c&
  276.     IF c&=aw&
  277.       c&=0
  278.       INC l&
  279.     ENDIF
  280.     EXIT IF l&=h&
  281.   NEXT a&
  282.   IF l&=h&
  283.     RETURN ""
  284.   ELSE
  285.     PRINT AT(c&*10+1,l&+2);
  286.     RETURN i$
  287.   ENDIF
  288. ENDFUNC
  289. '
  290. FUNCTION lc$(a$)
  291.   LOCAL c$,c&
  292.   FOR c&=1 TO LEN(a$)
  293.     c$=MID$(a$,c&,1)
  294.     IF c$>="A" AND c$<="Z"
  295.       c$=CHR$(ASC(c$)+32)
  296.       MID$(a$,c&,1)=c$
  297.     ENDIF
  298.   NEXT c&
  299.   RETURN a$
  300. ENDFUNC
  301. '
  302. FUNCTION select
  303.   LOCAL i&,j&,f$,x$,k$
  304.   i&=st&
  305.   DO
  306.     IF i&<=sna%
  307.       x$=@item$(i&)
  308.       PRINT c3$;i$;x$;SPACE$(8-LEN(x$));n$;
  309.     ENDIF
  310.     k$=""
  311.     WHILE k$=""
  312.       k$=INKEY$
  313.       IF i&<=sna%
  314.         @f
  315.       ENDIF
  316.     WEND
  317.     IF LEN(k$)=2
  318.       k$=CHR$(ASC(RIGHT$(k$,1))+128)
  319.     ENDIF
  320.     IF k$=CHR$(&H62+128)         ! HELP: Scan for files
  321.       k$=CHR$(13)
  322.       scan!=TRUE!
  323.     ENDIF
  324.     IF k$=CHR$(&H61+128)         ! UNDO: Full Screen
  325.       h&=az%-4
  326.       @cls
  327.       @h
  328.       @display
  329.     ENDIF
  330.     IF k$=CHR$(&H52+128)         ! INSERT: Name kopieren in Eingabezeile
  331.       IF sna%>0
  332.         IF sna_inf%(i&)<>&HFF AND sna_inf%(i&)<>&H10
  333.           f$=sna$(i&)
  334.         ENDIF
  335.       ENDIF
  336.     ENDIF
  337.     IF k$=CHR$(&H47+128)         ! CLR: Eingabezeile löschen
  338.       f$=""
  339.     ENDIF
  340.     EXIT IF k$=CHR$(27) OR k$=CHR$(13) OR (k$=CHR$(&HBF) AND inmem!)
  341.     IF i&<=sna%
  342.       x$=@item$(i&)
  343.       PRINT x$;SPACE$(8-LEN(x$));
  344.       SELECT ASC(k$)
  345.       CASE 8                    ! BACKSPACE
  346.         IF f$<>""
  347.           f$=LEFT$(f$,LEN(f$)-1)
  348.         ELSE
  349.           PRINT CHR$(7);
  350.         ENDIF
  351.       CASE 32,&HCD,9            ! Cursor right, SPACE, TAB
  352.         INC i&
  353.         IF i&>lx&
  354.           IF lx&<sna%
  355.             st&=st&+aw&*h&
  356.             i&=st&
  357.             @cls
  358.             @display
  359.           ELSE
  360.             i&=st&
  361.           ENDIF
  362.         ENDIF
  363.       CASE &HCB                 ! Cursor left
  364.         DEC i&
  365.         IF i&<st&
  366.           IF st&>1
  367.             st&=MAX(st&-aw&*h&,1)
  368.             @cls
  369.             @display
  370.           ELSE
  371.             i&=lx&
  372.           ENDIF
  373.         ENDIF
  374.       CASE &HD0                 ! Cursor down
  375.         IF i&+aw&<=lx&
  376.           i&=i&+aw&
  377.         ELSE
  378.           IF lx&<sna%
  379.             st&=st&+aw&*h&
  380.             i&=st&
  381.             @cls
  382.             @display
  383.           ELSE
  384.             i&=sna%
  385.           ENDIF
  386.         ENDIF
  387.       CASE &HC8                 ! Cursor up
  388.         IF i&-aw&>=st&
  389.           i&=i&-aw&
  390.         ELSE
  391.           IF st&>1
  392.             st&=MAX(st&-aw&*h&,1)
  393.             @cls
  394.             @display
  395.             i&=MAX(1,i&-aw&)
  396.           ENDIF
  397.         ENDIF
  398.       ENDSELECT
  399.     ENDIF
  400.     IF k$>" " AND k$<="z"
  401.       IF LEN(f$)<12
  402.         f$=f$+k$
  403.         j&=@jump(f$)
  404.         IF j&>0
  405.           IF j&<st& OR j&>lx&
  406.             st&=j&
  407.             i&=j&
  408.             @cls
  409.             @display
  410.           ELSE
  411.             i&=j&
  412.           ENDIF
  413.         ENDIF
  414.       ELSE
  415.         PRINT CHR$(7);
  416.       ENDIF
  417.     ENDIF
  418.     PRINT AT(1,h&+2);c4$;"SELECTION: ";f$;i$;" ";n$;SPACE$(11);
  419.   LOOP
  420.   IF k$=CHR$(27)
  421.     RETURN -1
  422.   ENDIF
  423.   exit_key|=ASC(k$)
  424.   sname$=UPPER$(f$)
  425.   RETURN i&
  426. ENDFUNC
  427. '
  428. FUNCTION jump(x$)
  429.   LOCAL i&
  430.   IF sna%>0
  431.     ' x$=@lc$(x$)
  432.     FOR i&=1 TO sna%
  433.       EXIT IF LEFT$(sna$(i&),LEN(x$))>=x$
  434.     NEXT i&
  435.     IF i&<=sna%
  436.       RETURN i&
  437.     ENDIF
  438.   ENDIF
  439.   RETURN -1
  440. ENDFUNC
  441. '
  442. PROCEDURE f
  443.   LOCAL x$
  444.   IF (LPEEK(&H462) DIV 20)<>f_time%
  445.     f_time%=LPEEK(&H462) DIV 20
  446.     x$=@item$(i&)
  447.     fmode!=NOT fmode!
  448.     IF fmode!
  449.       VSYNC
  450.       PRINT c3$;i$;x$;SPACE$(8-LEN(x$));n$;
  451.     ELSE
  452.       VSYNC
  453.       PRINT x$;SPACE$(8-LEN(x$));
  454.     ENDIF
  455.   ENDIF
  456. RETURN
  457. '
  458. PROCEDURE i
  459.   LOCAL s$,dta%,r%,c&,d&,e&,f%
  460.   SHOWM
  461.   DEFMOUSE 2
  462.   sna%=0
  463.   r%=BIOS(10)
  464.   c&=ASC(LEFT$(spfad$,1))-ASC("A")
  465.   e&=DPEEK(&H4A6)
  466.   SELECT e&
  467.   CASE 0
  468.     f%=&X1111111111111100
  469.   CASE 1
  470.     f%=&X1111111111111101
  471.   CASE 2
  472.     f%=&X1111111111111111
  473.   DEFAULT
  474.     f%=&X1111111111111111
  475.   ENDSELECT
  476.   FOR d&=0 TO 15
  477.     IF BTST(r%,d&) AND d&<>c& AND BTST(f%,d&)
  478.       INC sna%
  479.       sna$(sna%)="["+CHR$(d&+ASC("A"))+":]"
  480.       sna_inf%(sna%)=&HFF
  481.     ENDIF
  482.   NEXT d&
  483.   dta%=GEMDOS(47)
  484.   s$=spfad$+"*.*"+CHR$(0)
  485.   r%=GEMDOS(78,L:VARPTR(s$),&H10)
  486.   WHILE r%=0
  487.     IF @valid_sna(dta%)=1
  488.       INC sna%
  489.       EXIT IF sna%>max_sna%
  490.       sna$(sna%)=CHAR{dta%+30}
  491.       sna_inf%(sna%)=BYTE{dta%+21} AND &H10
  492.       IF sna_inf%(sna%)<>&H10
  493.         sna$(sna%)=@lc$(sna$(sna%))
  494.       ENDIF
  495.     ENDIF
  496.     EXIT IF sna%>max_sna%
  497.     r%=GEMDOS(79)
  498.   WEND
  499.   IF sna%>max_sna%
  500.     DEC sna%
  501.     PRINT CHR$(7);AT(1,h&+2);"Only first ";max_sna%;" files!";
  502.   ENDIF
  503.   ' @t
  504.   HIDEM
  505. RETURN
  506. '
  507. PROCEDURE h
  508.   PRINT AT(1,h&+3);c2$;i$;spfad$;SPACE$(80);n$;
  509.   PRINT AT(1,h&+4);c1$;i$;SPACE$((w&-(LEN(t$)-1))/2);t$;SPACE$(70);n$;
  510. RETURN
  511. '
  512. PROCEDURE t
  513.   LOCAL i&,i$
  514.   FOR i&=1 TO 100
  515.     i$=STR$(i&)
  516.     i$=STRING$(3-LEN(i$),"0")+i$
  517.     INC sna%
  518.     sna$(sna%)="file"+i$+".SNA"
  519.     sna_inf%(sna%)=0
  520.   NEXT i&
  521. RETURN
  522. '
  523. FUNCTION valid_sna(d%)
  524.   LOCAL f$,x$,l%
  525.   f$=CHAR{d%+30}
  526.   IF BYTE{d%+21}=&H10
  527.     IF f$="."
  528.       RETURN 0
  529.     ENDIF
  530.     RETURN 1
  531.   ENDIF
  532.   IF INSTR(f$,".SNA")>0
  533.     RETURN 1
  534.   ENDIF
  535.   IF INSTR(f$,".SNX")>0
  536.     RETURN 1
  537.   ENDIF
  538.   l%=(BYTE{d%+26}*256+BYTE{d%+27})*65536+BYTE{d%+28}*256+BYTE{d%+29}
  539.   IF l%=49179
  540.     RETURN 1
  541.   ENDIF
  542.   IF scan!
  543.     ' Dieser Teil ist ur-langsam
  544.     IF l%<7
  545.       RETURN 0
  546.     ENDIF
  547.     @p
  548.     OPEN "i",#2,spfad$+f$
  549.     x$=INPUT$(4,#2)
  550.     CLOSE #2
  551.     IF x$="XSNA"
  552.       RETURN 1
  553.     ENDIF
  554.   ENDIF
  555.   RETURN 0
  556. ENDFUNC
  557. '
  558. PROCEDURE p
  559.   PRINT AT(1,h&+4);i$;MID$(prop$,prop&+1,1);n$;
  560.   prop&=(prop&+1) MOD 3
  561. RETURN
  562. '
  563. PROCEDURE patch(s%)
  564.   '
  565.   ' Diese Prozedur patcht GFA-Basic 3.6 Compilate, damit
  566.   ' sie wiederaufruf-fähig werden, wenn sie resident im
  567.   ' Speicher stehen (Start mit EXEC-Mode 4).
  568.   ' s% -> Startadresse TEXT-Segment im Speicher
  569.   '
  570.   DO
  571.     EXIT IF DPEEK(s%)=&H4EB9        ! JSR init
  572.     ADD s%,2
  573.   LOOP
  574.   s%=LPEEK(s%+2)                    ! init
  575.   DO
  576.     EXIT IF DPEEK(s%)=&HA000        ! nach LINE-A Initialisierung
  577.     ADD s%,2
  578.   LOOP
  579.   IF DPEEK(s%+14)=&H6100            ! BSR InitAES aus-NOPen
  580.     s%=s%+14
  581.     DPOKE s%,&H4E71
  582.     DPOKE s%+2,&H4E71
  583.   ENDIF
  584. RETURN
  585.