home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / PGL.ZIP / PGLFS.ZIP / BM.FOR next >
Encoding:
Text File  |  1992-01-20  |  1.5 KB  |  59 lines
  1. C*****************************************************************************
  2. C  BM.FOR
  3. C
  4. C  This sample program demontsrates the use of the PGL Bitmap functions
  5. C  to save a bitmap image, a row at a time into a PGL drawing file.
  6. C  The example getpixel function returns 0-color values for even rows
  7. C  and 1-color values for odd rows.
  8. C****************************************************************************
  9.       include "pgl.for"
  10.       integer*2 i, j, err, bpp, compress, maxX, maxY, getpixel
  11.       integer*2 data(640)
  12.  
  13. C    
  14. C    Open A Drawing File.
  15. C    
  16.     call pgInitDrw( "bm.plt"//char(0), 640,480, err) 
  17.       if( err.ne.0)then
  18.         stop ' Error opeing drawing file'
  19.       endif
  20. C
  21. C     Initialize a PGL drawing file bitmap 
  22. C
  23.       maxX    = 640
  24.       maxY    = 480
  25.       bpp     = 1
  26.       compress=1
  27.       call pgBMInit(0,0,maxX,maxY,bpp,compress)
  28. C
  29. C     Save a screen bitmap, for printing.
  30. C     This code sample assumes you have a 'getpixel' function
  31. C     to return each screen pixel color, a dummy 'getpixel' is used
  32. C     below...
  33. C
  34.       do j=1,maxY
  35.         do i=1,maxX
  36.           data(i) = getpixel(i,j) 
  37.         end do
  38.         call pgBMData(j-1,data)
  39.       end do
  40. C
  41. C     Termmiante the bitmap 
  42. C
  43.       call pgBMEnd()
  44. C
  45. C     Close The Drawing File.
  46. C    
  47.       call pgEndDrw() 
  48. C
  49.       END
  50. C
  51. C     dummy getpixel function - replace with one from your screen graphics
  52. C     library
  53. C
  54.       integer*2 function getpixel(i,j)
  55.       integer*2 i,j
  56.         getpixel = mod(j, 2)
  57.       return
  58.       end
  59.