'===========================================================================
' Subject: BMP LOADER/MAKER                  Date: 11-18-98 (18:28)       
' Author:  Viktor Rootselainen               Code: QB, PDS                
' Origin:  viktor.rootselainen@pp.inet.fi  Packet: GRAPHICS.ABC
'===========================================================================
'-----------------------Bmp loader/maker by Thomas Nyberg---------------------
'modified by Viktor Rootselainen
'this program can open files of any size
'you can now load/save bmp to/from memory  :)
'this program is for BASIC PDS 7.1
'to work with QB 4.5 you must modify change sseg to varseg

DEFINT A-Z
DECLARE SUB Byte2Int (word%, low%, high%)
DECLARE SUB Int2Byte (word%, low, high)
DECLARE SUB BmpLoad (Filename$, Segment%, offset%)
DECLARE SUB BmpSave (Filename$, Segment%, offset%)

'$INCLUDE: 'qbx.bi'  'change to qbx.bi  in qb 4.5
'$DYNAMIC

'The header:

TYPE bmpinfo              'what it should say for a 320*200*256 bmp
	bm AS STRING * 2      'bm
	size AS LONG          'wid*hei+1078= 65078
	r1 AS INTEGER         '0
	r2 AS INTEGER         '0
	offsdata AS LONG      '1078
	hsize AS LONG         '40
	wid AS LONG           '320
	hei AS LONG           '200
	planes AS INTEGER     '1
	bpp AS INTEGER        '8
	comp AS LONG          '0
	isize AS LONG         '64000
	xpm AS LONG           '3790
	ypm AS LONG           '3780
	colus AS LONG         '0
	impcol AS LONG        '0
	pal AS STRING * 1024  'blue, green, red, 0
END TYPE

DIM SHARED BmpHeader AS bmpinfo, regs  AS RegTypeX
DIM Buffer(32000)


WinDir$ = ENVIRON$("winbootdir")
IF RIGHT$(WinDir$, 1) <> "\" THEN WinDir$ = WinDir$ + "\"

SCREEN 13

t! = TIMER   'Time how long it takes

BmpLoad WinDir$ + "logow.sys", VARSEG(Buffer(0)), VARPTR(Buffer(0))
'BmpLoad "c:\windows\logow.sys", &HA000, 0

PUT (0, 0), Buffer(0), PSET

DIM tmpbuf(1000)
GET (142, 91)-(149, 139), tmpbuf: PUT (125, 91), tmpbuf, PSET   ':=)

'BmpSave "test.bmp", VARSEG(Buffer(0)), VARPTR(Buffer(0))
BmpSave "test.bmp", &HA000, 0

PRINT TIMER - t!  'If you can't figure this one out...
SLEEP

SCREEN 0: WIDTH 80

REM $STATIC
SUB BmpLoad (Filename$, Segment, offset)

'Loads the header
OPEN Filename$ FOR BINARY AS #1
GET #1, , BmpHeader  'read it
CLOSE #1

'Loads the palette
OUT &H3C8, 0
FOR i = 1 TO 1024 STEP 4
	b = ASC(MID$(BmpHeader.pal, i, 1)) \ 4      'blue
	g = ASC(MID$(BmpHeader.pal, i + 1, 1)) \ 4  'green
	r = ASC(MID$(BmpHeader.pal, i + 2, 1)) \ 4  'red
	OUT &H3C9, r: OUT &H3C9, g: OUT &H3C9, b
NEXT

Filename$ = Filename$ + CHR$(0) 'filename must be ASCIIZ (zero terminated)

'opens the file
regs.ax = &H3D00
regs.ds = SSEG(Filename$)  'segment of name
regs.dx = SADD(Filename$)  'offset of name
INTERRUPTX &H21, regs, regs
regs.bx = regs.ax 'filehandle

'move filepointer to &h436 in the file
regs.ax = &H4200
regs.cx = 0
regs.dx = &H436
INTERRUPTX &H21, regs, regs

'Read the file

IF BmpHeader.wid > 320 THEN BmpHeader.wid = 320
IF BmpHeader.hei > 200 THEN BmpHeader.hei = 200

