Print Page - OpenGl2D Library

Programming => Example Code => Topic started by: Peter on October 06, 2015, 10:28:01 AM

Title: OpenGl2D Library
Post by: Peter on October 06, 2015, 10:28:01 AM

Hello,
yes I see, there's not much interest in sdl library.
what about OpenGl?

I wil start an attempt!
first example: graphics primitives

Code: [Select]

include "ogl.inc"
window 640,480,1

Enable GL_POINT_SMOOTH
Enable GL_LINE_SMOOTH

fontload(1,"glfonts/font15.bmp")

while key(27)=0
cls 100, 100, 100
color 255,255,0,255
line  0,100,639,100,6
color 255,255,0,200
line  0,106,639,106,6
color 255,255,0,128
line  0,112,639,112,6

color    255,200,200,255
box      50, 20,60,60,1
fillbox  110,20,60,60
circle   210,50,40,1
fillcircle 290,50,40
ellipse  370,50,40,20,1
fillellipse 430,50,20,40

color 0,255,255,255
for x=0 to 9
   SetPoint(150+rand(1,19),150+rand(1,19),8)
next

GetPixel(110,112)
text(1,0, 0,"RED   " + str(RED)  ,16,16) 
text(1,0,12,"GREEN " + str(GREEN),16,16) 
text(1,0,24,"BLUE  " + str(BLUE) ,16,16)

redraw
wait 10
wend
winExit

[attachment deleted by admin]

Title: Re: OpenGl2D Library
Post by: Peter on October 06, 2015, 10:31:35 AM

Hi,
second example: lorenz

Code: [Select]

include "ogl.inc"
window 800,700,1

fontload 1,"glfonts/font01.bmp"
Enable GL_POINT_SMOOTH

float x,y,n
string s="LORENZ LANDSCAPE"
Color 255,255,255,255    
    
while key(27)=0
cls 0,0,0
for t=0 to 100000
    x=Sin(t*0.99)-0.7*cos(t*3.01)
    y=Cos(t*1.01)+0.1*sin(t*15.03)
    x=x*200+350
    y=y*200+360
    setpixel y,x
next 

for i=1 to Len(s) 
    text 1,700,32+i*16,Mid(s,i,1),16,16
next 
swap
wait 10
wend
winExit

[attachment deleted by admin]

Title: Re: OpenGl2D Library
Post by: Peter on October 07, 2015, 01:40:15 AM

My attempt seems to have failed! ;D
What now, GDI again or go to hell with your Libraries! :D

Mein Versuch scheint gescheitert! ;D
Was nun, wieder GDI oder geh zur Hölle mit deinen Bibliotheken! :D

Title: Re: OpenGl2D Library
Post by: Mike Lobanovsky on October 07, 2015, 11:21:57 AM

No, of course not! :D

This image (reduced!)

