home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 6 / AACD06.ISO / AACD / Emulation / ZXAMSpectrum / ZXAM_Rexx / Español / ListBASIC.zxam < prev    next >
Text File  |  1995-07-31  |  2KB  |  94 lines
  1. /* este script saca el listado del BASIC presente en la memoria del */
  2. /* Cpectrum y lo graba como fichero */
  3.     
  4.     /* comprobamos si el emulador está presente */
  5.     address command
  6.     
  7.     if ~show(ports,ZXAM_REXX) then do
  8.         requestchoice '>nil: title "ZXAM Script error..." body "No encuentro el puerto del emulador!!" gadgets "AARGH!"'
  9.         exit
  10.         end
  11.  
  12.     /* Almacenar el estado inicial del emulador */
  13.     running=zxamactrun()    /* 1=en marcha */
  14.     zxamstop()              /* lo paramos */
  15.  
  16.     /* debemos listar el BASIC. primero lo localizamos */
  17.     
  18.     /* dir inicio del BASIC (variable PROG) */
  19.     baselist=zxamdpeek(23635)
  20.     
  21.     /* longitud del programa BASIC (con variable VARS) */
  22.     endlist=zxamdpeek(23627)
  23.     
  24.     /* calculamos tamaño */
  25.     longbasic=endlist-baselist
  26.     if longbasic=0 then do
  27.         requestchoice '>nil: title "ZXAM Script error..." body "No hay programa BASIC!!" gadgets "AARGH!"'
  28.         exit 0
  29.         end
  30.     
  31.     /* cogemos toda el area BASIC */
  32.     bloquebasic=zxamgetmem(baselist,endlist-baselist)
  33.     
  34.     
  35.     /* pedimos el nombre y path del fichero */
  36.     oldpath=zxamactsavepath()
  37.     oldpattern=zxamactpattern()
  38.     zxampattern('#?')
  39.     nombre=zxamsaverequester('Nombre para listado BASIC...','ram:')
  40.     zxamsavepath(oldpath)
  41.     zxampattern(oldpattern)
  42.     if nombre='' then exit 0    /* pulsado el CANCEL */
  43.     
  44.     if ~open('fichero',nombre,'w') then exit 0
  45.     
  46.     oldname=zxamactname()        /* nombre actual */
  47.     oldformat=zxamactformat()    /* formato actual */
  48.     
  49.     ZXAMEnableAbort()        /* activa gadget Abort ARexx */
  50.     
  51.     do forever
  52.     
  53.     /* procesamos la linea */
  54.         
  55.         /* imprimimos numero de linea */
  56.         numlinea=c2d(left(bloquebasic,2))
  57.         dummy=writech('fichero','  'numlinea)
  58.         zxamnameformat('     Convirtiendo linea 'numlinea,'Espera...')
  59.         longline=c2d(reverse(substr(bloquebasic,3,2))) /* fomato invertido Z80 */
  60.         do i=5 to 4+longline    /* para procesar los caracteres de la linea */
  61.         if substr(bloquebasic,i,1)='0e'x then do
  62.             i=i+5
  63.             iterate
  64.             end
  65.         dummy=writech('fichero',zxambasictoken(substr(bloquebasic,i,1)))
  66.         
  67.         if zxamreadabort() then do
  68.             if oldname='' then
  69.                 zxamclearnameformat()
  70.             else
  71.                 zxamnameformat(oldname,oldformat)
  72.             exit
  73.             end
  74.         
  75.         end i
  76.         
  77.     dummy=writech('fichero','0a'x)
  78.     
  79.     bloquebasic=right(bloquebasic,length(bloquebasic)-(longline+4))
  80.     if bloquebasic='' then break
  81.     end
  82.     
  83.     dummy=close('fichero')
  84.     
  85.     if oldname='' then
  86.         zxamclearnameformat()
  87.     else
  88.         zxamnameformat(oldname,oldformat)
  89.     
  90.     /* dejar el emulador como estaba */
  91.     if running=1 then zxamrun()
  92.  
  93.     exit
  94.