'===========================================================================
' Subject: LOAD/SAVE 320X200 BITMAPS         Date: 07-06-98 (22:27)       
' Author:  Anders Olofsson                   Code: QB, QBasic, PDS        
' Origin:  anders.olofsson@mail.bip.net    Packet: GRAPHICS.ABC
'===========================================================================
'
' Fast BMP-viewer for screen 13, by Anders Olofsson 1998.
' This program loads a 320 x 200 256 color bitmap picture in about 0.15
' seconds. (On my 486/66 mhz in QB 4.5)
'
' Thanks to Jonathan Leger for the Memcopy
' routine and Davey W. taylor for his BMPSNOW.BAS, where i found
' the BmpInfo type def.
'
'   E-mail: anders.olofsson@mail.bip.net
'

DEFINT A-Z
DECLARE SUB ShowBMP (File$)
DECLARE SUB SaveBMP (Filename$)
DECLARE FUNCTION getfilename$ (Text$)
DECLARE SUB Memcopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)


TYPE BmpInfo
 id AS STRING * 2
 filesize AS LONG
 reserved AS STRING * 4
 Offset AS LONG
 SizeOfHeader AS LONG
 BMPWidth AS LONG
 BmpHeight AS LONG
 Bitplanes AS INTEGER
 Bitsperpixel AS INTEGER
 Compression AS LONG
 Imagesize AS LONG
 Pelspermetrex AS LONG
 Pelspermetrey AS LONG
 UsedColors AS LONG
 importantcolors AS LONG
END TYPE


Z$ = getfilename$("Select 320x200 256 color BMP file to view: ")

SCREEN 13

T! = TIMER
ShowBMP Z$
PRINT USING "It took##.### seconds."; TIMER - T!

SLEEP

CLS : ShowBMP Z$
LOCATE 1, 1
PRINT "Saving BMP...";
T! = TIMER
SaveBMP "TEMP.BMP"
PRINT "done."
PRINT USING "It took##.### seconds."; TIMER - T!

WHILE LEN(INKEY$) = 0: WEND

FUNCTION getfilename$ (Text$)
SCREEN 0: WIDTH 80, 25: CLS
LOCATE 1, 1
PRINT Text$
LINE INPUT I$
IF I$ = "" THEN END
getfilename$ = I$
END FUNCTION

SUB Memcopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)

DIM MemCopy.ASM AS STRING
MemCopy.ASM = ""
MemCopy.ASM = MemCopy.ASM + CHR$(85)                             'PUSH BP
MemCopy.ASM = MemCopy.ASM + CHR$(137) + CHR$(229)                'MOV BP,SP
MemCopy.ASM = MemCopy.ASM + CHR$(30)                             'PUSH DS
MemCopy.ASM = MemCopy.ASM + CHR$(139) + CHR$(70) + CHR$(10)      'MOV AX,[BP+0A]
MemCopy.ASM = MemCopy.ASM + CHR$(142) + CHR$(192)                'MOV ES,AX
MemCopy.ASM = MemCopy.ASM + CHR$(139) + CHR$(70) + CHR$(14)      'MOV AX,[BP+0E]
MemCopy.ASM = MemCopy.ASM + CHR$(142) + CHR$(216)                'MOV DS,AX
MemCopy.ASM = MemCopy.ASM + CHR$(139) + CHR$(118) + CHR$(12)     'MOV SI,[BP+0C]
MemCopy.ASM = MemCopy.ASM + CHR$(139) + CHR$(126) + CHR$(8)      'MOV DI,[BP+08]
MemCopy.ASM = MemCopy.ASM + CHR$(139) + CHR$(78) + CHR$(6)       'MOV CX,[BP+06]
MemCopy.ASM = MemCopy.ASM + CHR$(243)                            'REPZ
MemCopy.ASM = MemCopy.ASM + CHR$(164)                            'MOVSB
MemCopy.ASM = MemCopy.ASM + CHR$(31)                             'POP DS
MemCopy.ASM = MemCopy.ASM + CHR$(93)                             'POP BP
MemCopy.ASM = MemCopy.ASM + CHR$(203)                            'RETF

DEF SEG = VARSEG(MemCopy.ASM)
        CALL Absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, SADD(MemCopy.ASM))
DEF SEG

END SUB

SUB SaveBMP (Filename$)
DIM BMPHeader AS BmpInfo

BMPHeader.id = "BM"
BMPHeader.SizeOfHeader = 40
BMPHeader.BMPWidth = 320
BMPHeader.BmpHeight = 200
BMPHeader.Bitsperpixel = 8
BMPHeader.Imagesize = 64000
BMPHeader.UsedColors = 255
BMPHeader.Bitplanes = 1
BMPHeader.Offset = 1078
BMPHeader.Pelspermetrex = 3780
BMPHeader.Pelspermetrey = 3790


F = FREEFILE
OPEN Filename$ FOR BINARY AS #F

 PUT #F, , BMPHeader

FOR C = 0 TO 255
 OUT &H3C7, C
 B = INP(&H3C9): G = INP(&H3C9): R = INP(&H3C9)
 PData$ = CHR$(R * 4) + CHR$(G * 4) + CHR$(B * 4) + " "
 PUT #F, , PData$
NEXT

DIM Buffer AS STRING
Segment = &HA000 + (64000 \ 16) - 20

FOR y = 200 TO 1 STEP -1
 Buffer = SPACE$(320)
 Memcopy Segment, 0, VARSEG(Buffer), SADD(Buffer), 320
 PUT #F, , Buffer
 Segment = Segment - 20
NEXT

CLOSE #F

END SUB

SUB ShowBMP (File$)

DIM BMPHeader AS BmpInfo

F = FREEFILE
OPEN File$ FOR BINARY ACCESS READ AS #F
GET #F, 1, BMPHeader

IF BMPHeader.id <> "BM" OR BMPHeader.SizeOfHeader <> 40 THEN
 PRINT File$; " is not a valid bitmap file": END
ELSEIF BMPHeader.BMPWidth <> 320 OR BMPHeader.BmpHeight <> 200 THEN
 PRINT "Size of image has to bee 320x200!": END
ELSEIF BMPHeader.Compression THEN
 PRINT "This program does'nt show rle compressed bmp's!": END
ELSEIF BMPHeader.Bitsperpixel <> 8 THEN
 PRINT "Only 256 color bitmaps can be displayed!": END
END IF

Pal$ = INPUT$(1024, F)
FOR C = 0 TO 255  'Set palette to black while drawing to screen
 OUT &H3C8, C: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
NEXT

DIM Buffer AS STRING
Segment = &HA000 + (64000 - 1280) \ 16

FOR y = 199 TO 0 STEP -4
 Buffer = SPACE$(320)
 GET #F, , Buffer
 Buffer = INPUT$(320, F) + Buffer
 Buffer = INPUT$(320, F) + Buffer
 Buffer = INPUT$(320, F) + Buffer
 Memcopy VARSEG(Buffer), SADD(Buffer), Segment, 0, 1280
 Segment = Segment - 80
NEXT

CLOSE #F

FOR C = 0 TO 255
 B = ASC(MID$(Pal$, C * 4 + 1, 1)) \ 4
 G = ASC(MID$(Pal$, C * 4 + 2, 1)) \ 4
 R = ASC(MID$(Pal$, C * 4 + 3, 1)) \ 4
 OUT &H3C8, C
 OUT &H3C9, R: OUT &H3C9, G: OUT &H3C9, B
NEXT
END SUB