Newsgroups: comp.sys.apple2.programmer,comp.sys.apple2.sources
Path: blue.weeg.uiowa.edu!news.uiowa.edu!hobbes.physics.uiowa.edu!math.ohio-state.edu!usc!howland.reston.ans.net!europa.eng.gtefsd.com!sundog.tiac.net!news.sprintlink.net!crash!akbar.cts.com!jeffmj
From: jeffmj@cts.com (Jeff Jungblut)
Subject: Re: Help with programming on a Apple // in Pascal
Organization: Jostens Learning Corporation, San Diego
Date: Tue, 16 Aug 1994 05:29:29 GMT
Message-ID: <jeffmj.1127402609B@donews.cts.com>
X-Newsreader: VersaTerm Link v1.1.5
References: <32ob8kINNf9u@no-names.nerdc.ufl.edu>
Sender: news@crash.cts.com (news subsystem)
Nntp-Posting-Host: akbar.cts.com
Lines: 301

In Article <32ob8kINNf9u@no-names.nerdc.ufl.edu>, mas@elm.circa.ufl.edu
(Mark Schneider) wrote:
>Please reply to the address on the from line below.
>
>>From: aldo@ins.infonet.net
>>
>>I am trying to progam a program in Pascal on an apple // e.
>>the program is just a simple read a text fle--file and 
>>write it to the screen. But the problem is that I have
>>tp -- to read from a Apple dos disk and a Pro Dos disk to
>>ge tthe data file. The Pascal will not find the file on those
>>formated type disks.... Does anyone have any sudggestions, or
>>do you know of a news group that specialized in this type of
>>question. If so point me in the right direction.....
>>Thanks you for you helppp....
>>
>>Alex.
>>Computer Programmer.
>>CCC. tok--Topeka KS.

Here's the code to do what you want for DOS 3.3 text files.  If you have
Beneath Apple ProDOS, you should be able to adapt the code for the ProDOS
file system, but I never tried doing it myself.

Basically all this code does is call Pascal's UNITREAD procedure to read
blocks from the disk into a buffer.  Procedures are provided to map Pascal
disk blocks to DOS 3.3 track/sector locations, interpret the DOS 3.3 VTOC
and catalog, and read bytes from DOS 3.3 files.

The procedures you need to call are OPENDOS to open a file on a DOS 3.3
disk.  Pass the Pascal unit number (unit 4=S6D1, unit 5=S6D2) and the name
of the DOS 3.3 file.  The boolean returned by OPENDOS tells you whether or
not the file was opened successfully.  Once the file is open, call
READBYTEDOS to read bytes from the file as integers, or READCHARDOS to read
characters from the file.  When you're all done, be sure to call CLOSEDOS
before opening any other files with OPENDOS.

The main program shows an example of how to make the OPENDOS, READCHARDOS,
READBYTEDOS, and CLOSEDOS calls.  It simply asks you for a DOS 3.3 file
name, then copies data from the DOS 3.3 file to a text file on a Pascal
disk.  If you want it to display the DOS 3.3 file on the screen, just change
the output stuff so that it writes to 'CONSOLE:' instead of a Pascal disk file.

--
Jeff Jungblut
jeffmj@cts.com

Port Charles is now online!  http://www.cts.com/~jeffmj/GeneralHospital.html

----------- cut here and compile! ------------------------------------------

program xfer;
  
(* This program transfers DOS 3.3 text files to Pascal text/data files. *)
(* The original procedures are from Call A.P.P.L.E.: All About Pascal.  *)
(* Modifications by Jeff Jungblut.  Last updated on 4/10/85.            *)

var
  o:text;
  dname,pname:string;
  filename:string[30];
  eofdos,filelock:boolean;
  realfiletype:char;
  count,errdos,filelength,fmapcont,fmapcons,off,lastblock,dosunit:integer;
  fmapt,fmaps:array[0..122] of 0..255;
  tst,tss,flen:array[1..7] of 0..255;
  locked:array[1..7] of boolean;
  ftype:array[1..7] of 0..127;
  realtype:array[1..7] of char;
  fname:array[1..7] of string[30];
  bytearray:packed array[0..512] of 0..255;
  t,s,vol,filetrack,filesector:0..255;
  filetype:0..127;
  fmapcurr:0..122;
  currbyte:0..256;

procedure getsector(t,s:integer);
  var i : integer;

  function cblk(t:integer; s:integer) : integer;
    begin
      if s=0 then s:=15
        else if s=15 then s:=0;
      cblk:=((t*8+(15-s) div 2)*2 + ((15-s) mod 2));
    end; (* cblk *)

  begin
    i:=cblk(t,s);
    off := (i mod 2) * 256;
    if (i div 2) <> (lastblock div 2)
      then unitread (dosunit,bytearray,512,i div 2);
    errdos:=ioresult;
    lastblock:=i;
  end; (* getsector *)

