'===========================================================================
' Subject: OPENBMP VERSION 0.3               Date: 11-01-98 (05:17)       
' Author:  Yousuf Philips                    Code: QB, QBasic, PDS        
' Origin:  philipz@emirates.net.ae         Packet: GRAPHICS.ABC
'===========================================================================
''''''''''''''''''''''''''''''''''''''''
' Program    : Loads BMP Files         '
' Name       : OPENBMP Version 0.3     '
' Programmer : Yousuf Philips          '
' Company    : Y P I                   '
' Updated On : 12th of Sept. 1998      '
' Email - [philipz85@hotmail.com]      '
' [http://members.xoom.com/Philipz/]   '
''''''''''''''''''''''''''''''''''''''''

'/*               Do not edit this file if you distribute it.              */'
'/*  (c) Copyrighted by YPI in 1998 | All Rights Reserved | Public Domain  */'

'/* This program has been created by YPI (Basic Programming Incorporation) */'
'/* as a utility to load BMP files. Aaron Zabudsky is the first programmer */'
'/* to load BMP files in BASIC and his loader is known as SHOWBMP.BAS. I   */'
'/* have been in contact with him and have to say that his commenting in   */'
'/* SHOWBMP.BAS of the BMP file format was excellent and simple. I would   */'
'/* like to give credit and special thanks to him. This loader was created */'
'/* to load all Windows BMPs and is fast in loading compressed BMPs.       */'
'/* This BMP loader is part of a series of BMP loaders which have been     */'
'/* created by YPI. The source code for version 0.1 and 0.2 haven't been   */'
'/* distributed and won't because this version (0.3) is many times faster  */'
'/* and is able to load all Windows BMPs but if you really want, just ask. */'

'/* If you use any of this code in your program then you must credit YPI   */'
'/* and also Aaron Zabudsky. This program has been placed in Public Domain */'
'/* and All Rights Are Reserved.                                           */'

'/* YPI has also created a PCX loader and an FLI player. The source can be */'
'/* gotten from our website <http://members.xoom.com/Philipz/>             */'
'/* The YPI Website has programs for beginners, tutorials and utilities.   */'
'/* Aaron Zabudsky's email is <zabudsk@ecf.utoronto.ca>                    */'

DECLARE SUB BMPInfo (FileName$)
DECLARE SUB SHOWBMP (FileName$)

DIM SHARED X, Y AS INTEGER

CLS
PRINT
PRINT " Fast BMP Loader for QBASIC - By YPI (BASIC Programming Incorporation)"
'FILES "*.bmp"
INPUT " Enter File Name - ", FileName$

IF LEN(LTRIM$(FileName$)) = 0 THEN
   END
ELSEIF INSTR(FileName$, ".") = 0 THEN
   FileName$ = FileName$ + ".bmp"
END IF

CALL BMPInfo(FileName$)
Wait$ = INPUT$(1)
CALL SHOWBMP(FileName$)
Wait$ = INPUT$(1)

SUB BMPInfo (FileName$)

'/* Opens the specified File Name */'
OPEN FileName$ FOR BINARY AS #1
'/* If the file name specified is empty then a line of text is printed, */'
'/* the file is then deleted and the program ends */'
IF LOF(1) = 0 THEN
   PRINT " FILE IS EMPTY"
   CLOSE #1
   KILL FileName$
   EXIT SUB
END IF

CLS
'/* Extracts the first 2 bytes of the file */'
ValidBMP$ = SPACE$(2)
GET #1, 1, ValidBMP$: PRINT
IF ValidBMP$ = "BM" THEN
   PRINT " Valid BMP FILE"
ELSE
   PRINT " InValid BMP FILE"
END IF

'/* Extracts the Size of the file without the header */'
SizeOfFile$ = SPACE$(4)
GET #1, 3, SizeOfFile$
PRINT " Size of the file -"; CVL(SizeOfFile$); " or "; LOF(1)

'/* Extracts the offset of the picture data in the file */'
LocationOfPictureData$ = SPACE$(4)
GET #1, 11, LocationOfPictureData$
PRINT " Location in file of Picture Data    -"; CVL(LocationOfPictureData$)

'/* Extracts the BMP type (Win or OS/2) */'
BMPType$ = SPACE$(4)
GET #1, 15, BMPType$
PRINT : PRINT " BMP Type       - ";
IF CVL(BMPType$) = 12 THEN
   PRINT "OS/2"
   PRINT " Size Of Header - 12"