(http://i1240.photobucket.com/albums/gg490/FbslGeek/Ocean.png) (http://s1240.photobucket.com/user/FbslGeek/media/Ocean.png.html)

with all its skies, water, clouds, mist, light shafts is drawn entirely programmatically using a couple of Windows APIs and some very basic BASIC code. Its FBSL implementation is as follows: (watch out for line wrap!)

Code: OxygenBasic

#AppType Console
#Include <Include/Windows.inc>
 
Dim %NZ[511, 511], !WB[1024, 384 To 768], !WX[1023, 384 To 767], !WY[1023, 384 To 767]
Dim %Col[1023, 767], %CC[128, 8]
Dim FC, SX, SY, $PS * 64
 
SetWindowLong(ME, GWL_STYLE, &H6000000)
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_PAINT
      InvalidateRect(ME, NULL, FALSE)
      Render(BeginPaint(ME, PS)): EndPaint(ME, PS): Return 0
  End Select
End Events
 
Sub Render(hDC)
  Initialize()
  Sky()
  Colorize()
  Water()
  Air(hDC)
End Sub
 
Sub Initialize()
  Dim x, y, d = 64, d2 = 128, gtc = GetTickCount()
  
  Print "Running Initialize() ";
  Randomize
  Do
        For y = 0 To 511 Step d2
                For x = 0 To 511 Step d2
                        NZ[(x + d) BAnd 511, y] = (NZ[x, y] + NZ[(x + d2) BAnd 511, y]) * 0.5 + d * (Rnd() - 0.5)
                        NZ[x, (y + d) BAnd 511] = (NZ[x, y] + NZ[x, (y + d2) BAnd 511]) * 0.5 + d * (Rnd() - 0.5)
                        NZ[(x + d) BAnd 511, (y + d) BAnd 511] = (NZ[x, y] + NZ[(x + d2) BAnd 511, (y + d2) BAnd 511] + NZ[x, (y + d2) BAnd 511] + NZ[(x + d2) BAnd 511, y]) * 0.25 + d * (Rnd() - 0.5)
                Next
        Next
        If d = 1 Then Exit Do
        d = d \ 2: d2 = d + d
  Loop
  Print GetTickCount() - gtc, " msec"
End Sub
 
Sub Air(hDC)
  Dim x, y, c, k1, k2, s, gtc = GetTickCount()
 
  Print "Running Air() ";
  For y = 0 To 767
    k1 = (1 - Abs(383.5 - y) / 384) ^ 5
    For x = 0 To 1023
      If y = SY Then
        k2 = 0.25
      Else
        k2 = ATn((x - SX) / (y - SY)) / M_TWOPI + 0.25
      End If
      If y - SY < 0 Then k2 = k2 + 0.5
      k2 = BN(k2 * 512, 0) * 0.03
      k2 = 0.2 - k2 ^ 2: If k2 < 0 Then k2 = 0
      s = 30 / SqR((x - SX) ^ 2 + (y - SY) ^ 2)
      If s > 1 Then s = 1
      c = Lerp(&HFFFFFF, FC, k2 * (1 - s))
      SetPixelV(hDC, x, y, Lerp(c, Col[x, y], k1))
    Next
  Next
  Print GetTickCount() - gtc, " msec"
End Sub
 
Sub Water()
  Dim x, y, x1, y1, k, kx, sx1, sy1, sx2, sy2, gtc = GetTickCount()
  
  Print "Running Water() ";
  For y = 767 DownTo 384
    k = (y - 383) * 0.5: kx = (900 - y) / 580
    For x = 1023 DownTo 0
      sy1 = 64000 / (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
      x1 = Abs(x + WX[x, y])
      y1 = 768 - y + WY[x, y]
      If y1 < 0 Then
        y1 = 0
      ElseIf y1 > 383 Then
        y1 = 383
      End If
      Col[x, y] = Lerp(BC(x1 / 8 / 2, y1 / 48 / 2), &H251510, kx) ' water tint
    Next
  Next
  Print GetTickCount() - gtc, " msec"
End Sub
 
Sub Sky()
  Dim x, y, c1, c2, k, s, sx1, sy1, dy, gtc = GetTickCount()
  
  Print "Running Sky() ";
  SX = 100 + Rnd() * 824: SY = 192 + Rnd() * 157
  For y = 0 To 383
    sy1 = 100000 / (390 - y)
    For x = 0 To 1023
      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 Then
        k = 0
      Else
        k = (k + 8) * 0.02 ' cloud density
      End If
      If k > 1 Then k = 1
      dy = y / 384
      FC = &H908000 + (SY + 500) * 0.2 ' haze tint
      c1 = Lerp(FC + 25, &H906050, dy)
      c2 = Lerp(&H807080, &HD0D0D0, dy)
      s = 30 / SqR((x - SX) ^ 2 + (y - SY) ^ 2) ' sun size
      If s > 1 Then s = 1
      c1 = Lerp(&HFFFFFF, c1, s)
      Col[x, y] = Lerp(c2, c1, k)
    Next
  Next
  Print GetTickCount() - gtc, " msec"
End Sub
 
Sub Colorize()
  Dim x, y, xx, yy, c, r, g, b, gtc = GetTickCount()
  
  Print "Running Colorize() ";
  For x = 0 To 127
        For y = 0 To 7
                Let(r, g, b) = 0
                For yy = 0 To 47
                        For xx = 0 To 7
                                c = Col[xx + x * 8, yy + y * 48]
                                r = r + (c BAnd &HFF)
                                g = g + (c BAnd &HFF00)
                                b = b + ((c BAnd &HFF0000) >> 8)
                        Next
                Next
                CC[x, y] = r \ 384 + ((g \ 384) BAnd &HFF00) + (((b \ 384) BAnd &HFF00) << 8)
        Next
        CC[x, 8] = CC[x, 7]
  Next
  Print GetTickCount() - gtc, " msec"
End Sub
 
Function BC(x, y)
  Dim ix = Floor(x), iy = Floor(y), SX = x - ix, SY = y - iy, c0, c1, c2, c3
  Dim ixy = (1 - SX) * (1 - SY), isxy = SX * (1 - SY), isyx = SY * (1 - SX), xy = SX * SY
  
  c0 = CC[ix BAnd 127, iy Mod 9]
  c1 = CC[(ix + 1) BAnd 127, iy Mod 9]
  c2 = CC[ix BAnd 127, (iy + 1) Mod 9]
  c3 = CC[(ix + 1) BAnd 127, (iy + 1) Mod 9]
  
  Return (c0 BAnd &HFF) * ixy + (c1 BAnd &HFF) * isxy + (c2 BAnd &HFF) * isyx + (c3 BAnd &HFF) * xy + _
  ((c0 BAnd &HFF00) * ixy + (c1 BAnd &HFF00) * isxy + (c2 BAnd &HFF00) * isyx + (c3 BAnd &HFF00) * xy BAnd &HFF00) + _
  ((c0 BAnd &HFF0000) * ixy + (c1 BAnd &HFF0000) * isxy + (c2 BAnd &HFF0000) * isyx + (c3 BAnd &HFF0000) * xy BAnd &HFF0000)
End Function
 
Function BN(x, y)
  Dim ix = Floor(x), iy = Floor(y), SX = x - ix, SY = y - iy, isx = 1 - SX, isy = 1 - SY, dx = (ix + 1) BAnd 511, dy = (iy + 1) BAnd 511
  
  ix = ix BAnd 511: iy = iy BAnd 511
  Return NZ[ix, iy] * isx * isy + NZ[dx, iy] * SX * isy + NZ[ix, dy] * isx * SY + NZ[dx, dy] * SX * SY
End Function
 
Function Lerp(c1, c2, k)
        Return((c1 BAnd &HFF) * k + (c2 BAnd &HFF) * (1 - k)) BOr (((c1 BAnd &HFF00) * k + (c2 BAnd &HFF00) * (1 - k)) BAnd &HFF00) BOr (((c1 BAnd &HFF0000) * k + (c2 BAnd &HFF0000) * (1 - k)) BAnd &HFF0000)
End Function

where % stands for As Long or Cast Long, ! same for Single, $ same for String, BAnd means binary And, and M_TWOPI denotes Pi * 2. Untyped variables are of type As Variant, which means they will store or pass any type assigned to them according to the types of expression operands and operators used for their assignment. For example, a Variant will become Double if floating-point division / is used, or Long if integer division \ is used.

Can any of your libraries or Win API + O2 code draw a similar picture? :)

Title: Re: OpenGl2D Library
Post by: Peter on October 07, 2015, 12:29:39 PM

Hi Mike
Great thing what you are showing here!

Quote

Can any of your libraries or Win API + O2 code draw a similar picture?

Of course not!

These libraries haven't enough power like FBSL.

Quote

Dim %NZ[511, 511], !WB[1024, 384 To 768], !WX[1023, 384 To 767], !WY[1023, 384 To 767]
Dim %Col[1023, 767], %CC[128, 8]

Quote

NZ[(x + d) BAnd 511, y] = (NZ[x, y] + NZ[(x + d2) BAnd 511, y]) * 0.5 + d * (Rnd() - 0.5)

This would be a handicap with OxygenBasic.
I think it's very much work, qualitatively to do the same with my puny libraries & OxygenBasic.

Many thanks for asking.

Title: Re: OpenGl2D Library
Post by: Aurel on October 07, 2015, 12:31:02 PM

Hey Mike
you must post this on bp.org forum and ask super ZXdunny is
there a way in spec<bas to draw uch a image ;D ;D

well i think that is possible to draw such a image with winApi in o2

Title: Re: OpenGl2D Library
Post by: Mike Lobanovsky on October 07, 2015, 03:06:35 PM

Hello Peter,

First of all, I must note you're making remarkably good progress with your English. My sincere compliments! :)

Secondly, please get me right; I was not trying to mock or diminish your work or your libraries. I just know that uneasy feeling very well when you've been working on something for a long time only to find in the end that nobody seems to take visible interest in your results. Then you get frustrated, and everything is falling out of your hands, and you can't find anything to occupy yourself with and recover from depression and despondency. :)

