' RGBCOL.bas   "true color" experiment                McCopies&D.Stribute 2001
'                             !"FARB-DREIECK"!

DECLARE FUNCTION conv$ (x!)
DECLARE FUNCTION byte4$ (z&)

DECLARE SUB openBMP5 (w%, h%, file$)

CLS : DEFINT A-Z


LOCATE 3, 1: PRINT "RGBCOL.bas"

w = 1024         ' ch's ME/900:  1024x768 16bit "high color"
'w = 640          ' 486SX25 VGA    640x480  4bit 
h = w * 3 / 4

'z = 4
'w = w / z: h = h / z     ' time test 1/z**2

of$ = "c:\rgbcol1x.bmp"

openBMP5 w, h, of$    ' <<< open BMP file as #5 and write header <<<<<<


' Bild Parameter:

y1 = h / 24         ' abstand basis - rand
y2 = h / 2        ' abstand spitze-rand
xm = w / 2    ' mitte horizontal
h1 = h - y1 - y2       ' h”he := "1"
h! = h1 * 1!              ' h”he als realzahl

xmax = w: ymax = h
DIM sq3 AS SINGLE: sq3 = SQR(3!)

LOCATE 8, 1: PRINT "writing to file "; of$


FOR iy = 0 TO ymax - 1   ' zeilen
y! = (iy - y1) / h!

LOCATE 13, 1: PRINT " line "; iy
FOR ix = 0 TO xmax - 1   ' spalten

x! = (ix - xm) / h! * sq3       ' = x * sqr(3)

r! = y!
b! = .5 * (1 + x! - y!)         '  0 < (r,g,b) < 1
g! = .5 * (1 - x! - y!)

r$ = conv$(r!)
g$ = conv$(g!)                  ' 0..255
b$ = conv$(b!)

PRINT #5, b$; g$; r$;    ' <<<<<<<<< write image data <<<<<<<<<<<<<<<<<

NEXT ix
NEXT iy

CLOSE
BEEP

PRINT " done. files closed."

SYSTEM
END

FUNCTION byte4$ (z&)    ' convert long integer to 4 byte string
zz& = z&
b$ = ""

FOR i = 1 TO 4
k% = zz& MOD 256
b$ = b$ + CHR$(k%)
zz& = INT(zz& / 256)
NEXT i

byte4$ = b$

END FUNCTION

FUNCTION conv$ (x!)    '

i% = INT(256 * x!) MOD 256
IF i% < 0 THEN i% = i% + 256

conv$ = CHR$(i%)

END FUNCTION

SUB openBMP5 (w%, h%, file$)

IF w% MOD 4 > 0 OR h% MOD 4 > 0 THEN SYSTEM    ' illegal size for BMP

CLOSE #5
OPEN file$ FOR OUTPUT AS #5

PRINT #5, "BM";
x3& = 3& * w% * h%
x& = x3& / 2 + 27

PRINT #5, byte4$(x&);

PRINT #5, byte4$(0); byte4$(54); byte4$(40);

x& = w%
PRINT #5, byte4$(x&);

x& = h%
PRINT #5, byte4$(x&);

PRINT #5, CHR$(1); CHR$(0);

PRINT #5, byte4$(24); CHR$(0); CHR$(0);

PRINT #5, byte4$(x3&);    '  ???

PRINT #5, CHR$(17); CHR$(23); CHR$(0); CHR$(0);    ' <<<<< ??
PRINT #5, CHR$(17); CHR$(23); CHR$(0); CHR$(0);    ' <<<<< ??

x& = 0&
PRINT #5, byte4$(0);
PRINT #5, byte4$(0);

END SUB