ELSEIF CVL(BMPType$) = 40 THEN
   PRINT "Windows"
   PRINT " Size Of Header - 40"
ELSE
   PRINT "Unknown Type"
END IF

'/* Extracts the Width and Height in Pixels of the Image */'
'/* and also the number of bits per pixel (bpp) */'
PixelWidth$ = SPACE$(4): PixelHeight$ = SPACE$(4)
BitsPerPixel$ = SPACE$(2): NoPlanes$ = SPACE$(2): Compress$ = SPACE$(4)
GET #1, 19, PixelWidth$
GET #1, 23, PixelHeight$
GET #1, 27, NoPlanes$
GET #1, 29, BitsPerPixel$
GET #1, 31, Compress$
PRINT
PRINT " Width of Image in Pixels           -"; CVL(PixelWidth$)
PRINT " Height of Image in Pixels          -"; CVL(PixelHeight$)
PRINT " Number of Planes                   -"; CVI(NoPlanes$)
PRINT " Number of Bits Per Pixel (bpp)     -"; CVI(BitsPerPixel$)
PRINT " Number of Colors Used in the Image -"; 2 ^ CVI(BitsPerPixel$)
IF CVL(Compress$) = 0 THEN
   PRINT " No Compression"
ELSEIF CVL(Compress$) = 1 THEN
   PRINT " RLE - 8-Bit Compression"
ELSEIF CVL(Compress$) = 2 THEN
   PRINT " RLE - 4-Bit Compression"
END IF
CLOSE

END SUB

SUB SHOWBMP (FileName$)

OPEN FileName$ FOR BINARY AS #1
IF LOF(1) = 0 THEN
   PRINT " FILE IS EMPTY"
   CLOSE #255
   KILL FileName$
   EXIT SUB
END IF

'/* Extracts the first 2 bytes of the file */'
ValidBMP$ = SPACE$(2)
GET #1, 1, ValidBMP$
'/* If the first 2 bytes of the file are not BM then a line of text is printed, */'
'/* and the program ends */'
IF ValidBMP$ <> "BM" THEN
   PRINT " THE FILE SPECIFIED IS NOT A VALID BMP"
   EXIT SUB
END IF

'/* Extracts the offset of the picture data in the file */'
LocationOfPictureData$ = SPACE$(4)
GET #1, 11, LocationOfPictureData$
LocationOfPictureData = CVL(LocationOfPictureData$)

'/* Extracts the BMP type (Win or OS/2) */'
BMPType$ = SPACE$(4)
GET #1, 15, BMPType$
'/* If the BMPType is for OS/2 then the a line of text is printed, then */'
'/* program ends */'
IF CVL(BMPType$) = 12 OR CVL(BMPType$) = 64 THEN
   PRINT " THIS BMP IS FOR THE OS/2 AND CAN'T BE OPENED IN THIS VERSION OF OPENBMP"
   PRINT " PLEASE SEND ANY OS/2 BMP TO phililpz85@hotmail.com"
   PRINT " BY SENDING OS/2 BMP's TO US, WE WILL HOPEFULLY BE ABLE TO OPEN THEM IN THE"
   PRINT " NEXT VERSION OF OPENBMP"
   EXIT SUB
END IF

'/* Extracts the Width and Height in Pixels of the Image */'
'/* and also the number of bits per pixel (bpp) */'
PixelWidth$ = SPACE$(4)
PixelHeight$ = SPACE$(4)
BitsPerPixel$ = SPACE$(2)
Compression$ = SPACE$(4)
GET #1, 19, PixelWidth$
GET #1, 23, PixelHeight$
GET #1, 29, BitsPerPixel$
GET #1, 31, Compression$
PixelWidth = CVL(PixelWidth$)
PixelHeight = CVL(PixelHeight$)
BitsPerPixel = CVI(BitsPerPixel$)
NumberOfColors = 2 ^ BitsPerPixel

'/* Changing to suitable screen modes to display the Image */'
IF BitsPerPixel = 1 THEN
   IF PixelWidth > 640 OR PixelHeight > 480 THEN
      PRINT " 1-BIT IMAGE IS TO LARGE"
      EXIT SUB
   END IF
   SCREEN 11
ELSEIF BitsPerPixel = 4 THEN
   SCREEN 12
ELSEIF BitsPerPixel = 8 THEN
   SCREEN 13
END IF

