OpenGL shader language math in FreeBASIC.

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: OpenGL shader language math in FreeBASIC.

Post by Luxan »

I wrote some code to help translate C files to a formatted text file that you might then use
with your shader project.

This might be used with examples similar to those in the references you mentioned.

Elsewhere copyright is definitely mentioned like here :
https://www.shadertoy.com/view/MdX3Rr

However there are rather a lot of possibilities, do , Google search, opengl terrain shader.

Code: Select all

'
'    file_io9.bas
'
'    sciwiseg@gmail.com
'
'    Translate C code to FreeBasic string, write to file .
'
'  This code finds a free file number to use and attempts to open the
' file "file.ext" and if successful, binds our file number to the opened
' file.
'  It reads the file line by line, outputting it to the screen. We loop 
'  until eof() returns true, in this case we ignore the loop if file 
' is empty.
'
'
'
declare sub file2array(bstr() as string, file_name as string)
declare sub array2file( astr() as string, file_name as string )

'
' ----------------------------------------------------------------------
'
Dim As String file_name
Dim As Long file_num, ff
'
dim as string astr(0 to 2)
redim as string bstr(0 to 2)
dim as integer i , ub, lb
'
' ----------------------------------------------------------------------
'
file_name = "terrain_shader.C"
file2array(bstr() , file_name )
' ......................................................................
'
ub = ubound(bstr,1)
lb = lbound(bstr,1)
for i=lb to ub
' print bstr(i)
next i
'
' .................................................
'
'  normal and quoted text from file .
'
lb = lbound(astr,1)
ub = ubound(astr,1)

astr(lb) = "CODE = !" + """"+bstr(lb) + " \n"" "
for i=lb+1 to ub
  astr(i) = "CODE &= !" + """"+bstr(i) + " \n"" "
next i
print
print astr(0)
print astr(1)
print astr(2)
print

'  write to alternate file
file_name = "file2.ext"
array2file( astr(), file_name)

End 0
'
' ======================================================================
'
'astr(0) = "CODE &= !" + """"+astr(0) + " \n"" " ' with print # , this discards quotes .

