TopWare Tools/TOOLS.iso/tools/top1290/parallel.pas

Pascal/Delphi Source File | 1993-08-30 | 4.9 KB | 244 lines

(* ----------------------------- *)
(* ------  PARALLEL.PAS -------- *)
(* ----------------------------- *)

(* two sources to read and write files with a parallel-connection *)


(* GetFile - 22.04.91 - MOLINARI Gilles - Turbo Pacal 5.0 MS-DOS
**
** Receive a file from AMSTRAD CPC by parallel port LPT2:
** Half-byte transfert.
** In both way, a line is use for synchro.
**
** THIS PROGRAM IS FREEWARE **

INTERFACE
---------

PC            CPC        Fonction
--------------------------------    --------------------------------
GND    19 ----    19    GND        GND
BUSY    11 <---    1    -STROBE        Synchro (data available)
-ACK    10 <---    8    D6        |
PE    12 <---    7    D5        | Data
SELECT    13 <---    6    D4        |
-ERROR    15 <---    5    D3        |
D0    2  --->    11    BUSY        Synchro (Ready to receive)

. CPC -> PC

  port $279      76543210
        ||||+---- ERROR
        |||+----- SELECT
        ||+------ PAPER END
        |+------- ACKNOWLEDGE
        +-------- BUSY

. PC -> CPC

  port $278    76543210
               +- D0
*)

uses
  crt,dos;
type
  t_filename=string[80];
const
  prompt : array[0..3] of string[2] = ('-'^H,'\'^H,'|'^H,'/'^H);
var
  fich:file;
  nomfich:t_filename;
  i,j,nblk:longint;
  buff:array[0..127] of byte;

  function decbin(n:integer):string;
  var
    i:integer;
    str:string;
  begin
    str:='';
    for i:=0 to 7 do begin
      if (n and $80)>0 then str:=str+'1' else str:=str+'0';
      n:=n shl 1;
    end;
    decbin:=str;
  end;

  function ReadHalfByte:byte;
  var
    i:byte;
    j:integer;
  begin
    port[$278]:=1;                       {Ready for reception}
    j:=0;
    repeat                               {Waiting for half-byte}
      i:=port[$279];
      inc(j);
      write(prompt[j and 3]);
    until i and $80>0;
    port[$278]:=0;                       {Reception OK}
    while port[$279] and $80<>0 do begin {Waiting for CPC to acknoledge}
      inc(j);
      write(prompt[j and 3]);
    end;
    ReadHalfByte:=(i shr 3) and $F;
  end;

  function ReadByte:byte;
  var
    i:byte;
  begin
    i:=ReadHalfByte;
    i:=i+ReadHalfByte shl 4;
    ReadByte:=i;
  end;

  procedure GetRequest(var str:t_filename;var nblk:longint);
  var
    i,n:integer;
  begin
    str:='';
    n:=ReadByte;
    for i:=1 to n do str:=str+chr(ReadByte);
    nblk:=ReadByte;
    nblk:=nblk+ReadByte shl 8;
    nblk:=nblk+ReadByte shl 16;
    nblk:=nblk+ReadByte shl 24;
  end;

begin
  GetRequest(nomfich,nblk);
  assign(fich,nomfich);
  writeln('Receiving file ',nomfich);
  {$I-}
  rewrite(fich,128);
  {$I+}
  i:=IOResult;
  if i>0 then begin
    writeln('Error ',i,' while creating file ',nomfich);
    halt;
  end;
  for i:=1 to nblk do begin
    write(^M'Block ',i,' of ',nblk);
    for j:=0 to 127 do buff[j]:=ReadByte;
    blockwrite(fich,buff,1);
  end;
  writeln;
  close(fich);
end.


(* ----------------------------- *)


(* SendFile - 21.04.91 - MOLINARI Gilles - Turbo Pascal 3.00A CP/M 80
**
** Sending file from CPC6128 to a remote PC running getfile, by // port, with
** an half-byte transfert.
**
** Program was tested under CP/M Plus, not CP/M 2.2
**
** THIS PROGRAM IS FREEWARE **

INTERFACE
---------

. CPC -> PC

 port $EFxx 76543210
            ||||+---- bit 0
            |||+----- bit 1
            ||+------ bit 2
        |+------- bit 3
        +-------- Data available

. PC -> CPC

 port $F5xx 76543210
             +------- Ready to receive
*)

program SendFile;
type
  t_filename=string[80];
var
  fich:file;
  buff:array[0..127] of byte;
  i,j,n:byte;

  function Pret:boolean;
  var
    i:byte;
  begin
    inline($01/>$f500/$ed/$78/$32/>i);
    Pret:=(i and $40) > 0;
  end;

  procedure OutPort(adr:integer;oct:byte);
  begin
    inline($ed/$4b/>adr/$3a/>oct/$ed/$79);
  end;

  procedure sendhbyte(doct:byte);
  var
    mot:byte;
  begin
    mot:=(doct shl 3) and $78;
    repeat until Pret;
    OutPort($ef00,mot or $80);
    repeat until not Pret;
    OutPort($ef00,0);
  end;

  procedure sendbyte(oct:byte);
  begin
    sendhbyte(oct and $f);
    sendhbyte(oct shr 4);
  end;

  procedure sendrequest(str:t_filename;nh,nl:integer);
  var
    i:integer;
  begin
    i:=pos(str,':');
    if i>0 then delete(str,1,i);
    for i:=0 to length(str) do sendbyte(ord(str[i]));
    sendbyte(n and $ff);
    sendbyte(n shr 8);
    sendbyte(nh and $ff);
    sendbyte(nh shr 8);
  end;

begin
  if ParamCount<>1 then begin
    writeln('Usage = SENDFILE filename');
    halt;
  end;
  assign(fich,paramstr(1));
  {$I-}
  reset(fich);
  {$I+}
  i:=IOResult;
  if i<>0 then begin
    writeln('Error ',i,' while opening file ',paramstr(1));
    halt;
  end;
  OutPort($32,0);
  i:=0;
  n:=filesize(fich);
  sendrequest(paramstr(1),0,n);
  while not eof(fich) do begin
    i:=i+1;
    write(i,' of ',n,^M);
    blockread(fich,buff,1);
    for j:=0 to 127 do
      sendbyte(buff[j]);
  end;
  clreol;
  close(fich);
end.

(* ----------------------------- *)