'/* If image is not 24-bit then load palette information from file */'
IF BitsPerPixel <> 24 THEN
   '/* Extracts Palette information for the colors used in the image */'
   PaletteColors$ = SPACE$(NumberOfColors * 4)
   GET #1, 55, PaletteColors$

   FOR Loops = 0 TO NumberOfColors - 1
   '/* Changes the Palette of each color to the one specified in the file */'
      IF BitsPerPixel = 1 AND Loops = 1 THEN Loops = 15
      OUT &H3C8, Loops
      IF BitsPerPixel = 1 AND Loops = 15 THEN Loops = 1
      OUT &H3C9, ASC(MID$(PaletteColors$, Loops * 4 + 3, 1)) \ 4 'Red
      OUT &H3C9, ASC(MID$(PaletteColors$, Loops * 4 + 2, 1)) \ 4 'Green
      OUT &H3C9, ASC(MID$(PaletteColors$, Loops * 4 + 1, 1)) \ 4 'Blue
   NEXT Loops

   '/* Finds correct location of Picture data */'
   IF LocationOfPictureData = 0 THEN
      LocationOfPictureData = LOC(255) + 1
   ELSE
      LocationOfPictureData = LocationOfPictureData + 1
   END IF
END IF

IF BitsPerPixel = 24 THEN
   SCREEN 13
   PaletteBlue$ = SPACE$(1): PaletteGreen$ = SPACE$(1): PaletteRed$ = SPACE$(1)
   SEEK #1, LocationOfPictureData
   FOR Loops = 0 TO 255
      OUT &H3C8, Loops
      OUT &H3C9, Loops \ 4
      OUT &H3C9, Loops \ 4
      OUT &H3C9, Loops \ 4
   NEXT Loops
   ActualWidth = PixelWidth / 320: ActualHeight = PixelHeight / 200
   IF ActualWidth < 1 THEN ActualWidth = 1
   IF ActualHeight < 1 THEN ActualHeight = 1
   IF (4 - ((PixelWidth * 3) MOD 4)) = 4 THEN
      LineExtract$ = SPACE$(PixelWidth * 3)
   ELSE
      LineExtract$ = SPACE$((PixelWidth * 3) + (4 - ((PixelWidth * 3) MOD 4)))
   END IF
   IF ActualWidth = 1 AND ActualHeight = 1 THEN
      FOR Y = PixelHeight - 1 TO 0 STEP -1
         GET #1, , LineExtract$
         FOR X = 0 TO PixelWidth - 1
            PaletteBlue$ = MID$(LineExtract$, X * 3 + 1, 1)
            PSET (X, Y), ASC(PaletteBlue$)
         NEXT X
      NEXT Y
   ELSE
      FOR Y = PixelHeight - 1 TO 0 STEP -1
         GET #1, , LineExtract$
         FOR X = 0 TO PixelWidth - 1
            PaletteBlue$ = MID$(LineExtract$, X * 3 + 1, 1)
            PSET (X / ActualWidth, Y / ActualHeight), ASC(PaletteBlue$)
         NEXT X
      NEXT Y
   END IF
   EXIT SUB
