'===========================================================================
' Subject: DISPLAY MONOCHROME .BMP FILES     Date: 10-07-97 (16:03)       
' Author:  Don Schullian                     Code: PB                     
' Origin:  d83@ath.forthnet.gr             Packet: GRAPHICS.ABC
'===========================================================================
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' Display monochrome (2 color) .BMP files on SCREEN 11
''
'' by Don Schullian
''   October 1997
''
'' This routine is released into the PUBLIC DOMAIN
''
'' fMonoBMP%( X%, Y%, FileSpec$ )
''   PARAMS: X%        left most pixel column to start display
''           Y%        top most pixel row to end display
''           FileSpec$ the file to be processed
''  RETURNS:  0 if all clear and as the image was displayed
''           53 if FileSpec$ did not exist
''           54 if FileSpec$ did not appear to be a 2 color .BMP file
''           nn any/all other PB error codes
''     NOTE: This routine is in its most basic form and can be speeded up
''           with a bit of work. I left it this way so modifications can
''           be made without doing a bunch of reverse technology.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
TestCode:
  DECLARE FUNCTION fMonoBMP(BYVAL X%,BYVAL Y%,SEG F$) AS INTEGER
  DIM FileName AS STRING

  SCREEN 11
  FileName$ = "IMAGE4.BMP"
  LOCATE 25, 1
  PRINT "ERROR CODE:"; fMonoBMP%( 0, 0, FileName$ )
  WHILE NOT INSTAT : WEND
  SCREEN 0
  CLS
  END

' -------------------------------------------------------------------------

TYPE BMPheaderTYPE
  Ident     AS INTEGER      ' 19778 = CVI("BM") if .BMP format
  Fsize     AS LONG         ' File size in bytes
  Reserved  AS STRING * 4   ' junk
  Offset    AS LONG         ' file offset to start of data
  Version   AS LONG         ' 40 = Windows 3.x  12 = OS/2
  Pwide     AS LONG         ' width in pixel columns
  Phigh     AS LONG         ' height in pixel rows
  Planes    AS INTEGER      ' number of color planes
  ClrBits   AS INTEGER      ' number of bits per color
  Packed    AS LONG         ' 0 if not packed
  PackSize  AS LONG         ' actual length of data
  ''''''''''''''''''''''''''' OS/2 stops here
  Xscale    AS LONG         '
  Yscale    AS LONG         '
  Colors    AS LONG         ' actual # of colors used
  ImpColors AS LONG         ' important colors used 0 = all
END TYPE

' --------------------------------------------------------------------------

FUNCTION fMonoBMP( BYVAL Col      AS INTEGER, _
                   BYVAL Row      AS INTEGER, _
                   SEG   FileSpec AS STRING   ) LOCAL PUBLIC AS INTEGER

  DIM tBMP     AS LOCAL BMPheaderTYPE              ' header type
  DIM  BperRow AS LOCAL INTEGER                    ' bytes per row of data
  DIM  D       AS LOCAL BYTE                       ' incoming grfx data
  DIM  FileNo  AS LOCAL INTEGER                    ' file number
  DIM  Oops    AS LOCAL INTEGER                    ' returning error code
  DIM  P       AS LOCAL INTEGER                    ' loop counter
  DIM  X       AS LOCAL INTEGER                    ' screen X position
  DIM  Z       AS LOCAL INTEGER                    ' loop counter
                                                   '
  ON LOCAL ERROR GOTO MonoBMPoops                  ' local error trap
                                                   '
  IF LEN(DIR$(FileSpec$)) = 0       THEN ERROR 53  ' file not found
                                                   '
  FileNo% = FREEFILE                               ' next file number
  OPEN "B", #FileNo%, FileSpec$                    ' open file
    GET #FileNo%, , tBMP                           ' read in header data
    IF tBMP.Ident   <> 19778        THEN ERROR 54  ' test if this is a valid
    IF tBMP.Fsize   <> LOF(FileNo%) THEN ERROR 54  '  monocrome BMP file
    IF tBMP.Version <> 40           THEN ERROR 54  '  54 = BAD FILE MODE
    IF tBMP.ClrBits <> 1            THEN ERROR 54  '
    IF tBMP.Packed  <> 0            THEN ERROR 54  '
                                                   '
  BperRow% = ( ( tBMP.Pwide + 7 ) \ 8 )            ' compute whole bytes
  INCR BperRow%, ( BperRow% MOD 4 )                ' pad to 4 byte gulps
  INCR Row%, ( tBMP.Phigh - 1 )                    ' set bottom row
  WHILE Row% > 479                                 ' all this is off the
    INCR tBMP.Offset, BperRow%                     '  screen so just skip
  WEND                                             '  it
                                                   '
  DO                                               ' start processing data
    X% = Col%                                      '  set left most column
    SEEK #FileNo%, tBMP.Offset                     '  set file pointer
    FOR Z% = 1 TO BperRow%                         '  read row data
      GET #1, , D?                                 '   read next byte
      FOR P% = 7 TO 0 STEP -1                      '   bit by bit data read
        PSET(X%,Row%), BIT(D?,P%)                  '    set pixel value
        INCR X%                                    '    next column
        IF X% > 639 THEN EXIT, EXIT                '    past end of screen
      NEXT                                         '
    NEXT                                           '
    DECR Row%                                      '  up one row
    IF Row% < 0 THEN EXIT LOOP                     '  past top of screen
    INCR tBMP.Offset, BperRow%                     '  increase file pointer
    DECR tBMP.Phigh                                '  decr data row counter
  LOOP UNTIL tBMP.Phigh = 0                        '
                                                   '
  ExitMonoBMP:                                     ' clean-up before exit
    IF FILEATTR(FileNo%,0) THEN CLOSE #FileNo%     '  close the file if open
    FUNCTION = Oops%                               '  RETURN error code
    EXIT FUNCTION                                  '------------------------
                                                   '
  MonoBMPoops:                                     ' local error trap
    Oops% = ERR                                    '  store error number
    RESUME ExitMonoBMP                             '  jump to clean-up
                                                   '
END FUNCTION