home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug162.arc / CONVMWB.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  3KB  |  115 lines
  1. CONST
  2.   key_words: ARRAY[1..107] OF STRING =
  3.               ('LET','LPRINT','PRINT','IF','NEW','LLIST','LIST','ELSE',
  4.                'THEN','FOR','NEXT','DIM','GOTO','OFF','ON','STOP','END',
  5.                'GOSUB','READ','DATA','RETURN','INPUT','RUN','RESTORE',
  6.                'TO','STOP','TAB','SPC','FN','VAR','POKE','OUT','REM',
  7.                'PRMT','ZONE','SD','CLEAR','EDIT','SET','RESET','SPEED',
  8.                'NORMAL','UNDERLINE','CSAVE','CLOAD','STRS','INVERSE','PCG',
  9.                'CURS','NOT','AND','OR','TRACE','CONT','CLS','HIRES','AUTO',
  10.                'INVERT','LORES','INT','IN','PEEK','USR','LEN','SEARCH',
  11.                'POINT','ERROR','POS','ASC','USED','NET','MEM','EDASM',
  12.                'GX','ABS','RND','FLT','FRE','VAL','FRACT','SGN','SQR','SIN',
  13.                'COS','ATAN','LOG','EXP','PLOT','DELETE','RENUM','PLAY',
  14.                'EXEC','STR','KEY','CHR','SAVE','LOAD','DIR','GRSAVE',
  15.                'GRLOAD','OPEN','CLOSE','NAME','KILL','AS','SYSTEM',
  16.                'DISKRESET');
  17.  
  18. var
  19.   oldfile,
  20.   newfile   : text;
  21.   filename,
  22.   line      : string;
  23.   count     : integer;
  24.   more      : boolean;
  25.  
  26. function translate(old:string):string;
  27.  
  28. var
  29.    t1,t2,
  30.    temp  : integer;
  31.    new   : string;
  32.  
  33. begin
  34.  
  35.   new := ' ';
  36.   str(ord(old[2])+ord(old[1])*256,new);
  37.  
  38.   for count := 4 to length(old) do
  39.    begin
  40.      temp := ord(old[count]);
  41.      if temp > 128
  42.         then new := new + key_words[temp - 128]
  43.         else new := new + old[count];
  44.    end;
  45.    translate := new;
  46. end;
  47.  
  48. procedure read_header;
  49.  
  50.   { read the first block of code and forget it }
  51. var
  52.   count : integer;
  53.   one_char : char;
  54. begin
  55.   count := 0;
  56.   repeat
  57.     read(oldfile,one_char);
  58.     count := count + 1;
  59.   until eof(oldfile) or (count = 64);
  60. end;
  61.  
  62. procedure read_a_line(var the_line:string;var more:boolean);
  63.  
  64. var
  65.   last_char,
  66.   k,
  67.   one_char  : char;
  68.   count,
  69.   line_len  : integer;
  70.  
  71. begin
  72.    line_len := 255;
  73.    count := 0;
  74.    one_char := ' ';
  75.    the_line := '';
  76.    repeat
  77.      read(oldfile,one_char);
  78.      count := count + 1;
  79.      the_line := the_line + one_char;
  80.      if count = 3
  81.         then line_len := ord(one_char);
  82.    until (count = line_len+2) or (count > 256);
  83.    more := not((the_line[1] = chr($ff)) and (the_line[2] = chr($ff)));
  84.    if eof(oldfile) then more := false;
  85. end;
  86.  
  87. begin
  88.  
  89.    write('Enter Filename -> ');
  90.    readln(filename);
  91.  
  92.   assign(oldfile,filename+'.mwb');
  93.   assign(newfile,filename+'.asc');
  94.   reset(oldfile);
  95.   rewrite(newfile);
  96.  
  97.   read_header;
  98.  
  99.   count := 1;
  100.   read_a_line(line,more);
  101.   while more do
  102.     begin
  103.       if count = 10
  104.          then begin
  105.                count := 1;
  106.                write('*')
  107.               end
  108.          else count := count + 1;
  109.       writeln(newfile,translate(line));
  110.       read_a_line(line,more);
  111.     end;
  112.  
  113.   close(oldfile);
  114.   close(newfile);
  115.  end.