ELSEIF CVL(Compression$) = 1 THEN
   PixelColors$ = SPACE$(1): NoOfSameColors$ = SPACE$(1)
   RightMovement$ = SPACE$(1):  UpMovement$ = SPACE$(1)
   ActualWidth = PixelWidth / 320: ActualHeight = PixelHeight / 200
   IF ActualWidth < 1 THEN ActualWidth = 1
   IF ActualHeight < 1 THEN ActualHeight = 1
   X = 0: Y = PixelHeight - 1
   DO
      GET #1, , NoOfSameColors$
      IF ASC(NoOfSameColors$) <> 0 THEN
         GET #1, , PixelColors$
         IF X + ASC(NoOfSameColors$) = PixelWidth THEN NoOfSameColors$ = CHR$(ASC(NoOfSameColors$) - 1)
         LINE (X / ActualWidth, Y / ActualHeight)-STEP(ASC(NoOfSameColors$) / ActualWidth, 0), ASC(PixelColors$)
         X = X + ASC(NoOfSameColors$)
      ELSE
         GET #1, , PixelColors$
         IF ASC(PixelColors$) = 0 THEN
            X = 0: Y = Y - 1
            IF Y < 0 THEN EXIT SUB
            '/* Used to skip the unnecessary lines in large pictures
            WHILE Y MOD ActualHeight <> 0
               DO
                  GET #1, , NoOfSameColors$
                  IF ASC(NoOfSameColors$) <> 0 THEN
                     GET #1, , PixelColors$
                  ELSE
                     GET #1, , PixelColors$
                     IF ASC(PixelColors$) = 0 THEN
                        EXIT DO
                     ELSEIF ASC(PixelColors$) = 1 THEN
                        EXIT SUB
                     ELSEIF ASC(PixelColors$) = 2 THEN
                        Bytez$ = SPACE$(2)
                        GET #1, , Bytez$
                        EXIT DO
                     ELSE
                        Bytez$ = SPACE$(ASC(PixelColors$))
                        IF ASC(PixelColors$) MOD 2 = 1 THEN Bytez$ = Bytez$ + " "
                        GET #1, , Bytez$
                     END IF
                  END IF
               LOOP
               Y = Y - 1
            WEND
         ELSEIF ASC(PixelColors$) = 1 THEN
            EXIT DO
         ELSEIF ASC(PixelColors$) = 2 THEN
            GET #1, , RightMovement$
            GET #1, , UpMovement$
            X = X + ASC(RightMovement$): Y = Y + ASC(UpMovement$)
         ELSE
            PixelColor$ = SPACE$(1)
            FOR Loops = 1 TO ASC(PixelColors$)
               GET #1, , PixelColor$
               PSET (X / ActualWidth, Y / ActualHeight), ASC(PixelColor$)
               X = X + 1
            NEXT Loops
            IF ASC(PixelColors$) MOD 2 = 1 THEN GET #1, , PixelColor$
         END IF
      END IF
   LOOP
   EXIT SUB
ELSEIF CVL(Compression$) = 2 THEN
   PixelColors$ = SPACE$(1): NoOfSameColors$ = SPACE$(1)
   RightMovement$ = SPACE$(1):  UpMovement$ = SPACE$(1)
   ActualWidth = PixelWidth / 640: ActualHeight = PixelHeight / 480
   IF ActualWidth < 1 THEN ActualWidth = 1
   IF ActualHeight < 1 THEN ActualHeight = 1
   X = 0: Y = PixelHeight - 1
   DO
      GET #1, , NoOfSameColors$
      IF ASC(NoOfSameColors$) <> 0 THEN
         GET #1, , PixelColors$
          FOR Loops = 0 TO ASC(NoOfSameColors$) - 1 STEP 2
             PSET (X / ActualWidth, Y / ActualHeight), ASC(PixelColors$) \ 16
             X = X + 1
             IF Loops + 1 <> ASC(NoOfSameColors$) THEN
                PSET (X / ActualWidth, Y / ActualHeight), ASC(PixelColors$) AND 15
                X = X + 1
             END IF
          NEXT Loops
      ELSE
         GET #1, , PixelColors$
         IF ASC(PixelColors$) = 0 THEN
            X = 0: Y = Y - 1
            IF Y < 0 THEN EXIT SUB
            '/* Used to skip the unnecessary lines in large pictures
            WHILE Y MOD ActualHeight <> 0
               DO
                  GET #1, , NoOfSameColors$
                  IF ASC(NoOfSameColors$) <> 0 THEN
                     GET #1, , PixelColors$
                  ELSE
                     GET #1, , PixelColors$
                     IF ASC(PixelColors$) = 0 THEN
                        EXIT DO
                     ELSEIF ASC(PixelColors$) = 1 THEN
                        EXIT SUB
                     ELSEIF ASC(PixelColors$) = 2 THEN
                        Bytez$ = SPACE$(2)
                        GET #1, , Bytez$
                        EXIT DO
                     ELSE
                        PixelColors = ASC(PixelColors$)
                        IF PixelColors MOD 2 = 1 THEN
                           PixelColors = PixelColors + 1
                        END IF
                        PixelColors = PixelColors / 2
                        IF PixelColors MOD 2 = 1 THEN
                           PixelColors = PixelColors + 1
                        END IF
                        Bytez$ = SPACE$(PixelColors)
                        GET #1, , Bytez$
                     END IF
                 END IF
               LOOP
               Y = Y - 1
            WEND
         ELSEIF ASC(PixelColors$) = 1 THEN
            EXIT DO
         ELSEIF ASC(PixelColors$) = 2 THEN
            GET #1, , RightMovement$
            GET #1, , UpMovement$
            X = X + ASC(RightMovement$): Y = Y + ASC(UpMovement$)
         ELSE
            PixelColor$ = SPACE$(1): PixelColors = ASC(PixelColors$)
            FOR Loops = 0 TO PixelColors - 1
               IF Loops MOD 2 = 0 THEN
                  GET #1, , PixelColor$
                  PSET (X / ActualWidth, Y / ActualHeight), ASC(PixelColor$) \ 16
                  X = X + 1
               END IF
               IF Loops MOD 2 = 1 THEN
                  PSET (X / ActualWidth, Y / ActualHeight), ASC(PixelColor$) AND 15
                  X = X + 1
               END IF
            NEXT Loops
            IF PixelColors MOD 2 = 1 THEN
               PixelColors = PixelColors + 1
            END IF
            NoOfBytes = PixelColors / 2
            IF (NoOfBytes MOD 2) = 1 THEN
               GET #1, , PixelColor$
            END IF
         END IF
      END IF
   LOOP
   EXIT SUB