'
' ----------------------------------------------------------------------
'
sub file2array(bstr() as string, file_name as string)
'
'                   Read from file into an array .
'
dim as long file_num, i
'
'
file_num = FreeFile( )  '' retrieve an available file number
'
'' open our file and bind our file number to it, exit on error
If( Open( file_name For Input As #file_num ) ) Then
   Print "ERROR: opening file " ; file_name
   End -1
End If
i=0
Do Until EOF( file_num )               '' loop until we have reached the end of the file
   Dim As String text
   Line Input #file_num, text               '' read a line of text ...
   i = i + 1                             '' ... and output it to the screen
Loop
print " Number of lines = "; i

redim bstr(0 to i-1)

Close #file_num 
'
file_num = FreeFile( )  '' retrieve an available file number
'
'                        read into string array .
'
'' reopen our file and bind our file number to it, exit on error
If( Open( file_name For Input As #file_num ) ) Then
   Print "ERROR: opening file " ; file_name
   End -1
End If
i=0
Do Until EOF( file_num )               '' loop until we have reached the end of the file
   Line Input #file_num, bstr(i)               '' read a line of text ...
   i=i+1                               '' ... and output it to the screen
Loop
Close #file_num   
'
                     '' close file via our file number
'
end sub
'
' ----------------------------------------------------------------------
'
sub array2file( astr() as string, file_name as string)
'
'                    Write x   Print array to file .
'
 dim as long ff, i, ub , lb
'
 lb = lbound(astr,1)
 ub = ubound(astr,1)
'
 ff = FreeFile()
 Open file_name For Output As #ff
 for i = lb to ub
 '  Write #ff, astr(i)
    Print #ff, astr(i) ' this doesn't produce extra quotes .
 next i
 Close #ff
'
end sub
'
' ----------------------------------------------------------------------
'

Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: OpenGL shader language math in FreeBASIC.

Post by Luxan »

Opps !

Forgot to extend code to translate whole file.
Also decided to use txt extension for output file; try now .

Code: Select all

'
'    file_io9.bas
'
'    sciwiseg@gmail.com
'
'    Translate C code to FreeBasic string, write to file .
'
'  This code finds a free file number to use and attempts to open the
' file "file.ext" and if successful, binds our file number to the opened
' file.
'  It reads the file line by line, outputting it to the screen. We loop 
'  until eof() returns true, in this case we ignore the loop if file 
' is empty.
'
'
'
declare sub file2array(bstr() as string, file_name as string)
declare sub array2file( astr() as string, file_name as string )

'
' ----------------------------------------------------------------------
'
Dim As String file_name
Dim As Long file_num, ff
'
redim as string astr(0 to 2)
redim as string bstr(0 to 2)
dim as integer i , ub, lb
'
' ----------------------------------------------------------------------
'
file_name = "terrain_shader.C"
file2array(bstr() , file_name )
' ......................................................................
'
ub = ubound(bstr,1)
lb = lbound(bstr,1)
for i=lb to ub
' print bstr(i)
next i
'
' .................................................
'
'  normal and quoted text from file .
'
lb = lbound(bstr,1)
ub = ubound(bstr,1)
redim as string astr(lb to ub)

astr(lb) = "CODE = !" + """"+bstr(lb) + " \n"" "
for i=lb+1 to ub
  astr(i) = "CODE &= !" + """"+bstr(i) + " \n"" "
next i

'  write to alternate file
file_name = "file2.txt"
array2file( astr(), file_name)

End 0
'
' ======================================================================
'
sub file2array(bstr() as string, file_name as string)
'
'                   Read from file into an array .
'
dim as long file_num, i
'
'
file_num = FreeFile( )  '' retrieve an available file number
'
'' open our file and bind our file number to it, exit on error
If( Open( file_name For Input As #file_num ) ) Then
   Print "ERROR: opening file " ; file_name
   End -1
End If
i=0
Do Until EOF( file_num )               '' loop until we have reached the end of the file
   Dim As String text
   Line Input #file_num, text               '' read a line of text ...
   i = i + 1                             '' ... and output it to the screen
Loop
print " Number of lines = "; i

redim bstr(0 to i-1)

Close #file_num 
'
file_num = FreeFile( )  '' retrieve an available file number
'
'                        read into string array .
'
'' reopen our file and bind our file number to it, exit on error
If( Open( file_name For Input As #file_num ) ) Then
   Print "ERROR: opening file " ; file_name
   End -1
End If
i=0
Do Until EOF( file_num )               '' loop until we have reached the end of the file
   Line Input #file_num, bstr(i)               '' read a line of text ...
   i=i+1                               '' ... and output it to the screen
Loop
Close #file_num   
'
                     '' close file via our file number
'
end sub
'
' ----------------------------------------------------------------------
'
sub array2file( astr() as string, file_name as string)
'
'                    Write x   Print array to file .
'
 dim as long ff, i, ub , lb
'
 lb = lbound(astr,1)
 ub = ubound(astr,1)
'
 ff = FreeFile()
 Open file_name For Output As #ff
 for i = lb to ub
 '  Write #ff, astr(i)
    Print #ff, astr(i) ' this doesn't produce extra quotes .
 next i
 Close #ff
'
end sub
'
' ----------------------------------------------------------------------
'


Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: OpenGL shader language math in FreeBASIC.

Post by Luxan »

Using the previous code and this new code, merged with some of the existing
FragmentProlog code, I've successfully generated a frame from a demanding render
in a brief amount of time; however animation beyond that isn't apparent and is expected.
Perhaps the FragmentEpilog is unique to each piece of C code .

The prolog fragment also needs to be translated, here's the code for that :

Code: Select all

'
'    file_io10.bas
'
'    sciwiseg@gmail.com
'
'    Translate C code to FreeBasic string, write to file .
'     Prolog fragment
'
'  This code finds a free file number to use and attempts to open the
' file "file.ext" and if successful, binds our file number to the opened
' file.
'  It reads the file line by line, outputting it to the screen. We loop 
'  until eof() returns true, in this case we ignore the loop if file 
' is empty.
'
'
'
declare sub file2array(bstr() as string, file_name as string)
declare sub array2file( astr() as string, file_name as string )

'
' ----------------------------------------------------------------------
'
Dim As String file_name
'
redim as string astr(0 to 2)
redim as string bstr(0 to 2)
dim as integer i , ub, lb
'
' ----------------------------------------------------------------------
'
file_name = "terrain_shader.inp"
file2array(bstr() , file_name )
' ......................................................................
'
ub = ubound(bstr,1)
lb = lbound(bstr,1)
for i=lb to ub
' print bstr(i)
next i
'
' .................................................
'
'  normal and quoted text from file .
'
lb = lbound(bstr,1)
ub = ubound(bstr,1)
redim as string astr(lb to ub)

astr(lb) = "FragmentProlog = !" + """"+bstr(lb) + " \n"" "
for i=lb+1 to ub
  astr(i) =  "FragmentProlog &= !" + """"+bstr(i) + " \n"" "
next i

'  write to alternate file
file_name = "file3.txt"
array2file( astr(), file_name)

End 0
'
' ======================================================================
'
sub file2array(bstr() as string, file_name as string)
'
'                   Read from file into an array .
'
dim as long file_num, i
'
'
file_num = FreeFile( )  '' retrieve an available file number
'
'' open our file and bind our file number to it, exit on error
If( Open( file_name For Input As #file_num ) ) Then
   Print "ERROR: opening file " ; file_name
   End -1
End If
i=0
Do Until EOF( file_num )               '' loop until we have reached the end of the file
   Dim As String text
   Line Input #file_num, text               '' read a line of text ...
   i = i + 1                             '' ... and output it to the screen
Loop
print " Number of lines = "; i

redim bstr(0 to i-1)

Close #file_num 
'
file_num = FreeFile( )  '' retrieve an available file number
'
'                        read into string array .
'
'' reopen our file and bind our file number to it, exit on error
If( Open( file_name For Input As #file_num ) ) Then
   Print "ERROR: opening file " ; file_name
   End -1
End If
i=0
Do Until EOF( file_num )               '' loop until we have reached the end of the file
   Line Input #file_num, bstr(i)               '' read a line of text ...
   i=i+1                               '' ... and output it to the screen
Loop
Close #file_num   
'
                     '' close file via our file number
'
end sub
'
' ----------------------------------------------------------------------
'
sub array2file( astr() as string, file_name as string)
'
'                    Write x   Print array to file .
'
 dim as long ff, i, ub , lb
'
 lb = lbound(astr,1)
 ub = ubound(astr,1)
'
 ff = FreeFile()
 Open file_name For Output As #ff
 for i = lb to ub
 '  Write #ff, astr(i)
    Print #ff, astr(i) ' this doesn't produce extra quotes .
 next i
 Close #ff
'
end sub
'
' ----------------------------------------------------------------------
'

Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: OpenGL shader language math in FreeBASIC.

Post by Luxan »

I found an example at :

https://www.shadertoy.com/view/Ms2SD1

that's under creative commons License.

Within the Geany editor, running FreeBasic, this generates the image and allows
one to scroll the image around; however there's no animation, what's going on ?

Code: Select all



'  shader_y.bas

' https://www.shadertoy.com/view/Ms2SD1
' Creative commons

/'
  Everthing after 
 dim as string CODE 
 is straight from above code .
'/

dim as string CODE
CODE = !"/* \n" 
CODE &= !" * Seascape by Alexander Alekseev aka TDM - 2014 \n" 
CODE &= !" * License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. \n" 
CODE &= !" * Contact: tdmaav@gmail.com \n" 
CODE &= !" */ \n" 
CODE &= !" \n" 
CODE &= !"const int NUM_STEPS = 8; \n" 
CODE &= !"const float PI	 	= 3.141592; \n" 
CODE &= !"const float EPSILON	= 1e-3; \n" 
CODE &= !"#define EPSILON_NRM (0.1 / iResolution.x) \n" 
CODE &= !"#define AA \n" 
CODE &= !" \n" 
CODE &= !"// sea \n" 
CODE &= !"const int ITER_GEOMETRY = 3; \n" 
CODE &= !"const int ITER_FRAGMENT = 5; \n" 
CODE &= !"const float SEA_HEIGHT = 0.6; \n" 
CODE &= !"const float SEA_CHOPPY = 4.0; \n" 
CODE &= !"const float SEA_SPEED = 0.8; \n" 
CODE &= !"const float SEA_FREQ = 0.16; \n" 
CODE &= !"const vec3 SEA_BASE = vec3(0.0,0.09,0.18); \n" 
CODE &= !"const vec3 SEA_WATER_COLOR = vec3(0.8,0.9,0.6)*0.6; \n" 
CODE &= !"#define SEA_TIME (1.0 + iTime * SEA_SPEED) \n" 
CODE &= !"const mat2 octave_m = mat2(1.6,1.2,-1.2,1.6); \n" 
CODE &= !" \n" 
CODE &= !"// math \n" 
CODE &= !"mat3 fromEuler(vec3 ang) { \n" 
CODE &= !"	vec2 a1 = vec2(sin(ang.x),cos(ang.x)); \n" 
CODE &= !"    vec2 a2 = vec2(sin(ang.y),cos(ang.y)); \n" 
CODE &= !"    vec2 a3 = vec2(sin(ang.z),cos(ang.z)); \n" 
CODE &= !"    mat3 m; \n" 
CODE &= !"    m[0] = vec3(a1.y*a3.y+a1.x*a2.x*a3.x,a1.y*a2.x*a3.x+a3.y*a1.x,-a2.y*a3.x); \n" 
CODE &= !"	m[1] = vec3(-a2.y*a1.x,a1.y*a2.y,a2.x); \n" 
CODE &= !"	m[2] = vec3(a3.y*a1.x*a2.x+a1.y*a3.x,a1.x*a3.x-a1.y*a3.y*a2.x,a2.y*a3.y); \n" 
CODE &= !"	return m; \n" 
CODE &= !"} \n" 
CODE &= !"float hash( vec2 p ) { \n" 
CODE &= !"	float h = dot(p,vec2(127.1,311.7));	 \n" 
CODE &= !"    return fract(sin(h)*43758.5453123); \n" 
CODE &= !"} \n" 
CODE &= !"float noise( in vec2 p ) { \n" 
CODE &= !"    vec2 i = floor( p ); \n" 
CODE &= !"    vec2 f = fract( p );	 \n" 
CODE &= !"	vec2 u = f*f*(3.0-2.0*f); \n" 
CODE &= !"    return -1.0+2.0*mix( mix( hash( i + vec2(0.0,0.0) ),  \n" 
CODE &= !"                     hash( i + vec2(1.0,0.0) ), u.x), \n" 
CODE &= !"                mix( hash( i + vec2(0.0,1.0) ),  \n" 
CODE &= !"                     hash( i + vec2(1.0,1.0) ), u.x), u.y); \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// lighting \n" 
CODE &= !"float diffuse(vec3 n,vec3 l,float p) { \n" 
CODE &= !"    return pow(dot(n,l) * 0.4 + 0.6,p); \n" 
CODE &= !"} \n" 
CODE &= !"float specular(vec3 n,vec3 l,vec3 e,float s) {     \n" 
CODE &= !"    float nrm = (s + 8.0) / (PI * 8.0); \n" 
CODE &= !"    return pow(max(dot(reflect(e,n),l),0.0),s) * nrm; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// sky \n" 
CODE &= !"vec3 getSkyColor(vec3 e) { \n" 
CODE &= !"    e.y = (max(e.y,0.0)*0.8+0.2)*0.8; \n" 
CODE &= !"    return vec3(pow(1.0-e.y,2.0), 1.0-e.y, 0.6+(1.0-e.y)*0.4) * 1.1; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// sea \n" 
CODE &= !"float sea_octave(vec2 uv, float choppy) { \n" 
CODE &= !"    uv += noise(uv);         \n" 
CODE &= !"    vec2 wv = 1.0-abs(sin(uv)); \n" 
CODE &= !"    vec2 swv = abs(cos(uv));     \n" 
CODE &= !"    wv = mix(wv,swv,wv); \n" 
CODE &= !"    return pow(1.0-pow(wv.x * wv.y,0.65),choppy); \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"float map(vec3 p) { \n" 
CODE &= !"    float freq = SEA_FREQ; \n" 
CODE &= !"    float amp = SEA_HEIGHT; \n" 
CODE &= !"    float choppy = SEA_CHOPPY; \n" 
CODE &= !"    vec2 uv = p.xz; uv.x *= 0.75; \n" 
CODE &= !"     \n" 
CODE &= !"    float d, h = 0.0;     \n" 
CODE &= !"    for(int i = 0; i < ITER_GEOMETRY; i++) {         \n" 
CODE &= !"    	d = sea_octave((uv+SEA_TIME)*freq,choppy); \n" 
CODE &= !"    	d += sea_octave((uv-SEA_TIME)*freq,choppy); \n" 
CODE &= !"        h += d * amp;         \n" 
CODE &= !"    	uv *= octave_m; freq *= 1.9; amp *= 0.22; \n" 
CODE &= !"        choppy = mix(choppy,1.0,0.2); \n" 
CODE &= !"    } \n" 
CODE &= !"    return p.y - h; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"float map_detailed(vec3 p) { \n" 
CODE &= !"    float freq = SEA_FREQ; \n" 
CODE &= !"    float amp = SEA_HEIGHT; \n" 
CODE &= !"    float choppy = SEA_CHOPPY; \n" 
CODE &= !"    vec2 uv = p.xz; uv.x *= 0.75; \n" 
CODE &= !"     \n" 
CODE &= !"    float d, h = 0.0;     \n" 
CODE &= !"    for(int i = 0; i < ITER_FRAGMENT; i++) {         \n" 
CODE &= !"    	d = sea_octave((uv+SEA_TIME)*freq,choppy); \n" 
CODE &= !"    	d += sea_octave((uv-SEA_TIME)*freq,choppy); \n" 
CODE &= !"        h += d * amp;         \n" 
CODE &= !"    	uv *= octave_m; freq *= 1.9; amp *= 0.22; \n" 
CODE &= !"        choppy = mix(choppy,1.0,0.2); \n" 
CODE &= !"    } \n" 
CODE &= !"    return p.y - h; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"vec3 getSeaColor(vec3 p, vec3 n, vec3 l, vec3 eye, vec3 dist) {   \n" 
CODE &= !"    float fresnel = clamp(1.0 - dot(n,-eye), 0.0, 1.0); \n" 
CODE &= !"    fresnel = pow(fresnel,3.0) * 0.5; \n" 
CODE &= !"         \n" 
CODE &= !"    vec3 reflected = getSkyColor(reflect(eye,n));     \n" 
CODE &= !"    vec3 refracted = SEA_BASE + diffuse(n,l,80.0) * SEA_WATER_COLOR * 0.12;  \n" 
CODE &= !"     \n" 
CODE &= !"    vec3 color = mix(refracted,reflected,fresnel); \n" 
CODE &= !"     \n" 
CODE &= !"    float atten = max(1.0 - dot(dist,dist) * 0.001, 0.0); \n" 
CODE &= !"    color += SEA_WATER_COLOR * (p.y - SEA_HEIGHT) * 0.18 * atten; \n" 
CODE &= !"     \n" 
CODE &= !"    color += vec3(specular(n,l,eye,60.0)); \n" 
CODE &= !"     \n" 
CODE &= !"    return color; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// tracing \n" 
CODE &= !"vec3 getNormal(vec3 p, float eps) { \n" 
CODE &= !"    vec3 n; \n" 
CODE &= !"    n.y = map_detailed(p);     \n" 
CODE &= !"    n.x = map_detailed(vec3(p.x+eps,p.y,p.z)) - n.y; \n" 
CODE &= !"    n.z = map_detailed(vec3(p.x,p.y,p.z+eps)) - n.y; \n" 
CODE &= !"    n.y = eps; \n" 
CODE &= !"    return normalize(n); \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"float heightMapTracing(vec3 ori, vec3 dir, out vec3 p) {   \n" 
CODE &= !"    float tm = 0.0; \n" 
CODE &= !"    float tx = 1000.0;     \n" 
CODE &= !"    float hx = map(ori + dir * tx); \n" 
CODE &= !"    if(hx > 0.0) { \n" 
CODE &= !"        p = ori + dir * tx; \n" 
CODE &= !"        return tx;    \n" 
CODE &= !"    } \n" 
CODE &= !"    float hm = map(ori + dir * tm);     \n" 
CODE &= !"    float tmid = 0.0; \n" 
CODE &= !"    for(int i = 0; i < NUM_STEPS; i++) { \n" 
CODE &= !"        tmid = mix(tm,tx, hm/(hm-hx));                    \n" 
CODE &= !"        p = ori + dir * tmid;                    \n" 
CODE &= !"    	float hmid = map(p); \n" 
CODE &= !"		if(hmid < 0.0) { \n" 
CODE &= !"        	tx = tmid; \n" 
CODE &= !"            hx = hmid; \n" 
CODE &= !"        } else { \n" 
CODE &= !"            tm = tmid; \n" 
CODE &= !"            hm = hmid; \n" 
CODE &= !"        } \n" 
CODE &= !"    } \n" 
CODE &= !"    return tmid; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"vec3 getPixel(in vec2 coord, float time) {     \n" 
CODE &= !"    vec2 uv = coord / iResolution.xy; \n" 
CODE &= !"    uv = uv * 2.0 - 1.0; \n" 
CODE &= !"    uv.x *= iResolution.x / iResolution.y;     \n" 
CODE &= !"         \n" 
CODE &= !"    // ray \n" 
CODE &= !"    vec3 ang = vec3(sin(time*3.0)*0.1,sin(time)*0.2+0.3,time);     \n" 
CODE &= !"    vec3 ori = vec3(0.0,3.5,time*5.0); \n" 
CODE &= !"    vec3 dir = normalize(vec3(uv.xy,-2.0)); dir.z += length(uv) * 0.14; \n" 
CODE &= !"    dir = normalize(dir) * fromEuler(ang); \n" 
CODE &= !"     \n" 
CODE &= !"    // tracing \n" 
CODE &= !"    vec3 p; \n" 
CODE &= !"    heightMapTracing(ori,dir,p); \n" 
CODE &= !"    vec3 dist = p - ori; \n" 
CODE &= !"    vec3 n = getNormal(p, dot(dist,dist) * EPSILON_NRM); \n" 
CODE &= !"    vec3 light = normalize(vec3(0.0,1.0,0.8));  \n" 
CODE &= !"              \n" 
CODE &= !"    // color \n" 
CODE &= !"    return mix( \n" 
CODE &= !"        getSkyColor(dir), \n" 
CODE &= !"        getSeaColor(p,n,light,dir,dist), \n" 
CODE &= !"    	pow(smoothstep(0.0,-0.02,dir.y),0.2)); \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// main \n" 
CODE &= !"void mainImage( out vec4 fragColor, in vec2 fragCoord ) { \n" 
CODE &= !"    float time = iTime * 0.3 + iMouse.x*0.01; \n" 
CODE &= !"	 \n" 
CODE &= !"#ifdef AA \n" 
CODE &= !"    vec3 color = vec3(0.0); \n" 
CODE &= !"    for(int i = -1; i <= 1; i++) { \n" 
CODE &= !"        for(int j = -1; j <= 1; j++) { \n" 
CODE &= !"        	vec2 uv = fragCoord+vec2(i,j)/3.0; \n" 
CODE &= !"    		color += getPixel(uv, time); \n" 
CODE &= !"        } \n" 
CODE &= !"    } \n" 
CODE &= !"    color /= 9.0; \n" 
CODE &= !"#else \n" 
CODE &= !"    vec3 color = getPixel(fragCoord, time); \n" 
CODE &= !"#endif \n" 
CODE &= !"     \n" 
CODE &= !"    // post \n" 
CODE &= !"	fragColor = vec4(pow(color,vec3(0.65)), 1.0); \n" 
CODE &= !"} \n" 

'
' --------------------------------- static code ------------------------
'
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glext.bi"

#ifndef NULL
#define NULL 0
#endif


type vec3
  as GLfloat x,y,z
end type

sub ErrorExit(msg as string)
  if screenptr() then screen 0
  dim as integer w,h
  screeninfo w,h : w*=0.75:h*=0.75
  screenres w,h
  print msg
  print "press any key to quit ..."
  beep : sleep : end 1
end sub



' define OpenGL proc's
#define glDefine(n) dim shared as PFN##n##PROC n
' texture
'glDefine(glActiveTexture)

' shader
glDefine(glCreateShader)
glDefine(glDeleteShader)
glDefine(glShaderSource)
glDefine(glCompileShader)
glDefine(glGetShaderiv)
glDefine(glGetShaderInfoLog)

' program
glDefine(glCreateProgram)
glDefine(glDeleteProgram)
glDefine(glAttachShader)
glDefine(glDetachShader)
glDefine(glLinkProgram)
glDefine(glGetProgramiv)
glDefine(glGetProgramInfoLog)
glDefine(glUseProgram)

' uniform
glDefine(glGetUniformLocation)
glDefine(glUniform1f)
glDefine(glUniform2f)
glDefine(glUniform3f)
glDefine(glUniform4f)
glDefine(glUniform1i)

#undef glDefine

sub glScreen(w as integer=800, h as integer=600, b as integer=32, d as integer=24, s as integer=0, f as integer=0)
  if ScreenPtr() then screen 0
  ScreenControl FB.SET_GL_STENCIL_BITS,s
  ScreenControl FB.SET_GL_DEPTH_BITS  ,d
  if ScreenRes(w,h,b,,FB.GFX_OPENGL or iif(f<>0,FB.GFX_FULLSCREEN,0)) then
    ErrorExit("screenres(" & w & "," & h &") failed !")
  end if
  Windowtitle "offline shadertoy.com"

  flip

  ' get OpenGL proc's (abort if something goes wrong)
  #define glProc(n) n = ScreenGLProc(#n) : if n = 0 then ErrorExit(#n)
  ' texture
'  glProc(glActiveTexture)
  ' shader
  glProc(glCreateShader)
  glProc(glDeleteShader)
  glProc(glShaderSource)
  glProc(glCompileShader)
  glProc(glGetShaderiv)
  glProc(glGetShaderInfoLog)
  ' program
  glProc(glCreateProgram)
  glProc(glDeleteProgram)
  glProc(glAttachShader)
  glProc(glDetachShader)
  glProc(glLinkProgram)
  glProc(glGetProgramiv)
  glProc(glGetProgramInfoLog)
  glProc(glUseProgram)
  ' uniform
  glProc(glGetUniformLocation)
  glProc(glUniform1f)
  glProc(glUniform2f)
  glProc(glUniform3f)
  glProc(glUniform4f)
  glProc(glUniform1i)
  #undef glProc

end sub

type ShaderToy
  declare destructor
  declare function CompileFile(Filename as string) as boolean
  declare function CompileCode(Code as string) as boolean
  as GLuint FragmentShader
  as GLuint ProgramObject
  as string Shaderlog
end type

destructor ShaderToy
  if ProgramObject then 
   glUseprogram(0)
   if FragmentShader  then 
     glDetachShader(ProgramObject,FragmentShader)
     glDeleteShader(FragmentShader)
   end if
   glDeleteProgram(ProgramObject)
  end if
end destructor

function ShaderToy.CompileFile(filename as string) as boolean
  dim as string code
  var hFile = FreeFile()
  if open(filename,for input, as #hFile) then 
    ShaderLog = "can't read shader: " & chr(34) & filename  & chr(34) & " !"
    return false
  end if
  while not eof(hFile)
    dim as string aLine
    line input #hFile,aLine
    code &= aLine & !"\n"
  wend
  close #hFile
  return CompileCode(code)
end function

function ShaderToy.CompileCode(UserCode as string) as boolean
  dim as GLint logSize
  dim as GLint status

  
dim as string FragmentProlog
FragmentProlog = !"uniform vec3      iResolution;           // viewport resolution (in pixels) \n" 
FragmentProlog &= !"uniform float     iTime;                 // shader playback time (in seconds) \n" 
FragmentProlog &= !"uniform float     iTimeDelta;            // render time (in seconds) \n" 
FragmentProlog &= !"uniform int       iFrame;                // shader playback frame \n" 
FragmentProlog &= !"uniform float     iChannelTime[4];       // channel playback time (in seconds) \n" 
FragmentProlog &= !"uniform vec3      iChannelResolution[4]; // channel resolution (in pixels) \n" 
FragmentProlog &= !"uniform vec4      iMouse;                // mouse pixel coords. xy: current (if MLB down), zw: click \n" 
FragmentProlog &= !"uniform sampler3D iChannel0;          // input channel. XX = 2D/Cube \n" 
FragmentProlog &= !"uniform sampler3D iChannel1;          // input channel. XX = 2D/Cube \n" 
FragmentProlog &= !"uniform sampler3D iChannel2;          // input channel. XX = 2D/Cube \n" 
FragmentProlog &= !"uniform sampler3D iChannel3;          // input channel. XX = 2D/Cube \n" 
FragmentProlog &= !"uniform vec4      iDate;                 // (year, month, day, time in seconds) \n" 
FragmentProlog &= !"uniform float     iSampleRate;           // sound sample rate (i.e., 44100) \n" 
FragmentProlog &=!"uniform float     iGlobalTime;  // shader playback time (in seconds)\n"


' void mainImage( out vec4 fragColor, in vec2 fragCoord ) 


  dim as string FragmentEpilog
  FragmentEpilog  = !"void main() {\n"
  FragmentEpilog &= !"  vec4 color;\n"
  FragmentEpilog &= !"  // call user shader\n"
  FragmentEpilog &= !"  mainImage(color, gl_FragCoord.xy);\n"
  FragmentEpilog &= !"  color.w = 1.0;\n"
  FragmentEpilog &= !"  gl_FragColor = color;\n"
  FragmentEpilog &= !"}\n"

  dim as string FragmentCode = FragmentProlog & UserCode & FragmentEpilog

  FragmentShader = glCreateShader(GL_FRAGMENT_SHADER)
  if FragmentShader=0 then 
    ShaderLog = "glCreateShader(GL_FRAGMENT_SHADER) failed !"
    return false
  end if
  dim as GLchar ptr pCode=strptr(FragmentCode)
  glShaderSource (FragmentShader, 1, @pCode, NULL)
  glCompileShader(FragmentShader)
  glGetShaderiv  (FragmentShader, GL_COMPILE_STATUS, @status)
  if status = GL_FALSE then 
    glGetShaderiv(FragmentShader, GL_INFO_LOG_LENGTH, @logSize)
    ShaderLog = space(logSize)
    pCode=strptr(ShaderLog)
    glGetShaderInfoLog(FragmentShader, logSize, NULL, pCode)
    ShaderLog = !"glCompileShader(FragmentShader) failed !\n" & Shaderlog
    glDeleteShader(FragmentShader) : FragmentShader = 0
    return false
  end if

  ProgramObject = glCreateProgram()
  if ProgramObject=0 then 
    ShaderLog = "glCreateProgram() failed !"
    glDeleteShader(FragmentShader) : FragmentShader = 0
    return false
  end if
  glAttachShader(ProgramObject,FragmentShader)
  glLinkProgram (ProgramObject)
  glGetProgramiv(ProgramObject, GL_LINK_STATUS, @status)
  if (status = GL_FALSE) then
    glGetProgramiv(ProgramObject, GL_INFO_LOG_LENGTH, @logSize)
    ShaderLog = space(logSize) : pCode = strptr(ShaderLog)
    glGetProgramInfoLog (ProgramObject, logSize, NULL, pCode)
    ShaderLog = !"glLinkProgram() failed !\n" & Shaderlog
    glDeleteShader(FragmentShader) : FragmentShader = 0
    return false
  end if
  return true
end function

'
' main
'
/'

Various commonly used screen resolutions .

SVGA 	800 X 600
WSVGA 	1024 X 600
XGA 	1024 X 768
XGA+ 	1152 X 864
WXGA 	1280 X 720
WXGA 	1280 X 768
WXGA 	1280 X 800
SXGA– (UVGA) 	1280 X 960
SXGA 	1280 X 1024
HD 	    1360 X 768
SXGA+ 	1400 X 1050
WXGA+ 	1440 X 900
HD+ 	1600 X 900
UXGA 	1600 X 1200
WSXGA+ 	1680 X 1050
FHD 	1920 X 1080


WUXGA 	 1920 X 1200
QWXGA 	 2048 X 1152
WQHD 	 2560 X 1440
'/

' init Screenres, create the OpenGL context and load some OpenGL procs.
dim as boolean fullscreen=false
dim as integer scr_w=640,scr_h=480
'dim as integer scr_w=1280,scr_h=960
'dim as integer scr_w=1360,scr_h=768


glScreen scr_w,scr_h,,,,fullscreen


' get curent resolution

screeninfo scr_w,scr_h

dim as vec3 v3
v3.x=scr_w     ' width in pixle
v3.y=scr_h     '`height in pixle
v3.z=v3.x/v3.y ' pixel ratio

dim as ShaderToy Shader

if Shader.CompileCode(CODE)=false then
  ErrorExit Shader.ShaderLog
end if  

' enable shader
glUseProgram(Shader.ProgramObject)

' get uniforms locations in shader program
var iGlobalTime = glGetUniformLocation(Shader.ProgramObject,"iGlobalTime")
var iTime = glGetUniformLocation(Shader.ProgramObject,"iTime")
var iResolution = glGetUniformLocation(Shader.ProgramObject,"iResolution")
var iMouse      = glGetUniformLocation(Shader.ProgramObject,"iMouse")

' set vec3 iResolution
glUniform3f(iResolution,v3.x,v3.y,v3.z)

dim as integer mx,my,mb,frames,fps
dim as double tStart = Timer()
dim as double tLast=tStart
while inkey=""
  dim as double tNow=Timer()
  ' set uniform float iGlobalTime
  glUniform1f(iGlobalTime,tNow-tStart)


  if frames mod 3=0 then
    ' set vec4 iMouse
    if getMouse(mx,my,,mb)=0 then
      if mb then
        glUniform4f(iMouse,mx,my,1,1)
      else
        glUniform4f(iMouse,0,0,0,0)
      end if
    end if
  end if
  'glClear(GL_COLOR_BUFFER_BIT)
  ' draw a rectangle (2 triangles over the whole screen)
  glRectf(-1,-1,1,1)
  flip ' swap the buffers

  frames+=1
  ' update fps
  if frames mod 10=0 then
    fps=10/(tNow-tLast)
    windowtitle "fps: " & fps
    tLast=tNow
  end if

wend

' disable shader
glUseProgram(0)

Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: OpenGL shader language math in FreeBASIC.

Post by Luxan »

I got it sorted, the C code is using a time variable iTime, this needs to
be initialized, just like iGlobalTime is set .

' set uniform float iGlobalTime
glUniform1f(iGlobalTime,tNow-tStart)

Also iTime needs to be set, do this near previous line, like this.

' set uniform float iTime
glUniform1f(iTime,tNow-tStart)

Everything is running swimmingly now.

Next to try this on another example that wasn't animated.
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: OpenGL shader language math in FreeBASIC.

Post by Luxan »

And....

Even on a complicated scene with many objects, more than 10000 in this instance,
animation is now possible.
This includes lighting, reflections, rotations .
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: OpenGL shader language math in FreeBASIC.

Post by D.J.Peters »

This thread here is primary for the OpenGL shader language on CPU with FreeBASIC!

you can define iTime as IGlobalTime in the shader code :-)

#define iTime iGlobalTime

By the way the shadertoy OpenGL shaders thread in FreeBASIC is here: viewtopic.php?t=28001

Joshy

Code: Select all


'  shader_y.bas

' https://www.shadertoy.com/view/Ms2SD1
' Creative commons

/'
  Everthing after 
 dim as string CODE 
 is straight from above code .
'/

dim as string CODE
CODE = !"/* \n" 
CODE &= !" * Seascape by Alexander Alekseev aka TDM - 2014 \n" 
CODE &= !" * License Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License. \n" 
CODE &= !" * Contact: tdmaav@gmail.com \n" 
CODE &= !" */ \n" 
CODE &= !" \n" 
CODE &= !"const int NUM_STEPS = 8; \n" 
CODE &= !"const float PI	 	= 3.141592; \n" 
CODE &= !"const float EPSILON	= 1e-3; \n" 
CODE &= !"#define EPSILON_NRM (0.1 / iResolution.x) \n" 
CODE &= !"#define AA \n" 
CODE &= !" \n" 
CODE &= !"// sea \n" 
CODE &= !"const int ITER_GEOMETRY = 3; \n" 
CODE &= !"const int ITER_FRAGMENT = 5; \n" 
CODE &= !"const float SEA_HEIGHT = 0.6; \n" 
CODE &= !"const float SEA_CHOPPY = 4.0; \n" 
CODE &= !"const float SEA_SPEED = 0.8; \n" 
CODE &= !"const float SEA_FREQ = 0.16; \n" 
CODE &= !"const vec3 SEA_BASE = vec3(0.0,0.09,0.18); \n" 
CODE &= !"const vec3 SEA_WATER_COLOR = vec3(0.8,0.9,0.6)*0.6; \n" 
CODE &= !"#define SEA_TIME (1.0 + iGlobalTime * SEA_SPEED) \n" 
CODE &= !"const mat2 octave_m = mat2(1.6,1.2,-1.2,1.6); \n" 
CODE &= !" \n" 
CODE &= !"// math \n" 
CODE &= !"mat3 fromEuler(vec3 ang) { \n" 
CODE &= !"	vec2 a1 = vec2(sin(ang.x),cos(ang.x)); \n" 
CODE &= !"    vec2 a2 = vec2(sin(ang.y),cos(ang.y)); \n" 
CODE &= !"    vec2 a3 = vec2(sin(ang.z),cos(ang.z)); \n" 
CODE &= !"    mat3 m; \n" 
CODE &= !"    m[0] = vec3(a1.y*a3.y+a1.x*a2.x*a3.x,a1.y*a2.x*a3.x+a3.y*a1.x,-a2.y*a3.x); \n" 
CODE &= !"	m[1] = vec3(-a2.y*a1.x,a1.y*a2.y,a2.x); \n" 
CODE &= !"	m[2] = vec3(a3.y*a1.x*a2.x+a1.y*a3.x,a1.x*a3.x-a1.y*a3.y*a2.x,a2.y*a3.y); \n" 
CODE &= !"	return m; \n" 
CODE &= !"} \n" 
CODE &= !"float hash( vec2 p ) { \n" 
CODE &= !"	float h = dot(p,vec2(127.1,311.7));	 \n" 
CODE &= !"    return fract(sin(h)*43758.5453123); \n" 
CODE &= !"} \n" 
CODE &= !"float noise( in vec2 p ) { \n" 
CODE &= !"    vec2 i = floor( p ); \n" 
CODE &= !"    vec2 f = fract( p );	 \n" 
CODE &= !"	vec2 u = f*f*(3.0-2.0*f); \n" 
CODE &= !"    return -1.0+2.0*mix( mix( hash( i + vec2(0.0,0.0) ),  \n" 
CODE &= !"                     hash( i + vec2(1.0,0.0) ), u.x), \n" 
CODE &= !"                mix( hash( i + vec2(0.0,1.0) ),  \n" 
CODE &= !"                     hash( i + vec2(1.0,1.0) ), u.x), u.y); \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// lighting \n" 
CODE &= !"float diffuse(vec3 n,vec3 l,float p) { \n" 
CODE &= !"    return pow(dot(n,l) * 0.4 + 0.6,p); \n" 
CODE &= !"} \n" 
CODE &= !"float specular(vec3 n,vec3 l,vec3 e,float s) {     \n" 
CODE &= !"    float nrm = (s + 8.0) / (PI * 8.0); \n" 
CODE &= !"    return pow(max(dot(reflect(e,n),l),0.0),s) * nrm; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// sky \n" 
CODE &= !"vec3 getSkyColor(vec3 e) { \n" 
CODE &= !"    e.y = (max(e.y,0.0)*0.8+0.2)*0.8; \n" 
CODE &= !"    return vec3(pow(1.0-e.y,2.0), 1.0-e.y, 0.6+(1.0-e.y)*0.4) * 1.1; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// sea \n" 
CODE &= !"float sea_octave(vec2 uv, float choppy) { \n" 
CODE &= !"    uv += noise(uv);         \n" 
CODE &= !"    vec2 wv = 1.0-abs(sin(uv)); \n" 
CODE &= !"    vec2 swv = abs(cos(uv));     \n" 
CODE &= !"    wv = mix(wv,swv,wv); \n" 
CODE &= !"    return pow(1.0-pow(wv.x * wv.y,0.65),choppy); \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"float map(vec3 p) { \n" 
CODE &= !"    float freq = SEA_FREQ; \n" 
CODE &= !"    float amp = SEA_HEIGHT; \n" 
CODE &= !"    float choppy = SEA_CHOPPY; \n" 
CODE &= !"    vec2 uv = p.xz; uv.x *= 0.75; \n" 
CODE &= !"     \n" 
CODE &= !"    float d, h = 0.0;     \n" 
CODE &= !"    for(int i = 0; i < ITER_GEOMETRY; i++) {         \n" 
CODE &= !"    	d = sea_octave((uv+SEA_TIME)*freq,choppy); \n" 
CODE &= !"    	d += sea_octave((uv-SEA_TIME)*freq,choppy); \n" 
CODE &= !"        h += d * amp;         \n" 
CODE &= !"    	uv *= octave_m; freq *= 1.9; amp *= 0.22; \n" 
CODE &= !"        choppy = mix(choppy,1.0,0.2); \n" 
CODE &= !"    } \n" 
CODE &= !"    return p.y - h; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"float map_detailed(vec3 p) { \n" 
CODE &= !"    float freq = SEA_FREQ; \n" 
CODE &= !"    float amp = SEA_HEIGHT; \n" 
CODE &= !"    float choppy = SEA_CHOPPY; \n" 
CODE &= !"    vec2 uv = p.xz; uv.x *= 0.75; \n" 
CODE &= !"     \n" 
CODE &= !"    float d, h = 0.0;     \n" 
CODE &= !"    for(int i = 0; i < ITER_FRAGMENT; i++) {         \n" 
CODE &= !"    	d = sea_octave((uv+SEA_TIME)*freq,choppy); \n" 
CODE &= !"    	d += sea_octave((uv-SEA_TIME)*freq,choppy); \n" 
CODE &= !"        h += d * amp;         \n" 
CODE &= !"    	uv *= octave_m; freq *= 1.9; amp *= 0.22; \n" 
CODE &= !"        choppy = mix(choppy,1.0,0.2); \n" 
CODE &= !"    } \n" 
CODE &= !"    return p.y - h; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"vec3 getSeaColor(vec3 p, vec3 n, vec3 l, vec3 eye, vec3 dist) {   \n" 
CODE &= !"    float fresnel = clamp(1.0 - dot(n,-eye), 0.0, 1.0); \n" 
CODE &= !"    fresnel = pow(fresnel,3.0) * 0.5; \n" 
CODE &= !"         \n" 
CODE &= !"    vec3 reflected = getSkyColor(reflect(eye,n));     \n" 
CODE &= !"    vec3 refracted = SEA_BASE + diffuse(n,l,80.0) * SEA_WATER_COLOR * 0.12;  \n" 
CODE &= !"     \n" 
CODE &= !"    vec3 color = mix(refracted,reflected,fresnel); \n" 
CODE &= !"     \n" 
CODE &= !"    float atten = max(1.0 - dot(dist,dist) * 0.001, 0.0); \n" 
CODE &= !"    color += SEA_WATER_COLOR * (p.y - SEA_HEIGHT) * 0.18 * atten; \n" 
CODE &= !"     \n" 
CODE &= !"    color += vec3(specular(n,l,eye,60.0)); \n" 
CODE &= !"     \n" 
CODE &= !"    return color; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// tracing \n" 
CODE &= !"vec3 getNormal(vec3 p, float eps) { \n" 
CODE &= !"    vec3 n; \n" 
CODE &= !"    n.y = map_detailed(p);     \n" 
CODE &= !"    n.x = map_detailed(vec3(p.x+eps,p.y,p.z)) - n.y; \n" 
CODE &= !"    n.z = map_detailed(vec3(p.x,p.y,p.z+eps)) - n.y; \n" 
CODE &= !"    n.y = eps; \n" 
CODE &= !"    return normalize(n); \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"float heightMapTracing(vec3 ori, vec3 dir, out vec3 p) {   \n" 
CODE &= !"    float tm = 0.0; \n" 
CODE &= !"    float tx = 1000.0;     \n" 
CODE &= !"    float hx = map(ori + dir * tx); \n" 
CODE &= !"    if(hx > 0.0) { \n" 
CODE &= !"        p = ori + dir * tx; \n" 
CODE &= !"        return tx;    \n" 
CODE &= !"    } \n" 
CODE &= !"    float hm = map(ori + dir * tm);     \n" 
CODE &= !"    float tmid = 0.0; \n" 
CODE &= !"    for(int i = 0; i < NUM_STEPS; i++) { \n" 
CODE &= !"        tmid = mix(tm,tx, hm/(hm-hx));                    \n" 
CODE &= !"        p = ori + dir * tmid;                    \n" 
CODE &= !"    	float hmid = map(p); \n" 
CODE &= !"		if(hmid < 0.0) { \n" 
CODE &= !"        	tx = tmid; \n" 
CODE &= !"            hx = hmid; \n" 
CODE &= !"        } else { \n" 
CODE &= !"            tm = tmid; \n" 
CODE &= !"            hm = hmid; \n" 
CODE &= !"        } \n" 
CODE &= !"    } \n" 
CODE &= !"    return tmid; \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"vec3 getPixel(in vec2 coord, float time) {     \n" 
CODE &= !"    vec2 uv = coord / iResolution.xy; \n" 
CODE &= !"    uv = uv * 2.0 - 1.0; \n" 
CODE &= !"    uv.x *= iResolution.x / iResolution.y;     \n" 
CODE &= !"         \n" 
CODE &= !"    // ray \n" 
CODE &= !"    vec3 ang = vec3(sin(time*3.0)*0.1,sin(time)*0.2+0.3,time);     \n" 
CODE &= !"    vec3 ori = vec3(0.0,3.5,time*5.0); \n" 
CODE &= !"    vec3 dir = normalize(vec3(uv.xy,-2.0)); dir.z += length(uv) * 0.14; \n" 
CODE &= !"    dir = normalize(dir) * fromEuler(ang); \n" 
CODE &= !"     \n" 
CODE &= !"    // tracing \n" 
CODE &= !"    vec3 p; \n" 
CODE &= !"    heightMapTracing(ori,dir,p); \n" 
CODE &= !"    vec3 dist = p - ori; \n" 
CODE &= !"    vec3 n = getNormal(p, dot(dist,dist) * EPSILON_NRM); \n" 
CODE &= !"    vec3 light = normalize(vec3(0.0,1.0,0.8));  \n" 
CODE &= !"              \n" 
CODE &= !"    // color \n" 
CODE &= !"    return mix( \n" 
CODE &= !"        getSkyColor(dir), \n" 
CODE &= !"        getSeaColor(p,n,light,dir,dist), \n" 
CODE &= !"    	pow(smoothstep(0.0,-0.02,dir.y),0.2)); \n" 
CODE &= !"} \n" 
CODE &= !" \n" 
CODE &= !"// main \n" 
CODE &= !"void mainImage( out vec4 fragColor, in vec2 fragCoord ) { \n" 
CODE &= !"    float time = iGlobalTime * 0.3 + iMouse.x*0.01; \n" 
CODE &= !"	 \n" 
CODE &= !"#ifdef AA \n" 
CODE &= !"    vec3 color = vec3(0.0); \n" 
CODE &= !"    for(int i = -1; i <= 1; i++) { \n" 
CODE &= !"        for(int j = -1; j <= 1; j++) { \n" 
CODE &= !"        	vec2 uv = fragCoord+vec2(i,j)/3.0; \n" 
CODE &= !"    		color += getPixel(uv, time); \n" 
CODE &= !"        } \n" 
CODE &= !"    } \n" 
CODE &= !"    color /= 9.0; \n" 
CODE &= !"#else \n" 
CODE &= !"    vec3 color = getPixel(fragCoord, time); \n" 
CODE &= !"#endif \n" 
CODE &= !"     \n" 
CODE &= !"    // post \n" 
CODE &= !"	fragColor = vec4(pow(color,vec3(0.65)), 1.0); \n" 
CODE &= !"} \n" 

'
' --------------------------------- static code ------------------------
'
#include once "fbgfx.bi"
#include once "GL/gl.bi"
#include once "GL/glext.bi"

#ifndef NULL
#define NULL 0
#endif


type vec3
  as GLfloat x,y,z
end type

sub ErrorExit(msg as string)
  if screenptr() then screen 0
  dim as integer w,h
  screeninfo w,h : w*=0.75:h*=0.75
  screenres w,h
  print msg
  print "press any key to quit ..."
  beep : sleep : end 1
end sub



' define OpenGL proc's
#define glDefine(n) dim shared as PFN##n##PROC n
' texture
'glDefine(glActiveTexture)

' shader
glDefine(glCreateShader)
glDefine(glDeleteShader)
glDefine(glShaderSource)
glDefine(glCompileShader)
glDefine(glGetShaderiv)
glDefine(glGetShaderInfoLog)

' program
glDefine(glCreateProgram)
glDefine(glDeleteProgram)
glDefine(glAttachShader)
glDefine(glDetachShader)
glDefine(glLinkProgram)
glDefine(glGetProgramiv)
glDefine(glGetProgramInfoLog)
glDefine(glUseProgram)

' uniform
glDefine(glGetUniformLocation)
glDefine(glUniform1f)
glDefine(glUniform2f)
glDefine(glUniform3f)
glDefine(glUniform4f)
glDefine(glUniform1i)

#undef glDefine

sub glScreen(w as integer=800, h as integer=600, b as integer=32, d as integer=24, s as integer=0, f as integer=0)
  if ScreenPtr() then screen 0
  ScreenControl FB.SET_GL_STENCIL_BITS,s
  ScreenControl FB.SET_GL_DEPTH_BITS  ,d
  if ScreenRes(w,h,b,,FB.GFX_OPENGL or iif(f<>0,FB.GFX_FULLSCREEN,0)) then
    ErrorExit("screenres(" & w & "," & h &") failed !")
  end if
  Windowtitle "offline shadertoy.com"

  flip

  ' get OpenGL proc's (abort if something goes wrong)
  #define glProc(n) n = ScreenGLProc(#n) : if n = 0 then ErrorExit(#n)
  ' texture
'  glProc(glActiveTexture)
  ' shader
  glProc(glCreateShader)
  glProc(glDeleteShader)
  glProc(glShaderSource)
  glProc(glCompileShader)
  glProc(glGetShaderiv)
  glProc(glGetShaderInfoLog)
  ' program
  glProc(glCreateProgram)
  glProc(glDeleteProgram)
  glProc(glAttachShader)
  glProc(glDetachShader)
  glProc(glLinkProgram)
  glProc(glGetProgramiv)
  glProc(glGetProgramInfoLog)
  glProc(glUseProgram)
  ' uniform
  glProc(glGetUniformLocation)
  glProc(glUniform1f)
  glProc(glUniform2f)
  glProc(glUniform3f)
  glProc(glUniform4f)
  glProc(glUniform1i)
  #undef glProc

end sub

type ShaderToy
  declare destructor
  declare function CompileFile(Filename as string) as boolean
  declare function CompileCode(Code as string) as boolean
  as GLuint FragmentShader
  as GLuint ProgramObject
  as string Shaderlog
end type

destructor ShaderToy
  if ProgramObject then 
   glUseprogram(0)
   if FragmentShader  then 
     glDetachShader(ProgramObject,FragmentShader)
     glDeleteShader(FragmentShader)
   end if
   glDeleteProgram(ProgramObject)
  end if
end destructor

function ShaderToy.CompileFile(filename as string) as boolean
  dim as string code
  var hFile = FreeFile()
  if open(filename,for input, as #hFile) then 
    ShaderLog = "can't read shader: " & chr(34) & filename  & chr(34) & " !"
    return false
  end if
  while not eof(hFile)
    dim as string aLine
    line input #hFile,aLine
    code &= aLine & !"\n"
  wend
  close #hFile
  return CompileCode(code)
end function

function ShaderToy.CompileCode(UserCode as string) as boolean
  dim as GLint logSize
  dim as GLint status

  
dim as string FragmentProlog
FragmentProlog  = !"uniform vec3      iResolution;           // viewport resolution (in pixels) \n" 
FragmentProlog &= !"uniform float     iTime;                 // shader playback time (in seconds) \n" 
FragmentProlog &= !"uniform float     iTimeDelta;            // render time (in seconds) \n" 
FragmentProlog &= !"uniform int       iFrame;                // shader playback frame \n" 
FragmentProlog &= !"uniform float     iChannelTime[4];       // channel playback time (in seconds) \n" 
FragmentProlog &= !"uniform vec3      iChannelResolution[4]; // channel resolution (in pixels) \n" 
FragmentProlog &= !"uniform vec4      iMouse;                // mouse pixel coords. xy: current (if MLB down), zw: click \n" 
FragmentProlog &= !"uniform sampler3D iChannel0;          // input channel. XX = 2D/Cube \n" 
FragmentProlog &= !"uniform sampler3D iChannel1;          // input channel. XX = 2D/Cube \n" 
FragmentProlog &= !"uniform sampler3D iChannel2;          // input channel. XX = 2D/Cube \n" 
FragmentProlog &= !"uniform sampler3D iChannel3;          // input channel. XX = 2D/Cube \n" 
FragmentProlog &= !"uniform vec4      iDate;                 // (year, month, day, time in seconds) \n" 
FragmentProlog &= !"uniform float     iSampleRate;           // sound sample rate (i.e., 44100) \n" 
FragmentProlog &= !"uniform float      iGlobalTime;  // shader playback time (in seconds)\n"


' void mainImage( out vec4 fragColor, in vec2 fragCoord ) 


  dim as string FragmentEpilog
  FragmentEpilog  = !"void main() {\n"
  FragmentEpilog &= !"  vec4 color;\n"
  FragmentEpilog &= !"  // call user shader\n"
  FragmentEpilog &= !"  mainImage(color, gl_FragCoord.xy);\n"
  FragmentEpilog &= !"  color.w = 1.0;\n"
  FragmentEpilog &= !"  gl_FragColor = color;\n"
  FragmentEpilog &= !"}\n"

  dim as string FragmentCode = FragmentProlog & UserCode & FragmentEpilog

  FragmentShader = glCreateShader(GL_FRAGMENT_SHADER)
  if FragmentShader=0 then 
    ShaderLog = "glCreateShader(GL_FRAGMENT_SHADER) failed !"
    return false
  end if
  dim as GLchar ptr pCode=strptr(FragmentCode)
  glShaderSource (FragmentShader, 1, @pCode, NULL)
  glCompileShader(FragmentShader)
  glGetShaderiv  (FragmentShader, GL_COMPILE_STATUS, @status)
  if status = GL_FALSE then 
    glGetShaderiv(FragmentShader, GL_INFO_LOG_LENGTH, @logSize)
    ShaderLog = space(logSize)
    pCode=strptr(ShaderLog)
    glGetShaderInfoLog(FragmentShader, logSize, NULL, pCode)
    ShaderLog = !"glCompileShader(FragmentShader) failed !\n" & Shaderlog
    glDeleteShader(FragmentShader) : FragmentShader = 0
    return false
  end if

  ProgramObject = glCreateProgram()
  if ProgramObject=0 then 
    ShaderLog = "glCreateProgram() failed !"
    glDeleteShader(FragmentShader) : FragmentShader = 0
    return false
  end if
  glAttachShader(ProgramObject,FragmentShader)
  glLinkProgram (ProgramObject)
  glGetProgramiv(ProgramObject, GL_LINK_STATUS, @status)
  if (status = GL_FALSE) then
    glGetProgramiv(ProgramObject, GL_INFO_LOG_LENGTH, @logSize)
    ShaderLog = space(logSize) : pCode = strptr(ShaderLog)
    glGetProgramInfoLog (ProgramObject, logSize, NULL, pCode)
    ShaderLog = !"glLinkProgram() failed !\n" & Shaderlog
    glDeleteShader(FragmentShader) : FragmentShader = 0
    return false
  end if
  return true
end function

'
' main
'
/'

Various commonly used screen resolutions .

SVGA 	800 X 600
WSVGA 	1024 X 600
XGA 	1024 X 768
XGA+ 	1152 X 864
WXGA 	1280 X 720
WXGA 	1280 X 768
WXGA 	1280 X 800
SXGA– (UVGA) 	1280 X 960
SXGA 	1280 X 1024
HD 	    1360 X 768
SXGA+ 	1400 X 1050
WXGA+ 	1440 X 900
HD+ 	1600 X 900
UXGA 	1600 X 1200
WSXGA+ 	1680 X 1050
FHD 	1920 X 1080


WUXGA 	 1920 X 1200
QWXGA 	 2048 X 1152
WQHD 	 2560 X 1440
'/

' init Screenres, create the OpenGL context and load some OpenGL procs.
dim as boolean fullscreen=false
dim as integer scr_w=640,scr_h=480
'dim as integer scr_w=1280,scr_h=960
'dim as integer scr_w=1360,scr_h=768


glScreen scr_w,scr_h,,,,fullscreen


' get curent resolution

screeninfo scr_w,scr_h

dim as vec3 v3
v3.x=scr_w     ' width in pixle
v3.y=scr_h     '`height in pixle
v3.z=v3.x/v3.y ' pixel ratio

dim as ShaderToy Shader

if Shader.CompileCode(CODE)=false then
  ErrorExit Shader.ShaderLog
end if  

' enable shader
glUseProgram(Shader.ProgramObject)

' get uniforms locations in shader program
var iGlobalTime = glGetUniformLocation(Shader.ProgramObject,"iGlobalTime")
var iResolution = glGetUniformLocation(Shader.ProgramObject,"iResolution")
var iMouse      = glGetUniformLocation(Shader.ProgramObject,"iMouse")

' set vec3 iResolution
glUniform3f(iResolution,v3.x,v3.y,v3.z)

dim as integer mx,my,mb,frames,fps
dim as double tStart = Timer()
dim as double tLast=tStart
while inkey=""
  dim as double tNow=Timer()
  ' set uniform float iGlobalTime
  glUniform1f(iGlobalTime,tNow-tStart)

  if frames mod 3=0 then
    ' set vec4 iMouse
    if getMouse(mx,my,,mb)=0 then
      if mb then
        glUniform4f(iMouse,mx,my,1,1)
      else
        glUniform4f(iMouse,0,0,0,0)
      end if
    end if
  end if
  'glClear(GL_COLOR_BUFFER_BIT)
  ' draw a rectangle (2 triangles over the whole screen)
  glRectf(-1,-1,1,1)
  flip ' swap the buffers

  frames+=1
  ' update fps
  if frames mod 10=0 then
    fps=10/(tNow-tLast)
    windowtitle "fps: " & fps
    tLast=tNow
  end if

wend

' disable shader
glUseProgram(0)
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: OpenGL shader language math in FreeBASIC.

Post by Luxan »

Thank you for clarifying those two issues.

I left a message at the other thread, mentioning the availability of relevant code upon
this thread.

Your code runs smoothly upon my computer with 640x480 or higher resolution and at a color
depth of 32 .

FreeBasic is defining formatted c code as a string, compiling that, then running the resultant
from FreeBasic.

How might I run a function defined within the FreeBasic portion of this code, within the c code
portion .
Luxan
Posts: 222
Joined: Feb 18, 2009 12:47
Location: New Zealand

Re: OpenGL shader language math in FreeBASIC.

Post by Luxan »

Elsewhere I got a reply about using freebasic functions in C; search for me on freebasic, and you'll locate one
possible method.

The freebasic code I'm using to compile the shadertoy code, only uses one channel, yet there's
a few lines that were commented out that may of allowed the use of channels 0 to 3.
Is there a reason why this feature wasn't implemented .
Post Reply