home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG159.ARC / MWB2ASC.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  6KB  |  154 lines
  1. {Converts a Micro World BASIC program into a }
  2. {text file.                                  }
  3. {Written in Turbo Pascal version 3.0 on Microbee}
  4. {Written by Chris Topher Paul Gibson.        }
  5. {Commenced writing:      23/5/90             }
  6. {Finished:               27/5/90             }
  7.  
  8. const
  9.  maxsect=64;            {Buffer size}
  10.  
  11.  {array of tokens used in microworld disk basic}
  12.  
  13.  token: array[129..235] of string [9]
  14.  =('LET','LPRINT','PRINT','IF','NEW','LLIST',
  15.  'LIST','ELSE','THEN','FOR','NEXT','DIM','GOTO',
  16.  'OFF','ON','STOP','END','GOSUB','READ','DATA',
  17.  'RETURN','INPUT','RUN','RESTORE','TO','STEP',
  18.  'TAB','SPC','FN','VAR','POKE','OUT','REM',
  19.  'PRMT','ZONE','SD','CLEAR','EDIT','SET','RESET',
  20.  'SPEED','NORMAL','UNDERLINE','CSAVE','CLOAD',
  21.  'STRS','INVERSE','PCG','CURS','NOT','AND','OR',
  22.  'TRACE','CONT','CLS','HIRES','AUTO','INVERT',
  23.  'LORES','INT','IN','PEEK','USR','LEN','SEARCH',
  24.  'POINT','ERROR','POS','ASC','USED','NET','EOF',
  25.  'EDASM','GX','ABS','RND','FLT','FRE','VAL',
  26.  'FRACT','SGN','SQR','SIN','COS','ATAN','LOG',
  27.  'EXP','PLOT','DELETE','RENUM','PLAY','EXEC',
  28.  'STR','KEY','CHR','SAVE','LOAD','DIR','GRSAVE',
  29.  'GRLOAD','OPEN','CLOSE','NAME','KILL','AS',
  30.  'SYSTEM','DISKRESET');
  31.  
  32. type
  33.  NameType = string [20];
  34.  
  35. var
  36.  in_name ,            {holds name of input file}
  37.  out_name: NameType;  {holds name of output file}
  38.  in_file : file;      {Untyped input file.}
  39.  out_file: text;      {Text output file.}
  40.  progdata: array[1..maxsect,0..127] of byte;
  41.                       {big bit of MWB prog}
  42.  h,i,j,k : integer;   {General counters.}
  43.  LnNo    : real;      {Line number.}
  44.  LnNoStr : string[6]; {line number as string.}
  45.  in_byte : byte;      {One byte of program.}
  46.  end_in  : boolean;   {IndicatE end of input file}
  47.  error   ,            {Error in file detected.}
  48.  CntOnErr: boolean;   {Continue on error.}
  49.  InKey   : char;      {Can hold single key input.}
  50.  
  51. function NameFile(GivenName:NameType):NameType;
  52.  {NameFile searches file name given for extension}
  53.  {if no extension found appends .MWB to the name.}
  54.  
  55. begin {function NameFile}
  56. if pos('.',GivenName) = 0 {see if there is a '.'}
  57.   then                        {if there wasn't}
  58.    NameFile:=GivenName+'.MWB' {add one.}
  59.   else                        {otherwise}
  60.    NameFile:=GivenName        {don't}
  61. end;                          {function NameFile}
  62. function GetByte:byte;        {single byte from in_file}
  63.  begin
  64.  if i>127      {have we drained that sector}
  65.   then        {read sector if necessary}
  66.   begin
  67.    if h>k      {have we emptied our buffer?}
  68.     then
  69.     begin
  70.      end_in:=eof(in_file);             {Set that's all flag.}
  71.      k:=0;
  72.      while (k<>maxsect) and not eof(in_file) do
  73.        {while we have some file left and room}
  74.        {in buffer}
  75.      begin
  76.       k:=k+1;                          {set next buffer block}
  77.       blockread(in_file,progdata[k],1);
  78.                                        {get sector}
  79.      end;
  80.      h:=0;
  81.     end;
  82.    h:=h+1;
  83.    i:=0
  84.   end;
  85.  GetByte:=progdata[h,i];               {give value to this}
  86.  i:=i+1;                               {function}
  87. end;                                   {function GetByte}
  88.  
  89. begin                                  {Main Program}
  90. write('Convert Microworld basic into text. V1.0');
  91.  writeln;
  92.  write('Please enter name of .MWB file. ');
  93.  readln(in_name);
  94.  assign(in_file,NameFile(in_name));    {open file}
  95.  {$i-} reset(in_file) {$i+};           {see if file exists}
  96.  while ioresult<>0 do                  {while it doesn't}
  97.   begin                                {get another name}
  98.    writeln(NameFile(in_name),' not found');
  99.    write('Pleas re-enter name of file. ');
  100.    readln(in_name);
  101.    assign(in_file,NameFile(in_name));
  102.    {$i-} reset(in_file) {$i+}
  103.   end;
  104.  write('Please enter name of text output file. ');
  105.  readln(out_name);
  106.  assign(out_file,out_name);
  107.  rewrite(out_file);                    {open text file}
  108.  end_in:=false;                        {Not end of input file yet}
  109.  error:=false;                         {No error found yet}
  110.  CntOnErr:=false;                      {Don't continue on error yet}
  111.  h:=1;k:=0;                            {Sector no.}
  112.  i:=128;                               {Forces function GetByte to read sector}
  113.                                        {the first time it is called.}
  114.  in_byte:=GetByte;                     {Call it}
  115.  i:=64;                                {and ignore the first 64 bytes}
  116. LnNo:=256.0*GetByte+GetByte;           {Get 1st line number}
  117.  
  118. while not(end_in or (LnNo=65535.0))    {while not end}
  119.       and (CntOnErr or not error)
  120.  do                                    {of input file or program}
  121.   begin
  122.                                        {write line number}
  123.    str(LnNo:1:0,LnNoStr);              {convert to a string}
  124.    while length(LnNoStr)<5
  125.     do                                 {Append leadig zeros}
  126.      LnNoStr:='0'+LnNoStr;
  127.    write(out_file,LnNoStr);
  128.    for j:=3 to GetByte do              {one to end of line}
  129.     begin
  130.      in_byte:=GetByte;                 {Get a byte of program.}
  131.      if in_byte>128                    {If byte is a token}
  132.       then                             {write it as such}
  133.        write(out_file,token[in_byte])
  134.       else                             {write text}
  135.        write(out_file,char(in_byte))
  136.    end;                                {for loop}
  137.    error:=error or (GetByte<>13);      {Detect error}
  138.    if error and not CntOnErr
  139.     then                               {if error found and Continue not set.}
  140.      begin
  141.       write('Error detected in ');
  142.       write(NameFile(in_name),' Continue (Y/N) ');
  143.       read(kbd,InKey);
  144.       CntOnErr:=upcase(InKey)='Y';
  145.      end;
  146.    writeln(out_file);                  {new line}
  147.    LnNo:=GetByte*256.0+GetByte;        {next line No.}
  148.   end; {while loop}
  149. close(in_file);
  150. close(out_file);
  151. if error and not CntOnErr              {If aborted error}
  152.  then
  153.   erase(out_file)                      {then remove the rubbish}
  154. end.                                   {program}