END IF

IF BitsPerPixel = 8 THEN
   LineExtract = (INT((PixelWidth - 1) / 4) + 1) * 4
   LineExtract$ = SPACE$(LineExtract)
   ActualWidth = PixelWidth / 320
   ActualHeight = PixelHeight / 200
   IF ActualHeight <= 1 AND ActualWidth <= 1 THEN
      FOR Y = 0 TO PixelHeight - 1
         GET #1, 1079 + ((PixelHeight - 1) * LineExtract) - (Y * LineExtract), LineExtract$
         FOR X = 0 TO PixelWidth - 1
            PSET (X, Y), ASC(MID$(LineExtract$, X + 1, 1))
         NEXT X
      NEXT Y
   ELSE
      FOR Y = 0 TO PixelHeight - 1 STEP ActualHeight
         GET #1, LocationOfPictureData + ((LineExtract * (PixelHeight - 1)) - (LineExtract * Y)), LineExtract$
         FOR X = 0 TO PixelWidth - 1 STEP ActualWidth
            PSET (X / ActualWidth, Y / ActualHeight), ASC(MID$(LineExtract$, X + 1, 1))
         NEXT X
      NEXT Y
   END IF
ELSEIF BitsPerPixel = 4 THEN
   LineExtract = (INT((PixelWidth - 1) / 8) + 1) * 4
   LineExtract$ = SPACE$(LineExtract)
   ActualWidth = PixelWidth / 640
   ActualHeight = PixelHeight / 480
   IF ActualWidth <= 1 AND ActualHeight <= 1 THEN
      FOR Y = 0 TO PixelHeight - 1
         GET #1, LocationOfPictureData + ((LineExtract * (PixelHeight - 1)) - (LineExtract * Y)), LineExtract$
         FOR X = 0 TO (PixelWidth / 2) - 1
            PixelColor = ASC(MID$(LineExtract$, X + 1, 1))
            PSET (X * 2, Y), PixelColor \ 16
            IF (X * 2) + 1 < PixelWidth THEN
               PSET ((X * 2) + 1, Y), PixelColor AND 15
            END IF
         NEXT X
      NEXT Y
   ELSE
      FOR Y = 0 TO PixelHeight - 1 STEP ActualHeight
         GET #1, LocationOfPictureData + ((LineExtract * (PixelHeight - 1)) - (LineExtract * Y)), LineExtract$
         FOR X = 0 TO (PixelWidth / 2) - 1
            PixelColor = ASC(MID$(LineExtract$, X + 1, 1))
            PSET (X / ActualWidth, Y / ActualHeight), PixelColor \ 16
            IF (X * 2) + 1 < PixelWidth THEN
               PSET ((X + 1) / ActualWidth, Y / ActualHeight), PixelColor AND 15
            END IF
         NEXT X
      NEXT Y
   END IF
ELSEIF BitsPerPixel = 1 THEN
   LineExtract = (INT((PixelWidth - 1) / 32) + 1) * 4
   LineExtract$ = SPACE$(LineExtract)
   FOR Y = 0 TO PixelHeight - 1
      DEF SEG = &HA000
      GET #1, LocationOfPictureData + ((PixelHeight - 1) * LineExtract) - (Y * LineExtract), LineExtract$
      FOR X = 0 TO CINT(PixelWidth / 8) - 1
         IF Y < 409 THEN
            POKE (Y * 80 + X), ASC(MID$(LineExtract$, X + 1, 1))
         ELSE
            DEF SEG = &HA7D0
            POKE ((Y - 400) * 80 + X), ASC(MID$(LineExtract$, X + 1, 1))
         END IF
      NEXT X
   NEXT Y
   DEF SEG
END IF

END SUB