# To unbundle, sh this file
echo jcon.pas 1>&2
tail +2 >jcon.pas <<'End of jcon.pas'
################################################################
program jet_8801_documentfile_convertor;

(*

    JET-8801 --> CP/M-80 document file convertor

    revision history
        1.0: Oct. ??, 1987 by Dai ISHIJIMA
        2.0: Nov. 29, 1987

*)

const
  SPT      = 63;        { sectors par track }
  JET_DRV  = 1;         { drive B: }
  DIR_TRK  = 0;         { track of directory }
  DIR_STT  = 32;        { start sector of directory }
  DIR_END  = 47;        { end sector of directory }
  NAM_LEN  = 17;        { filename length }
  NO_PASS  = 6;         { No password flag }
  MAXSLOTS = 63;        { Maximum size of directory entry }
  ENDMARK  = #13;
  ERRMSG1  = 'ドライブＢにＪＥＴの文書ディスケットを入れてください。';
  ERRMSG2  = 'ドライブＢの文書ディスケットに該当文書はありません。';
  USGMSG1  = '使いかた: ';
  USGMSG2  = ' [ -n -c -s -0 ] ファイル名';
  HELPMSG1 = '-n  JIS -> SHIFT JIS変換をしません。';
  HELPMSG2 = '-c  半角のヌル文字を無視します。';
  HELPMSG3 = '-s  ０桁目を無視します。';
  HELPMSG4 = '-0  ０桁目のヌル文字を無視します。';
  SUPERSUB: array[0..15] of char = '0123456789(+)-./';
  YES      = TRUE;
  NO       = FALSE;

type
  str255 = string[255];
  dskbuf = array[0..127] of byte;
  slot   = record
             filmod: byte;
             filnam: array[1..17] of char;
             enpass: byte;
             tateyo: byte;
             doclen: integer;
             passwd: integer;
             psleft: byte;
             psrigt: byte;
             undlin: char;
             ltmarg: byte;
             chrspc: byte;
             linspc: byte;
             strack: byte;
             ssectr: byte;
           end;
  slots  = array[0..MAXSLOTS] of slot;

var
  secbuf: dskbuf;
  dirbuf: slots;
  jisflag: boolean;
  ignornull: boolean;  { ignore half null charactor }
  icolumn0: boolean;   { ignore column 0 }
  icol0null: boolean;  { ignore null charactor on column 0 }

{$I stdio.lib}
{$I diskio.lib}
{$I kanjicod.lib}


(* check document disk *)
function checkdisk: boolean;

  const
    ID_TRK = 0;
    ID_SEC = 3;
    ID_BYTE = $70;
    DOC_DSK = 'F';

  var secbuf: dskbuf;

  begin
    readsec(secbuf, JET_DRV, ID_TRK, ID_SEC);
    if chr(secbuf[ID_BYTE]) = DOC_DSK then
      checkdisk := YES
    else
      checkdisk := NO;
  end; { of checkdisk }


(* read directory *)
procedure readdir;

  var
    i: integer;

  begin
    for i := DIR_STT to DIR_END do
      readsec(dirbuf[(i - DIR_STT) * 4], JET_DRV, DIR_TRK, i);
  end; { of readdir }


(* display directory *)
procedure directory;

  var
    i, j, n: integer;

  begin
    n := 0;
    for i := 0 to MAXSLOTS do
      begin
        with dirbuf[i] do
          begin
            if (filmod = NO_PASS) and (filnam[1] <> ENDMARK) then
              begin
                n := n + 1;
                j := 1;
                write(stdout, n :2, ':');
                while (filnam[j] <> ENDMARK) and (j <= NAM_LEN) do
                  begin
                    write(stdout, filnam[j]);
                    j := j + 1;
                  end;
                while (j <= NAM_LEN) do
                  begin
                    write(stdout, ' ');
                    j := j + 1;
                  end;
                write(stdout, '  ');
                if (n mod 3) = 0 then writeln(stdout);
              end;
          end; { of with }
      end;
  end; { of directory }