function opendos (unitno:integer; name:string) : boolean;
  var
    i,j,k,l : integer;
    ch: char;
    endcat: boolean;

  procedure getcat(off:integer);
    var
      j,k,st,l: integer;
      types : string[8];
      lastchar : 0..255;
    begin
      t:=bytearray[off+1];
      s:=bytearray[off+2];
      for j:= 1 to 7 do
        begin
          st:= off + 11 + (j-1)*35;
          tst[j]:= bytearray[st+0];
          tss[j]:= bytearray[st+1];
          locked[j] := ((bytearray[st+2] div 128) = 1);
          ftype[j]:=bytearray[st+2] mod 128;
          flen[j] :=bytearray[st+33];
          (*$r-*)
          lastchar := 0;
          for k := 0 to 29 do
          begin
            fname[j][k+1]:=chr(bytearray[st+3+k] mod 128);
            if fname[j][k+1] <> ' ' then lastchar := k+1;
          end;
          fname[j][0] := chr(lastchar);
          (*$r+*)
          l:=1; k:=ftype[j];
          while k <> 0 do
            begin
              l:=succ(l);
              k:=k div 2;
            end;
          types := 'TIABRS??';
          realtype[j]:=types[l];
        end;
    end; { get cat }

  procedure getvtoc;
    begin
      getsector(17,0);
      vol:=bytearray[off+6];
    end;(* get vtoc *)
    
  begin(* open dos *)
    dosunit := unitno;
    getvtoc;
    if errdos <> 0 then
      begin
        opendos:=false;
        exit(opendos);
      end;
    t := bytearray[off+1];
    s := bytearray[off+2];
    opendos:=false;
    endcat:=false;
    while not endcat do 
      begin
        getsector(t,s);
        getcat(off);
        for k := 1 to 7 do
          begin
            if tst[k] <> 0 then
              if (tst[k] < 128) and (name = fname[k]) then
                begin
                  endcat := true;
                  opendos:= true;
                  filetrack:= tst[k];
                  filesector := tss[k];
                  filelength := flen[k];
                  filelock := locked[k];
                  filetype := ftype[k];
                  realfiletype := realtype[k];
                  filename := fname[k];
                  fmapcont := filetrack;
                  fmapcons := filesector;
                  fmapcurr := 122;
                  eofdos := false;
                end
              else(* dummy else *)
            else endcat := true;
          end;
      end;
  end;

function readbytedos:integer;

  procedure getfmap(t,s:integer);
    var j:integer;
    begin
      getsector(t,s);
      for j:= 0 to 121 do
        begin
          fmapt[j] := bytearray[off+12+j*2];
          fmaps[j] := bytearray[off+12+j*2+1];
        end;
      fmapcont := bytearray[off+1];
      fmapcons := bytearray[off+2];
      currbyte := 256;
    end; (* get file map *)

  begin (* readbytedos *)
    if eofdos or (errdos <> 0) then 
      begin
        readbytedos := 0;
        exit(readbytedos);
      end;
    if fmapcurr > 121 then
    begin
      repeat
        if fmapcont + fmapcons <> 0 then getfmap(fmapcont,fmapcons)
          else begin
            eofdos := true;
            readbytedos := 0;
            exit(readbytedos);
          end;
        fmapcurr := 0;
        while not ((fmapcurr > 121) or (fmapt[fmapcurr]+fmaps[fmapcurr] <> 0))
          do fmapcurr := succ(fmapcurr);
      until (fmapt[fmapcurr] + fmaps[fmapcurr] <> 0);
    end;
    if currbyte > 255 then
    begin
      while not ((fmapcurr > 121) or (fmapt[fmapcurr] + fmaps[fmapcurr] <> 0))
        do fmapcurr := succ(fmapcurr);
      if fmapcurr <= 121 then getsector(fmapt[fmapcurr],fmaps[fmapcurr])
        else begin
          readbytedos := 0;
          exit(readbytedos);
        end;
      currbyte:=0;
      fmapcurr := succ(fmapcurr);
    end;
    readbytedos := bytearray[off+currbyte];
    currbyte := succ(currbyte);
  end;

function readchardos:char;
  begin
    readchardos := chr(readbytedos mod 128);
  end;

procedure closedos;
  begin
    lastblock := -1;
    eofdos:= true;
    errdos:= 0;
    dosunit := -1;
    fmapcont:= 0;
    fmapcons:= 0;
    fmapcurr:= 122;
    currbyte:= 256;
  end;

begin (* main *)
  closedos;
  page (output);
  writeln ('DOS 3.3 to Pascal text file converter');
  writeln;
  writeln('Insert the Pascal disk in drive 1.');
  writeln('Insert the DOS 3.3 disk in drive 2.');
  writeln;
  write('DOS file name ? ');
  readln(dname);
  if dname = '' then exit(program);
  if not opendos(5,dname) then
    begin
      writeln;
      write('Error: DOS file not found.  Press <return>. ');
      readln;
      exit(program);
    end;
  writeln;
  if filelocked then write ('*') else write (' ');
  write (realfiletype,' ',filelength:3,' ',filename);
  writeln;
  while pos(' ',dname) <> 0 do
    delete(dname,pos(' ',dname),1);
  if length(dname) > 10 then pname:=copy(dname,1,10)
    else pname:=dname;
  if pos('.',pname) = 0 then pname:=concat(pname,'.TEXT');
  pname:=concat('#4:',pname);
  writeln;
  writeln('Pascal file name is ',pname);
  count:=1;
  rewrite(o,pname);
  gotoxy(0,13);
  write('Converting sector # 1');
  repeat
    count:=count+1;
    if count mod 256 = 0 then
      begin
        gotoxy(20,13);
        write((count div 256) + 1:3);
      end;
    write(o,readchardos);
  until eofdos or (errdos <> 0);
  close (o,lock);
  writeln;
  writeln ('completed.');
  writeln;
end.