🚀 go-pugleaf

Received: by DJUKFA11 (Mailer X1.23b) id 9193; Thu, 07 May 87 15:10:00 MEZ
Date:         Thu, 07 May 87 15:09:47 MEZ
From:         Christian Bode <KPH017@DJUKFA11>
To:           INFO-ATARI16@SCORE.STANFORD.EDU

[INHERIT('SYS$LIBRARY:STARLET')]
program uudecode_vms (INPUT,output,infile,OUTFILE);
{ Original source pilfered from the MS-DOS turbo version on SIMTEL20}
{ Converted from Turbo to Vax-Pascal by Erik Olson, Harvey Mudd College
                                         (EOLSON@HMCVAX.BITNET)
                                         (eolson@muddcs.UUCP)
     10/86 }
{Corrected small bug for End of file -  10/15/86 eol}
{Change of optical presentation by Christian Bode KPH017@DJUKFA11.BITNET}

  CONST offset = 32;

  TYPE string80 = varying[80] of char;
       pack_128 = varying[128] of char;
       unsigned_word = [word] 0..65535;

  VAR outfile    : text;
      infile     : text;
      dummy      : packed array[1..2] of char;
      dummy_count: integer;
      lineNum    : integer;
      line       : string80;
      outidx     : integer;
      outbuf     : pack_128;
      lines      : integer;
      display    : integer;
      pasteboard : integer;
      keyboard   : integer;
      errors     : integer;
      size       : integer;
      op_mode    : string80;
      flag1,flag2: boolean;
      s_length   : integer;

FUNCTION SMG$CREATE_VIRTUAL_DISPLAY(
    ROWS, COLUMNS : INTEGER;
    VAR DISPLAY_ID : INTEGER;
    DISPLAY_ATTRIBUTES, VIDEO_ATTRIBUTES, CHAR_SET : UNSIGNED
        := %IMMED 0) : UNSIGNED; EXTERN;

FUNCTION SMG$CREATE_PASTEBOARD (
    VAR PASTEBOARD_ID : INTEGER;
    OUTPUT_DEVICE : PACKED ARRAY[A..B:INTEGER] OF CHAR:= %IMMED 0;
    ROWS, COLUMNS : INTEGER := %IMMED 0;
    PRESERVE_SCREEN_FLAG : BOOLEAN := %IMMED 0) : UNSIGNED; EXTERN;

FUNCTION SMG$CREATE_VIRTUAL_KEYBOARD (
    VAR KEYBOARD_ID : INTEGER;
    FILESPEC : PACKED ARRAY[A..B:INTEGER] OF CHAR := %IMMED 0;
    DEFAULT_FILESPEC : PACKED ARRAY [C..D:INTEGER] OF CHAR := %IMMED 0;
    RESULTANT_FILESPEC : PACKED ARRAY [E..F:INTEGER] OF CHAR := %IMMED 0
    ) : UNSIGNED; EXTERN;

FUNCTION SMG$PASTE_VIRTUAL_DISPLAY (
    DISPLAY_ID, PASTEBOARD_ID : INTEGER;
    ROW, COLUMN : INTEGER) : UNSIGNED; EXTERN;

FUNCTION SMG$UNPASTE_VIRTUAL_DISPLAY (
    DISPLAY_ID,PASTEBOARD_ID : INTEGER) : UNSIGNED; EXTERN;

FUNCTION SMG$PUT_CHARS (
    DISPLAY_ID : INTEGER;
    TEXT : PACKED ARRAY [A..B:INTEGER] OF CHAR;
    ROW : INTEGER := %IMMED 0;
    COLUMN : INTEGER := %IMMED 0;
    ERASE_FLAG, RENDITION_SET, RENDITION_COMPLEMENT : UNSIGNED := %IMMED 0;
    CHAR_SET : UNSIGNED := %IMMED 0) : UNSIGNED; EXTERN;

FUNCTION SMG$CREATE_VIRTUAL_KEYBOARD (
    VAR KEYBOARD_ID : INTEGER;
    FILESPEC : PACKED ARRAY[A..B:INTEGER] OF CHAR := %IMMED 0;
    DEFAULT_FILESPEC : PACKED ARRAY [C..D:INTEGER] OF CHAR := %IMMED 0;
    RESULTANT_FILESPEC : PACKED ARRAY [E..F:INTEGER] OF CHAR := %IMMED 0
    ) : UNSIGNED; EXTERN;

