home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 6 / AACD06.ISO / AACD / Emulation / ZXAMSpectrum / ZXAM_Rexx / English / ListBASIC.zxam < prev    next >
Text File  |  1995-07-31  |  2KB  |  95 lines
  1. /* this script saves the ASCII listing of the BASIC program inside the */ 
  2. /* Spectrum's memory */
  3.     
  4.     /* test if emulator is present */
  5.     address command
  6.     
  7.     if ~show(ports,ZXAM_REXX) then do
  8.         requestchoice '>nil: title "ZXAM Script error..." body "I can''t find the emulator''s port!!" gadgets "AARGH!"'
  9.         exit
  10.         end
  11.  
  12.     /* store the initial status of the emulator */
  13.     running=zxamactrun()    /* 1=running */
  14.     zxamstop()              /* stop the emulation */
  15.  
  16.     /* locate the BASIC listing */
  17.     
  18.     /* start of BASIC */
  19.     baselist=zxamdpeek(23635)
  20.     
  21.     /* end of BASIC */
  22.     endlist=zxamdpeek(23627)
  23.     
  24.     /* length of BASIC */
  25.     longbasic=endlist-baselist
  26.     if longbasic=0 then do
  27.         requestchoice '>nil: title "ZXAM Script error..." body "No BASIC program in memory!!" gadgets "AARGH!"'
  28.         exit 0
  29.         end
  30.     
  31.     /* get all the BASIC block */
  32.     bloquebasic=zxamgetmem(baselist,endlist-baselist)
  33.     
  34.     
  35.     /* ask for path&name */
  36.     oldpath=zxamactsavepath()
  37.     oldpattern=zxamactpattern()
  38.     zxampattern('#?')
  39.     nombre=zxamsaverequester('Name for BASIC listing...','ram:')
  40.     zxamsavepath(oldpath)
  41.     zxampattern(oldpattern)
  42.     if nombre='' then exit 0    /* CANCEL */
  43.     
  44.     if ~open('fichero',nombre,'w') then exit 0
  45.     
  46.     /* old window status */
  47.     oldname=zxamactname()
  48.     oldformat=zxamactformat()
  49.     
  50.     ZXAMEnableAbort()        /* enables 'Abort ARexx' gadget */
  51.     
  52.     do forever
  53.     
  54.     /* process a line */
  55.         
  56.         /* print line number */
  57.         numlinea=c2d(left(bloquebasic,2))
  58.         dummy=writech('fichero','  'numlinea)
  59.         zxamnameformat('     Converting line 'numlinea,'Wait...')
  60.         longline=c2d(reverse(substr(bloquebasic,3,2))) /* reversed Z80 format */
  61.         do i=5 to 4+longline    /* to process the line chars */
  62.         if substr(bloquebasic,i,1)='0e'x then do
  63.             i=i+5
  64.             iterate
  65.             end
  66.         dummy=writech('fichero',zxambasictoken(substr(bloquebasic,i,1)))
  67.         
  68.         if zxamreadabort() then do
  69.             if oldname='' then
  70.                 zxamclearnameformat()
  71.             else
  72.                 zxamnameformat(oldname,oldformat)
  73.             exit
  74.             end
  75.         
  76.         end i
  77.         
  78.     dummy=writech('fichero','0a'x)
  79.     
  80.     bloquebasic=right(bloquebasic,length(bloquebasic)-(longline+4))
  81.     if bloquebasic='' then break
  82.     end
  83.     
  84.     dummy=close('fichero')
  85.     
  86.     if oldname='' then
  87.         zxamclearnameformat()
  88.     else
  89.         zxamnameformat(oldname,oldformat)
  90.     
  91.     /* restore the status */
  92.     if running=1 then zxamrun()
  93.  
  94.     exit
  95.