Porting someone else's code proved a good remedy for me in the past and I just thought that perhaps you might find it useful as well.

Hello Aurel,

Yes, I think it is perfectly feasible to translate this code to OxygenBasic. Each two-dimensional array will just have to be split in two linear arrays of matching size. The lower bound of those formerly second-dimension arrays can start at 0 and you can simply ignore those lower elements that aren't useful for your code. Similar to VB, FBSL has means to eliminate them completely in order to reduce memory usage because every FBSL variable regardless of its data type is in fact at least a 20 byte long Variant structure.

On splitting the arrays, most headaches will be over because O2 seems to have all other instruments to reimplement this code almost word for word.

But no, I won't be showing off anything at BP. I'm waking up from my usual standby lurking mode only when Jochen attacks the C language (that's my everyday programming instrument) over there for no apparent reason. :)

Title: Re: OpenGl2D Library
Post by: Patrice Terrier on October 08, 2015, 01:04:12 AM

Mike--

Do you have the same source code in either plain PowerBASIC or C++ (without variant) ?

I would like to give it a try in true compiled mode, thank you.

...

Title: Re: OpenGl2D Library
Post by: Patrice Terrier on October 08, 2015, 07:16:44 AM

I did translate Mike's code to PB, however i must have done several errors in the translation, because what i get is rather far from the posted screen shot.

I would say however than the use of SetPixel (even SetPixelV) is known to be notoriously slow, and i would rather use a memory DIB bitmap to setup the pixels using direct addressing (pointer), then BitBlting everything in WM_PAINT in a blink eye.

...

Title: Re: OpenGl2D Library
Post by: Peter on October 08, 2015, 09:06:10 AM

Hello,

Quote

I did translate Mike's code to PB, however i must have done several errors in the translation, because what i get is rather far from the posted screen shot.

How does it look?

Title: Re: OpenGl2D Library
Post by: Aurel on October 08, 2015, 09:22:57 AM

Quote

and i would rather use a memory DIB bitmap to setup the pixels using direct addressing (pointer), then BitBlting everything in WM_PAINT in a blink eye.

yes we like to know that ...if is not a problem.... ;)

Title: Re: OpenGl2D Library
Post by: Patrice Terrier on October 08, 2015, 09:35:52 AM

Mike is using a client size of 1024 x 768, and a fixed window (no resize), then all you have to do is to create a memory bitmap of the same size using for example CreateDIBSection.

Code: [Select]

FUNCTION zCreateDIBSection(BYVAL hDC AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL BitCount AS LONG) AS LONG
    LOCAL bi AS BITMAPINFO
    bi.bmiHeader.biSize = SIZEOF(bi.bmiHeader)
    bi.bmiHeader.biWidth = nWidth
    bi.bmiHeader.biHeight = nHeight
    bi.bmiHeader.biPlanes = 1
    bi.bmiHeader.biBitCount = BitCount
    bi.bmiHeader.biCompression = %BI_RGB
    FUNCTION = CreateDIBSection(hDC, bi, %DIB_RGB_COLORS, 0, 0, 0)