(* convert document file *)
procedure convert(name: str255);

  var
    i, track, sector, fillen: integer;
    j, k, c, h, l: integer;
    found: boolean;

  function hankaku(c: integer): char;

    begin
      if (c = 0) or (c = $20) then
        hankaku := ' '
      else if c < $20 then
        hankaku := SUPERSUB[c and $f]
      else
        hankaku := chr(c);
    end; { of hankaku }


  begin
    val(name, k, j);
    if j <> 0 then
      k := MAXSLOTS;
    i := 0;
    j := 0;
    found := NO;
    while (i <= MAXSLOTS) and (not found) do
      begin
        with dirbuf[i] do
          begin
            if filmod = NO_PASS then
              begin
                j := j + 1;
                if (j = k) or (name = copy(filnam, 1,
                                      pos(ENDMARK, filnam) - 1))
                then
                  found := YES;
              end;
          end; { of with }
        i := i + 1;
      end; { of while }
    if not found then
      error(name + ': ' + ERRMSG2);
    with dirbuf[i - 1] do
      begin
        track := strack div 2;
        sector := ((ssectr - 1) * 2 + (strack mod 2) * 32);
        fillen := doclen div 128;
      end;
    for i := 0 to fillen - 1 do
      begin
        readsec(secbuf, JET_DRV, track, sector);
        sector := sector + 1;
        if sector > SPT then
          begin
            sector := 0;
            track := track + 1;
          end;
        k := 62;
        while (k > 0) and ((secbuf[k * 2] = 0) and (secbuf[k * 2 + 1] = 0))  do
          k := k - 1;
        for j := 0 to k do
          begin
            h := secbuf[j * 2];
            l := secbuf[j * 2 + 1] and $7f;
            c := h + l * 256;
            if (h and $80) <> 0 then
              begin
                h := h and $7f;
                write(stdout, hankaku(h));
                write(stdout, hankaku(l));
              end
            else
              begin
                if (c = $2121) or (c = 0) then
                  write(stdout, '  ')
                else
                  begin
                    c := toshift(c);
                    write(stdout, chr(hi(c)), chr(lo(c)));
                  end;
              end;
          end;
        writeln(stdout);
      end;
  end; { of convert }


begin
  openstd;
  if checkdisk <> YES then
    error(ERRMSG1);
  readdir;
  if argc = 0 then
    directory
  else
    convert(argv(1));
  closestd;
end.
End of jcon.pas
################################################################
echo stdio.lib 1>&2
tail +2 >stdio.lib <<'End of stdio.lib'
################################################################
(*

    standard i/o library   (C) by Dai ISHIJIMA

    revision history
        1.0: Dec. 25, 1986 ( 1st version: "redirect.inc" )
        2.0: Jan. 20, 1987
        2.2: Feb. 18, 1987
        3.0: Mar.  7, 1987
        3.1: Mar. 11, 1987
        3.2: Apr.  5, 1987
        3.3: Nov. 13, 1987
        4.0:

    usage: {$I stdio.inc}

    CAUTION !!!
        You must write "openstd;" on the first line
        of your program.

    procedures and functions
        error(s: string);
        openf(var filvar: text;  filename: string; mode: char);
        exist(filename: string): boolean;
        chgname(oldname, newname: string);
        parmcnt: integer;
        parmstr(i: integer): integer;
        openstd;
        closestd;
        argc: integer;
        argv(i: integer): string;

*)

type
  _string = string[255];

var
  stdin:  text; { standard input file }
  stdout: text; { standard output file }
  stderr: text;
  cmdlin: _string;
  argstr: _string;


(* file already exists on the disk? *)
function exist(filename: _string): boolean;

  var
    filvar: file;

  begin
    assign(filvar, filename);
    {$I-}
    reset(filvar);
    {$I+}
    if ioresult = 0 then
      exist := TRUE
    else
      exist := FALSE;
  end; { of exist }


(* exit to CP/M sytem *)
procedure exit(exitcode: integer);

  const
    BATFILE = '$$$.SUB';

  var
    f: file;

  begin
    if (exitcode <> 0) and (exist(BATFILE)) then
      begin
        assign(f, BATFILE);
        erase(f);
      end;
    halt;
  end; { of exit }


(* write error message on console & return CP/M *)
procedure error(s: _string);

  begin
    writeln(CON, s);
    exit(1);
  end; { of error }


(* open file *)
procedure openf(var filvar: text;  filename: _string; mode: char);

  const
    F_READ  = 'R';
    F_WRITE = 'W';

  begin
    assign(filvar, filename);
    {$I-}
    case upcase(mode) of
      F_READ:  reset(filvar);
      F_WRITE: rewrite(filvar);
    end;
    {$I+}
    if ioresult <> 0 then
      error(filename + ': Can''t open. ');
  end; { of openf }


