home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / apps / misc / zx_sp207 / source / spshell.gfa (.txt) < prev    next >
GFA-BASIC Atari  |  1993-06-29  |  8KB  |  359 lines
  1. ' ###################################################
  2. ' ZX-SPECTRUM EMULATOR SHELL 3/93  C. Gandler
  3. '
  4. ' This is only thought as demonstration what can
  5. ' be done, and HOW it can be done.
  6. '
  7. ' Feel free to modify and extend !
  8. ' ###################################################
  9. $m20000
  10. $C+
  11. $B+
  12. $E$
  13. '
  14. ' ## INLINE:
  15. ' $0000: 48 79 00 00 00 1e 2f 08 48 79 00 00 00 1e 3f 3c 
  16. ' $0010: 00 04 3f 3c 00 4b 4e 41 4f ef 00 10 4e 75 00 00 
  17. ' $0020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 
  18. ' $0030: 00 00 
  19. ' 50  Bytes.
  20. INLINE exe%,50
  21. ' ## INLINE:
  22. ' $0000: 00 00 
  23. ' 2  Bytes.
  24. INLINE inst%,2
  25. '
  26. test&=0        ! Test-Switch, set to 1 to test with Interpreter
  27. IF test&=1
  28.   RESERVE 20000
  29. ENDIF
  30. maxtool%=7
  31. '
  32. ' When the shell is executed from desktop, it terminates, after
  33. ' issuing a request to load SPECCI.DAT afterwards.
  34. '
  35. smode|=0
  36. IF BYTE{BASEPAGE+129}<>189 AND test&=0
  37.   IF SHEL_READ(ownpath$,cmd$)=0
  38.     ownpath$=""
  39.   ENDIF
  40.   cmd$=CHAR{BASEPAGE+129}
  41.   IF cmd$<>""
  42.     cmd$=cmd$+" "
  43.   ENDIF
  44.   cmd$=cmd$+"/s"+ownpath$
  45.   ~SHEL_WRITE(1,1,1,CHR$(LEN(cmd$))+cmd$,"SPECCI.DAT")
  46.   '
  47.   ' If called from SPECCI.DAT the commandline is saved and scanned
  48.   '
  49. ELSE
  50.   IF test&=0
  51.     cmd$=CHAR{BASEPAGE+128}
  52.     FOR j&=0 TO 6
  53.       x$=""
  54.       FOR i&=0 TO 7
  55.         x$=x$+CHR$(BYTE{BASEPAGE+130+j&*8+i&})
  56.       NEXT i&
  57.       x%=VAL("&h"+x$)
  58.       SELECT j&
  59.       CASE 0
  60.         setup%=x%+8             ! Adress of setup-patch-area
  61.       CASE 1
  62.         zxpage%=x%              ! Adress of the ZX-Page whithin emulator
  63.       CASE 2
  64.         zxregs%=x%              ! Adress of the Z80-register-structure
  65.       CASE 3
  66.         sstore%=x%              ! Adress of emulator-screen-buffer
  67.       CASE 4
  68.         sup_ret%=x%             ! Adress for return-value(s)
  69.       CASE 5
  70.         setnr%=x%               ! Number of active set (0..3)
  71.       CASE 6
  72.         specci%=x%              ! Adress, where to call the emulator
  73.       ENDSELECT
  74.     NEXT j&
  75.     smode|=BYTE{zxregs%-13}     ! Called in Shell-Mode?
  76.   ENDIF
  77.   '
  78.   IF smode|
  79.     CLS
  80.     PRINT
  81.     PRINT "ZX-SPECTRUM EMULATOR SHELL V1.00"
  82.     PRINT "(c) 1993 by Christian Gandler"
  83.     PRINT
  84.     PRINT "Wait, emulator beeing initialized..."
  85.     PRINT
  86.     @fm
  87.   ELSE
  88.     IF BYTE{inst%}=0 AND test&=0
  89.       @patch(BASEPAGE+256)
  90.     ELSE
  91.       V~H=V_OPNVWK(XBIOS(4)+2)
  92.     ENDIF
  93.   ENDIF
  94.   BYTE{inst%}=1
  95.   '
  96.   DIM resbp%(maxtool%)
  97.   DIM tool$(maxtool%)
  98.   DIM tmen$(maxtool%)
  99.   DIM fpal&(maxtool%)
  100.   DIM keys&(maxtool%)
  101.   DIM palette&(16)
  102.   anzres%=0
  103.   IF EXIST("SPSHELL.INF")
  104.     OPEN "i",#2,"SPSHELL.INF"
  105.     WHILE NOT EOF(#2)
  106.       EXIT IF anzres%=maxtool%
  107.       INPUT #2,n$
  108.       EXIT IF n$="***"
  109.       INPUT #2,t$,rf&,fp&,key&
  110.       IF smode|=0
  111.         rf&=0
  112.       ENDIF
  113.       IF rf& AND MALLOC(-1)>200000
  114.         t%=MALLOC(MALLOC(-1)-200000)
  115.         bp%=EXEC(3,n$,cmd$,"")
  116.         IF t%>0
  117.           ~MFREE(t%)
  118.         ENDIF
  119.         IF bp%>0
  120.           PRINT n$;" is resident."
  121.           ' @bpi(bp%)
  122.           INC anzres%
  123.           resbp%(anzres%)=bp%
  124.           tool$(anzres%)=n$
  125.           tmen$(anzres%)=t$
  126.           fpal&(anzres%)=fp&
  127.           keys&(anzres%)=key&
  128.         ELSE
  129.           PRINT "Error ";INT(bp%);" loading ";n$;"."
  130.           REPEAT
  131.           UNTIL INKEY$<>""
  132.         ENDIF
  133.         @fm
  134.       ELSE
  135.         INC anzres%
  136.         resbp%(anzres%)=-1
  137.         tool$(anzres%)=n$
  138.         tmen$(anzres%)=t$
  139.         fpal&(anzres%)=fp&
  140.         keys&(anzres%)=key&
  141.       ENDIF
  142.     WEND
  143.     CLOSE #2
  144.   ENDIF
  145.   FOR i&=0 TO 15
  146.     palette&(i&)=DPEEK(&HFF8240+2*i&)
  147.   NEXT i&
  148.   RESTORE exedat
  149.   x%=exe%
  150.   DO
  151.     READ r%
  152.     EXIT IF r%=&HFFFF
  153.     DPOKE x%,r%
  154.     ADD x%,2
  155.   LOOP
  156.   DIM reg%(16)
  157.   '
  158.   @make_bar
  159.   '
  160.   DO
  161.     exit&=0
  162.     DO
  163.       IF test&=1 OR smode|=0
  164.         r%=1
  165.       ELSE
  166.         r%=C:specci%()
  167.       ENDIF
  168.       EXIT IF r%=0
  169.       FOR i&=1 TO anzres%
  170.         IF r%=SHR(keys&(i&),8)
  171.           exit&=i&
  172.         ENDIF
  173.       NEXT i&
  174.       IF exit&=0
  175.         ~FORM_DIAL(3,0,0,0,0,0,0,WORK_OUT(0),WORK_OUT(1))
  176.         moff&=0
  177.         SHOWM
  178.         DEFMOUSE 0
  179.         ON MENU KEY GOSUB mkey
  180.         ON MENU GOSUB menu
  181.         MENU bar$()
  182.         DO
  183.           ON MENU 1000
  184.           EXIT IF moff&<>0 OR exit&<>0
  185.         LOOP
  186.         MENU OFF
  187.         MENU KILL
  188.       ENDIF
  189.       IF smode|=0 AND test&=0
  190.         IF moff&
  191.           exit&=99
  192.         ELSE
  193.           IF exit&=99
  194.             WORD{sup_ret%}=1
  195.           ENDIF
  196.         ENDIF
  197.       ENDIF
  198.       EXIT IF exit&<>0
  199.     LOOP
  200.     EXIT IF exit&=99 OR r%=0
  201.     @swp
  202.     bp%=resbp%(exit&)
  203.     IF bp%=-1
  204.       ~EXEC(0,tool$(exit&),cmd$,"")
  205.     ELSE
  206.       reg%(8)=bp%
  207.       CHAR{bp%+128}=cmd$
  208.       RCALL exe%,reg%()
  209.       @patch(bp%+256)
  210.     ENDIF
  211.     @swp
  212.     EXIT IF smode|=0 AND test&=0
  213.   LOOP
  214. ENDIF
  215. IF test&=1
  216.   RESERVE
  217. ENDIF
  218. END
  219. '
  220. PROCEDURE swp
  221.   LOCAL r%,t%
  222.   IF fpal&(exit&)
  223.     FOR r%=0 TO 15
  224.       t%=palette&(r%)
  225.       palette&(r%)=DPEEK(&HFF8240+r%*2)
  226.       SDPOKE &HFF8240+r%*2,t%
  227.     NEXT r%
  228.   ENDIF
  229. RETURN
  230. '
  231. PROCEDURE patch(s%)
  232.   '
  233.   ' Diese Prozedur patcht GFA-Basic 3.6 Compilate, damit
  234.   ' sie wiederaufruf-fähig werden, wenn sie resident im
  235.   ' Speicher stehen (Start mit EXEC-Mode 4).
  236.   ' s% -> Startadresse TEXT-Segment im Speicher
  237.   '
  238.   DO
  239.     EXIT IF DPEEK(s%)=&H4EB9        ! JSR init
  240.     ADD s%,2
  241.   LOOP
  242.   s%=LPEEK(s%+2)                    ! init
  243.   DO
  244.     EXIT IF DPEEK(s%)=&HA000        ! nach LINE-A Initialisierung
  245.     ADD s%,2
  246.   LOOP
  247.   IF DPEEK(s%+14)=&H6100            ! BSR InitAES aus-NOPen
  248.     s%=s%+14
  249.     DPOKE s%,&H4E71
  250.     DPOKE s%+2,&H4E71
  251.   ENDIF
  252. RETURN
  253. '
  254. PROCEDURE mkey
  255.   LOCAL i&,m&
  256.   m&=MENU(14)
  257.   IF BYTE(m&)=27
  258.     moff&=1
  259.   ENDIF
  260.   FOR i&=1 TO anzres%
  261.     IF m&=keys&(i&)
  262.       exit&=i&
  263.     ENDIF
  264.   NEXT i&
  265. RETURN
  266. '
  267. PROCEDURE menu
  268.   LOCAL m&,f&,x%,y%,w%,h%,t%,dia%
  269.   m&=MENU(0)
  270.   IF m&>=tools%
  271.     exit&=m&-tools%+1
  272.   ELSE
  273.     SELECT m&
  274.     CASE 1
  275.       f&=0
  276.       IF RSRC_LOAD("SPECCI.RSC")
  277.         f&=1
  278.         IF XBIOS(4)=2
  279.           t%=0
  280.         ELSE
  281.           t%=1
  282.         ENDIF
  283.         ~RSRC_GADDR(0,t%,dia%)
  284.         ~FORM_CENTER(dia%,x%,y%,w%,h%)
  285.         ~OBJC_DRAW(dia%,0,7,x%,y%,w%,h%)
  286.         ~FORM_DO(dia%,0)
  287.         ~RSRC_FREE()
  288.         ~FORM_DIAL(3,0,0,0,0,0,0,WORK_OUT(0),WORK_OUT(1))
  289.       ENDIF
  290.       IF f&=0
  291.         ALERT 1,"* ZX-SPECTRUM EMULATOR SHELL *|    V1.0 - Demo, (c) 1993| |   by Christian Gandler",1," OK ",q&
  292.       ENDIF
  293.       MENU OFF
  294.     CASE 11
  295.       moff&=1
  296.     CASE 13
  297.       exit&=99
  298.     DEFAULT
  299.       MENU OFF
  300.     ENDSELECT
  301.   ENDIF
  302. RETURN
  303. '
  304. PROCEDURE fm
  305.   PRINT MALLOC(-1);" Bytes of free memory"
  306. RETURN
  307. '
  308. PROCEDURE bpi(x%)
  309.   PRINT "TEXT=";LONG{x%+12};", DATA=";LONG{x%+20};", BSS=";LONG{x%+28}
  310. RETURN
  311. '
  312. PROCEDURE make_bar
  313.   LOCAL i&,j&
  314.   DIM bar$(60)
  315.   RESTORE bar
  316.   FOR i&=0 TO 60
  317.     READ bar$(i&)
  318.     EXIT IF bar$(i&)="***"
  319.   NEXT i&
  320.   tools%=i&
  321.   IF anzres%=0
  322.     DEC i&
  323.   ELSE
  324.     FOR j&=1 TO anzres%
  325.       bar$(i&)=tmen$(j&)
  326.       INC i&
  327.     NEXT j&
  328.   ENDIF
  329.   bar$(i&)=""
  330. RETURN
  331. '
  332. bar:
  333. DATA SPECCI,  About...  ,---------------------,1,2,3,4,5,6,
  334. DATA Options,  ⇨ Emulator,-------------------,  Quit to desktop  ,
  335. DATA Tools
  336. DATA ***
  337. '
  338. exedat:
  339. DATA &H4879,&H0000,&H001E
  340. '                           pea nullstrg
  341. DATA &H2F08
  342. '                           move.l a0,-(sp)
  343. DATA &H4879,&H0000,&H001E
  344. '                           pea nullstrg
  345. DATA &H3F3C,&H0004
  346. '                           move.w #4,-(sp)
  347. DATA &H3F3C,&H004B
  348. '                           move.w #pexec,-(sp)
  349. DATA &H4E41
  350. '                           trap #gemdos
  351. DATA &H4FEF,&H0010
  352. '                           lea 16(sp),sp
  353. DATA &H4E75
  354. '                           rts
  355. DATA &H0000
  356. '                 nullstrg: dc.b 0
  357. DATA &HFFFF
  358. '                           (Endmark)
  359.