FUNCTION SMG$READ_KEYSTROKE (
    KEYBOARD_ID : INTEGER;
    VAR TERMINATOR_CODE : UNSIGNED_WORD;
    PROMPT : PACKED ARRAY[A..B:INTEGER] OF CHAR := %IMMED 0;
    TIMEOUT, DISPLAY_ID : INTEGER := %IMMED 0) : UNSIGNED; EXTERN;

Procedure Writebin(ch : char);
begin
 if op_mode='VAXBIN'
  then
   begin
    dummy[dummy_count]:=ch;
    dummy_count:=succ(dummy_count);
    if dummy_count = 3
     then
      begin
       dummy_count:=1;
       writeln(outfile,dummy);
      end;
   end
  else
   if op_mode = 'VAX'
    then
     if flag1
      then begin flag1:=false; s_length:=256*ord(ch); end
      else if flag2
            then begin s_length:=s_length+ord(ch); flag2:=false end
            else if (s_length<=outidx)
                  then
                   begin
                    writeln(outfile);
                    flag1:=false;
                    flag2:=true;
                    s_length:=ord(ch)*256;
                    outidx:=0;
                   end
                  else
                   begin
                    write(outfile,ch);
                    outidx:=outidx+1;
                   end
    else
     begin
      if outidx=128
       then
        begin
         writeln(outfile,ch);
         outidx:=0;
        end
       else
        begin
         outidx:=outidx+1;
         write(outfile,ch);
        end;
     end;
end;

  procedure Abort(message: string80);
  var line : string80;
      blank: packed array[1..48] of char;
    begin {abort}
      if message<>'Successfull.' then errors:=succ(errors);
      blank:=' ';
      if lineNum > 0
        then line:='Line '+dec(lineNum,5,1)+': '+message
        else line:=message;
      smg$put_chars(display_id:=display,row:=11,column:=13,text:=blank);
      smg$put_chars(display_id:=display,row:=10,column:=13,text:=blank);
      smg$put_chars(display_id:=display,row:=10,column:=53,
                    text:=dec(errors,5,1));
      smg$put_chars(display_id:=display,row:=11,column:=59-length(line),
                    text:=line);
    end; {Abort}

  procedure NextLine(var s: string80);

    begin {NextLine}
      smg$put_chars(display_id:=display,row:=8,column:=53,
          text:=dec(LineNum,5,1));
      LineNum := succ(LineNum);
      readln(infile, s)
    end; {NextLine}

  procedure Init;
  var outfilename : string80;

procedure trailer;
BEGIN
    SMG$CREATE_VIRTUAL_DISPLAY (ROWS:=12,COLUMNS:=60,display_id:=display,
        DISPLAY_ATTRIBUTES:=SMG$M_BORDER);
    SMG$CREATE_PASTEBOARD (PASTEBOARD_ID:=pasteboard);
    SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID:=keyboard);
    SMG$PASTE_VIRTUAL_DISPLAY(DISPLAY_ID:=DISPLAY,
        PASTEBOARD_ID:=pasteboard,ROW:=6,COLUMN:=10);
    smg$put_chars(display_id:=display,row:=2,column:=24,text:='UUDECODE V 1.5');
    smg$put_chars(display_id:=display,row:=5,column:=2,text:='Destination:');
    smg$put_chars(display_id:=display,row:=7,column:=2,text:='Filesize:');
    smg$put_chars(display_id:=display,row:=8,column:=2,text:='Lines decoded:');
    smg$put_chars(display_id:=display,row:=9,column:=2,text:='Lines short:');
    smg$put_chars(display_id:=display,row:=10,column:=2,text:='Errors:');
    smg$put_chars(display_id:=display,row:=11,column:=2,text:='Last Error:');