END FUNCTION

Title: Re: OpenGl2D Library
Post by: Aurel on October 08, 2015, 09:49:57 AM

Thanks Patrice...
but if I understand ..first we must define BITMAPINFO header ..right?
just a function is not enough...

which other api functions are required?

Title: Re: OpenGl2D Library
Post by: Aurel on October 08, 2015, 09:56:59 AM

I just look into Jose Roca site and found this :

Description

The DIBSECTION structure contains information about a DIB created by calling the CreateDIBSection function. A DIBSECTION structure includes information about the bitmap's dimensions, color format, color masks, optional file mapping object, and optional bit values storage offset. An application can obtain a filled-in DIBSECTION structure for a given DIB by calling the GetObject function.

C++ Syntax

typedef struct tagDIBSECTION {

BITMAP dsBm;

BITMAPINFOHEADER dsBmih;

DWORD dsBitfields[3];

HANDLE dshSection;

DWORD dsOffset;

} DIBSECTION, *PDIBSECTION;

PowerBASIC Syntax

TYPE DIBSECTION

dsBm AS BITMAP

dsBmih AS BITMAPINFOHEADER

dsBitfields(2) AS DWORD

dshSection AS DWORD

dsOffset AS DWORD

END TYPE

Members

dsBm

A BITMAP data structure that contains information about the DIB: its type, its dimensions, its color capacities, and a pointer to its bit values.

dsBmih

A BITMAPINFOHEADER structure that contains information about the color format of the DIB.

dsBitfields

Specifies three color masks for the DIB. This field is only valid when the BitCount member of the BITMAPINFOHEADER structure has a value greater than 8. Each color mask indicates the bits that are used to encode one of the three color channels (red, green, and blue).

dshSection

Contains a handle to the file mapping object that the CreateDIBSection function used to create the DIB. If CreateDIBSection was called with a NULL value for its hSection parameter, causing the system to allocate memory for the bitmap, the dshSection member will be NULL.

dsOffset

Specifies the offset to the bitmap's bit values within the file mapping object referenced by dshSection. If dshSection is NULL, the dsOffset value has no meaning.

Title: Re: OpenGl2D Library
Post by: Mike Lobanovsky on October 08, 2015, 04:39:29 PM

Hi Patrice,

Currently, this code exists only in FBSL BASIC and VB6. The VB6 implementation uses Form.AutoRedraw = TRUE which effectively means its internal PSet() interpretation (~ SetPixelV() here) draws directly into the DIB section pixel array and then simply blits the array on screen as needed in response to the incoming WM_PAINT messages. But even when compiled to native code, autoredraw-able VB6 is only some 5 times faster than this interpretative FBSL script.

I can try and re-write it in FBSL's Dynamic C, which will make the script code suitable for use in any static C compiler with just a couple of C-language standard system include files and a few extra lines to create a window to draw to instead of FBSL's default main window created automatically at app start (in FBSL, we refer to its hWnd traditionally as ME) that DynC will be using for its graphic output.

Please stay tuned. :)

(Note that each generated image is unique in size and position of sun, light shafts, clouds, and sea waves)

Title: Re: OpenGl2D Library
Post by: Patrice Terrier on October 09, 2015, 12:53:49 AM

Mike

Maybe that rough PB SDK code translation, could help you to convert it into true compiled code.

ML.bas main code

Code: [Select]

#COMPILE EXE "ML.exe"

#INCLUDE "MiniPB.inc" '// Flat API declaration
'MACRO Pi = 3.141592653589793##
'MACRO HalfPI = 1.5707963267948965##
'MACRO PiDiv4 = 0.785398163397448##
MACRO M_TWOPI = 6.28318530718##

'SetWindowLong(ME, GWL_STYLE, &H6000000)
%ClientW            = 1024
%ClientH            = 768

TYPE PROP
    hMain           as dword
    MinTrackSizeW   as long
    MinTrackSizeH   as long
    col(1023, 767)  as long
    CC(128, 8)      as long
    NZ(511, 511)    as long
    WB(1024, 384 to 768) as single
    WX(1023, 384 to 767) as single
    WY(1023, 384 to 767) as single
    FC              as single
    SX              as single
    SY              as single
END TYPE

GLOBAL gP as PROP ''// Global class properties

function Lerp(byval c1 as single, byval c2 as single, byval k as single) as dword
    function = ((c1 and &HFF) * k + (c2 and &HFF) * (1 - k)) or (((c1 and &HFF00) * k + (c2 and &HFF00) * (1 - k)) and &HFF00) or (((c1 and &HFF0000) * k + (c2 and &HFF0000) * (1 - k)) and &HFF0000)
end function

function BC(byval x as single, byval y as single) as single
    local ix, iy as long
    ix = round(x, 0): iy = round(y, 0)
    gP.SX = x - ix: gP.SY = y - iy
    local c0, c1, c2, c3 as long
    local ixy, isyx, isxy, xy as single
    ixy = (1 - gP.SX) * (1 - gP.SY)
    isxy = gP.SX * (1 - gP.SY)
    isyx = gP.SY * (1 - gP.SX)
    xy = gP.SX * gP.SY

    c0 = gP.CC(ix and 127, iy mod 9)
    c1 = gP.CC((ix + 1) and 127, iy mod 9)
    c2 = gP.CC(ix and 127, (iy + 1) mod 9)
    c3 = gP.CC((ix + 1) and 127, (iy + 1) mod 9)

    function = (c0 and &HFF) * ixy + (c1 and &HFF) * isxy + (c2 and &HFF) * isyx + (c3 and &HFF) * xy + _
               ((c0 and &HFF00) * ixy + (c1 and &HFF00) * isxy + (c2 and &HFF00) * isyx + (c3 and &HFF00) * xy and &HFF00) + _
               ((c0 and &HFF0000) * ixy + (c1 and &HFF0000) * isxy + (c2 and &HFF0000) * isyx + (c3 and &HFF0000) * xy and &HFF0000)
