home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
EV61.ARJ
/
B2E.BAS
next >
Wrap
BASIC Source File
|
1995-08-05
|
5KB
|
166 lines
' B2E, BMP to EGT Converter
' by Beowulf Shaeffer 1995
'
' At some places you'll find some dutch words... Enjoy :-)
'
' Dim some stuff...
DIM bmpname AS STRING, buffer AS STRING, colors AS STRING, nieuw AS STRING
' Standard stuff, in ANY program
RANDOMIZE TIMER: ON ERROR GOTO foutje
letop:
' Check if there is a dot at the commandline
plaats = INSTR(COMMAND$, ".")
' Dot present?
IF plaats > 0 THEN
' Yes? Cut name just before
bmpname = LEFT$(COMMAND$, plaats - 1)
ELSE
' No? Don't change
bmpname = COMMAND$
END IF
' Remove trailing and leading spaces
bmpname = RTRIM$(LTRIM$(bmpname))
vgacheck:
' Point to the BIOS data segment 0040:0000
DEF SEG = &H40
' Check bit 0 at 0040:0089
vga = 0 - (PEEK(&H89) AND 1)
' Restore segment to BASIC's-
DEF SEG
' Check for message
IF NOT vga THEN PRINT "No VGA present. Can't continue...": GOTO klaar
okee:
' Prepare 1024 bytes in string "colors"
colors = STRING$(1024, 0)
' I don't remember why I put this here...
nieuw$=""
' Tell DOS that we like to read binary files, and everytime we read, we'd like
' 1024 bytes at a time.
OPEN bmpname + ".bmp" FOR BINARY ACCESS READ AS #1 LEN = 1024
' Check the size of the file
grootte = LOF(1)
' Correct size?
IF grootte <> 65078 THEN GOTO foutje
' Now load the palette in string "colors". The palette begins at byte 55 of
' the BMP file.
GET #1, 55, colors: CLOSE 1
' Switch to mode 13h, MCGA
SCREEN 13
' Prepare 320 bytes (linesize) in string "buffer"
buffer = STRING$(320, 0)
' Tell DOS that we like to read binary files, and everytime we read, we'd like
' 320 bytes at a time.
OPEN bmpname + ".bmp" FOR BINARY ACCESS READ AS #1 LEN = 320
' Vertical position into y%
y% = 200
' Load the first block of bytes into string "buffer"
GET #1, 1078 + 1, buffer
' Process this horizontal line
GOSUB rafel
' Now setup the last 199 horizontal lines to be processed
FOR stuks% = 1 TO y%
' Get the next block of bytes into string "buffer"
GET #1, , buffer
' Process this line also
GOSUB rafel
' Do the next line
NEXT stuks%
' No more need for loading
CLOSE #1
' The picture is on the screen now, BUT the colors are all messed up!
' The palette is processed last, because you can see the progress by looking
' at the screen...
' The new palette is completely empty...
nieuw = ""
' Prepare for colors #0 through #255
FOR stuks% = 0 TO 255
' Get RED component
r = INT(ASC(MID$(colors, stuks% * 4 + 1, 1)) / 4)
' Get GREEN component
g = INT(ASC(MID$(colors, stuks% * 4 + 2, 1)) / 4)
' Get BLUE component
b = INT(ASC(MID$(colors, stuks% * 4 + 3, 1)) / 4)
' The new order is now BGR! And every fourth palette value is thrown away
nieuw = nieuw + CHR$(b) + CHR$(g) + CHR$(r)
' Set this color to the correct one
' This is a very bulky way to do it, but it works
PALETTE stuks%, VAL("&h" + RIGHT$("0" + HEX$(r), 2) + RIGHT$("0" + HEX$(g), 2) + RIGHT$("0" + HEX$(b), 2))
' Do the next color
NEXT stuks%
' Prepare to write the new file with blocks of 768 bytes (palette size)
' We only do this once...
OPEN bmpname + ".egt" FOR BINARY ACCESS WRITE AS #1 LEN = 768
' Write the palette
PUT #1, 1, nieuw
' Stop it
CLOSE #1
' Prepare to write the new file with blocks of 320 bytes (linesize)
OPEN bmpname + ".egt" FOR BINARY ACCESS WRITE AS #1 LEN = 320
' Begin at the top horizontal line
stuks% = 0
' Process that line
GOSUB tsjakka
' Put it in the file just after the palette
PUT #1, 769, buffer
' Prepare the next 199 lines
FOR stuks% = 1 TO 199
' Process that line also
GOSUB tsjakka
' Put the line just after the previous one
PUT #1, , buffer
' Do the next line
NEXT stuks%
klaar:
' Stop the process, and return to textmode
CLOSE : SCREEN 0
SYSTEM: END
' Simple errorroutine
foutje:
PRINT "Sorry, it does not exist, or it's not of the required size!"
GOTO klaar
rafel:
' Prepare 320 pixels horizontally
FOR stuk% = 1 TO 320
' Put the correct pixel on the screen
PSET (stuk% - 1, y%), ASC(MID$(buffer, stuk%, 1))
' Do the next one
NEXT stuk%
' Decrease the vertical position
y% = y% - 1
RETURN
tsjakka:
' Clear the bufferstring
buffer = ""
' Prepare 320 pixels horizontally
FOR stuk% = 1 TO 320
' Get the pixel from the screen
buffer = buffer + CHR$(POINT(stuk% - 1, stuks%))
' Do the next one
NEXT stuk%
RETURN