IF Segment <> &HA000 THEN
   DEF SEG = Segment
	   Int2Byte ((BmpHeader.wid - 1) * 8 + 8), low, high
	   POKE offset, low: POKE offset + 1, high
	   POKE offset + 2, BmpHeader.hei
   DEF SEG
   offset = offset + 4
END IF

FOR y = BmpHeader.hei - 1 TO 0 STEP -1
	regs.ax = &H3F00
	regs.cx = BmpHeader.wid
	regs.ds = Segment                                         'segment of array
	IF Segment <> &HA000 THEN
	   regs.dx = VAL("&H" + HEX$(y * BmpHeader.wid + offset)) 'offset of array
	ELSE
	   regs.dx = VAL("&H" + HEX$(y * 320& + offset))          'offset of array
	END IF
	INTERRUPTX &H21, regs, regs
NEXT

'close it
regs.ax = &H3E00
INTERRUPTX &H21, regs, regs

Filename$ = LEFT$(Filename$, LEN(Filename$) - 1)  'restore the filename

END SUB

SUB BmpSave (Filename$, Segment, offset)

'reads the palette
OUT &H3C7, 0
FOR i = 0 TO 255
	r = INP(&H3C9) * 4: g = INP(&H3C9) * 4: b = INP(&H3C9) * 4
	a$ = a$ + CHR$(b) + CHR$(g) + CHR$(r) + CHR$(0)
NEXT

IF Segment <> &HA000 THEN
   DEF SEG = Segment
	   low = PEEK(offset): high = PEEK(offset + 1)
	   Byte2Int Maxx, low, high: Maxx = Maxx / 8
	   low = PEEK(offset + 2): high = PEEK(offset + 3)
	   Byte2Int Maxy, low, high
   DEF SEG
   offset = offset + 4
ELSE
   Maxx = 320: Maxy = 200
END IF

'creates the header
BmpHeader.bm = "BM"
BmpHeader.size = (CLNG(Maxx) * CLNG(Maxy)) + 1078&
BmpHeader.r1 = 0
BmpHeader.r2 = 0
BmpHeader.offsdata = 1078
BmpHeader.hsize = 40
BmpHeader.wid = Maxx
BmpHeader.hei = Maxy
BmpHeader.planes = 1
BmpHeader.bpp = 8
BmpHeader.comp = 0
BmpHeader.isize = 64000
BmpHeader.xpm = 3790
BmpHeader.ypm = 3780
BmpHeader.colus = 0
BmpHeader.impcol = 0
BmpHeader.pal = a$

'saves the header
OPEN Filename$ FOR OUTPUT AS #1: CLOSE #1
OPEN Filename$ FOR BINARY AS #1
PUT #1, , BmpHeader 'write the header
CLOSE #1

Filename$ = Filename$ + CHR$(0) 'filename must be ASCIIZ (zero terminated)

'opens the file
regs.ax = &H3D01
regs.ds = SSEG(Filename$)  'segment of filename
regs.dx = SADD(Filename$)  'offset of filename
INTERRUPTX &H21, regs, regs
regs.bx = regs.ax  'filehandle

'moves the filepointer
regs.ax = &H4200
regs.cx = 0
regs.dx = &H436
INTERRUPTX &H21, regs, regs

'saves the screen into the file
FOR y = Maxy - 1 TO 0 STEP -1
	regs.ax = &H4000
	regs.cx = Maxx    'number of bytes to write
	regs.ds = Segment  'screen 13's segment
	regs.dx = VAL("&H" + HEX$(y * CLNG(Maxx) + offset))  'Has to do with QB integers
	INTERRUPTX &H21, regs, regs
NEXT

'close the file
regs.ax = &H3E00
INTERRUPTX &H21, regs, regs

Filename$ = LEFT$(Filename$, LEN(Filename$) - 1)  'restore the filename
END SUB

SUB Byte2Int (word, low, high)

word = (word AND &HFF) OR ((high AND &HFF) * &H100) 'Insert high byte into integer
word = (word AND &HFF00) OR (low AND &HFF)          'Insert low byte into integer

END SUB

SUB Int2Byte (word, low, high)
'extract integer to 2 bytes

high = (word \ &H100) AND &HFF    'Extract high byte from integer
low = word AND &HFF               'Extract low byte from integer

END SUB