end function

function BN(byval x as single, byval y as single) as long
    local ix, iy, idx, idy as long
    ix = round(x, 0): iy = round(y, 0)
    local ssx, ssy as single
    gP.SX = x - ix: gP.SY = y - iy
    ssx = 1 - gP.SX: ssy = 1 - gP.SY
    idx = (ix + 1) and 511: idy = (iy + 1) and 511
    ix = ix and 511: iy = iy and 511
    function = gP.NZ(ix, iy) * ssx * ssy + gP.NZ(idx, iy) * gP.SX * ssy + gP.NZ(ix, idy) * ssx * gP.SY + gP.NZ(idx, idy) * gP.SX * gP.SY
end function

Sub Air(byval hDC as dword)
    local x, y as long, c as dword, k1, k2, s as single
    'local gtc as dword: gtc = GetTickCount()
    'print "Running Air() ";
    for y = 0 to 767
        k1 = (1 - abs(383.5 - y) / 384) ^ 5
        for x = 0 to 1023
            if (y = gP.SY) then
                k2 = 0.25
            else
                k2 = atn((x - gP.SX) / (y - gP.SY)) / M_TWOPI + 0.25
            end if
            if (y - gP.SY < 0) then k2 = k2 + 0.5
            k2 = BN(k2 * 512, 0) * 0.03
            k2 = 0.2 - k2 ^ 2: if k2 < 0 then k2 = 0
            s = 30 / sqr((x - gP.SX) ^ 2 + (y - gP.SY) ^ 2)
            if (s > 1) then s = 1
            c = Lerp(&HFFFFFF, gP.FC, k2 * (1 - s))
            SetPixelV(hDC, x, y, Lerp(c, gP.col(x, y), k1))
        next
    next
    'Print GetTickCount() - gtc, " msec"
end sub

sub Water()
    local sx1, sy1, sx2, sy2 as single
    local x, y, x1, y1, k, kx as long
    'local gtc as dword: gtc = GetTickCount()
    'Print "Running Water() "

    for y = 767 to 384 step -1
        k = (y - 383) * 0.5: kx = (900 - y) / 580
        for x = 1023 to 0 step -1
            sy1 = 64000 / (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
            gP.WB(x, y) = BN(sx1, sy1) - BN(sx2, sy2)
            gP.WX(x, y) = (gP.WB(x + 1, y) - gP.WB(x, y)) * k * kx
            gP.WY(x, y) = (gP.WB(x, y + 1) - gP.WB(x, y)) * k
            x1 = abs(x + gP.WX(x, y))
            y1 = 768 - y + gP.WY(x, y)
            if (y1 < 0) then
                y1 = 0
            elseif (y1 > 383) then
                y1 = 383
            end if
            gP.col(x, y) = Lerp(BC(x1 / 8 / 2, y1 / 48 / 2), &H251510, kx) ' water tint
        next
    next
    'Print GetTickCount() - gtc, " msec"
end sub

sub Sky()
    local x, y, k as long
    local c1, c2 as dword
    local s, sx1, sy1, dy as single
    'local gtc as dword: gtc = GetTickCount()
    'Print "Running Sky() ";

    gP.SX = 100 + rnd() * 824: gP.SY = 192 + rnd() * 157

    for y = 0 to 383
        sy1 = 100000 / (390 - y)
        for x = 0 to 1023
            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) then
                k = 0
            else
                k = (k + 8) * 0.02 ' cloud density
            end if
            if (k > 1) then k = 1
            dy = y / 384
            gP.FC = &H908000 + (gP.SY + 500) * 0.2 ' haze tint
            c1 = Lerp(gP.FC + 25, &H906050, dy)
            c2 = Lerp(&H807080, &HD0D0D0, dy)
            s = 30 / sqr((x - gP.SX) ^ 2 + (y - gP.SY) ^ 2) ' sun size
            if (s > 1) then s = 1
            c1 = Lerp(&HFFFFFF, c1, s)
            gP.col(x, y) = Lerp(c2, c1, k)
        next
    next
    'Print GetTickCount() - gtc, " msec"
end sub

sub Colorize()
    local x, y, xx, yy, c, r, g, b, nc as long
    'local gtc as dword: gtc = GetTickCount()
    'Print "Running Colorize() ";

    for x = 0 to 127
        for y = 0 to 7
            r = g = b = 0
            for yy = 0 to 47
                for xx = 0 to 7
                    c = gP.col(xx + x * 8, yy + y * 48)
                    r = r + (c and &HFF)
                    g = g + (c and &HFF00)
                    nc = c and &HFF0000: shift right nc, 8
                    b = b + nc
                next
            next
            nc = (b \ 384) and &HFF00: shift left nc, 8
            gP.CC(x, y) = r \ 384 + ((g \ 384) and &HFF00) + nc
        next
        gP.CC(x, 8) = gP.CC(x, 7)
    next
    'Print GetTickCount() - gtc, " msec"