(* rename file *)
procedure chgname(oldname, newname: _string);

  var
    oldfile, newfile: file;

  begin
    assign(oldfile, oldname);
    if exist(newname) then
      begin
        assign(newfile, newname);
        erase(newfile);
      end;
    rename(oldfile, newname);
  end; { of chgname }


(* get a number of parameters *)
function parmcnt: integer;

  var
    count, i: integer;
    inword: boolean;

  begin
    count := 0;
    inword := FALSE;
    for i := 1 to length(cmdlin) do
      begin
        if cmdlin[i] = ' ' then
          inword := FALSE
        else
          begin
            if inword = FALSE then
              count := count + 1;
            inword := TRUE
          end;
      end;
    parmcnt := count - 1;
  end; { of parmcnt }


(* get parameters *)
function parmstr(i: integer): _string;

  var
    j, k, m: integer;

  begin
    if (i < 0) or (parmcnt < i) then
      parmstr := ''
    else
      begin
        k := 1;
        while cmdlin[k] = ' ' do
          k := k + 1;
        for j := 1 to i do
          begin
            while cmdlin[k] <> ' ' do
              k := k + 1;
            while cmdlin[k] = ' ' do
              k := k + 1;
          end;
        m := 0;
        while (cmdlin[k + m] <> ' ') and ((m + k) <= length(cmdlin)) do
          m := m + 1;
        parmstr := copy(cmdlin, k, m);
      end;
  end; { of parmstr }


