apfpdeng.pas

Async Professional 4.07

begin
  {$IFDEF LogControls}
  LogControl(lpdv, $FFFE, nil, nil);
  {$ENDIF}

  { if allocated private PDEVICE data... }
  if (lpdv^.hMD <> 0) then begin
    { get pointer to our private data stored in UniDrv's PDEVICE }
    lpXPDV := lpdv^.lpMD;

    { free private PDEVICE buffer }
    FreeScanNodes(lpdv);                                          
    if lpXPDV^.apfConverter <> nil then
      acDoneFaxConverter(lpXPDV^.apfConverter);
    GlobalUnlock(lpdv^.hMD);
    GlobalFree(lpdv^.hMD);
  end;

  UniDisable(lpdv);
end;

function Enable(lpdv : PDev; wStyle : Word; lpModel : PStr; lpPort : PStr;
                lpStuff : PDevMode) : Integer;
var
  sRet    : Integer;
  IsHiRes : WordBool;
  h       : THandle;
  cd      : TCustomData;

begin
  {$IFDEF LogControls}
  LogControl(lpdv, $FFFF, @wStyle, nil);
  {$ENDIF}

  cd.cbSize := sizeof(TCustomData);
  cd.hMd := GetModuleHandle(ModuleName);

  { output raster graphics in portrait and landscape orientations }
  cd.fnOEMDump := fnDump;
  cd.fnOEMOutputChar := nil;

  sRet := UniEnable(lpdv, wStyle, lpModel, lpPort, lpStuff, @cd);
  if (sRet = 0) then begin
    Enable := sRet;
    exit;
  end;

  { allocate private PDEVICE }
  if ((wStyle and 1) = 0) then begin
    { "0" means we've been asked to initialize our data }
    lpdv^.hMD := GlobalAlloc(gHnd, sizeof(TDevExt));
    if (lpdv^.hMD = 0) then begin
      Enable := 0;
      exit;
    end;

    lpdv^.lpMD := GlobalLock(lpdv^.hMD);
    FillChar(lpdv^.lpMD^, sizeof(TDevExt), 0);
    with lpdv^.lpMD^ do begin
      acInitFaxConverter(apfConverter, nil, nil, nil, nil, '');

      { force margins off since GDI should handle margins for us }
      with apfConverter^ do begin
        LeftMargin := 0;
        TopMargin := 0;
      end;

      IsHiRes := True;      { default to true }
      IsLandscape := False; { default to false }
      if Assigned(lpStuff) then begin
        IsHiRes := lpStuff^.dmYResolution = 196;
        IsLandscape := lpStuff^.dmOrientation = orientLandscape;
      end;
      acSetResolutionMode(apfConverter, IsHiRes);

      {$IFDEF LogControls}
      LogControl(lpdv, nclogSetCvtRes, @IsHiRes, nil);
      LogControl(lpdv, nclogOrientation, @IsLandscape, nil);
      {$ENDIF}
    end;
  end;

  Enable := sRet;
end;

function fnDump(lpdv : PDev; lpptCursor : PPoint; fMode : WORD) : Integer;
  {
    Gets filled in band block from GDI and convert it a raster line at a
    time to apf format.
  }
var
  iScan             : Word;
  i                 : Word;
  WidthBytes        : Word;
  BandHeight        : Word;
  wScanlinesPerSeg  : Word;
  wSegmentInc       : Word;
  lpbmHdr           : PBitmap;
  lpSrc             : PByte;
  lpScanLine        : PByte;
  lpXPDV            : PDevExt;
  wRemainingScans   : Word;
  TmpBufLen         : Word;
  slDest            : PByteArray;

begin
  {$IFDEF LogControls}
  LogControl(lpdv, nclogCBFnDump, @fMode, nil);
  {$ENDIF}

  { get pointer to our private data from MiniDrv data area in PDEVICE struct }
  lpXPDV := lpdv^.lpMD;

  with lpXPDV^, apfConverter^ do begin
    { get pointer to source PBITMAP }
    lpbmHdr := PBitmap(PStr(lpdv) + lpdv^.oBitmapHdr);

    { initialize some things }
    lpSrc := lpbmHdr^.bmBits;
    WidthBytes := lpbmHdr^.bmWidthBytes;
    BandHeight := lpbmHdr^.bmHeight;
    wScanlinesPerSeg := lpbmHdr^.bmScanSegment;
    wSegmentInc := lpbmHdr^.bmSegmentIndex;
    slDataSize := WidthBytes;
    slBitWidth := lpbmHdr^.bmWidth;                             
    {$IFDEF LogControls}
    LogControl(lpdv, nclogBandSize, @lpbmHdr^.bmWidth, @lpbmHdr^.bmHeight);
    {$ENDIF}

    acInitDataLine(apfConverter);
    FillChar(TmpBuffer^, MaxData, 0);
    iScan := 0;
    while ((iScan < BandHeight) and
           QueryAbort(lpXPDV^.hAppDC,0)) do begin
      { get the next 64k segment of scans }
      if (iScan <> 0) then begin
        wRemainingScans := BandHeight - iScan;

        { cross the segment boundary }
        inc(OS(lpSrc).S, wSegmentInc);

        if (wScanlinesPerSeg > wRemainingScans) then
          wScanlinesPerSeg := wRemainingScans;
      end;

      { loop through scan lines in 64k segment }
      i := iScan;
      lpScanLine := lpSrc;
      if IsLandscape then begin
        {landscape - build entire image into memory; rotate later}
        while ((i < iScan + wScanlinesPerSeg) and
               QueryAbort(lpXPDV^.hAppDC,0)) do begin
          slDest := CreateNewNode(lpdv);
          move(lpScanLine^, slDest^[0], slDataSize);
          inc(OS(lpScanLine).O, WidthBytes);
          inc(i);
        end;
      end else begin
        {portrait - send scan lines directly to fax converter}
        while ((i < iScan + wScanlinesPerSeg) and
               QueryAbort(lpXPDV^.hAppDC,0)) do begin
          TmpBufLen := MinWord(216, WidthBytes);    {1728 div 8 -> 216}
          Move(lpScanLine^, TmpBuffer^, TmpBufLen);
          NotBuffer(TmpBuffer^, TmpBufLen);
          acCompressRasterLine(apfConverter, TmpBuffer^);
          FillChar(TmpBuffer^, MaxData, 0);
          cvtLastError := acOutToFileCallBack(apfConverter, DataLine^,
                                              ByteOfs, False, True);
          inc(OS(lpScanLine).O, WidthBytes);
          inc(i);
        end;
      end;                                                       

      inc(iScan,wScanlinesPerSeg);
    end;

    cvtSomeDataWritten := True;
  end;
  fnDump := 1;
end;

{-------------------------------------------------------------------}
{ the following are "helper" routines for landscape mode printing   }
{-------------------------------------------------------------------}

function CreateNewNode (lpdv : PDev) : pointer;
  { allocate a scan node (if necessary) and return pointer to scan data location }
var
  NewNode : pScanNode;
  lpXPDV  : PDevExt;

begin
  { get pointer to our private data from MiniDrv data area in PDEVICE struct }
  lpXPDV := lpdv^.lpMD;

  with lpXPDV^ do begin
    if (CurrentScanNode = nil) or
       (CurrentScanNode^.slIndex = 8) then begin
      {just starting or block of eight in current node full...}
      {...so allocate another node to hold up to eight more raster lines}
      GetMem(NewNode, sizeof(tScanNode));
      FillChar(NewNode^, sizeof(tScanNode), 0);
      if FirstScanNode = nil then begin
        FirstScanNode := NewNode;
        CurrentScanNode := NewNode;
        {$IFDEF LogControls}
        LogControl(lpdv, nclogLndscpAlloc, FirstScanNode, nil);
        {$ENDIF}
      end else begin
        CurrentScanNode^.NextNode := NewNode;
        CurrentScanNode := NewNode;
      end;
    end;

    {allocate space for one of eight raster lines in the node}
    with CurrentScanNode^ do begin
      inc(slIndex);
      GetMem(ScanLines[slIndex], slDataSize);
      CreateNewNode := ScanLines[slIndex];
    end;
  end;
end;

procedure FreeScanNodes (lpdv : PDev);
  { free the linked list of scan nodes }
var
  NodeToDel : pScanNode;
  lpXPDV    : PDevExt;

begin
  { get pointer to our private data from MiniDrv data area in PDEVICE struct }
  lpXPDV := lpdv^.lpMD;

  { free linked list of scan lines }
  with lpXPDV^ do begin
    CurrentScanNode := FirstScanNode;

    {$IFDEF LogControls}
    if FirstScanNode <> nil then
      LogControl(lpdv, nclogLndscpFree, FirstScanNode, nil);
    {$ENDIF}

    while CurrentScanNode <> nil do begin
      NodeToDel := CurrentScanNode;
      CurrentScanNode := CurrentScanNode^.NextNode;

      { free the scan line data }
      with NodeToDel^ do
        while (slIndex > 0) and (ScanLines[slIndex] <> nil) do begin
          FreeMem(ScanLines[slIndex], slDataSize);
          dec(slIndex);
        end;

      { free the linked list node }
      FreeMem(NodeToDel, sizeof(tScanNode));
    end;

    FirstScanNode := nil;
    CurrentScanNode := nil;
  end;
end;

procedure ProcessLandscapeRasterLines (lpdv : PDev);
  { translated data to portrait raster lines, then send it to converter. }
type
  TOctet        = array[0..7] of Byte;

  TRotatedLine  = array[0..220{pred(1728 div 8)}] of byte;

  PRotatedSet   = ^TRotatedSet;
  TRotatedSet   = array[0..7] of TRotatedLine;

  PTranslation  = ^TTranslation;
  TTranslation  = array[0..7, 0..1] of Byte;

const
  TransTable    : TTranslation = ((0, $80), (0, $40), (0, $20), (0, $10),
                                  (0, $08), (0, $04), (0, $02), (0, $01));

var
  lpXPDV          : PDevExt;

  LandscapeOctet  : TOctet;         { octet of bytes provided by GDI }
  PortraitOctet   : TOctet;         { octet of bytes after translation }
  PortraitSet     : PRotatedSet;    { eight rotated scan lines we're building }
  LScanLineOfs    : Word;           { byte offset of octet in landscape data }
  PScanLineOfs    : Word;           { byte offset of octet in portrait data }
  FirstOctet      : Boolean;        { first octect could contain padding lines }
  i               : Byte;
  j               : Byte;

begin
  { get pointer to our private data from MiniDrv data area in PDEVICE struct }
  lpXPDV := lpdv^.lpMD;

  {$IFDEF LogControls}
  LogControl(lpdv, nclogLndscpRotate, nil, nil);
  {$ENDIF}

  { allocate space for a set of eight complete scan lines }
  GetMem(PortraitSet, sizeof(TRotatedSet));

  with lpXPDV^ do begin
    LScanLineOfs := (slBitWidth div 8) + 1;   { skip over padding bytes }
    FirstOctet := True;
    while LScanLineOfs > 0 do begin
      CurrentScanNode := FirstScanNode;
      PScanLineOfs := 0;
      fillchar(PortraitSet^, sizeof(TRotatedSet), 0);
      while CurrentScanNode <> nil do begin
        { copy byte at ScanLineOfs for each scan line to landscape octet }
        fillchar(LandscapeOctet, sizeof(TOctet), 0);
        with CurrentScanNode^ do
          for i := 1 to slIndex do
            LandscapeOctet[pred(i)] := PByteArray(ScanLines[i])^[LScanLineOfs];

        { zero out the portrait octet }
        fillchar(PortraitOctet,  sizeof(TOctet), 0);

        { perform the translation }
        for i := 0 to 7 do
          for j := 0 to 7 do begin
            inc(PortraitOctet[i], TransTable[j, LandscapeOctet[j] and $1]);
            LandscapeOctet[j] := LandscapeOctet[j] shr 1;
          end;

        { translation complete -- move portrait octet to set of scan lines }
        for i := 0 to 7 do
          PortraitSet^[i][PScanLineOfs] := PortraitOctet[i];

        { increment byte offset into new portrait scan lines }
        inc(PScanLineOfs);

        { get another octet of data from the next node }
        CurrentScanNode := CurrentScanNode^.NextNode;
      end;

      { we've completely processed the LScanLineOfs byte from each scan line }
      { and generated eight new scan lines in portrait mode, so send them to }
      { the converter.  the new width is 216 bytes (1728 div 8) }
      with apfConverter^ do