end sub

sub Initialize()
    local x, y, d, d2 as long
    d = 64: d2 = 128

    'local gtc as dword: gtc = GetTickCount()
    'Print "Running Initialize() ";

    randomize
    do
        for y = 0 to 511 step d2
            for x = 0 to 511 step d2
                gP.NZ((x + d) and 511, y) = (gP.NZ(x, y) + gP.NZ((x + d2) and 511, y)) * 0.5 + d * (rnd() - 0.5)
                gP.NZ(x, (y + d) and 511) = (gP.NZ(x, y) + gP.NZ(x, (y + d2) and 511)) * 0.5 + d * (rnd() - 0.5)
                gP.NZ((x + d) and 511, (y + d) and 511) = (gP.NZ(x, y) + gP.NZ((x + d2) and 511, (y + d2) and 511) + gP.NZ(x, (y + d2) and 511) + gP.NZ((x + d2) and 511, y)) * 0.25 + d * (rnd() - 0.5)
            next
        next
        if d = 1 then exit do
        d = d \ 2: d2 = d + d
    loop
    'Print GetTickCount() - gtc, " msec"
end sub

sub RenderScene(byval hDC as dword)
    Initialize()
    Sky()
    Colorize()
    Water()
    Air(hDC)
end sub

function WndProc(byval hWnd as dword, byval Msg as dword, byval wParam as dword, byval lParam as dword) as long
    LOCAL ps as PAINTSTRUCT
    LOCAL rc as RECT

    SELECT CASE long Msg

    CASE %WM_GETMINMAXINFO
         LOCAL pMM as MINMAXINFO PTR
         pMM = lParam
         @pMM.ptMinTrackSize.x = gP.MinTrackSizeW
         @pMM.ptMinTrackSize.y = gP.MinTrackSizeH

    'case %WM_NCHITTEST
    '     function = 2 ' %HTCAPTION
    '     exit function

    CASE %WM_SIZE
         InvalidateRect(hWnd, byval(%NULL), %TRUE)

    CASE %WM_COMMAND
         LOCAL wmId, wmEvent as long
         wmID    = LOINT(wParam)
         wmEvent = HIINT(wParam)
         '//SELECT CASE long LOWRD(wParam)
         '//
         '//END SELECT

    CASE %WM_PAINT
         LOCAL hDC as dword
         'InvalidateRect(hWnd, %NULL, %FALSE)
         hDC = BeginPaint(hWnd, ps)
         '// Paint the window content here
         RenderScene(hDC)
         EndPaint(hWnd, ps)
         function = 0: EXIT function

    CASE %WM_DESTROY
         PostQuitMessage(0)
         function = 0: EXIT function

    END SELECT

    function = DefWindowProc(hWnd, Msg, wParam, lParam)

end function

function WinMain (byval hInstance     as long, _
                  byval hPrevInstance as long, _
                  byval lpCmdLine     as ASCIIZ PTR, _
                  byval iCmdShow      as long) as long

    LOCAL nRet     as dword
    LOCAL wcx      as WNDCLASSEXA
    LOCAL szClass  as ASCIIZ * 16
    szClass = "FLAT_API_POPUP" '// The class name of our popup window.

    wcx.cbSize = SIZEOF(wcx)
    LOCAL IsInitialized as long
    IsInitialized = GetClassInfoEx(hInstance, szClass, wcx)
    if IsInitialized&   = 0 then
        wcx.style         = %CS_HREDRAW OR %CS_VREDRAW
        wcx.lpfnWndProc   = CODEPTR(WndProc)
        wcx.cbClsExtra    = 0
        wcx.cbWndExtra    = 0 '// %EXTEND_EXTRA * 4
        wcx.hInstance     = hInstance
        wcx.hIcon         = %NULL
        wcx.hCursor       = LoadCursor(%NULL, byval %IDC_ARROW)
        wcx.hbrBackground = GetStockObject(%WHITE_BRUSH)
        wcx.lpszMenuName  = %NULL
        wcx.lpszClassName = VARPTR(szClass)
        wcx.hIconSm       = wcx.hIcon
        if RegisterClassEx(wcx) then IsInitialized = %TRUE
    end if

    if (IsInitialized) then
        LOCAL r as RECT
        LOCAL uMsg as TagMSG
        LOCAL dwExStyle, dwStyle, hMain as dword
        LOCAL x, y as long

        dwExStyle = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
        dwStyle = %WS_POPUP OR %WS_CAPTION OR %WS_SYSMENU OR %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN

        SetRect(r, 0, 0, %ClientW, %ClientH)
        AdjustWindowRectEx(r, dwStyle, %FALSE, dwExStyle)

        gP.MinTrackSizeW = r.nRight - r.nLeft
        gP.MinTrackSizeH = r.nBottom - r.nTop
        x = MAX&((GetSystemMetrics(%SM_CXSCREEN) - gP.MinTrackSizeW) \ 2, 0)
        y = MAX&((GetSystemMetrics(%SM_CYSCREEN) - gP.MinTrackSizeH) \ 2, 0)

        gP.hMain = CreateWindowEx(dwExStyle, szClass, "Popup window 32-bit", dwStyle, _
                                  x, y, gP.MinTrackSizeW, gP.MinTrackSizeH, 0, 0, hInstance, byval %NULL)

        if (gP.hMain) then

            ShowWindow(gP.hMain, iCmdShow)
            SetForegroundWindow(gP.hMain) '// Slightly Higher Priority

            WHILE GetMessage(uMsg, %NULL, 0, 0)
                 TranslateMessage(uMsg)
                 DispatchMessage(uMsg)
            WEND

            nRet = uMsg.wParam
        end if

    end if

    function = nRet