(* open stdio & get command line parameters *)
procedure openstd;

  const
    OLDEXT = '.BAK';

  var
    infile:   _string;
    outfile:  _string;
    append:   _string;
    prim:     _string;
    second:   _string;

  (* get command line from CCP *)
  procedure getcmdlin;

    const
      OFFSET = 8;

    var
      i: integer;
      ch: char;

    function ccpadr: integer;

      const
        BIAS = $1600;

      begin
        ccpadr := mem[2] * 256 - BIAS;
      end; { of ccpadr }


    (* main of getcmdlin *)
    begin
      i := ccpadr + OFFSET;
      while mem[i] = ord(' ') do
        i := i + 1;
      while (mem[i] <> ord(' ')) and (mem[i] <> 0) do
        i := i + 1;
      while mem[i] = ord(' ') do
        i := i + 1;
      if (paramcount > 0) and (chr(mem[i]) <> copy(paramstr(1), 1, 1)) then
        begin
          cmdlin := 'Turbo-PASCAL';
          for i := 1 to paramcount do
            cmdlin := cmdlin + ' ' + paramstr(i);
        end
      else
        begin
          cmdlin := '';
          i := ccpadr + OFFSET;
          ch := chr(mem[i]);
          while ch <> chr(0) do
            begin
              cmdlin := cmdlin + ch;
              i := i + 1;
              ch := chr(mem[i]);
            end;
        end;
    end; { of getcmdlin }


  (* pipe line *)
  procedure pipe;

    const
      PIPEMARK = '|';
      BATFILE  = 'a:$$$.sub';
      TMPFIL1  = '%pipe00';
      TMPFIL2  = '.$$$';
      ERACMD   = 'era ';

    type
      nfile  = file;

    var
      fp: nfile;
      i: integer;


      (* open subfile *)
      procedure subopen(var filvar: nfile);

        begin
          assign(filvar, BATFILE);
          rewrite(filvar);
        end; { of subopen }


      (* get number of pipeline *)
      function pipecnt: integer;

        var
          i, cnt: integer;

        begin
          cnt := 0;
          for i := 1 to length(cmdlin) do
            begin
              if cmdlin[i] = PIPEMARK then
                cnt := cnt + 1;
            end;
          pipecnt := cnt;
        end; { of pipecnt }


      (* get command string *)
      function getcmd(n: integer): _string;

        var
          i, j: integer;
          work: _string;

        begin
          i := 1;
          for j := 1 to n - 1 do
            begin
              while cmdlin[i] <> PIPEMARK do
                i := i + 1;
              i := i + 1;
            end;
          while cmdlin[i] = ' ' do
            i := i + 1;
          work := '';
          while (cmdlin[i] <> PIPEMARK) and (i <= length(cmdlin)) do
            begin
              work := work + cmdlin[i];
              i := i + 1;
            end;
          getcmd := work;
        end; { of getcmd }


      (* get tempolary file name *)
      function tempname(i: integer): _string;

        begin
          tempname := TMPFIL1 + chr(i + ord('0') ) + TMPFIL2;
        end; { of tempname }


      (* write to subfile *)
      procedure writef(var filvar: nfile; s: _string);

        const
          BUFLEN = 127;

        var
          buffer: array[0..BUFLEN] of char;
          i: integer;

        begin
          buffer[0] := chr(length(s));
          for i := 1 to length(s) do
            buffer[i] := s[i];
          buffer[length(s) + 1] := chr(0);
          for i := length(s) + 2 to BUFLEN do
            buffer[i] := chr($1A);
          blockwrite(filvar, buffer, 1);
        end; { of writef }


    (* main of pipe *)
    begin
      if pipecnt > 0 then
        begin
          subopen(fp);
          writef(fp, ERACMD + tempname(pipecnt));
          if getcmd(pipecnt + 1) = '' then
            error('Invalid null command')
          else
            writef(fp, getcmd(pipecnt + 1) + ' <' + tempname(pipecnt) );
          for i := pipecnt downto 2 do
            begin
              writef(fp, ERACMD + tempname(i - 1) );
              writef(fp, getcmd(i) + ' <'+tempname(i - 1) + ' >' + tempname(i));
            end;
          close(fp);
          cmdlin := getcmd(1) + ' >' + tempname(1);
        end;
    end; { of pipe }


  (* get file name of backup file *)
  function backname(filename: _string): _string;

    var
      i, j: integer;

    begin
      i := pos(':', filename);
      j := pos('.', filename);
      if j = 0 then
        begin
          backname := copy(filename, 1, i + 8) + OLDEXT;
        end
      else
        begin
          backname := copy(copy(filename, 1, j - 1), 1, i + 8) + OLDEXT;
        end;
    end; { of getname }


  (* get open mode *)
  function openmode(s: _string): char;

    begin
      if s[1] = '<' then
        openmode := 'r'
      else if (s[1] = '>') and (s[2] <> '>') and (s[2] <> '<') then
        openmode := 'w'
      else if (s[1] = '>') and (s[2] = '>') then
        openmode := 'a'
      else
        openmode := 'n';
    end; { of openmode }


  (* check command line *)
  procedure checkargs;

    var
      i, j: integer;
      mode: char;
      s:    _string;

    begin
      i := 1;
      while i <= parmcnt do
        begin
          s := parmstr(i);
          mode := openmode(s);
          if openmode(s) <> 'n' then
            begin
              j := 1;
              while (s[j] = '<') or (s[j] = '>') do
                j := j + 1;
              delete(s, 1, j - 1);
              if s = '' then
                begin
                  i := i + 1;
                  s := parmstr(i);
                end;
              case mode of
                'r': begin
                       infile := s;
                     end;
                'w': begin
                       outfile := s;
                       append := '';
                     end;
                'a': begin
                       outfile := '';
                       append := s;
                     end;
              end; { of case }
            end
          else
            argstr := argstr + ' ' + s;
          i := i + 1;
        end;
    end; { of checkargs }


  (* file copy for append *)
  procedure filcopy(filename: _string);

    var
      sourcef: text;
      ch: char;

    begin
      openf(sourcef, filename, 'r');
      while not eof(sourcef) do
        begin
          read(sourcef, ch);
          write(stdout, ch);
        end;
    end; { of filcopy }


  (* openstd main *)
  begin
    getcmdlin;
    pipe;
    argstr := parmstr(0);
    infile := 'TRM:';
    outfile := 'CON:';
    append := '';
    checkargs;
    openf(stderr, 'CON:', 'w');
    if infile = outfile then
      begin
        chgname(infile, backname(infile));
        infile := backname(infile);
      end;
    openf(stdin, infile, 'r');
    if outfile <> '' then
      begin
        if exist(outfile) then
          begin
            chgname(outfile, backname(outfile));
          end;
        openf(stdout, outfile, 'w');
      end
    else if append <> '' then
      begin
        if exist(append) then
          begin
            chgname(append, backname(append));
            openf(stdout, append, 'w');
            filcopy(backname(append));
          end
        else
         openf(stdout, append, 'w');
      end;
  end; { of openstd }


(* close stdin, stdout, stderr *)
procedure closestd;

  begin
    close(stdin);
    close(stdout);
    close(stderr);
  end;


(* get a number of args *)
function argc: integer;

  var
    count, i: integer;
    inword: boolean;

  begin
    count := 0;
    inword := FALSE;
    for i := 1 to length(argstr) do
      begin
        if argstr[i] = ' ' then
          inword := FALSE
        else
          begin
            if inword = FALSE then
              count := count + 1;
            inword := TRUE;
          end;
      end;
    argc := count - 1;
  end; { of argc }