end;
    procedure Getinput;

      VAR inputname: string80;

      begin {Getinput}
       readln(inputname);
       open(infile,inputname,history:=old);
       reset(infile);
      end; {Getinput}

    procedure GetOutFile;

      var header, mode : string80;
          ch: char;

      procedure ParseHeader;

        VAR index: integer;

        Procedure NextWord(var word:string80; var index: integer);

          begin {nextword}
            word := '';
            while header[index] = ' ' do
              begin
                index := succ(index);
                if index > length(header) then abort ('Incomplete header')
              end;
            while header[index] <> ' ' do
              begin
                word := word+header[index];
                index := succ(index)
              end
          end; {NextWord}

        begin {ParseHeader}
          header := header+' ';
          index := 7;
          NextWord(mode, index);
          NextWord(outfilename, index)
        end; {ParseHeader}

      begin {GetOutFile}
        if eof(infile) then abort('Nothing to decode.');
        NextLine (header);
        while not ((substr(header,1,6) = 'begin ') or eof(input)) do
          NextLine(header);
        writeln;
        if eof(infile) then abort('Nothing to decode.');
        ParseHeader;
        smg$put_chars(display_id:=display,row:=5,column:=59-length(outfilename),
                      text:=outfilename);
       end; {GetOutFile}

      Procedure GetOpMode;
      begin
       readln(op_mode);
       if op_mode='BINARY'
        then begin flag1:=true; flag2:=true; outidx:=0; end
        else begin flag1:=false; flag2:=false; end;
      end;

      Procedure OpenOutFile;
      begin
       if op_mode='VAXBIN'
        then
         open(outfile, outfilename,RECORD_LENGTH:=2,Record_type:=fixed,
                       history:=new)
        else
         begin
          open(outfile,outfilename,history:=new);
          if op_mode = 'VAX'
           then
            begin flag1:=true; flag2:=true; end;
         end;
       rewrite (outfile);
      end;

    begin {init}
      lineNum := 0;
      dummy_count:=1;
      outidx:=0;
      errors:=0;
      trailer;
      Getinput;
      GetOutFile;
      GetOpMode;
      OpenOutFile;
    end; { init}

  Function CheckLine: boolean;

    begin {CheckLine}
      if line = '' then abort ('Blank line in file');
      CheckLine := not((line[1] in [' ', '`']) or (line = 'end'))
    end; {CheckLine}


  procedure DecodeLine;

    VAR lineIndex, byteNum, count, i, act_length : integer;
        chars: array [0..3] of integer;
        hunk: array [0..2] of  integer;

    function nextch: char;

      begin {nextch}
        lineIndex := succ(lineIndex);
        if lineIndex > length(line)
         then
          begin
           act_length:=length(line);
           line:=pad(line,' ',lineindex);
           lines:=lines+1;
           smg$put_chars(display_id:=display,row:=9,column:=53,
                         text:=dec(lines,5,1));
          end;
        if not (line[lineindex] in [' '..'`'])
          then abort('Illegal character in line.');
        if line[lineindex] = '`' then nextch := ' '
                                  else nextch := line[lineIndex]
      end; {nextch}

    procedure DecodeByte;

      procedure GetNextHunk;

        VAR i: integer;

        begin {GetNextHunk}
          for i := 0 to 3 do chars[i] := ord(nextch) - offset;
          hunk[0] := (chars[0] * 4) + (chars[1] div 16);
          hunk[1] := (chars[1] * 16) + (chars[2] div 4);
          hunk[2] := (chars[2] * 64) + chars[3];
          byteNum := 0
        end; {GetNextHunk}

      begin {DecodeByte}
        if byteNum = 3 then GetNextHunk;
        writebin (chr(hunk[byteNum]));
        byteNum := succ(byteNum)
      end; {DecodeByte}

    begin {DecodeLine}
      lineIndex := 0;
      byteNum := 3;
      count := (ord(nextch) - offset);
      for i := 1 to count do DecodeByte;
      size:=size+count;
      smg$put_chars(display_id:=display,row:=7,column:=53,text:=dec(size,5,1));
    end; {DecodeLine}

  procedure terminate;

    var trailer    : string80;
        TERMINATOR : UNSIGNED_WORD;
        keyboard   : integer;

    begin {terminate}
     if eof(infile)
      then abort ('Abnormal end.')
      else
       begin
        NextLine (trailer);
        if (length(trailer)<3) or (substr(trailer,1,3)<>'end')
         then abort ('Abnormal end.')
         else
          begin
           size:=size+outidx;
           smg$put_chars(display_id:=display,row:=7,column:=53,
                         text:=dec(size,5,1));
           write(outfile,outbuf);
           smg$put_chars(display_id:=display,row:=12,column:=2,
                         text:='Successfull. Please press Return');
          end;
       end;
     close (outfile);
     repeat
      smg$read_keystroke(keyboard_id:=keyboard,terminator_code:=terminator,
          display_id:=display,timeout:=1);
     until (terminator=270) or (terminator=13);
     smg$unpaste_virtual_display(display_id:=display,pasteboard_id:=pasteboard);
    end;

  begin {uudecode}
    init;
    NextLine(line);
    while CheckLine do
      begin
        DecodeLine;
        NextLine(line)
      end;
    terminate
  end.