end function

MiniPB.inc include

Code: [Select]

'// Flat API declaration

%CS_VREDRAW             = &H0001
%CS_HREDRAW             = &H0002

%SM_CXSCREEN            = 0
%SM_CYSCREEN            = 1

%IDC_ARROW              = 32512

%WS_BORDER              = 8388608
%WS_POPUP               = -2147483648
%WS_CHILD               = 1073741824
%WS_VISIBLE             = 268435456
%WS_CLIPSIBLINGS        = 67108864
%WS_CLIPCHILDREN        = 33554432
%WS_CAPTION             = 12582912
%WS_SYSMENU             = 524288
%WS_THICKFRAME          = 262144
%WS_MINIMIZEBOX         = 131072
%WS_MAXIMIZEBOX         = 65536
%WS_TABSTOP             = %WS_MAXIMIZEBOX
%WS_VSCROLL             = 2097152

%WS_EX_APPWINDOW        = 262144
%WS_EX_WINDOWEDGE       = 256

%WM_CREATE              = &H1
%WM_DESTROY             = &H2
%WM_PAINT               = &HF
%WM_CLOSE               = &H10
%WM_COMMAND             = &H111
%WM_GETMINMAXINFO       = &H24

%TRUE                   = 1
%FALSE                  = 0
%NULL                   = 0

%SW_HIDE                = 0
%SW_SHOW                = 5

%WHITE_BRUSH            = 0

TYPE POINT
    x AS LONG   '// long x
    y AS LONG   '// long y
END TYPE

TYPE TagMSG
    hWnd     AS DWORD   '// HWND hwnd
    nMessage AS DWORD   '// UINT Message
    wParam   AS DWORD   '// WPARAM wParam
    lParam   AS DWORD   '// LPARAM lParam
    nTime    AS DWORD   '// DWORD time
    pt       AS POINT   '// POINT pt
END TYPE

TYPE RECT
    nLeft   AS LONG   '// long Left
    nTop    AS LONG   '// long top
    nRight  AS LONG   '// long Right
    nBottom AS LONG   '// long bottom
END TYPE

TYPE WNDCLASSEXA
    cbSize          AS DWORD        '//Type C : UINT
    style           AS DWORD        '//Type C : UINT
    lpfnWndProc     AS DWORD        '//Type C : WNDPROC
    cbClsExtra      AS LONG         '//Type C : int
    cbWndExtra      AS LONG         '//Type C : int
    hInstance       AS DWORD        '//Type C : HINSTANCE
    hIcon           AS DWORD        '//Type C : HICON
    hCursor         AS DWORD        '//Type C : HCURSOR
    hbrBackground   AS DWORD        '//Type C : HBRUSH
    lpszMenuName    AS DWORD        '//Type C : LPCSTR
    lpszClassName   AS DWORD        '//Type C : LPCSTR
    hIconSm         AS DWORD        '//Type C : HICON   
END TYPE

TYPE PAINTSTRUCT
    hdc             AS DWORD        '//Type C : HDC
    fErase          AS LONG         '//Type C : BOOL
    rcPaint         AS RECT         '//RECT est une autre structure
    fRestore        AS LONG         '//Type C : BOOL
    fIncUpdate      AS LONG         '//Type C : BOOL
    rgbReserved     AS ASCIIZ * 32  '//Type C : BYTE
END TYPE

TYPE MINMAXINFO
    ptReserved      AS POINT
    ptMaxSize       AS POINT
    ptMaxPosition   AS POINT
    ptMinTrackSize  AS POINT
    ptMaxTrackSize  AS POINT
END TYPE

DECLARE FUNCTION AdjustWindowRectEx LIB "USER32.DLL" ALIAS "AdjustWindowRectEx" (lpRect AS RECT, BYVAL dsStyle AS LONG, BYVAL bMenu AS LONG, BYVAL dwEsStyle AS DWORD) AS LONG
DECLARE FUNCTION BeginPaint LIB "USER32.DLL" ALIAS "BeginPaint" (BYVAL hWnd AS DWORD, lpPaint AS PAINTSTRUCT) AS LONG
DECLARE FUNCTION CreateWindowEx LIB "USER32.DLL" ALIAS "CreateWindowExA" (BYVAL dwExStyle AS DWORD, lpClassName AS ASCIIZ, lpWindowName AS ASCIIZ, BYVAL dwStyle AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG, _
                 BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, BYVAL hWndParent AS DWORD, BYVAL hMenu AS DWORD, BYVAL hInstance AS DWORD, lpParam AS ANY) AS DWORD