(* get arg *)
function argv(i: integer): _string;

  var
    j, k, m: integer;

  begin
    if (i < 0) or (argc < i) then
      argv := ''
    else
      begin
        k := 1;
        while argstr[k] = ' ' do
          k := k + 1;
        for j := 1 to i do
          begin
            while argstr[k] <> ' ' do
              k := k + 1;
            while argstr[k] = ' ' do
              k := k + 1;
          end;
        m := 0;
        while (argstr[k + m] <> ' ') and ((k + m) <= length(argstr)) do
          m := m + 1;
        argv := copy(argstr, k, m);
      end;
  end; { of argv }


(* end of redirect.inc *)
End of stdio.lib
################################################################
echo kanjicod.lib 1>&2
tail +2 >kanjicod.lib <<'End of kanjicod.lib'
################################################################
(*

    kanji code conversion library


    revision history
      0.0: Nov.  1, 1987 by Dai ISHIJIMA


    procedures & functions

        toshift(jiscode: integer): integer;
        tojis(shiftjiscode: integer): integer;

*)


(* check upper byte of shift jis code *)
function iskanji1(c: integer): boolean;

  begin
    if (($80 <= c) and (c <= $9f)) or (($e0 <= c) and (c <= $f0)) then
      iskanji1 := YES
    else
      iskanji1 := NO;
  end; { of iskanji1 }


(* check shift jis code *)
function iskanji(sjis: integer): boolean;

  var
    h, l: integer;

  begin
    h := hi(sjis);
    l := lo(sjis);
    if iskanji1(h) and ((($40 <= l) or (l <= $fc)) and (l <> $7f)) then
      iskanji := YES
    else
      iskanji := NO;
  end; { of iskanji }

(* jis -> shift-jis *)
function toshift(jis: integer): integer;

  var
    h, l, x, y: integer;

  begin
    h := hi(jis);
    l := lo(jis);
    if odd(h) then
      begin
        x := (h - $1f) div 2 + $80;
        y := l + $1f;
        if y >= $7f then
          y := y + 1;
      end
    else
      begin
        x := (h - $20) div 2 + $80;
        y :=  l + $9e - $20
      end;
    if x >= $a0 then
      x := x + $e0 - $a0;
    toshift := x * 256 + y;
  end; { of toshift }


(* shift-jis -> jis *)
function tojis(sftjis: integer): integer;

  var
    h, l, x, y: integer;

  begin
    h := hi(sftjis);
    l := lo(sftjis);
    if h >= $e0 then
      h := h + $a0 - $e0;
    if l > $9e then
      begin
        x := (h - $80) * 2 + $20;
        y := l + $20 - $9e;
      end
    else
      begin
        x := (h - $80) * 2 + $1f;
        if l > $7f then
          l := l - 1;
        y := l - $1f;
      end;
    tojis := x * 256 + y;
  end; { of tojis }
End of kanjicod.lib
################################################################
echo diskio.lib 1>&2
tail +2 >diskio.lib <<'End of diskio.lib'
################################################################
(* read disk *)
procedure readsec(var buffer; drive, track, sector: integer);

  const
    SETTRK  = 9;        { bios call }
    SETSEC  = 10;
    SETDMA  = 11;
    SECREAD = 12;
    SELDRV  = 14;       { bdos call }
    INQDRV  = 25;

  var
    curdrv: integer;

  begin
    curdrv := bdos(INQDRV);
    bdos(SELDRV, drive);
    bios(SETTRK, track);
    bios(SETSEC, sector);
    bios(SETDMA, addr(buffer));
    bios(SECREAD);
    bdos(SELDRV, curdrv);
  end; { of readsec }


procedure writesec(var buffer: dskbuf; drive, track, sector: integer);

  const
    SETTRK  = 9;        { bios call }
    SETSEC  = 10;
    SETDMA  = 11;
    SECWRT  = 13;
    SELDRV  = 14;       { bdos call }
    INQDRV  = 25;

  var
    curdrv: integer;

  begin
    curdrv := bdos(INQDRV);
    bdos(SELDRV, drive);
    bios(SETTRK, track);
    bios(SETSEC, sector);
    bios(SETDMA, addr(buffer));
    bios(SECWRT);
    bdos(SELDRV, curdrv);
  end; { of writesec }
End of diskio.lib
################################################################