home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Programming Tools / Pascal Demos from Apple / show paint / SHOWPAINT.TEXT next >
Encoding:
Text File  |  1984-06-28  |  2.6 KB  |  91 lines  |  [TEXT/ttxt]

  1. {$X-}
  2. {$U-}
  3. program showPaint;
  4.  
  5. {Scott Knaster   Macintosh Tech Support   5/84
  6.  Displays the upper-left corner of a MacPaint document on the screen.
  7.  Based on Bill Atkinson's document
  8.  Note: screen sizes are hard-coded for 512 by 342 }
  9.  
  10. {Small and slow version.
  11.  This version saves memory by doing a CopyBits for each line individually, so
  12.  it's much slower than the all-at-once method.
  13.  You can speed it up by making the constant srcBlocks larger, but every srcBlock
  14.  costs you 512 bytes.
  15.  Ultra-fast, pig version which reads in the whole picture (needs 24K) then does
  16.  CopyBits is available from Macintosh Tech Support                 }
  17.  
  18.    uses
  19.       {$U obj/memtypes}    memtypes,
  20.       {$U obj/quickdraw}   quickdraw,
  21.       {$U obj/osintf}      osintf,
  22.       {$U obj/toolintf}    toolintf;
  23.  
  24.    const
  25.       srcBlocks = 2; {Make this number larger to speed things up.  Uses 512 bytes
  26.                       for each number increased.}
  27.       headerSize = 512;
  28.  
  29.    type
  30.       diskBlock = packed array [1..512] of QDbyte;
  31.  
  32.    var
  33.       srcBuf : array [1..srcBlocks] of diskBlock;
  34.       theBits : packed array [1..72] of byte;
  35.       srcPtr, dstPtr : Ptr;
  36.       dstBits : bitmap;
  37.       error : OSErr;
  38.       refNum, scanline, srcSize : integer;
  39.       count : longint;
  40.       aPort : GrafPort;
  41.       debug : text;
  42.       showRect, lineRect : Rect;
  43.  
  44. begin
  45.    InitGraf (@thePort);
  46.    FlushEvents (everyEvent, 0);
  47.    InitCursor;
  48.    OpenPort (@aPort);
  49.  
  50.    srcSize := srcBlocks * 512;
  51.  
  52.    srcPtr := @srcBuf;
  53.  
  54.    dstBits.rowBytes := 72;
  55.    dstBits.baseAddr := @theBits;
  56.    SetRect (dstBits.bounds, 0, 0, 576, 1);
  57.    dstPtr := pointer (dstBits.baseAddr);
  58.  
  59.    error := FSOpen ('macPic', 0, refNum);
  60.  
  61.    {skip the header}
  62.    count := headerSize;
  63.    error := FSRead (refNum, count, @srcBuf);
  64.  
  65.    {prime srcBuf}
  66.    count := srcSize;
  67.    error := FSRead (refNum, count, @srcBuf);
  68.    SetRect (lineRect, 0, 0, 512, 1);
  69.    SetRect (showRect, 0, 0, 512, 1);
  70.    count := count - 512;
  71.  
  72.    {unpack each scanline into dstBits, reading more source as needed}
  73.    for scanline := 1 to 342 do
  74.       begin
  75.          UnpackBits (srcPtr, dstPtr, 72);
  76.          CopyBits (dstBits, screenBits, lineRect, showRect,
  77.              srcCopy, nil);
  78.          dstPtr := pointer (dstBits.baseAddr);
  79.          OffsetRect (showRect, 0, 1);
  80.          if ord (srcPtr) > (ord (@srcBuf) + srcSize - 512)
  81.             then begin
  82.                   srcBuf [1] := srcBuf [srcBlocks];
  83.                   error := FSRead (refNum, count, @srcBuf [2]);
  84.                   srcPtr := pointer (ord (srcPtr) + 512 - srcSize);
  85.                  end;
  86.       end;
  87.    error := FSClose (refnum);
  88.    repeat until button;
  89. end.
  90.  
  91.