DECLARE FUNCTION DefWindowProc LIB "USER32.DLL" ALIAS "DefWindowProcA" (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
DECLARE FUNCTION DispatchMessage LIB "USER32.DLL" ALIAS "DispatchMessageA" (lpMsg AS tagMSG) AS LONG
DECLARE FUNCTION EndPaint LIB "USER32.DLL" ALIAS "EndPaint" (BYVAL hWnd AS DWORD, lpPaint AS PAINTSTRUCT) AS LONG
DECLARE FUNCTION GetClassInfoEx LIB "USER32.DLL" ALIAS "GetClassInfoExA" (BYVAL hInst AS DWORD, lpszClass AS ASCIIZ, lpWndClass AS WNDCLASSEXA) AS LONG
DECLARE FUNCTION GetMessage LIB "USER32.DLL" ALIAS "GetMessageA" (lpMsg AS tagMSG, BYVAL hWnd AS DWORD, BYVAL uMsgFilterMin AS DWORD, BYVAL uMsgFilterMax AS DWORD) AS LONG
DECLARE FUNCTION GetStockObject LIB "GDI32.DLL" ALIAS "GetStockObject" (BYVAL nIndex AS LONG) AS DWORD
DECLARE FUNCTION GetSystemMetrics LIB "USER32.DLL" ALIAS "GetSystemMetrics" (BYVAL nIndex AS LONG) AS LONG
DECLARE FUNCTION InvalidateRect LIB "USER32.DLL" ALIAS "InvalidateRect" (BYVAL hWnd AS DWORD, lpRect AS RECT, BYVAL bErase AS LONG) AS LONG
DECLARE SUB      PostQuitMessage LIB "USER32.DLL" ALIAS "PostQuitMessage" (BYVAL nExitCode AS LONG)
DECLARE FUNCTION RegisterClassEx LIB "USER32.DLL" ALIAS "RegisterClassExA" (pcWndClassEx AS WNDCLASSEXA) AS WORD
DECLARE FUNCTION SetForegroundWindow LIB "USER32.DLL" ALIAS "SetForegroundWindow" (BYVAL hWnd AS DWORD) AS LONG
DECLARE FUNCTION SetRect LIB "USER32.DLL" ALIAS "SetRect" (lpRect AS RECT, BYVAL X1 AS LONG, BYVAL Y1 AS LONG, BYVAL X2 AS LONG, BYVAL Y2 AS LONG) AS LONG
DECLARE FUNCTION ShowWindow LIB "USER32.DLL" ALIAS "ShowWindow" (BYVAL hWnd AS DWORD, BYVAL nCmdShow AS LONG) AS LONG
DECLARE FUNCTION TranslateMessage LIB "USER32.DLL" ALIAS "TranslateMessage" (lpMsg AS tagMSG) AS LONG
DECLARE FUNCTION LoadCursor LIB "USER32.DLL" ALIAS "LoadCursorA" (BYVAL hInstance AS DWORD, lpCursorName AS ASCIIZ) AS DWORD
declare function SetPixelV lib "GDI32.DLL" alias "SetPixelV" (byval hDC as dword, byval x as long, byval y as long, byval crColor as dword) as long

This pure SDK code could be easily translated to C/C++, however this one will produce a small 16384 bytes standalone EXE (when compiled with PB 10), and 15872 bytes (with PB 9.05). ;)

Note: for speed and to keep the code small, avoid to use variant like the plague.

...

Title: Re: OpenGl2D Library
Post by: Mike Lobanovsky on October 09, 2015, 04:23:16 AM

Hi Patrice,

Thanks for the PB code! I've got the translation early in the morning but John's servers weren't accessible from this country for quite some time, hence the delay, for which I apologize.

Here comes the Dynamic C script. It uses FBSL's default window to draw to but some generic main window code may be easily added if the DynC portion is used with another static C compiler.

I used a 24-bit DIB and SetPixelV() because it doesn't add much overhead. It adds less than 100 ms extra as compared to setting the DIB pixel values directly but direct writes would require transposition of the array which would also take time and would drive me dizzy. I'm leaving SetPixelV() to you to substitute if necessary. :)

Overall startup time is approx. 0.5 sec on my PC. A precompiled executable is also attached in the zip below. Enjoy! :)

Code: C

// 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);
  double fabs(double);
  double atan(double);
  double sqrt(double);
  double floor(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;
        x1 = fabs(x + WX[x][y]);
        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

[attachment deleted by admin]

Title: Re: OpenGl2D Library
Post by: JRS on October 09, 2015, 04:54:25 AM

Quote

John's servers weren't accessible from this country for quite some time,

And why was that?
Why didn't you e-mail me with the issue on your end?

There was only a short outage a while back due to the All BASIC Blog (WP) with hacking issues turning the server into a spam server and eating resources. (China 'friends')

Title: Re: OpenGl2D Library
Post by: Mike Lobanovsky on October 09, 2015, 05:08:51 AM

Hi John,

Quote from: John on October 09, 2015, 04:54:25 AM

Why didn't you e-mail me with the issue on your end?

I would, if only the problem persisted for over 12 hours but it didn't. The outage does happen from time to time, probably once in two or three weeks for a few hours but of course not as often as in the BP case. At any rate, we aren't as active here now as we used to be, so that isn't a problem for me really. As it happens, fbsl dot net is usually out for a few hours late on Wednesday nights as well (it uses a U.S. server provider) but there it's usually due to maintenance hours.

No big deal, really. :)

Oxygen Basic

Programming => Example Code => Topic started by: Peter on October 06, 2015, 10:28:01 AM