- Welcome to Interactive PowerBasic Forum.
Your resource for programming with PowerBASIC™
Recent posts
#1
OxygenBasic / Re: Create a PDF directly
Last post by Charles Pegge - Today at 11:22:31 AMLimited time and energy constrain me from getting more involved, unfortunately. I am a limited resource. AI to the rescue? 
#2
OxygenBasic Examples / Re: Spheres + reflection (rayt...
Last post by Charles Pegge - Today at 11:10:24 AMThere's a sphere texture mapping for the Earth:
demos\OpenGl\ConsoleG\SphereMapPolar.o2bas
demos\OpenGl\ConsoleG\SphereMapPolar.o2bas
Code Select
% Title "Sphere Mapping Demo"
% Animated
% ScaleUp
'% PlaceCentral
'% AnchorCentral
$ filename "t.exe"
'uses RTL64
uses ConsoleG
function SphereMap(int nPrecision)
==================================
'From Mike Lobanovsky / Sphere mapping
float ex,ey,ez,theta1,theta2,theta3
float M_TWOPI = pi()*2
float M_PI_2 = pi()/2
int i,j,ei
ei=(nprecision-1)\2
For i = 0 To ei
theta1 = i * M_TWOPI / nPrecision - M_PI_2
theta2 = (i + 1) * M_TWOPI / nPrecision - M_PI_2
glBegin(GL_TRIANGLE_STRIP)
For j = 0 To nPrecision
theta3 = j * M_TWOPI / nPrecision
' Splices
ex = cos(theta2) * cos(theta3) ' calculate Euler angles on 3 axes
ey = sin(theta2)
ez = cos(theta2) * sin(theta3)
glNormal3f(ex, ey, ez) ' set up normals
glTexCoord2f(-j / nPrecision, 2 * (i + 1) / nPrecision) ' set up UVs
glVertex3f(1.5 * ex, 1.5 * ey, 1.5 * ez) ' render vertices
' Sides
ex = cos(theta1) * cos(theta3)
ey = sin(theta1)
ez = cos(theta1) * sin(theta3)
glNormal3f(ex, ey, ez)
glTexCoord2f(-j / nPrecision, 2 * i / nPrecision)
glVertex3f(1.5 * ex, 1.5 * ey, 1.5 * ez)
Next
glEnd()
Next
end function
sub main()
==========
static int imgn,res,wi,ht,earth
static float angx,angy
if not imgn
imgn=21
res=0 'use image wi and ht (512*256)
LoadTexture "..\..\images\Earth.jpg",imgn,res,wi,ht
'LoadTexture "NASA_Blue_Marble.jpg",imgn,res,wi,ht
'http://www.johnstonsarchive.net/spaceart/earthmap.jpg
'LoadTexture "earthmap.jpg",imgn,res,wi,ht
earth=CompileList : SphereMap 128 : glEndlist
end if
cls '0,0,0
'display image
'
pushstate
move 16,-16
shading
color 1,1,1,1
texture imgn
scale 8
'rotateX angX
rotateY angY
go earth
'quadnorm 10.0, 10.0 'apply image texture to quad
texture 0
popstate
flat
move 0,-.5
scale 2
printl "Sphere Mapping"
angx+=.100 : if angx>=360 then angx-=360
angy+=.125 : if angy>=360 then angy-=360
end sub 'main
EndScript
#3
OxygenBasic / Re: Array Ubound problem
Last post by Nicola - Today at 11:01:59 AMvery good.
In fact, I wasn't making use of arrays while waiting for news.
Thank you Charles.
In fact, I wasn't making use of arrays while waiting for news.
Thank you Charles.
#4
OxygenBasic / Re: Array Ubound problem
Last post by Charles Pegge - Today at 10:57:58 AMUbound etc last tested in March. Should be ok now.
#5
microA Interpreter / Re: UDF testing in micro(A)
Last post by Zlatko Vid - Today at 10:45:52 AMin case someone is interested
https://discord.gg/ANsRUPy
https://discord.gg/ANsRUPy
#6
Discussion / Re: Why this Forum is so dead?...
Last post by Johan Klassen - Yesterday at 06:15:28 PMin the 70's when the micro computer revolution was happening, everybody got excited and people were very busy trying all kinds of things, the WWW was not in existence at the time but we had bulletin boards to share code, plus tons of magazines and outlets selling CD's loaded with source-code and shareware programs, but that's not the case today.
#7
OxygenBasic / Re: Create a PDF directly
Last post by Nicola - Yesterday at 05:17:53 PMHi Charles,
the information from idrsolutions is very interesting.
Very good.
I also found how to do it via qpdf with the use of a json...
...
For now, I'm using programs that use the command line.
Cheers
the information from idrsolutions is very interesting.
Very good.
I also found how to do it via qpdf with the use of a json...
...
For now, I'm using programs that use the command line.
Cheers
#8
Discussion / Re: Why this Forum is so dead?...
Last post by Zlatko Vid - Yesterday at 05:08:57 PMQuotefreebasic thinbasic are more busy?
Hi Frank
I really don't know why you have such a feeling
i don't visit freeBasic and thinBasic forum very much
just because they looks static to ...or simply i am not interested to see
what is there ..i am not sure .
#9
OxygenBasic Examples / Re: Spheres + reflection (rayt...
Last post by Frank Brübach - Yesterday at 03:48:21 PMHi Charles need your Help how to Set Up a sphere mapping... for a Cube Texture mapping is OK Here
Thx, Frank
Thx, Frank
Code Select
'-- openGL test for sphere mapping and reflections
'-- oxygen basic, 30.04.-02.05.2024, by frank bruebach
'-- part one
'
#compact
$ title "Objects and Reflection"
$ FileName "t.exe"
'uses RTL64
% ExplicitMain
% MultiSamples 4
uses OpenglSceneFrame
uses MinMidi
uses glo2\shapes
uses glo2\materials
uses glo2\particles
uses glo2\ShaderSupport
uses glo2\shaders
'--------------------------------------------- //
% GL_ARRAY_BUFFER 0x8892
% GL_ELEMENT_ARRAY_BUFFER 0x8893
% GL_STATIC_DRAW 0x88E4
/* Shaders */
% GL_FRAGMENT_SHADER 0x00008B30
% GL_VERTEX_SHADER 0x00008B31
% GL_MAX_VERTEX_ATTRIBS 0x00008869
% GL_MAX_VERTEX_UNIFORM_VECTORS 0x00008DFB
% GL_MAX_VARYING_VECTORS 0x00008DFC
% GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS 0x00008B4D
% GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS 0x00008B4C
% GL_MAX_TEXTURE_IMAGE_UNITS 0x00008872
% GL_MAX_FRAGMENT_UNIFORM_VECTORS 0x00008DFD
% GL_SHADER_TYPE 0x00008B4F
% GL_DELETE_STATUS 0x00008B80
% GL_LINK_STATUS 0x00008B82
% GL_VALIDATE_STATUS 0x00008B83
% GL_ATTACHED_SHADERS 0x00008B85
% GL_ACTIVE_UNIFORMS 0x00008B86
% GL_ACTIVE_UNIFORM_MAX_LENGTH 0x00008B87
% GL_ACTIVE_ATTRIBUTES 0x00008B89
% GL_ACTIVE_ATTRIBUTE_MAX_LENGTH 0x00008B8A
% GL_SHADING_LANGUAGE_VERSION 0x00008B8C
% GL_CURRENT_PROGRAM 0x00008B8D
/* Shader Source */
% GL_COMPILE_STATUS 0x00008B81
% GL_INFO_LOG_LENGTH 0x00008B84
% GL_SHADER_SOURCE_LENGTH 0x00008B88
% GL_SHADER_COMPILER 0x00008DFA
'
'declare pointered functions
'====================
'
'Vertex Buffer Objects
!*glGenBuffers(sys n, *buffers)
!*glBindBuffer(sys target, buffer)
!*glBufferData(sys target, size, pdat, usage)
!*glDeleteBuffers(sys n, *buffers)
'
'Shaders
!*glCreateShader (sys shadertype) as sys
!*glShaderSource (sys shader,count,strings,lengths)
!*glCompileShader (sys shader)
!*glGetShaderInfoLog (sys shader,maxlength,*length,char*infolog)
!*glGetProgramInfoLog (sys shader,maxlength,*length,char*infolog)
!*glGetShaderiv (sys shader,pname,*params)
!*glAttachShader (sys program,shader)
!*glDetachShader (sys program,shader)
!*glDeleteShader (sys shader)
!*glLinkProgram (sys program)
!*glCreateProgram () as sys
!*glDeleteProgram (sys program)
!*glGetProgramiv (sys program,pname,*params)
!*glUseProgram (sys program)
'!*glGetUniformLocation(sys program, char*name) as sys
!*glGetUniformLocation(sys program, string*name) as sys
!*glGetUniformfv (sys program,location,float*params)
!*glGetUniformiv (sys program,location,int*params)
!*glUniform1f (sys location, float v1)
!*glUniform2f (sys location, float v1,v2)
!*glUniform3f (sys location, float v1,v2,v3)
!*glUniform4f (sys location, float v1,v2,v3,v4)
'types
'====
'
type vert float x,y,z
type tex float u,v
type rgba byte r,g,b,a
'globals
'=====
'
sys shaderP,shaderV,shaderF
sys VBOs 'flag VBOs in use
sys vbo[4]
sys VertBuf,NormBuf,TexBuf,IndexBuf
sys VertCount
sys Texname
'
string glExt
indexbase 1
int ShaderShn,ShaderSky,ShaderRfl
'indexbase 1
sys GdiplusToken
float ang1
float ma[16]
float li[16]
sys cube,sphere,csface
Cloud cloud1
sub SetupGLSL()
=============
SetFun glCreateShader
SetFun glShaderSource
SetFun glCompileShader
SetFun glGetShaderInfoLog
SetFun glGetProgramInfoLog
SetFun glGetShaderiv
SetFun glAttachShader
SetFun glDetachShader
SetFun glDeleteShader
SetFun glLinkProgram
SetFun glCreateProgram
SetFun glDeleteProgram
SetFun glGetProgramiv
SetFun glUseProgram
SetFun glGetUniformLocation
SetFun glGetUniformfv
SetFun glGetUniformiv
SetFun glUniform1f
SetFun glUniform2f
SetFun glUniform3f
SetFun glUniform4f
end sub
function CreateShaderProg(string Vertexs,Fragments,sys *VObj,*FObj) as sys
===========================================================
'http://www.opengl.org/sdk/docs/tutorials/ClockworkCoders/loading.php
string fi,sh
sys Program, VertexShader, FragmentShader
sys vle,fle
sys linked
string vsh,fsh, Infolog
'
vsh=getfile Vertexs
fsh=getfile Fragments
if vsh="" or fsh="" then jmp fwd done
'
VertexShader = glCreateShader GL_VERTEX_SHADER
FragmentShader = glCreateShader GL_FRAGMENT_SHADER
vle=len vsh
fle=len fsh
sys sa[2]
sa[1]=strptr vsh
sa[2]=strptr fsh
sys vcompiled,fcompiled,linked
glShaderSource VertexShader, 1, &sa[1], &vle
glShaderSource FragmentShader, 1, &sa[2], &fle
glCompileShader VertexShader
glCompileShader FragmentShader
glGetShaderiv VertexShader, GL_COMPILE_STATUS, vcompiled
glGetShaderiv FragmentShader, GL_COMPILE_STATUS, fcompiled
'
if vcompiled=0 or fcompiled=0
string vlog,flog
if GetShaderInfoLog(VertexShader,vlog) or GetShaderInfoLog(FragmentShader,flog)
print vlog+flog
jmp fwd done
end if
end if
'Linking:
Program = glCreateProgram
glAttachShader Program, vertexShader
glAttachShader Program, fragmentShader
glLinkProgram Program
'
glGetProgramiv Program, GL_LINK_STATUS, linked
if not linked
string plog
if GetProgramInfoLog(Program,plog)
print plog
end if
end if
done:
Vobj=VertexShader
FObj=FragmentShader
return Program
end function
'--------------------------------------------- //
indexbase 1
sys GdiplusToken
float ang1
float ma[16]
float li[16]
int cube,sphere,helix,tors,csface,pent
sys hmo 'midi
Cloud cloud1
Smoke smoke1
plant fern
sub MinTextureA(int n,f,h,b)
============================
static long v[16]
v<=
b,b,b,b,
b,f,h,b,
b,h,h,b,
b,b,b,b
MakeTexture @v, 4, 4, n
End sub
sub RenderCrate(float x,y,z,sc,sys tex)
=======================================
'glColor4f .99,.99,.99,.99
glEnable GL_TEXTURE_2D
glBindTexture GL_TEXTURE_2D,tex
glPushMatrix
gltranslatef x,y,z
glrotatef 45.0,0,1,0
glscalef sc+0.4,sc+0.4,sc+0.4
glCallList Cube
'glCallList Pent
glPopMatrix
glDisable GL_TEXTURE_2D
end sub
sub InitMidi()
================
int er
er=midiOutOpen(hmo, 0, 0, 0, CALLBACK_NULL) '0=synth a 2=soft synth
midiOutShortMsg(hmo, 0xC0+0x0D00) 'Xylophone Bells assign
end sub
function ding(int v,n)
======================
if v>127 then v=127
if v<10 then v=10
'midiOutShortMsg(hmo, v*0x10000+n*0x100+0x89) 'percussion off
midiOutShortMsg(hmo, v*0x10000+n*0x100+0x99) 'percussion on
end function
'------------------------ //
sub initialize(sys hWnd)
========================
'
InitMidi
GDIplus 1
'
'PREPARE TEXTURES
'
glGenTextures 2, texn
'
static sys res=256
string imgs[3]
MinTexture texn[1],0xffffffff,0x80ffffff,0x00ffffff
MinTexture texn[2],0xffffffff,0x80ffffff,0x00000000
LoadPixImage "Nehe_Reflection.jpg",res,imgs[3] '"../images/crate.jpg"
MakeTexture *imgs[3],res,res,texn[3]
'
cube=CompileList : CubeForm : glEndList
pent=CompileList : Sides 5,1,1 : glEndList
'
SetTimer hWnd,1,10,null
'PREPARE TEXTURES
'
glGenTextures 16, texn
'
seed=0x12345678
MinTexture texn[1],0xffffffff,0x80ffffff,0x00ffffff 'whitecloud
MinTexture texn[2],0xffffffff,0x80ffffff,0x00000000 'smoke
MinTextureA texn[3],0x80000000,0x40000000,0x00000000 'soft light shadow
MinTextureA texn[4],0xc0000000,0x60000000,0x00000000 'soft medium shadow
MinTextureA texn[5],0xff000000,0x80000000,0x00000000 'soft intense shadow
'
static int res=256,texspace
texspace=res*res*4
string imgs[3]
imgs[1]=nuls texspace
imgs[2]=imgs[1]
imgs[3]=imgs[1]
'LoadPixImage "../images/crate.jpg",res,imgs[1]
'
'pixbase,width,height,stride,colorval,offset
--------------------------------------------
AddNoiseC strptr imgs[1],res,res,32,060,060,100,255,0x53535353,1
AddNoiseC strptr imgs[1],res,res,16,060,060,100, 0,0x35353535
AddNoiseC strptr imgs[1],res,res,08,070,070,050, 0,0x53535353
AddNoiseC strptr imgs[1],res,res,02,010,010,005, 0,0x53535353
MakeTexture strptr imgs[1],res,res,texn[10]
'
AddNoiseC strptr imgs[2],res,res,08,100,100,000,255,0x35353535,1
AddNoiseC strptr imgs[2],res,res,02,100,100,000, 0,0x35353535
AddNoiseC strptr imgs[2],res,res,01,050,050,000, 0,0x35353535
MakeTexture strptr imgs[2],res,res,texn[11]
'
'AddNoiseC strptr imgs[3],res,res,32,060,060,100,128,0x53535353,1 'const alpha
AddNoiseC strptr imgs[3],res,res,32,060,060,100,255,0x53535353
AddNoiseC strptr imgs[3],res,res,16,060,060,100, 0,0x35353535
AddNoiseC strptr imgs[3],res,res,08,070,070,050, 0,0x53535353
AddNoiseC strptr imgs[3],res,res,02,010,010,005, 0,0x53535353
MakeTexture strptr imgs[3],res,res,texn[12]
'
sys p
p=fern.new res,32000 'pixel map
MakeTexture p,res,res,texn[13]
fern.free
cube=CompileList : CubeForm : glEndList
sphere=CompileList : Spheric 1,1,6 : glEndList
tors=CompileList : torus 1.,.20 : glEndList
'
SetTimer hWnd,1,10,null
end sub
sub Release(sys hwnd)
'====================
glDeleteLists cube,1
glDeleteLists sphere,1
glDeleteLists helix,1
glDeleteLists tors,1
glDeleteLists csface,1
glDeleteTextures 16, texn
Gdiplus 0
killTimer hwnd, 1
MidiOutClose hmo
end sub
sub RenderPlane(int tex, float u,v)
===================================
glBindTexture GL_TEXTURE_2D,tex
glBegin GL_QUADS
glNormal3f 0.,1.,0.
glTexCoord2f 0.0,0.0 : glVertex3f -1.0,0,-1.0
glTexCoord2f u ,0.0 : glVertex3f 1.0,0,-1.0
glTexCoord2f u ,v : glVertex3f 1.0,0, 1.0
glTexCoord2f 0.0,v : glVertex3f -1.0,0, 1.0
glend
end sub
'------------------- //
sub scene(sys hWnd)
===================
'
static single ra,ri,angi1=.4
'
ActiveFrame
glClearColor 0.5, 0.5, 0.7, 0
Fog 0.5, 0.5, 0.7, 0.030
StandardLighting li
StandardMaterial ma
' '
glGenTextures 2, texn
static as single,
light_position(4) => (0.0, 8.0, 8.0, 0.0), '(0.0, 0.0, 2.0, 1.0),
light_diffuse (4) => (0.29, 0.29, 0.29, 1.0), '(0.5, 0.5, 0.5, 1.0), 1,1,1,1
light_specular(4) => (0.59, 0.59, 0.59, 1.0), '(0.5, 0.5, 0.5, 1.0),
light_ambient (4) => (0.75, 0.75, 0.75, 1.0) '(0.5, 0.5, 0.5, 1.0) '0.5,0.5,0.5,1.0
static as double aspect
static int t1,t2,t3
t1=texn[10] : t2=texn[11] : t3=texn[12]
'
glEnable GL_TEXTURE_2D
glShadeModel GL_SMOOTH
'glClearColor 0.0, 0.0, 0.0, 0.5
glClearDepth 1.0
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
'Configure and enable light source 1
' here you can do some changes --------------------- //
glLightfv GL_LIGHT1, GL_POSITION, light_position '(4) '' activate use all is white-black
glLightfv GL_LIGHT1, GL_AMBIENT, light_ambient '(4)
glLightfv GL_LIGHT1, GL_DIFFUSE, light_diffuse '(4) 'red effect
glLightfv GL_LIGHT1, GL_SPECULAR, light_specular '(4)
' here you can do some changes --------------------- //
glDepthFunc GL_LEQUAL
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
glEnable GL_LIGHT1
glEnable GL_LIGHTING
'
static sys res=256
string imgs[3]
MinTexture texn[1],0xffffffff,0x80ffffff,0x00ffffff
MinTexture texn[2],0xffffffff,0x80ffffff,0x00000000
LoadPixImage "Nehe_Reflection.jpg",res,imgs[3] '"../images/crate.jpg"
MakeTexture *imgs[3],res,res,texn[3]
'
cube=CompileList : CubeForm : glEndList
pent=CompileList : Sides 5,1,1 : glEndList
'
SetTimer hWnd,1,10,null
'CRATES
glColor4f .99,.99,.99,.99
sys n=texn[3]
'RenderCrate 11.5,-0.9,-24.0,0.5,n
'RenderCrate 6.5,-0.9,-16.0,0.5,n
'RenderCrate 2.5,-0.9,-8.0, 0.5,n
RenderCrate -1.5,0.29,-7.0, 0.5,n '-1.5,-0.59,-7.0, 0.5,n
'RenderCrate 0.5,-0.9,-4.0, 0.5,n
'RenderCrate -0.5,-0.9,-2.0, 0.5,n
glDisable GL_LIGHTING
float fcolor[4]={.5, .5, .7, .99}
glfogi GL_FOG_MODE,GL_EXP
glfogf GL_FOG_DENSITY,0.020
glfogfv GL_FOG_COLOR, fcolor
glfogf GL_FOG_INDEX, 0
glfogf GL_FOG_START, -1.0
glfogf GL_FOG_END, -100.0
glEnable GL_FOG
'
glPolygonMode GL_FRONT_AND_BACK, GL_FILL
glEnable GL_NORMALIZE
'
static int t1,t2,t3
t1=texn[10] : t2=texn[11] : t3=texn[12]
'
'MYSTERIOUS RED PLANET
glPushMatrix
glTranslatef -20.,10.,-95.0 '-95.0
Material Red
glScalef 8.0,8.0,8.0 '6.,6.,6.
glEnable GL_LIGHTING
glCallList sphere
'glDisable GL_LIGHTING
glPopMatrix
'
'OBJECTS REFLECTED IN FLOOR
---------------------------
'
li[2]=-li[2] : lighting li 'y position
'
'CONE REFLECTION
glPushMatrix
Material Silver
glTranslatef -3.0,-2.,-8.0
glScalef .5,-.5,.5
glBindTexture GL_TEXTURE_2D,t1
ConeFaces 16,0.,2.,0.
glPopMatrix
'RING REFLECTION
Material Gold
glPushMatrix
glTranslatef 1.0,-2.23,-7.0 '2.0,-2.23,-7.0
glScalef .75,-1.00,.75
glCallList tors
glPopMatrix
li[2]=-li[2] : lighting li 'y position
'
'FLOOR TILES
glPushMatrix
glEnable GL_TEXTURE_2D
glTranslatef -8.0,-1.99,-5.0
glScalef .25,1.,.25
glPushMatrix
int i,j,a
macro rtile1
Material White
RenderPlane t3,1.,1.
glTranslatef 2.,0.,0.
end macro
macro rtile2
Material White
RenderPlane t3,1.,1.
glTranslatef 2.,0.,0.
end macro
for j=1 to 16
for i=1 to 16
if a
rtile1
rtile2
else
rtile2
rtile1
end if
next
glTranslatef -64.0,0.,-2.
a=1-a 'alternate
next
glPopMatrix
glDisable GL_TEXTURE_2D
glPopMatrix
Material White
'
'SPHERES
glPushMatrix
indexbase 1
glTranslatef 1.,2.,-9.0 ''1.,2.,-12.0 '-2.8,1.,-12.0
Material Red 'Gold
glScalef 1.5,1.5,1.5
glCallList sphere
Material White
glPopMatrix
glPushMatrix
glTranslatef 2.5,-1.0,-6.0
glScalef .75,.75,.75
glCallList sphere
glPopMatrix
glPushMatrix
glTranslatef -2.5,-1.0,-6.0
Material silver
glScalef .75,.75,.75
'glCallList sphere
glPopMatrix
'RING
Material Gold
glPushMatrix
'glTranslatef 3.0,-1.77,-7.0
glTranslatef 1.0,-1.27,-7.0
glScalef .75,1.00,.75
glCallList tors
glPopMatrix
'
'CONE
glPushMatrix
Material Silver
'glTranslatef -3.,-2.,-8.0
glTranslatef -3.,-1.75,-8.0
glScalef .5,.5,.5
glBindTexture GL_TEXTURE_2D,t1
ConeFaces 16,0.,2.,0.
glPopMatrix
glDisable GL_TEXTURE_2D
'
ang1+=angi1
if ang1>360 then ang1-=360
end sub
MainWindow width,height,WS_OVERLAPPEDWINDOW
#10
OxygenBasic / Re: Array Ubound problem
Last post by Nicola - Yesterday at 03:45:00 PMHi Charles.
Could you please update me on the progress related to the Arrays?
Ubound? and other related commands working properly now?
Thank you very much.
Could you please update me on the progress related to the Arrays?
Ubound? and other related commands working properly now?
Thank you very much.