// VB6 code (c)2014 Mikle http://www.fbsl.net/phpbb2
// FBSL port (c)2015 Mike Lobanovsky http://www.fbsl.net/phpbb2
#Include <Include/Windows.inc>
Type BITMAPINFOHEADER Align 2
%biSize
%biWidth
%biHeight
%biPlanes * 16
%biBitCount * 16
%biCompression
%biSizeImage
%biXPelsPerMeter
%biYPelsPerMeter
%biClrUsed
%biClrImportant
End Type
Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
%bmiColors
End Type
Dim %Pixdata[1023, 767]
Dim Dib As BITMAPINFO
With Dib.bmiHeader
.biSize = SizeOf(BITMAPINFOHEADER)
.biWidth = 1024
.biHeight = 768
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
End With
Dim Bmp = CreateDIBSection(GetDC(ME), @Dib, DIB_RGB_COLORS, NULL, NULL, 0)
Dim MemDC = CreateCompatibleDC(GetDC)
SetDIBits(GetDC, Bmp, 0, 768, @Pixdata, @Dib, DIB_RGB_COLORS)
SelectObject(MemDC, Bmp)
ReleaseDC(ME, GetDC)
Render(MemDC)
SetWindowLong(ME, GWL_STYLE, &H6000000)
FbslTile(ME, Bmp)
Resize(ME, 0, 0, 1024, 768)
Center(ME): Show(ME)
Begin Events
Select Case CBMSG
Case WM_NCHITTEST
Return HTCAPTION
Case WM_COMMAND
If CBWPARAM = 2 Then PostMessage(ME, WM_CLOSE, 0, 0)
Case WM_DESTROY
DeleteDC(MemDC)
DeleteObject(Bmp)
End Select
End Events
DynC Render(%dc)
#ifndef M_TWOPI
#define M_TWOPI 6.28318530717958647692 // Pi * 2
#endif
#ifdef RAND_MAX
#undef RAND_MAX
#endif
#define RAND_MAX 32767.0
// *********************************************
// For other C compilers, replace this part with
// #include <windows.h>
// #include <math.h>
// Standard headers may require much stricter
// func parm and local var type definitions
// *********************************************
#ifndef STDCALL
#define STDCALL __attribute__((stdcall))
#endif
double pow(double, double);
int STDCALL RtlZeroMemory(void*, int);
int STDCALL GetTickCount(void);
int STDCALL SetPixelV(int, int, int, int);
// *********************************************
#define Rnd() rand() / RAND_MAX
#define Randomize() srand(GetTickCount())
static int Col[1024][768], CC[128][8], NZ[512][512], WB[1024][768], WX[1024][768], WY[1024][768];
static double SX = 0.0, SY = 0.0, FC = 0.0;
int Lerp(int c1, int c2, double k)
{
double d = 1.0 - k;
return (int)((c1 & 0xFF)* k + (c2 & 0xFF)* d)
| ((int)((c1 & 0xFF00)* k + (c2 & 0xFF00)* d) & 0xFF00)
| ((int)((c1 & 0xFF0000)* k + (c2 & 0xFF0000)* d) & 0xFF0000);
}
double BN(double x, double y) {
int ix
= (int)floor(x
), iy
= (int)floor(y
), dx
= (ix
+ 1) & 511, dy
= (iy
+ 1) & 511; double SX = x - ix, SY = y - iy, isx = 1.0 - SX, isy = 1.0 - SY;
ix &= 511; iy &= 511;
return NZ[ix][iy] * isx * isy + NZ[dx][iy] * SX * isy + NZ[ix][dy] * isx* SY + NZ[dx][dy] * SX * SY;
}
int BC(double x, double y) {
int ix
= (int)floor(x
), iy
= (int)floor(y
), c0
, c1
, c2
, c3
; double SX = x - ix, SY = y - iy, ixy = (1.0 - SX) * (1.0 - SY);
double isxy = SX * (1.0 - SY), isyx = SY * (1.0 - SX), xy = SX * SY;
c0 = CC[ix & 127][iy % 9];
c1 = CC[(ix + 1) & 127][iy % 9];
c2 = CC[ix & 127][(iy + 1) % 9];
c3 = CC[(ix + 1) & 127][(iy + 1) % 9];
return (c0 & 0xFF)* ixy + (c1 & 0xFF)* isxy + (c2 & 0xFF)* isyx + (c3 & 0xFF)* xy
+ ((int)((c0 & 0xFF00)* ixy + (c1 & 0xFF00)* isxy + (c2 & 0xFF00)* isyx + (c3 & 0xFF00)* xy) & 0xFF00)
+ ((int)((c0 & 0xFF0000)* ixy + (c1 & 0xFF0000)* isxy + (c2 & 0xFF0000)* isyx + (c3 & 0xFF0000)* xy) & 0xFF0000);
}
void Initialize()
{
int x, y, d = 64, d2 = 128;
Randomize();
while (1) {
for (y = 0; y < 512; y += d2) {
for (x = 0; x < 512; x += d2) {
NZ[(x + d) & 511][y] = (NZ[x][y] + NZ[(x + d2) & 511][y])* 0.5 + d * (Rnd() - 0.5);
NZ[x][(y + d) & 511] = (NZ[x][y] + NZ[x][(y + d2) & 511]) * 0.5 + d * (Rnd() - 0.5);
NZ[(x + d) & 511][(y + d) & 511] = (NZ[x][y] + NZ[(x + d2) & 511][(y + d2) & 511]
+ NZ[x][(y + d2) & 511] + NZ[(x + d2) & 511][y]) * 0.25 + d * (Rnd() - 0.5);
}
}
if (d == 1) break;
d >>= 1; d2 = d + d;
}
}
void Colorize()
{
int x, y, xx, yy, c, r, g, b;
for (x = 0; x < 128; x++) {
for (y = 0; y < 8; y++) {
r = g = b = 0;
for (yy = 0; yy < 48; yy++) {
for (xx = 0; xx < 8; xx++) {
c = Col[xx + x * 8][yy + y * 48];
r += (c & 0xFF);
g += (c & 0xFF00);
b += ((c & 0xFF0000) >> 8);
}
}
CC[x][y] = r / 384 + ((g / 384) & 0xFF00) + (((b / 384) & 0xFF00) << 8);
}
CC[x][8] = CC[x][7];
}
}
void Sky()
{
int x, y, c1, c2;
double k, s, sx1, sy1, dy;
Initialize();
SX = 100 + Rnd() * 824; SY = 192 + Rnd() * 157;
for (y = 0; y < 384; y++) {
sy1 = 100000.0 / (390.0 - y);
for (x = 0; x < 1024; x++) {
sx1 = (x - 511.5) * sy1 * 0.0005;
k = BN(sx1, sy1) - BN(sx1 * 0.14 + sy1 * 0.21, sy1 * 0.14 - sx1 * 0.21);
if (k < -8.0)
k = 0.0;
else
k = (k + 8.0) * 0.02; // cloud density
if (k > 1.0) k = 1.0;
dy = y / 384.0;
FC = 0x908000 + (SY + 500.0) * 0.2; // haze tint
c1 = Lerp(FC + 25, 0x906050, dy);
c2 = Lerp(0x807080, 0xD0D0D0, dy);
s
= 30.0 / sqrt((x
- SX
) * (x
- SX
) + (y
- SY
) * (y
- SY
)); // sun size if (s > 1.0) s = 1.0;
c1 = Lerp(0xFFFFFF, c1, s);
Col[x][y] = Lerp(c2, c1, k);
}
}
}
void Water()
{
int x, y;
double x1, y1, k, kx, sx1, sy1, sx2, sy2;
Colorize();
for (y = 767; y >= 384; y--) {
k = (y - 383) * 0.5; kx = (900 - y) / 580.0;
for (x = 1023; x >= 0; x--) {
sy1 = 64000.0 / (y - 380);
sx1 = (x - 511.5) * sy1 * 0.002;
sy2 = sy1 * 0.34 - sx1 * 0.71;
sx2 = sx1 * 0.34 + sy1 * 0.71;
sy1 = sy2 * 0.34 - sx2 * 0.21;
sx1 = sx2 * 0.34 + sy2 * 0.21;
WB[x][y] = BN(sx1, sy1) - BN(sx2, sy2);
WX[x][y] = (WB[x + 1][y] - WB[x][y]) * k * kx;
WY[x][y] = (WB[x][y + 1] - WB[x][y]) * k;
y1 = 768.0 - y + WY[x][y];
if (y1 < 0.0)
y1 = 0.0;
else if (y1 > 383.0)
y1 = 383.0;
Col[x][y] = Lerp(BC(x1 / 8, y1 / 48), 0x251510, kx); // water tint
}
}
}
void Air(int hDC)
{
int x, y, c;
double k1, k2, s;
for (y = 0; y < 768; y++) {
k1
= pow((1.0 - fabs(383.5 - y
) / 384.0), 5.0); for (x = 0; x < 1024; x++) {
if (y == SY)
k2 = 0.25;
else
k2
= atan((x
- SX
) / (y
- SY
)) / M_TWOPI
+ 0.25; if (y - SY < 0) k2 = k2 + 0.5;
k2 = BN(k2 * 512.0, 0.0) * 0.03;
k2 = 0.2 - k2 * k2; if (k2 < 0.0) k2 = 0.0;
s
= 30.0 / sqrt((x
- SX
) * (x
- SX
) + (y
- SY
) * (y
- SY
)); if (s > 1.0) s = 1.0;
c = Lerp(0xFFFFFF, FC, k2 * (1.0 - s));
SetPixelV(hDC, x, y, Lerp(c, Col[x][y], k1));
}
}
}
void main(int hDC)
{
RtlZeroMemory(Col, 1024 * 768 * sizeof(int));
RtlZeroMemory(CC, 128 * 8 * sizeof(int));
RtlZeroMemory(NZ, 512 * 512 * sizeof(int));
RtlZeroMemory(WB, 1024 * 768 * sizeof(int));
RtlZeroMemory(WX, 1024 * 768 * sizeof(int));
RtlZeroMemory(WY, 1024 * 768 * sizeof(int));
Sky();
Water();
Air(hDC);
}
End DynC
