|
OPENGL?
Jun 30, 2023 18:14:29 GMT -5
Post by Walt Decker on Jun 30, 2023 18:14:29 GMT -5
Yes, they are non-functional. As I wrote LB source code I updated the dll to handle the code. I reasoned that there was not much point in having only a partially functioning dll hanging around.
I will create a new functions/equate list and put that and all the source code in a zip. Probably post it tomorrow.
As for OPENGL versions that will work natively with LB's CALLDLL, the answer is none. Reason, LB can pass only words(ushort), integers(short), dwords(ulong), long, and double precision values, and does not do a very good job of passing double precision. I have tested all the ogl functions against the corresponding LB values and the only ones I have found that will work without a wrapper is obtaining a rendering context, and byte colors. The remainder fail. When attempting more complicated things like display lists and texture mapping there is no way because LB can not pass arrays to dlls.
The best tutorial I have found is out of print. It is titled "OPENGL Super Bible" by Richard S. Wright and Michael Sweet, ISBN 1-57169-073-5, 1996 published by the Waite Group Press.
A fair reference is Beginnning OPENGL Game Programming, by Dave Astle and Kevin Hawkins, ISBN 1-59200-369-9, 2004 published by Premier Press.
You do not have to worry about "old stuff". OPENGL is backward compatible to almost its beginning.
|
|
|
OPENGL?
Jul 1, 2023 14:33:57 GMT -5
Post by Walt Decker on Jul 1, 2023 14:33:57 GMT -5
Updated dll docs plus source code files and explanation text.
|
|
|
OPENGL?
Jul 1, 2023 15:10:44 GMT -5
Post by tsh73 on Jul 1, 2023 15:10:44 GMT -5
Thank you, will read.
|
|
|
OPENGL?
Jul 1, 2023 16:46:51 GMT -5
Post by Walt Decker on Jul 1, 2023 16:46:51 GMT -5
You are welcome. I would like to see what you do with it.
|
|
|
Post by Rod on Jul 2, 2023 3:57:42 GMT -5
The LBPE link to old code does work. But remember you now have to first copy the link and then paste it into your browser search bar. Single Click downloads have been made harder to prevent inappropriate file downloads by novices.
|
|
|
OPENGL?
Jul 2, 2023 12:43:16 GMT -5
Post by tsh73 on Jul 2, 2023 12:43:16 GMT -5
|
|
|
OPENGL?
Jul 4, 2023 15:13:15 GMT -5
Post by Brandon Parker on Jul 4, 2023 15:13:15 GMT -5
and does not do a very good job of passing double precision Can you clarify this? Are you talking about the propensity for LB to automatically cast a floating point number like "2.0" as a float to "2" as an integer before it sends it to the DLL call? If so, there is a workaround for that... {:0) Brandon Parker
|
|
|
OPENGL?
Jul 7, 2023 16:23:31 GMT -5
Post by Walt Decker on Jul 7, 2023 16:23:31 GMT -5
While re-learning OpenGL I have developed this little app. There is no source code. If anyone is interested I will attempt to create LB source for it.
NOTE: When getting a bmp file for the first time the default is SUNSET.BMP. That is not in the zip. Along with the other bmp files the zip became way too large.
ZIP CONTENTS: OGL_PIX_MAP.EXE SAND.BMP GRANIT.BMP GRASS.BMP CLOUDS.BMP WATER.BMP WATER1.BMP
TO: Brandon Parker
Mr. Parker, there is no need for double work-a-rounds. As long as the double is placed in a variable the DLL will properly cast them.
|
|
|
OPENGL?
Jul 8, 2023 15:45:08 GMT -5
Post by tsh73 on Jul 8, 2023 15:45:08 GMT -5
It does work for me, but user should * LOAD bmp then * DRAW it Without second action there is no way to guess program does something at all.
edit OK if I try all the menus, some goes to open BMP automatically. but first item is LOAD and as I said it produces no visible effect.
EDIT ok I see it works But what exactly it does / how it differs from LOADBMP etc?
|
|
|
OPENGL?
Jul 8, 2023 17:13:49 GMT -5
Post by Walt Decker on Jul 8, 2023 17:13:49 GMT -5
The program remembers the bmp name that was originally loaded. If you want to draw a different bitmap you have to LOAD it then do whatever you want with it. The new bmp file now becomes the original so if you want to look a at different one you have to load it; ad infinitum.
Does that explain it?
|
|
|
OPENGL?
Jul 12, 2023 16:14:15 GMT -5
Post by Walt Decker on Jul 12, 2023 16:14:15 GMT -5
I was not going to do this but thought it might be of interest to someone. There is no explanation of what is going on in the below code. To run it you will need LBOGL 0.DLL VERSION 1.04, attached.
I am currently working on a method to add action a background bitmap.
' NOMAINWIN OPEN "User32.DLL" FOR DLL AS #USER OPEN "Kernel32.DLL" FOR DLL AS #KERN OPEN "LBOGL 0.DLL" FOR DLL AS #LBOGL
[DEFINE.GLOBALS] GLOBAL Grc, _ Gdc
GLOBAL BmpWide, _ BmpHigh
GLOBAL GmaFlg, _ Gamma
GLOBAL Sclx, _ Scly
GLOBAL LstFile$, _ BitStr$
Sclx = 1 Scly = 1
[DEFINE.LOCALS] Xw = 0 Yh = 0
RetVal = 0 WinHndl = 0 GfxHndl = 0
OglRange = 0
Xw = 400 Yh = 400
[BEGIN] WinHndl = FN.CreateWindow("Draw Pix Test", Xw, Yh, GfxHndl) RetVal = FN.CreateCtlWindow(WinHndl) GfxRc = FN.GetPixelFormat(GfxHndl, GfxDc) Grc = GfxRc Gdc = GfxDc OglRange = MAX(Xw, Yh)
RetVal = FN.DefineOglWindow(Xw, Yh, OglRange) WAIT
'-------------------------- '--------------------------
SUB CLOSE.ORTHO WinHndl$
WinRc = Grc CALLDLL #LBOGL, "GLMakeCurrent", 0 AS ULONG, 0 AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLDeleteContext", WinRc AS ULONG, RetVal AS VOID
CLOSE #USER CLOSE #KERN CLOSE #LBOGL CLOSE #CTL CLOSE #WinHndl$ END END SUB
'-------------------------- '--------------------------
SUB CTRLS CkbHndl$
GL.TRUE = 1 GL.FALSE = 0
GL.MAP.COLOR = HEXDEC("&H0D10")
GL.PIXEL.MAP.R.TO.R = HEXDEC("&H0C76") GL.PIXEL.MAP.G.TO.G = HEXDEC("&H0C77") GL.PIXEL.MAP.B.TO.B = HEXDEC("&H0C78") GL.PIXEL.MAP.A.TO.A = HEXDEC("&H0C79")
RetVal = 0 Xwide = 0 Yhigh = 0
Checked$ = "" BitStream$ = ""
GfxDc = Gdc CurFile$ = LstFile$
IF Busy THEN EXIT SUB
#CkbHndl$, "VALUE? Checked$"
IF Checked$ = "set" THEN SELECT CASE CkbHndl$ CASE "#CTL.CKLOAD" CurFile$ = FN.SelectFile$(CurFile$) LstFile$ = CurFile$
IF LstFile$ = "" THEN GOTO [UNSET.CHECK]
BitStream$ = FN.GetBitStream$(CurFile$, Xwide, Yhigh)
BitStr$ = BitStream$ BmpWide = Xwide BmpHigh = Yhigh Sclx = 1 Scly = 1 RetVal = FN.DrawPicture(GfxDc, BitStream$, Xwide, Yhigh)
CASE "#CTL.CKGPIX" RetVal = FN.DrawGfxBits(CurFile$) Busy = 1 LstFile$ = CurFile$
CASE "#CTL.CKGSCL" IF LstFile$ = "" THEN GOTO [UNSET.CHECK]
Xwide = BmpWide Yhigh = BmpHigh
RetVal = FN.CreateScaleDlg(Xwide, Yhigh) RetVal = FN.WaitForINPUT(200, "#SCL")
Xwide = BmpWide Yhigh = BmpHigh ' BitStream$ = BitStr$ RetVal = FN.DrawPicture(GfxDc, BitStr$, Xwide, Yhigh)
CASE "#CTL.CKGGMA" IF LstFile$ = "" THEN GOTO [UNSET.CHECK] RetVal = FN.CreateGammaDlg() RetVal = FN.WaitForINPUT(200, "#GMA")
IF GmaFlg = Gamma THEN GOTO [UNSET.CHECK]
CALLDLL #LBOGL, "GLClearGammaEx", RetVal AS VOID CALLDLL #LBOGL, "GLSetGammaEx", Gamma AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLPixTransferI", GL.MAP.COLOR AS ULONG, GL.TRUE AS USHORT, RetVal AS VOID CALLDLL #LBOGL, "GLPixMapfv", GL.PIXEL.MAP.R.TO.R AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLPixMapfv", GL.PIXEL.MAP.G.TO.G AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLPixMapfv", GL.PIXEL.MAP.B.TO.B AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLPixMapfv", GL.PIXEL.MAP.A.TO.A AS ULONG, RetVal AS VOID
Xwide = BmpWide Yhigh = BmpHigh BitStream$ = BitStr$ RetVal = FN.DrawPicture(GfxDc, BitStream$, Xwide, Yhigh) CALLDLL #LBOGL, "GLPixTransferI", GL.MAP.COLOR AS ULONG, GL.FALSE AS USHORT, RetVal AS VOID GmaFlg = Gamma END SELECT END IF
[UNSET.CHECK] #CkbHndl$, "RESET" Busy = 0 END SUB
'-------------------------- '--------------------------
SUB GAMMA.BTNS GmaHndl$
NewGamma$ = ""
SELECT CASE GmaHndl$ CASE "#GMA.BTNOK" #GMA.TXBGMA, "!CONTENTS? NewGamma$"
IF NewGamma$ = "" THEN CLOSE #GMA EXIT SUB END IF
Gamma = VAL(NewGamma$) CLOSE #GMA
CASE "#GMA.BTNNO" CLOSE #GMA END SELECT
END SUB
'-------------------------- '--------------------------
SUB SCALE.BTN SclHndl$
Scalex$ = "" Scaley$ = "" SELECT CASE SclHndl$ CASE "#SCL.OK" #SCL.TXBX, "!CONTENTS? Scalex$" #SCL.TXBY, "!CONTENTS? Scaley$"
IF Scalex$ <> "" THEN Sclx = VAL(Scalex$) IF Scaley$ <> "" THEN Scly = VAL(Scaley$) CLOSE #SCL EXIT SUB
CASE "#SCL.NO" CLOSE #SCL END SELECT
END SUB
'-------------------------- '--------------------------
FUNCTION FN.CreateWindow(Title$, BYREF Xwide, BYREF Yhigh, BYREF CtlHndl)
WS.BORDER = HEXDEC("&H00800000")
WinHndl = 0
'Xwide = 300 'Yhigh = 310
RetVal = 0
Ux = 0 Uy = 0 Cx = 0 Cy = 0
STYLEBITS #ORTHO.GFX, 0, WS.BORDER, 0, 0 GRAPHICBOX #ORTHO.GFX, 0, 0, 290, 270
RetVal = FN.ScreenCenter(Cx, Cy) Ux = INT(Cx - Xwide / 2) Uy = INT(Cy - Yhigh / 2)
RetVal = FN.SetWinPos(Ux, Uy) RetVal = FN.SetWinSize(Xwide, Yhigh)
OPEN Title$ FOR WINDOW AS #ORTHO
WinHndl = HWND(#ORTHO) RetVal = FN.ClientSize(WinHndl, Xwide, Yhigh)
#ORTHO.GFX, "LOCATE 0 0 ";Xwide; " "; Yhigh #ORTHO, "REFRESH" #ORTHO, "TRAPCLOSE CLOSE.ORTHO" '#ORTHO.GFX, "when leftButtonDown ROTATE" CtlHndl = HWND(#ORTHO.GFX) FN.CreateWindow = WinHndl END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateCtlWindow(WinHndl)
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000") WS.GROUP = HEXDEC("&H00020000") WS.TABSTOP = HEXDEC("&H00010000")
BS.PUSHLIKE = HEXDEC("&H00001000")
RetVal = 0
Ux = 0 Uy = 0 Cx = 0 Cy = 0
WinWide = 118 WinHigh = 135
RetVal = FN.GetWinRect(WinHndl, Ux, Uy, 0, 0) STYLEBITS #CTL.CKLOAD, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 STYLEBITS #CTL.CKGPIX, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 STYLEBITS #CTL.CKGSCL, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 STYLEBITS #CTL.CKGGMA, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 CHECKBOX #CTL.CKLOAD, "LOAD", CTRLS, CTRLS, 5, 5, 100, 20 CHECKBOX #CTL.CKGPIX, "GFX PIXLES", CTRLS, CTRLS, 5, 30, 100, 20 CHECKBOX #CTL.CKGSCL, "SCALE PICTURE", CTRLS, CTRLS, 5, 55, 100, 20 CHECKBOX #CTL.CKGGMA, "ADJUST GAMMA", CTRLS, CTRLS, 5, 80, 100, 20
RetVal = FN.ScreenCenter(Cx, Cy) RetVal = FN.SetWinPos(Ux - WinWide, Uy) RetVal = FN.SetWinSize(WinWide, WinHigh)
STYLEBITS #CTL, WS.CAPTION OR DS.ABSALIGN, WS.SYSMENU, 0, 0 OPEN "OPTIONS" FOR DIALOG AS #CTL
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateGammaDlg()
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000")
RetVal = 0 Cx = 0 Cy = 0 Xw = 70 Yh = 110
TEXTBOX #GMA.TXBGMA, 5, 5, 50, 20 BUTTON #GMA.BTNOK, "APPLY", GAMMA.BTNS, UL, 5, 30, 50, 20 BUTTON #GMA.BTNNO, "CANCEL", GAMMA.BTNS, UL, 5, 55, 50, 20
RetVal = FN.ScreenCenter(Cx, Cy) RetVal = FN.SetWinPos(INT(Cx - Xw / 2), INT(Cy - Yh / 2)) RetVal = FN.SetWinSize(Xw, Yh)
STYLEBITS #GMA, DS.ABSALIGN, WS.SYSMENU, 0, 0 OPEN "GAMMA?" FOR DIALOG_MODAL AS #GMA
#GMA.TXBGMA, STR$(Gamma) END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateScaleDlg(TileWide, TileHigh)
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000")
SS.CENTER = HEXDEC("&H00000001") SS.CENTERIMAGE = HEXDEC("&H00000200")
Cx = 0 Cy = 0 Tw = 0 Th = 0 Ux = 0 Uy = 0 Wx = 90 Wh = 130
RetVal = 0 GfxHndl = 0
GfxHndl = FN.GetHndl("#ORTHO.GFX") RetVal = FN.ClientSize(GfxHndl, Ux, Uy) Tw = Ux / TileWide Th = Uy / TileHigh
STYLEBITS #SCL.STAX, SS.CENTER OR SS.CENTERIMAGE, 0, 0, 0 STYLEBITS #SCL.STAY, SS.CENTER OR SS.CENTERIMAGE, 0, 0, 0 STATICTEXT #SCL.STAX, "X", 5, 5, 35, 15 STATICTEXT #SCL.STAX, "Y", 45, 5, 35, 15
TEXTBOX #SCL.TXBX, 5, 20, 35, 20 TEXTBOX #SCL.TXBY, 45, 20, 35, 20
RetVal = FN.ScreenCenter(Cx, Cy) Ux = INT(Cx - Wx / 2) Uy = INT(Cy - Wh / 2)
RetVal = FN.SetWinPos(Ux, Uy) RetVal = FN.SetWinSize(Wx, Wh)
BUTTON #SCL.OK, "APPLY", SCALE.BTN, UL, 15, 45, 50, 20 BUTTON #SCL.NO, "CANCEL", SCALE.BTN, UL, 15, 70, 50, 20 OPEN "SCALE?" FOR DIALOG_MODAL AS #SCL
#SCL.TXBX, STR$(Tw) #SCL.TXBY, STR$(Th)
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.WaitForINPUT(Ms, WinHndl$)
RetVal = 0 WHILE FN.GetHndl(WinHndl$) <> 0 CALLDLL #KERN, "Sleep", Ms AS LONG, RetVal AS VOID SCAN WEND
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.GetPixelFormat(WinHndl, BYREF Dc)
PFD.DOUBLEBUFFER = HEXDEC("&H00000001") PFD.STEREO = HEXDEC("&H00000002") PFD.DRAW.TO.WINDOW = HEXDEC("&H00000004") PFD.DRAW.TO.BITMAP = HEXDEC("&H00000008") PFD.SUPPORT.GDI = HEXDEC("&H00000010") PFD.SUPPORT.OPENGL = HEXDEC("&H00000020")
PFD.TYPE.RGBA = 0 PFD.MAIN.PLANE = 0
STRUCT tOgl, _ WinHndl AS ULONG, _ '<--- INPUT; handle of target window WinDc AS ULONG, _ '<--- RETURN; device context used for drawing WinRc AS ULONG, _ '<--- RETURN; rendering context for OPENGL. dwFlags AS ULONG, _ '<--- symbolic names(tags) iPixelType AS USHORT, _ '<--- type of pixel format cColorBits AS USHORT, _ '<--- # of bits required to display colors; _ 'accepted values: 8, 16, 24, 32 cDepthBits AS USHORT, _ '<--- # of bits for color depth calculations; _ 'accepted values: 8, 16, 24, 32 dwLayerMask AS ULONG '<--- which plain to draw on; one valid value: 'PFD.MAIN.PLANE
Dc = 0 WinRc = 0
tOgl.WinHndl.struct = WinHndl tOgl.dwFlags.struct = PFD.DRAW.TO.WINDOW OR PFD.SUPPORT.OPENGL OR PFD.DOUBLEBUFFER tOgl.dwLayerMask.struct = PFD.MAIN.PLANE tOgl.iPixelType.struct = PFD.TYPE.RGBA tOgl.cColorBits.struct = 32 tOgl.cDepthBits.struct = 32
CALLDLL #LBOGL, "FN_GLContext", tOgl AS STRUCT, RetVal AS LONG Dc = tOgl.WinDc.struct WinRc = tOgl.WinRc.struct
FN.GetPixelFormat = WinRc END FUNCTION
'----------------------------- '-----------------------------
FUNCTION FN.DefineOglWindow(Wide, High, Range)
GL.DEPTH.BUFFER.BIT = HEXDEC("&H00000100") GL.COLOR.BUFFER.BIT = HEXDEC("&H00004000") GL.ACCUM.BUFFER.BIT = HEXDEC("&H00000200") GL.STENCIL.BUFFER.BIT = HEXDEC("&H00000400")
GL.MODELVIEW = HEXDEC("&H1700") GL.PROJECTION = HEXDEC("&H1701")
GL.FRONT = HEXDEC("&H0404") GL.BACK = HEXDEC("&H0405") GL.FRONT.AND.BACK = HEXDEC("&H0408")
GL.POINT = HEXDEC("&H1B00") GL.LINE = HEXDEC("&H1B01") GL.FILL = HEXDEC("&H1B02")
GL.FLAT = HEXDEC("&H1D00") GL.SMOOTH = HEXDEC("&H1D01") GL.DEPTH.TEST = HEXDEC("&H0B71")
RetVal = 0
R = 0.3 G = 0.7 B = 1.0
'Aspect = Wide / High ClearBits = GL.DEPTH.BUFFER.BIT OR GL.COLOR.BUFFER.BIT OR GL.ACCUM.BUFFER.BIT OR _ GL.STENCIL.BUFFER.BIT
Range = Range * 0.50
'IF Wide <= High THEN Xmin = -1 * Range Xmax = Range Ymin = -1 * Range' * Aspect Ymax = Range' * Aspect 'ELSE ' Xmin = -1 * Range * Aspect ' Xmax = Range * Aspect ' Ymin = -1 * Range ' Ymax = Range 'END IF Zmin = -1 * Range Zmax = Range
CALLDLL #LBOGL, "GLBkgColor", R AS DOUBLE, G AS DOUBLE, _ B AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLEnableFunc", GL.DEPTH.TEST AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLShade", GL.SMOOTH AS ULONG, RetVal AS VOID
CALLDLL #LBOGL, "GLPolyMode", GL.FRONT.AND.BACK AS ULONG, GL.FILL AS ULONG, _ RetVal AS VOID CALLDLL #LBOGL, "GLView", 0 AS LONG, 0 AS LONG, Wide AS LONG, _ High AS LONG, RetVal AS VOID CALLDLL #LBOGL, "GLMatMode", GL.PROJECTION AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLLoadIdent", RetVal AS VOID
CALLDLL #LBOGL, "OrthoGL", Xmin AS DOUBLE, Xmax AS DOUBLE, Ymin AS DOUBLE, _ Ymax AS DOUBLE, Zmin AS DOUBLE, Zmax AS DOUBLE, _ RetVal AS VOID CALLDLL #LBOGL, "GLMatMode", GL.MODELVIEW AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLLoadIdent", RetVal AS VOID CALLDLL #LBOGL, "GLClearBuffers", ClearBits AS ULONG, RetVal AS VOID
END FUNCTION
'--------------------------------------- '---------------------------------------
FUNCTION FN.GetBitStream$(FilePath$, BYREF TileWide, BYREF TileHigh)
BmpStr$ = ""
LOFILE = 0
BitPath$ = SPACE$(512) Wide$ = SPACE$(6) High$ = SPACE$(6)
CALLDLL #LBOGL, "FN_GLGetBitsEx", FilePath$ AS PTR, 0 AS ULONG, _ Wide$ AS STRUCT, High$ AS STRUCT, BitPath$ AS STRUCT, RetVal AS LONG
BitPath$ = TRIM$(BitPath$)
TileWide = VAL(Wide$) TileHigh = VAL(High$)
OPEN BitPath$ FOR BINARY AS #1 LOFILE = LOF(#1)
BmpStr$ = INPUT$(#1, LOFILE) CLOSE #1
FN.GetBitStream$ = BmpStr$ END FUNCTION
'--------------------------------------- '---------------------------------------
FUNCTION FN.DrawPicture(GfxDc, BitStream$, ImgWide, ImgHigh)
GL.DEPTH.BUFFER.BIT = HEXDEC("&H00000100") GL.COLOR.BUFFER.BIT = HEXDEC("&H00004000") GL.ACCUM.BUFFER.BIT = HEXDEC("&H00000200") GL.STENCIL.BUFFER.BIT = HEXDEC("&H00000400")
GL.UNPACK.ALIGNMENT = HEXDEC("&H0CF5") GL.UNSIGNED.BYTE = HEXDEC("&H1401") GL.RGBA = HEXDEC("&H1908")
RetVal = 0 ColorBits = GL.DEPTH.BUFFER.BIT OR GL.COLOR.BUFFER.BIT OR GL.ACCUM.BUFFER.BIT OR _ GL.STENCIL.BUFFER.BIT
CALLDLL #LBOGL, "GLPixZoom", Sclx AS DOUBLE, Scly AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLPixStoreI", GL.UNPACK.ALIGNMENT AS ULONG, 4 AS LONG, RetVal AS VOID CALLDLL #LBOGL, "GLPixelDraw", ImgWide AS ULONG, ImgHigh AS ULONG, BitStream$ AS PTR, RetVal AS VOID
CALLDLL #LBOGL, "GLSwap", GfxDc AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLClearBuffers", ColorBits AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "FlushGL", RetVal AS VOID CALLDLL #LBOGL, "FinishGL", RetVal AS VOID
END FUNCTION '--------------------------------------- '---------------------------------------
FUNCTION FN.Bcolor(R, G, B)
RetVal = 0 CALLDLL #LBOGL, "GLubColor", R AS USHORT, G AS USHORT, B AS USHORT, RetVal AS VOID
END FUNCTION
'---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.Vertexf(X, Y, Z)
RetVal = 0 CALLDLL #LBOGL, "GL3fVertex", X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE, _ RetVal AS VOID END FUNCTION
'---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.ClientSize(WinHndl, BYREF Xw, BYREF Yh)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
RetVal = 0 CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, RetVal AS LONG
Xw = tRect.X1.struct Yh = tRect.Y1.struct
FN.GetClient = RetVal END FUNCTION
'--------------------------- '---------------------------
FUNCTION FN.GetWinRect(WinHndl, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
RetVal = 0 CALLDLL #USER, "GetWindowRect", WinHndl AS ULONG, tRect AS STRUCT, RetVal AS LONG
Ux = tRect.X.struct Uy = tRect.Y.struct Bx = tRect.X1.struct By = tRect.Y1.struct
FN.GetWinRect = RetVal END FUNCTION
'--------------------------- '---------------------------
FUNCTION FN.ScreenCenter(BYREF Cx, BYREF Cy)
Cx = INT(DisplayWidth * 0.5) Cy = INT(DisplayHeight * 0.5)
FN.ScreenCenter = Cx * Cy END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.SetWinPos(PosX, PosY)
UpperLeftX = PosX UpperLeftY = PosY
FN.SetWinPos = PosX * PosY END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.SetWinSize(Szx, Szy)
WindowWidth = Szx WindowHeight = Szy
FN.SetWinSize = Szx * Szy END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.CheckTag$(Tag$)
IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$
FN.CheckTag$ = Tag$ END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.GetHndl(WinTag$)
Hndl = 0
WinTag$ = FN.CheckTag$(WinTag$)
ON ERROR GOTO [TAG.ERROR]
Hndl = HWND(#WinTag$) FN.GetHndl = Hndl EXIT FUNCTION
[TAG.ERROR] END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.SelectFile$(LastFile$)
FilePtr = 0
Dir$ = "" RetPath$ = ""
Dir$ = DefaultDir$ + CHR$(0) RetPath$ = SPACE$(512) CALLDLL #LBOGL, "FN_GLGetFileName", LastFile$ AS PTR, Dir$ AS PTR, RetPath$ AS struct, FilePtr AS ULONG
IF FilePtr < 1 THEN EXIT FUNCTION
RetPath$ = WINSTRING(FilePtr) RetPath$ = TRIM$(RetPath$)
FN.SelectFile$ = RetPath$ END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.DrawGfxBits(BYREF RetPath$)
LOFILE = 0 BytePos = 0 Xwide = 0 Yhigh = 0
R = 0 G = 0 B = 0 X = 0 Y = 0
RetStr$ = "" BmpStr$ = "" BmpFile$ = ""
Wide$ = "" High$ = ""
BmpFile$ = RetPath$ RetPath$ = FN.SelectFile$(BmpFile$)
IF RetPath$ = "" THEN EXIT FUNCTION
RetStr$ = SPACE$(512) Wide$ = SPACE$(6) High$ = SPACE$(6) CALLDLL #LBOGL, "FN_GLGetBitsEx", RetPath$ AS PTR, 0 AS ULONG, _ Wide$ AS STRUCT, High$ AS STRUCT, RetStr$ AS STRUCT, RetVal AS LONG
RetStr$ = TRIM$(RetStr$)
Xwide = VAL(Wide$) Yhigh = VAL(High$)
OPEN RetStr$ FOR BINARY AS #1 LOFILE = LOF(#1)
BmpStr$ = INPUT$(#1, LOFILE) CLOSE #1
#ORTHO.GFX, "DOWN"
X = 10 Y = 10 BytePos = LEN(BmpStr$) - 1 FOR I = 1 TO Yhigh FOR J = 1 TO Xwide B = ASC(MID$(BmpStr$, BytePos, 1)) G = ASC(MID$(BmpStr$, BytePos - 1, 1)) R = ASC(MID$(BmpStr$, BytePos - 2, 1)) BytePos = BytePos - 4 #ORTHO.GFX, "COLOR ";R;" ";G;" ";B ' #ORTHO.GFX, "DOWN" #ORTHO.GFX, "SET ";X;" ";Y X = X + 1 NEXT J X = 10 Y = Y + 1 NEXT I END FUNCTION
'---------------------------------------------------------- '---------------------------------------------------------- '
Finding a way to make the above code work with OpenGL was quite a challenge. With this version of LBOGL 0.DLL I have implemented "FN_GLVersion"() which will tell tell you the current version of the dll.
CONTENTS:
LBOGL 0.DLL VERSION 1.04 DRW_BMP_001._BAS <--- above code MOVE.BMP BLUHLS.BMP SAND.BMP GRANIT.BMP GRASS.BMP CLOUDS.BMP WATER.BMP WATER1.BMP
|
|
|
OPENGL?
Jul 13, 2023 17:43:32 GMT -5
Post by Walt Decker on Jul 13, 2023 17:43:32 GMT -5
This file is like the one above except it has animation on the background. Discussion is welcome. ' NOMAINWIN OPEN "User32.DLL" FOR DLL AS #USER OPEN "Kernel32.DLL" FOR DLL AS #KERN OPEN "LBOGL 0.DLL" FOR DLL AS #LBOGL
[DEFINE.GLOBALS] DIM Quad(-1, -1) DIM Kolr(-1, -1)
GLOBAL UbndQ, _ Busy
GLOBAL Grc, _ Gdc
GLOBAL BmpWide, _ BmpHigh
GLOBAL GmaFlg, _ Gamma
GLOBAL Sclx, _ Scly
GLOBAL LstFile$, _ BitStr$
Sclx = 1 Scly = 1
[DEFINE.LOCALS] Xw = 0 Yh = 0
RetVal = 0 WinHndl = 0 GfxHndl = 0
OglRange = 0
Xw = 400 Yh = 400
[BEGIN] UbndQ = FN.QuadData() RetVal = FN.ColorData() WinHndl = FN.CreateWindow("Draw Pix Test", Xw, Yh, GfxHndl) RetVal = FN.CreateCtlWindow(WinHndl) GfxRc = FN.GetPixelFormat(GfxHndl, GfxDc) Grc = GfxRc Gdc = GfxDc OglRange = MAX(Xw, Yh)
RetVal = FN.DefineOglWindow(Xw, Yh, OglRange) WAIT
'-------------------------- '--------------------------
SUB CLOSE.ORTHO WinHndl$ Busy = 0 WinRc = Grc CALLDLL #LBOGL, "GLMakeCurrent", 0 AS ULONG, 0 AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLDeleteContext", WinRc AS ULONG, RetVal AS VOID
CLOSE #USER CLOSE #KERN CLOSE #LBOGL CLOSE #CTL CLOSE #WinHndl$ END END SUB
'-------------------------- '--------------------------
SUB CTRLS CkbHndl$
GL.TRUE = 1 GL.FALSE = 0
GL.MAP.COLOR = HEXDEC("&H0D10")
GL.PIXEL.MAP.R.TO.R = HEXDEC("&H0C76") GL.PIXEL.MAP.G.TO.G = HEXDEC("&H0C77") GL.PIXEL.MAP.B.TO.B = HEXDEC("&H0C78") GL.PIXEL.MAP.A.TO.A = HEXDEC("&H0C79")
RetVal = 0 Xwide = 0 Yhigh = 0
Checked$ = "" BitStream$ = ""
GfxDc = Gdc CurFile$ = LstFile$
IF Busy THEN EXIT SUB
#CkbHndl$, "VALUE? Checked$"
IF Checked$ = "set" THEN Busy = 1 SELECT CASE CkbHndl$ CASE "#CTL.CKLOAD" CurFile$ = FN.SelectFile$(CurFile$) LstFile$ = CurFile$
IF LstFile$ = "" THEN GOTO [UNSET.CHECK]
BitStream$ = FN.GetBitStream$(CurFile$, Xwide, Yhigh)
BitStr$ = BitStream$ BmpWide = Xwide BmpHigh = Yhigh Sclx = 1 Scly = 1 RetVal = FN.DrawPicture(GfxDc, BitStream$, Xwide, Yhigh)
CASE "#CTL.CKGPIX" RetVal = FN.DrawGfxBits(CurFile$) Busy = 1 LstFile$ = CurFile$
CASE "#CTL.CKGSCL" IF LstFile$ = "" THEN GOTO [UNSET.CHECK]
Xwide = BmpWide Yhigh = BmpHigh
RetVal = FN.CreateScaleDlg(Xwide, Yhigh) RetVal = FN.WaitForINPUT(200, "#SCL")
Xwide = BmpWide Yhigh = BmpHigh ' BitStream$ = BitStr$ RetVal = FN.DrawPicture(GfxDc, BitStr$, Xwide, Yhigh)
CASE "#CTL.CKGGMA" IF LstFile$ = "" THEN GOTO [UNSET.CHECK] RetVal = FN.CreateGammaDlg() RetVal = FN.WaitForINPUT(200, "#GMA")
IF GmaFlg = Gamma THEN GOTO [UNSET.CHECK]
CALLDLL #LBOGL, "GLClearGammaEx", RetVal AS VOID CALLDLL #LBOGL, "GLSetGammaEx", Gamma AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLPixTransferI", GL.MAP.COLOR AS ULONG, GL.TRUE AS USHORT, RetVal AS VOID CALLDLL #LBOGL, "GLPixMapfv", GL.PIXEL.MAP.R.TO.R AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLPixMapfv", GL.PIXEL.MAP.G.TO.G AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLPixMapfv", GL.PIXEL.MAP.B.TO.B AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLPixMapfv", GL.PIXEL.MAP.A.TO.A AS ULONG, RetVal AS VOID
Xwide = BmpWide Yhigh = BmpHigh BitStream$ = BitStr$ RetVal = FN.DrawPicture(GfxDc, BitStream$, Xwide, Yhigh) CALLDLL #LBOGL, "GLPixTransferI", GL.MAP.COLOR AS ULONG, GL.FALSE AS USHORT, RetVal AS VOID GmaFlg = Gamma END SELECT END IF
[UNSET.CHECK] #CkbHndl$, "RESET" Busy = 0 END SUB
'-------------------------- '--------------------------
SUB GAMMA.BTNS GmaHndl$
NewGamma$ = ""
SELECT CASE GmaHndl$ CASE "#GMA.BTNOK" #GMA.TXBGMA, "!CONTENTS? NewGamma$"
IF NewGamma$ = "" THEN CLOSE #GMA EXIT SUB END IF
Gamma = VAL(NewGamma$) CLOSE #GMA
CASE "#GMA.BTNNO" CLOSE #GMA END SELECT
END SUB
'-------------------------- '--------------------------
SUB SCALE.BTN SclHndl$
Scalex$ = "" Scaley$ = "" SELECT CASE SclHndl$ CASE "#SCL.OK" #SCL.TXBX, "!CONTENTS? Scalex$" #SCL.TXBY, "!CONTENTS? Scaley$"
IF Scalex$ <> "" THEN Sclx = VAL(Scalex$) IF Scaley$ <> "" THEN Scly = VAL(Scaley$) CLOSE #SCL EXIT SUB
CASE "#SCL.NO" CLOSE #SCL END SELECT
END SUB
'-------------------------- '--------------------------
FUNCTION FN.CreateWindow(Title$, BYREF Xwide, BYREF Yhigh, BYREF CtlHndl)
WS.BORDER = HEXDEC("&H00800000")
WinHndl = 0 RetVal = 0
Ux = 0 Uy = 0 Cx = 0 Cy = 0
STYLEBITS #ORTHO.GFX, 0, WS.BORDER, 0, 0 GRAPHICBOX #ORTHO.GFX, 0, 0, 290, 270
RetVal = FN.ScreenCenter(Cx, Cy) Ux = INT(Cx - Xwide / 2) Uy = INT(Cy - Yhigh / 2)
RetVal = FN.SetWinPos(Ux, Uy) RetVal = FN.SetWinSize(Xwide, Yhigh)
OPEN Title$ FOR WINDOW AS #ORTHO
WinHndl = HWND(#ORTHO) RetVal = FN.ClientSize(WinHndl, Xwide, Yhigh)
#ORTHO.GFX, "LOCATE 0 0 ";Xwide; " "; Yhigh #ORTHO, "REFRESH" #ORTHO, "TRAPCLOSE CLOSE.ORTHO"
CtlHndl = HWND(#ORTHO.GFX) FN.CreateWindow = WinHndl END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateCtlWindow(WinHndl)
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000") WS.GROUP = HEXDEC("&H00020000") WS.TABSTOP = HEXDEC("&H00010000")
BS.PUSHLIKE = HEXDEC("&H00001000")
RetVal = 0
Ux = 0 Uy = 0 Cx = 0 Cy = 0
WinWide = 118 WinHigh = 135
RetVal = FN.GetWinRect(WinHndl, Ux, Uy, 0, 0) STYLEBITS #CTL.CKLOAD, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 STYLEBITS #CTL.CKGPIX, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 STYLEBITS #CTL.CKGSCL, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 STYLEBITS #CTL.CKGGMA, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 CHECKBOX #CTL.CKLOAD, "LOAD", CTRLS, CTRLS, 5, 5, 100, 20 CHECKBOX #CTL.CKGPIX, "GFX PIXLES", CTRLS, CTRLS, 5, 30, 100, 20 CHECKBOX #CTL.CKGSCL, "SCALE PICTURE", CTRLS, CTRLS, 5, 55, 100, 20 CHECKBOX #CTL.CKGGMA, "ADJUST GAMMA", CTRLS, CTRLS, 5, 80, 100, 20
RetVal = FN.ScreenCenter(Cx, Cy) RetVal = FN.SetWinPos(Ux - WinWide, Uy) RetVal = FN.SetWinSize(WinWide, WinHigh)
STYLEBITS #CTL, WS.CAPTION OR DS.ABSALIGN, WS.SYSMENU, 0, 0 OPEN "OPTIONS" FOR DIALOG AS #CTL
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateGammaDlg()
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000")
RetVal = 0 Cx = 0 Cy = 0 Xw = 70 Yh = 110
TEXTBOX #GMA.TXBGMA, 5, 5, 50, 20 BUTTON #GMA.BTNOK, "APPLY", GAMMA.BTNS, UL, 5, 30, 50, 20 BUTTON #GMA.BTNNO, "CANCEL", GAMMA.BTNS, UL, 5, 55, 50, 20
RetVal = FN.ScreenCenter(Cx, Cy) RetVal = FN.SetWinPos(INT(Cx - Xw / 2), INT(Cy - Yh / 2)) RetVal = FN.SetWinSize(Xw, Yh)
STYLEBITS #GMA, DS.ABSALIGN, WS.SYSMENU, 0, 0 OPEN "GAMMA?" FOR DIALOG_MODAL AS #GMA
#GMA.TXBGMA, STR$(Gamma) END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateScaleDlg(TileWide, TileHigh)
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000")
SS.CENTER = HEXDEC("&H00000001") SS.CENTERIMAGE = HEXDEC("&H00000200")
Cx = 0 Cy = 0 Tw = 0 Th = 0 Ux = 0 Uy = 0 Wx = 90 Wh = 130
RetVal = 0 GfxHndl = 0
GfxHndl = FN.GetHndl("#ORTHO.GFX") RetVal = FN.ClientSize(GfxHndl, Ux, Uy) Tw = Ux / TileWide Th = Uy / TileHigh
STYLEBITS #SCL.STAX, SS.CENTER OR SS.CENTERIMAGE, 0, 0, 0 STYLEBITS #SCL.STAY, SS.CENTER OR SS.CENTERIMAGE, 0, 0, 0 STATICTEXT #SCL.STAX, "X", 5, 5, 35, 15 STATICTEXT #SCL.STAX, "Y", 45, 5, 35, 15
TEXTBOX #SCL.TXBX, 5, 20, 35, 20 TEXTBOX #SCL.TXBY, 45, 20, 35, 20
RetVal = FN.ScreenCenter(Cx, Cy) Ux = INT(Cx - Wx / 2) Uy = INT(Cy - Wh / 2)
RetVal = FN.SetWinPos(Ux, Uy) RetVal = FN.SetWinSize(Wx, Wh)
BUTTON #SCL.OK, "APPLY", SCALE.BTN, UL, 15, 45, 50, 20 BUTTON #SCL.NO, "CANCEL", SCALE.BTN, UL, 15, 70, 50, 20 OPEN "SCALE?" FOR DIALOG_MODAL AS #SCL
#SCL.TXBX, STR$(Tw) #SCL.TXBY, STR$(Th)
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.WaitForINPUT(Ms, WinHndl$)
RetVal = 0 WHILE FN.GetHndl(WinHndl$) <> 0 CALLDLL #KERN, "Sleep", Ms AS LONG, RetVal AS VOID SCAN WEND
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.GetPixelFormat(WinHndl, BYREF Dc)
PFD.DOUBLEBUFFER = HEXDEC("&H00000001") PFD.STEREO = HEXDEC("&H00000002") PFD.DRAW.TO.WINDOW = HEXDEC("&H00000004") PFD.DRAW.TO.BITMAP = HEXDEC("&H00000008") PFD.SUPPORT.GDI = HEXDEC("&H00000010") PFD.SUPPORT.OPENGL = HEXDEC("&H00000020")
PFD.TYPE.RGBA = 0 PFD.MAIN.PLANE = 0
STRUCT tOgl, _ WinHndl AS ULONG, _ '<--- INPUT; handle of target window WinDc AS ULONG, _ '<--- RETURN; device context used for drawing WinRc AS ULONG, _ '<--- RETURN; rendering context for OPENGL. dwFlags AS ULONG, _ '<--- symbolic names(tags) iPixelType AS USHORT, _ '<--- type of pixel format cColorBits AS USHORT, _ '<--- # of bits required to display colors; _ 'accepted values: 8, 16, 24, 32 cDepthBits AS USHORT, _ '<--- # of bits for color depth calculations; _ 'accepted values: 8, 16, 24, 32 dwLayerMask AS ULONG '<--- which plain to draw on; one valid value: 'PFD.MAIN.PLANE
Dc = 0 WinRc = 0
tOgl.WinHndl.struct = WinHndl tOgl.dwFlags.struct = PFD.DRAW.TO.WINDOW OR PFD.SUPPORT.OPENGL OR PFD.DOUBLEBUFFER tOgl.dwLayerMask.struct = PFD.MAIN.PLANE tOgl.iPixelType.struct = PFD.TYPE.RGBA tOgl.cColorBits.struct = 32 tOgl.cDepthBits.struct = 32
CALLDLL #LBOGL, "FN_GLContext", tOgl AS STRUCT, RetVal AS LONG Dc = tOgl.WinDc.struct WinRc = tOgl.WinRc.struct
FN.GetPixelFormat = WinRc END FUNCTION
'----------------------------- '-----------------------------
FUNCTION FN.DefineOglWindow(Wide, High, Range)
GL.DEPTH.BUFFER.BIT = HEXDEC("&H00000100") GL.COLOR.BUFFER.BIT = HEXDEC("&H00004000") GL.ACCUM.BUFFER.BIT = HEXDEC("&H00000200") GL.STENCIL.BUFFER.BIT = HEXDEC("&H00000400")
GL.MODELVIEW = HEXDEC("&H1700") GL.PROJECTION = HEXDEC("&H1701")
GL.FRONT = HEXDEC("&H0404") GL.BACK = HEXDEC("&H0405") GL.FRONT.AND.BACK = HEXDEC("&H0408")
GL.POINT = HEXDEC("&H1B00") GL.LINE = HEXDEC("&H1B01") GL.FILL = HEXDEC("&H1B02")
GL.FLAT = HEXDEC("&H1D00") GL.SMOOTH = HEXDEC("&H1D01") GL.DEPTH.TEST = HEXDEC("&H0B71")
RetVal = 0
R = 0.3 G = 0.7 B = 1.0
ClearBits = GL.DEPTH.BUFFER.BIT OR GL.COLOR.BUFFER.BIT OR GL.ACCUM.BUFFER.BIT OR _ GL.STENCIL.BUFFER.BIT
Range = Range * 0.50
Xmin = -1 * Range Xmax = Range Ymin = -1 * Range' * Aspect Ymax = Range' * Aspect Zmin = -1 * Range Zmax = Range
CALLDLL #LBOGL, "GLBkgColor", R AS DOUBLE, G AS DOUBLE, _ B AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLShade", GL.SMOOTH AS ULONG, RetVal AS VOID
CALLDLL #LBOGL, "GLPolyMode", GL.FRONT.AND.BACK AS ULONG, GL.FILL AS ULONG, _ RetVal AS VOID CALLDLL #LBOGL, "GLView", 0 AS LONG, 0 AS LONG, Wide AS LONG, _ High AS LONG, RetVal AS VOID CALLDLL #LBOGL, "GLMatMode", GL.PROJECTION AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLLoadIdent", RetVal AS VOID
CALLDLL #LBOGL, "OrthoGL", Xmin AS DOUBLE, Xmax AS DOUBLE, Ymin AS DOUBLE, _ Ymax AS DOUBLE, Zmin AS DOUBLE, Zmax AS DOUBLE, _ RetVal AS VOID CALLDLL #LBOGL, "GLMatMode", GL.MODELVIEW AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLLoadIdent", RetVal AS VOID CALLDLL #LBOGL, "GLClearBuffers", ClearBits AS ULONG, RetVal AS VOID
END FUNCTION
'--------------------------------------- '---------------------------------------
FUNCTION FN.GetBitStream$(FilePath$, BYREF TileWide, BYREF TileHigh)
BmpStr$ = ""
LOFILE = 0
BitPath$ = SPACE$(512) Wide$ = SPACE$(6) High$ = SPACE$(6)
CALLDLL #LBOGL, "FN_GLGetBitsEx", FilePath$ AS PTR, 0 AS ULONG, _ Wide$ AS STRUCT, High$ AS STRUCT, BitPath$ AS STRUCT, RetVal AS LONG
BitPath$ = TRIM$(BitPath$)
TileWide = VAL(Wide$) TileHigh = VAL(High$)
OPEN BitPath$ FOR BINARY AS #1 LOFILE = LOF(#1)
BmpStr$ = INPUT$(#1, LOFILE) CLOSE #1
FN.GetBitStream$ = BmpStr$ END FUNCTION
'--------------------------------------- '---------------------------------------
FUNCTION FN.DrawPicture(GfxDc, BitStream$, ImgWide, ImgHigh)
GL.DEPTH.BUFFER.BIT = HEXDEC("&H00000100") GL.COLOR.BUFFER.BIT = HEXDEC("&H00004000") GL.ACCUM.BUFFER.BIT = HEXDEC("&H00000200") GL.STENCIL.BUFFER.BIT = HEXDEC("&H00000400")
GL.UNPACK.ALIGNMENT = HEXDEC("&H0CF5") GL.UNSIGNED.BYTE = HEXDEC("&H1401") GL.RGBA = HEXDEC("&H1908")
GL.QUADS = HEXDEC("&H0007")
RetVal = 0 ColorBits = 0 Angle = 0 Deg = -0.10 Rx = 15 P1 = 1 P2 = 0 Qszx = 7.5 Qszy = 7.5 Qszz = 3.5
ColorBits = GL.DEPTH.BUFFER.BIT OR GL.COLOR.BUFFER.BIT OR GL.ACCUM.BUFFER.BIT OR _ GL.STENCIL.BUFFER.BIT
CALLDLL #LBOGL, "GLPushMat", RetVal AS VOID CALLDLL #LBOGL, "GL3fScale", Qszx AS DOUBLE, Qszy AS DOUBLE, Qszz AS DOUBLE, RetVal AS VOID
DO CALLDLL #LBOGL, "GLPushMat", RetVal AS VOID CALLDLL #LBOGL, "GLLoadIdent", RetVal AS VOID
CALLDLL #LBOGL, "GLPixZoom", Sclx AS DOUBLE, Scly AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLPixStoreI", GL.UNPACK.ALIGNMENT AS ULONG, 4 AS LONG, RetVal AS VOID CALLDLL #LBOGL, "GLPixelDraw", ImgWide AS ULONG, ImgHigh AS ULONG, BitStream$ AS PTR, RetVal AS VOID
CALLDLL #LBOGL, "GLPopMat", RetVal AS VOID CALLDLL #LBOGL, "GL3fRotate", Deg AS DOUBLE, P1 AS DOUBLE, P2 AS DOUBLE, _ P2 AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GL3fRotate", Rx AS DOUBLE, P1 AS DOUBLE, P2 AS DOUBLE, _ P1 AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLStart", GL.QUADS AS ULONG, RetVal AS VOID FOR I = 0 TO UbndQ ClrIdx = Quad(I, 3) - 1
IF ClrIdx > -1 THEN RetVal = FN.Bcolor(Kolr(ClrIdx, 0), Kolr(ClrIdx, 1), Kolr(ClrIdx, 2)) END IF
RetVal = FN.Vertexf(Quad(I, 0), Quad(I, 1), Quad(I, 2)) NEXT I CALLDLL #LBOGL, "GLStop", RetVal AS VOID
CALLDLL #LBOGL, "FlushGL", RetVal AS VOID CALLDLL #LBOGL, "GLSwap", GfxDc AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLClearBuffers", ColorBits AS ULONG, RetVal AS VOID
CALLDLL #KERN, "Sleep", 50 AS LONG, RetVal AS VOID SCAN IF Busy < 1 THEN EXIT FUNCTION Angle = Angle -0.50 LOOP UNTIL Angle < -361
CALLDLL #LBOGL, "GLPopMat", RetVal AS VOID CALLDLL #LBOGL, "FinishGL", RetVal AS VOID
END FUNCTION '--------------------------------------- '---------------------------------------
FUNCTION FN.Bcolor(R, G, B)
RetVal = 0 CALLDLL #LBOGL, "GLubColor", R AS USHORT, G AS USHORT, B AS USHORT, RetVal AS VOID
END FUNCTION
'---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.Vertexf(X, Y, Z)
RetVal = 0 CALLDLL #LBOGL, "GL3fVertex", X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE, _ RetVal AS VOID END FUNCTION
'---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.ClientSize(WinHndl, BYREF Xw, BYREF Yh)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
RetVal = 0 CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, RetVal AS LONG
Xw = tRect.X1.struct Yh = tRect.Y1.struct
FN.GetClient = RetVal END FUNCTION
'--------------------------- '---------------------------
FUNCTION FN.GetWinRect(WinHndl, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
RetVal = 0 CALLDLL #USER, "GetWindowRect", WinHndl AS ULONG, tRect AS STRUCT, RetVal AS LONG
Ux = tRect.X.struct Uy = tRect.Y.struct Bx = tRect.X1.struct By = tRect.Y1.struct
FN.GetWinRect = RetVal END FUNCTION
'--------------------------- '---------------------------
FUNCTION FN.ScreenCenter(BYREF Cx, BYREF Cy)
Cx = INT(DisplayWidth * 0.5) Cy = INT(DisplayHeight * 0.5)
FN.ScreenCenter = Cx * Cy END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.SetWinPos(PosX, PosY)
UpperLeftX = PosX UpperLeftY = PosY
FN.SetWinPos = PosX * PosY END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.SetWinSize(Szx, Szy)
WindowWidth = Szx WindowHeight = Szy
FN.SetWinSize = Szx * Szy END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.CheckTag$(Tag$)
IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$
FN.CheckTag$ = Tag$ END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.GetHndl(WinTag$)
Hndl = 0
WinTag$ = FN.CheckTag$(WinTag$)
ON ERROR GOTO [TAG.ERROR]
Hndl = HWND(#WinTag$) FN.GetHndl = Hndl EXIT FUNCTION
[TAG.ERROR] END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.SelectFile$(LastFile$)
FilePtr = 0
Dir$ = "" RetPath$ = ""
Dir$ = DefaultDir$ + CHR$(0) RetPath$ = SPACE$(512) CALLDLL #LBOGL, "FN_GLGetFileName", LastFile$ AS PTR, Dir$ AS PTR, RetPath$ AS struct, FilePtr AS ULONG
IF FilePtr < 1 THEN FN.SelectFile$ = "" EXIT FUNCTION END IF
RetPath$ = WINSTRING(FilePtr) RetPath$ = TRIM$(RetPath$)
FN.SelectFile$ = RetPath$ END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.DrawGfxBits(BYREF RetPath$)
LOFILE = 0 BytePos = 0 Xwide = 0 Yhigh = 0
R = 0 G = 0 B = 0 X = 0 Y = 0
RetStr$ = "" BmpStr$ = "" BmpFile$ = ""
Wide$ = "" High$ = ""
BmpFile$ = RetPath$ RetPath$ = FN.SelectFile$(BmpFile$)
IF RetPath$ = "" THEN EXIT FUNCTION
RetStr$ = SPACE$(512) Wide$ = SPACE$(6) High$ = SPACE$(6) CALLDLL #LBOGL, "FN_GLGetBitsEx", RetPath$ AS PTR, 0 AS ULONG, _ Wide$ AS STRUCT, High$ AS STRUCT, RetStr$ AS STRUCT, RetVal AS LONG
RetStr$ = TRIM$(RetStr$)
Xwide = VAL(Wide$) Yhigh = VAL(High$)
OPEN RetStr$ FOR BINARY AS #1 LOFILE = LOF(#1)
BmpStr$ = INPUT$(#1, LOFILE) CLOSE #1
#ORTHO.GFX, "DOWN"
X = 10 Y = 10 BytePos = LEN(BmpStr$) - 1 FOR I = 1 TO Yhigh FOR J = 1 TO Xwide B = ASC(MID$(BmpStr$, BytePos, 1)) G = ASC(MID$(BmpStr$, BytePos - 1, 1)) R = ASC(MID$(BmpStr$, BytePos - 2, 1)) BytePos = BytePos - 4 #ORTHO.GFX, "COLOR ";R;" ";G;" ";B ' #ORTHO.GFX, "DOWN" #ORTHO.GFX, "SET ";X;" ";Y X = X + 1 NEXT J X = 10 Y = Y + 1 NEXT I END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.QuadData() '######################################## ' Changed the quad data. Notice that the ' walls are connected to the back of the ' box via the depth (Z) parameter. '########################################
' X Y Z color index DATA 5, 2.5, 0, 1 DATA -5, 2.5, 0, 0 DATA -5, -2.5, 0, 0 DATA 5, -2.5, 0, 3
DATA 5, 2.5, 0, 2 DATA -5, 2.5, 0, 0 DATA -5, 2.5, 5, 0 DATA 5, 2.5, 5, 3
DATA 5, -2.5, 0, 2 DATA -5, -2.5, 0, 0 DATA -5, -2.5, 5, 0 DATA 5, -2.5, 5, 1
DATA -5, -2.5, 0, 4 DATA -5, 2.5, 0, 3 DATA -5, 2.5, 5, 0 DATA -5, -2.5, 5, 0
DATA 5, 2.5, 0, 5 DATA 5, 2.5, 5, 0 DATA 5, -2.5, 5, 0 DATA 5, -2.5, 0, 1
'<======= LOCAL VARIABLES =========> I = 0 J = 0
Ubnd = 0 Varb = 0
Ubnd = 19 REDIM Quad(Ubnd, 3) '<--- 12 ROWS, 4 COLUMNS
FOR I = 0 TO Ubnd FOR J = O TO 3 READ Varb Quad(I, J) = Varb NEXT J NEXT I
FN.QuadData = Ubnd END FUNCTION
'---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.ColorData() '######################################## ' Colors used to fill the shapes '########################################
' red green blue DATA 255, 255, 0 DATA 0, 255, 0 DATA 0, 255, 255 DATA 255, 0, 255 DATA 255, 128, 96
'<========== LOCAL VARIABLES ========> I = 0 J = 0 Ubnd = 0 Varb = 0
Ubnd = 4 REDIM Kolr(Ubnd, 2) '<--- 3 rows, 3 columns
FOR I = 0 TO Ubnd FOR J = 0 TO 2 READ Varb Kolr(I, J)= Varb NEXT J NEXT I
FN.ColorData = Ubnd END FUNCTION
'------------------------------------ '------------------------------------
'
|
|
|
OPENGL?
Jul 17, 2023 12:19:21 GMT -5
Post by Walt Decker on Jul 17, 2023 12:19:21 GMT -5
Here is a little item I found in my archives of about 100 years ago. It uses texture mapping of a 64 x 64 internal bitmap for animation and rendering. Click on either the KILL button or press the ESC key to end the application.
|
|
|
OPENGL?
Jul 27, 2023 11:57:30 GMT -5
Post by Walt Decker on Jul 27, 2023 11:57:30 GMT -5
Some perspective texturing. You will need LBOGL 0.DLL v 1.06 attached. I am working on updated dll documentation.
Discussion is welcome.
' [GLOBALS] DIM QubePnts(-1, -1) DIM QubeCords(-1, -1)
GLOBAL Wrc, _ Wdc
GLOBAL Busy
GLOBAL TexWide, _ TexHigh
GLOBAL RenderFlag, _ UbndQ
GLOBAL DefaultFile$, _ TexDataFile$, _ TexBits$
GLOBAL Lookx, _ Looky, _ Lookz, _ Centx, _ Centy, _ Centz, _ Posnx, _ Posny, _ Posnz
[GLOBALS.END]
RetVal = 0 CtlHndl = 0 WinHndl = 0 GfxDc = 0 GfxRc = 0 Xwide = 0 Yhigh = 0 Dbl = 0
Lookz = 6.0 Posny = 1.0
[GET.TEXTURRE.DATA] UbndQ = FN.TextureCoordData() RetVal = FN.QubeVecData()
OPEN "User32.dll" FOR DLL AS #USER OPEN "LBOGL 0.DLL" FOR DLL AS #LBOGL 'OPEN "Kernel32.dll" FOR DLL AS #KERN
WinHndl = FN.CreateWindow("TEXTURES", Xwide, Yhigh, CtlHndl) RetVal = FN.CreateCtlWindow(WinHndl)
GfxRc = FN.GetPixelFormat(CtlHndl, GfxDc)
Wrc = GfxRc Wdc = GfxDc
RetVal = FN.DefineOglWindow(Xwide, Yhigh, 0)
WAIT
'-------------------------- '--------------------------
SUB CLOSE.GL.WIN GlHndl$
WinRc = Wrc App.Done = 1
CALLDLL #LBOGL, "GLMakeCurrent", 0 AS ULONG, 0 AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLDeleteContext", WinRc AS ULONG, RetVal AS VOID
IF TexDataFile$ <> "" THEN KILL TexDataFile$
CLOSE #USER CLOSE #LBOGL 'CLOSE #OLEAUT CLOSE #CTL CLOSE #GlHndl$ END
END SUB
'-------------------------- '--------------------------
SUB CTRLS CkbHndl$
GL.TEXTURE.2D = HEXDEC("&H0DE1")
RetVal = 0 Xwide = 0 Yhigh = 0 Ubnd = 0
Checked$ = "" BitStream$ = "" ColorFile$ = ""
GfxDc = Wdc CurFile$ = DefaultFile$
IF Busy THEN EXIT SUB
#CkbHndl$, "VALUE? Checked$"
IF Checked$ = "set" THEN Busy = 1 SELECT CASE CkbHndl$ CASE "#CTL.CKLOAD" RetVal = FN.DrawGfxBits(CurFile$, ColorFile$, Xwide, Yhigh)
IF CurFile$ = "" THEN GOTO [UNSET.CHECK]
DefaultFile$ = CurFile$ TexDataFile$ = ColorFile$ TexWide = Xwide TexHigh = Yhigh ' RenderFlag = 0
CASE "#CTL.CKGPIX" ColorFile$ = TexDataFile$ Ubnd = UbndQ Xwide = TexWide Yhigh = TexHigh
IF RenderFlag THEN CALLDLL #LBOGL, "DisableGL", GL.TEXTURE.2D AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLTextureDel", RenderFlag AS LONG, RenderFlag AS ULONG, RetVal AS VOID END IF
RetVal = FN.InitializeTextureMapping(Xwide, Yhigh, ColorFile$) RetVal = FN.RenderScene(GfxDc, Ubnd) RenderFlag = 1 END SELECT END IF
[UNSET.CHECK] #CkbHndl$, "RESET" Busy = 0 END SUB
'-------------------------- '-------------------------- FUNCTION FN.CreateWindow(Title$, BYREF Xwide, BYREF Yhigh, BYREF CtlHndl)
WS.BORDER = HEXDEC("&H00800000")
WinHndl = 0
Xwide = 300 Yhigh = 310
RetVal = 0
Ux = 0 Uy = 0 Cx = 0 Cy = 0
STYLEBITS #GL.GFX, 0, WS.BORDER, 0, 0 GRAPHICBOX #GL.GFX, 0, 0, 290, 270
RetVal = FN.ScreenCenter(Cx, Cy) Ux = INT(Cx - Xwide / 2) Uy = INT(Cy - Yhigh / 2)
RetVal = FN.SetWinPos(Ux, Uy) RetVal = FN.SetWinSize(Xwide, Yhigh)
OPEN Title$ FOR WINDOW AS #GL
WinHndl = HWND(#GL) RetVal = FN.ClientSize(WinHndl, Xwide, Yhigh)
#GL.GFX, "LOCATE 0 0 ";Xwide; " "; Yhigh #GL, "REFRESH" #GL, "TRAPCLOSE CLOSE.GL.WIN" '#ORTHO.GFX, "when leftButtonDown ROTATE" CtlHndl = HWND(#GL.GFX) FN.CreateWindow = WinHndl END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateCtlWindow(WinHndl)
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000") WS.GROUP = HEXDEC("&H00020000") WS.TABSTOP = HEXDEC("&H00010000")
BS.PUSHLIKE = HEXDEC("&H00001000")
RetVal = 0
Ux = 0 Uy = 0 Cx = 0 Cy = 0
WinWide = 118 WinHigh = 135
RetVal = FN.GetWinRect(WinHndl, Ux, Uy, 0, 0)
STYLEBITS #CTL.CKLOAD, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 STYLEBITS #CTL.CKGPIX, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 'STYLEBITS #CTL.CKGSCL, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 'STYLEBITS #CTL.CKGGMA, BS.PUSHLIKE OR WS.TABSTOP, 0, 0, 0 CHECKBOX #CTL.CKLOAD, "LOAD", CTRLS, CTRLS, 5, 5, 100, 20 CHECKBOX #CTL.CKGPIX, "RENDER SCENE", CTRLS, CTRLS, 5, 30, 100, 20 'CHECKBOX #CTL.CKGSCL, "CHANGE VIEW", CTRLS, CTRLS, 5, 55, 100, 20 'CHECKBOX #CTL.CKGGMA, "ADJUST GAMMA", CTRLS, CTRLS, 5, 80, 100, 20
RetVal = FN.ScreenCenter(Cx, Cy) RetVal = FN.SetWinPos(Ux - WinWide, Uy) RetVal = FN.SetWinSize(WinWide, WinHigh)
STYLEBITS #CTL, WS.CAPTION OR DS.ABSALIGN, WS.SYSMENU, 0, 0 OPEN "OPTIONS" FOR DIALOG AS #CTL
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.DefineOglWindow(Wide, High, Range)
GL.DEPTH.BUFFER.BIT = HEXDEC("&H00000100") GL.COLOR.BUFFER.BIT = HEXDEC("&H00004000") GL.ACCUM.BUFFER.BIT = HEXDEC("&H00000200") GL.STENCIL.BUFFER.BIT = HEXDEC("&H00000400")
GL.MODELVIEW = HEXDEC("&H1700") GL.PROJECTION = HEXDEC("&H1701")
GL.FRONT = HEXDEC("&H0404") GL.BACK = HEXDEC("&H0405") GL.FRONT.AND.BACK = HEXDEC("&H0408")
GL.POINT = HEXDEC("&H1B00") GL.LINE = HEXDEC("&H1B01") GL.FILL = HEXDEC("&H1B02")
GL.FLAT = HEXDEC("&H1D00") GL.SMOOTH = HEXDEC("&H1D01") GL.DEPTH.TEST = HEXDEC("&H0B71")
RetVal = 0 Aspect = 0
Near = 0.0000 Far = 0.0000 Fov = 0.0000
'Aspect = FN.MakeFloat(MIN(Wide, High) / MAX(Wide, High)) Aspect = VAL(USING("###.########", MIN(Wide, High) / MAX(Wide, High))) 'trace 2 R = 0.000000 G = 0.000000 B = 0.000000 'FN.MakeFloat(0.4)
R = VAL(USING("###.########", 0.3000)) G = VAL(USING("###.########", 0.0000)) B = VAL(USING("###.########", 0.7000))
ClearBits = GL.DEPTH.BUFFER.BIT OR GL.COLOR.BUFFER.BIT OR GL.ACCUM.BUFFER.BIT OR _ GL.STENCIL.BUFFER.BIT
CALLDLL #LBOGL, "GLBkgColor", R AS DOUBLE, G AS DOUBLE, _ B AS DOUBLE, RetVal AS VOID 'CALLDLL #LBOGL, "GLEnableFunc", GL.DEPTH.TEST AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLShade", GL.SMOOTH AS ULONG, RetVal AS VOID
CALLDLL #LBOGL, "GLPolyMode", GL.FRONT.AND.BACK AS ULONG, GL.FILL AS ULONG, _ RetVal AS VOID CALLDLL #LBOGL, "GLView", 0 AS LONG, 0 AS LONG, Wide AS LONG, _ High AS LONG, RetVal AS VOID CALLDLL #LBOGL, "GLMatMode", GL.PROJECTION AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLLoadIdent", RetVal AS VOID
'Fov = FN.MakeFloat(Wide * 0.25 * Aspect) 'Near = FN.MakeFloat(0.012) 'Far = FN.MakeFloat(100.00) Fov = VAL(USING("####.######", Wide * 0.25 * Aspect)) Near = VAL(USING("####.######", 0.012)) Far = VAL(USING("####.######", 100.0000))
CALLDLL #LBOGL, "GLPerspective", Fov AS DOUBLE, Aspect AS DOUBLE, Near AS DOUBLE, Far AS DOUBLE, _ RetVal AS VOID CALLDLL #LBOGL, "GLMatMode", GL.MODELVIEW AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLLoadIdent", RetVal AS VOID CALLDLL #LBOGL, "GLClearBuffers", ClearBits AS ULONG, RetVal AS VOID
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.InitializeTextureMapping(Wide, High, BitFile$)
GL.UNSIGNED.BYTE = HEXDEC("&H1401") GL.RGB = HEXDEC("&H1907") GL.RGBA = HEXDEC("&H1908") GL.TEXTURE.MAG.FILTER = HEXDEC("&H2800") GL.TEXTURE.MIN.FILTER = HEXDEC("&H2801") GL.TEXTURE.WRAP.S = HEXDEC("&H2802") GL.TEXTURE.WRAP.T = HEXDEC("&H2803") GL.MODULATE = HEXDEC("&H2100") GL.TEXTURE.ENV.MODE = HEXDEC("&H2200") GL.TEXTURE.ENV = HEXDEC("&H2300") GL.TEXTURE.2D = HEXDEC("&H0DE1") GL.PERSPECTIVE.CORRECTION.HINT = HEXDEC("&H0C50") GL.NICEST = HEXDEC("&H1102") GL.CLAMP = HEXDEC("&H2900") GL.REPEAT = HEXDEC("&H2901") GL.NEAREST = HEXDEC("&H2600") GL.LINEAR = HEXDEC("&H2601") GL.DEPTH.TEST = HEXDEC("&H0B71")
RetVal = 0 ClearDepth = 1.0 'VAL(USING("##.############", 1.0)) TexNum = 1
CALLDLL #LBOGL, "GLDepth", ClearDepth AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "HintGL", GL.PERSPECTIVE.CORRECTION.HINT AS ULONG, GL.NICEST AS ULONG, _ RetVal AS VOID CALLDLL #LBOGL, "EnableGL", GL.TEXTURE.2D AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLTexFenv", GL.TEXTURE.ENV AS ULONG, GL.TEXTURE.ENV.MODE AS ULONG, _ GL.MODULATE AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLTextureBind", GL.TEXTURE.2D AS ULONG, TexNum AS LONG, RetVal AS VOID CALLDLL #LBOGL, "GLTexparamI", GL.TEXTURE.2D AS ULONG, GL.TEXTURE.WRAP.S AS ULONG, _ GL.CLAMP AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLTexparamI", GL.TEXTURE.2D AS ULONG, GL.TEXTURE.WRAP.T AS ULONG, _ GL.CLAMP AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLTexparamI", GL.TEXTURE.2D AS ULONG, GL.TEXTURE.MAG.FILTER AS ULONG, _ GL.LINEAR AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLTexparamI", GL.TEXTURE.2D AS ULONG, GL.TEXTURE.MIN.FILTER AS ULONG, _ GL.LINEAR AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "EnableGL", GL.DEPTH.TEST AS ULONG, RetVal AS VOID
CALLDLL #LBOGL, "GL2DTexImage", BitFile$ AS PTR, GL.TEXTURE.2D AS ULONG, 0 AS USHORT, _ GL.RGB AS ULONG, Wide AS LONG, High AS LONG, 0 AS USHORT, _ GL.RGBA AS ULONG, GL.UNSIGNED.BYTE AS ULONG, RetVal AS VOID
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.RenderScene(GfxDc, Ubnd)
GL.DEPTH.BUFFER.BIT = HEXDEC("&H00000100") GL.COLOR.BUFFER.BIT = HEXDEC("&H00004000") GL.ACCUM.BUFFER.BIT = HEXDEC("&H00000200") GL.STENCIL.BUFFER.BIT = HEXDEC("&H00000400")
GL.QUADS = HEXDEC("&H0007")
RetVal = 0.0 AngleX = -60.0 AngleY = 45.500 AngleZ = -45.50 ColorBits = 0
Cnt = 0 C1 = 0.0 C2 = 0.0 V1 = 0.0 V2 = 0.0 V3 = 0.0
P1 = 1.0 P2 = 0.0
I = 0
ColorBits = GL.DEPTH.BUFFER.BIT OR GL.COLOR.BUFFER.BIT OR GL.ACCUM.BUFFER.BIT OR _ GL.STENCIL.BUFFER.BIT Cnt = Ubnd + 1 CALLDLL #LBOGL, "GLInitTexCordsEx", Cnt AS LONG, RetVal AS LONG Cnt = 0 FOR I = 0 TO Ubnd Cnt = Cnt + 1 C1 = QubeCords(I, 0) C2 = QubeCords(I, 1) V1 = QubePnts(I, 0) V2 = QubePnts(I, 1) V3 = QubePnts(I, 2) CALLDLL #LBOGL, "GLSetTexCordsEx", Cnt AS LONG, C1 AS DOUBLE, C2 AS DOUBLE, V1 AS DOUBLE, _ V2 AS DOUBLE, V3 AS DOUBLE, RetVal AS VOID NEXT I
CALLDLL #LBOGL, "GLPushMat", RetVal AS VOID
CALLDLL #LBOGL, "GLLookAt", Lookx AS DOUBLE, Looky AS DOUBLE, Lookz AS DOUBLE, _ Centx AS DOUBLE, Centy AS DOUBLE, Centz AS DOUBLE, Posnx AS DOUBLE, _ Posny AS DOUBLE, Posnz AS DOUBLE, RetVal AS VOID
CALLDLL #LBOGL, "GL3fRotate", AngleX AS DOUBLE, P1 AS DOUBLE, P2 AS DOUBLE, P2 AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GL3dRotate", AngleY AS DOUBLE, P2 AS DOUBLE, P1 AS DOUBLE, P2 AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GL3dRotate", AngleZ AS DOUBLE, P2 AS DOUBLE, P2 AS DOUBLE, P1 AS DOUBLE, RetVal AS VOID Cnt = Ubnd + 1 CALLDLL #LBOGL, "GLRenderTexEx", 1 AS LONG, Cnt AS LONG, GL.QUADS AS ULONG, RetVal AS VOID
CALLDLL #LBOGL, "GLPopMat", RetVal AS VOID
CALLDLL #LBOGL, "GLSwap", GfxDc AS ULONG, RetVal AS VOID
CALLDLL #LBOGL, "GLClearBuffers", ColorBits AS ULONG, RetVal AS VOID 'CALLDLL #KERN, "Sleep", 150 AS LONG, RetVal AS VOID
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.TexCoord(Cordx, Cordy)
RetVal = 0 CALLDLL #LBOGL, "GLTex2fCoord", Cordx AS DOUBLE, Cordy AS DOUBLE, RetVal AS VOID
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.Vertexf(X, Y, Z)
RetVal = 0 CALLDLL #LBOGL, "GL3fVertex", X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE, _ RetVal AS VOID END FUNCTION
'---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.Bcolor(R, G, B)
RetVal = 0 CALLDLL #LBOGL, "GLubColor", R AS USHORT, G AS USHORT, B AS USHORT, RetVal AS VOID
END FUNCTION
'---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.ClientSize(WinHndl, BYREF Xw, BYREF Yh)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
RetVal = 0 CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, RetVal AS LONG
Xw = tRect.X1.struct Yh = tRect.Y1.struct
FN.GetClient = RetVal END FUNCTION
'--------------------------- '---------------------------
FUNCTION FN.GetWinRect(WinHndl, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
STRUCT tRect, _ X AS LONG, _ Y AS LONG, _ X1 AS LONG, _ Y1 AS LONG
RetVal = 0 CALLDLL #USER, "GetWindowRect", WinHndl AS ULONG, tRect AS STRUCT, RetVal AS LONG
Ux = tRect.X.struct Uy = tRect.Y.struct Bx = tRect.X1.struct By = tRect.Y1.struct
FN.GetWinRect = RetVal END FUNCTION
'--------------------------- '---------------------------
FUNCTION FN.ScreenCenter(BYREF Cx, BYREF Cy)
Cx = INT(DisplayWidth * 0.5) Cy = INT(DisplayHeight * 0.5)
FN.ScreenCenter = Cx * Cy END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.SetWinPos(PosX, PosY)
UpperLeftX = PosX UpperLeftY = PosY
FN.SetWinPos = PosX * PosY END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.SetWinSize(Szx, Szy)
WindowWidth = Szx WindowHeight = Szy
FN.SetWinSize = Szx * Szy END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.GetPixelFormat(WinHndl, BYREF Dc)
PFD.DOUBLEBUFFER = HEXDEC("&H00000001") PFD.STEREO = HEXDEC("&H00000002") PFD.DRAW.TO.WINDOW = HEXDEC("&H00000004") PFD.DRAW.TO.BITMAP = HEXDEC("&H00000008") PFD.SUPPORT.GDI = HEXDEC("&H00000010") PFD.SUPPORT.OPENGL = HEXDEC("&H00000020")
PFD.TYPE.RGBA = 0 PFD.MAIN.PLANE = 0
STRUCT tOgl, _ WinHndl AS ULONG, _ '<--- INPUT; handle of target window WinDc AS ULONG, _ '<--- RETURN; device context used for drawing WinRc AS ULONG, _ '<--- RETURN; rendering context for OPENGL. dwFlags AS ULONG, _ '<--- symbolic names(tags) iPixelType AS USHORT, _ '<--- type of pixel format cColorBits AS USHORT, _ '<--- # of bits required to display colors; _ 'accepted values: 8, 16, 24, 32 cDepthBits AS USHORT, _ '<--- # of bits for color depth calculations; _ 'accepted values: 8, 16, 24, 32 dwLayerMask AS ULONG '<--- which plain to draw on; one valid value: 'PFD.MAIN.PLANE
Dc = 0 WinRc = 0
tOgl.WinHndl.struct = WinHndl tOgl.dwFlags.struct = PFD.DRAW.TO.WINDOW OR PFD.SUPPORT.OPENGL OR PFD.DOUBLEBUFFER tOgl.dwLayerMask.struct = PFD.MAIN.PLANE tOgl.iPixelType.struct = PFD.TYPE.RGBA tOgl.cColorBits.struct = 32 tOgl.cDepthBits.struct = 32
CALLDLL #LBOGL, "FN_GLContext", tOgl AS STRUCT, RetVal AS LONG Dc = tOgl.WinDc.struct WinRc = tOgl.WinRc.struct
FN.GetPixelFormat = WinRc END FUNCTION
'----------------------------- '-----------------------------
FUNCTION FN.SelectFile$(LastFile$)
FilePtr = 0
Dir$ = "" RetPath$ = ""
Dir$ = DefaultDir$ + CHR$(0) RetPath$ = SPACE$(512) CALLDLL #LBOGL, "FN_GLGetFileName", LastFile$ AS PTR, Dir$ AS PTR, RetPath$ AS struct, FilePtr AS ULONG
IF FilePtr < 1 THEN FN.SelectFile$ = "" EXIT FUNCTION END IF
RetPath$ = WINSTRING(FilePtr) RetPath$ = TRIM$(RetPath$)
FN.SelectFile$ = RetPath$ END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.DrawGfxBits(BYREF RetPath$, BYREF ColorFile$, BYREF Xwide, BYREF Yhigh)
GfxHndl = 0 LOFILE = 0 BytePos = 0 Xwide = 0 Yhigh = 0 CliHigh = 0 RetVal = 0
R = 0 G = 0 B = 0 X = 0 Y = 0
RetStr$ = "" BmpStr$ = "" BmpFile$ = ""
Wide$ = "" High$ = ""
BmpFile$ = RetPath$ RetPath$ = FN.SelectFile$(BmpFile$)
IF RetPath$ = "" THEN EXIT FUNCTION
RetStr$ = SPACE$(512) Wide$ = SPACE$(6) High$ = SPACE$(6) CALLDLL #LBOGL, "FN_GLGetColorsEx", RetPath$ AS PTR, 0 AS ULONG, _ Wide$ AS STRUCT, High$ AS STRUCT, RetStr$ AS STRUCT, RetVal AS LONG
ColorFile$ = TRIM$(RetStr$) Xwide = VAL(Wide$) Yhigh = VAL(High$)
OPEN ColorFile$ FOR BINARY AS #1 LOFILE = LOF(#1)
BmpStr$ = INPUT$(#1, LOFILE) CLOSE #1
'KILL RetStr$ TexBits$ = "" GfxHndl = HWND(#GL.GFX) RetVal = FN.ClientSize(GfxHndl, 0, CliHigh)
#GL.GFX, "DOWN"
X = 10 Y = 10 BytePos = 1 FOR I = 1 TO Yhigh FOR J = 1 TO Xwide R = ASC(MID$(BmpStr$, BytePos, 1)) G = ASC(MID$(BmpStr$, BytePos + 1, 1)) B = ASC(MID$(BmpStr$, BytePos + 2, 1)) BytePos = BytePos + 4 #GL.GFX, "COLOR ";R;" ";G;" ";B ' #ORTHO.GFX, "DOWN" #GL.GFX, "SET ";X;" ";Y X = X + 1 NEXT J X = 10 Y = Y + 1 IF Y > CliHigh THEN EXIT FOR NEXT I
TexBits$ = BmpStr$
END FUNCTION
'---------------------------------------------------------- '----------------------------------------------------------
FUNCTION FN.TextureCoordData() ' Front Face DATA 0.0, 0.0 ' Bottom Left Of The Texture And Quad DATA 1.0, 0.0 ' Bottom Right Of The Texture And Quad DATA 1.0, 1.0 ' Top Right Of The Texture And Quad DATA 0.0, 1.0 ' Top Left Of The Texture And Quad ' Back Face DATA 1.0, 0.0 ' Bottom Right Of The Texture And Quad DATA 1.0, 1.0 ' Top Right Of The Texture And Quad DATA 0.0, 1.0 ' Top Left Of The Texture And Quad DATA 0.0, 0.0 ' Bottom Left Of The Texture And Quad ' Top Face DATA 0.0, 1.0 ' Top Left Of The Texture And Quad DATA 0.0, 0.0 ' Bottom Left Of The Texture And Quad DATA 1.0, 0.0 ' Bottom Right Of The Texture And Quad DATA 1.0, 1.0 ' Top Right Of The Texture And Quad ' Bottom Face DATA 1.0, 1.0 ' Top Right Of The Texture And Quad DATA 0.0, 1.0 ' Top Left Of The Texture And Quad DATA 0.0, 0.0 ' Bottom Left Of The Texture And Quad DATA 1.0, 0.0 ' Bottom Right Of The Texture And Quad ' Right face DATA 1.0, 0.0 ' Bottom Right Of The Texture And Quad DATA 1.0, 1.0 ' Top Right Of The Texture And Quad DATA 0.0, 1.0 ' Top Left Of The Texture And Quad DATA 0.0, 0.0 ' Bottom Left Of The Texture And Quad ' Left Face DATA 0.0, 0.0 ' Bottom Left Of The Texture And Quad DATA 1.0, 0.0 ' Bottom Right Of The Texture And Quad DATA 1.0, 1.0 ' Top Right Of The Texture And Quad DATA 0.0, 1.0 ' Top Left Of The Texture And Quad
Ubnd = 0 Varb = 0 I = 0 J = 0
Ubnd = 23 REDIM QubeCords(Ubnd, 1)
FOR I = 0 TO Ubnd FOR J = 0 TO 1 READ Varb QubeCords(I, J) = Varb NEXT J NEXT I
FN.TextureCoordData = Ubnd END FUNCTION
'--------------------------------------- '---------------------------------------
FUNCTION FN.QubeVecData() ' Front Face DATA -1.0, -1.0, 1.0 ' Bottom Left Of The Texture And Quad DATA 1.0, -1.0, 1.0 ' Bottom Right Of The Texture And Quad DATA 1.0, 1.0, 1.0 ' Top Right Of The Texture And Quad DATA -1.0, 1.0, 1.0 ' Top Left Of The Texture And Quad ' Back Face DATA -1.0, -1.0, -1.0 ' Bottom Right Of The Texture And Quad DATA -1.0, 1.0, -1.0 ' Top Right Of The Texture And Quad DATA 1.0, 1.0, -1.0 ' Top Left Of The Texture And Quad DATA 1.0, -1.0, -1.0 ' Bottom Left Of The Texture And Quad ' Top Face DATA -1.0, 1.0, -1.0 ' Top Left Of The Texture And Quad DATA -1.0, 1.0, 1.0 ' Bottom Left Of The Texture And Quad DATA 1.0, 1.0, 1.0 ' Bottom Right Of The Texture And Quad DATA 1.0, 1.0, -1.0 ' Top Right Of The Texture And Quad ' Bottom Face DATA -1.0, -1.0, -1.0 ' Top Right Of The Texture And Quad DATA 1.0, -1.0, -1.0 ' Top Left Of The Texture And Quad DATA 1.0, -1.0, 1.0 ' Bottom Left Of The Texture And Quad DATA -1.0, -1.0, 1.0 ' Bottom Right Of The Texture And Quad ' Right face DATA 1.0, -1.0, -1.0 ' Bottom Right Of The Texture And Quad DATA 1.0, 1.0, -1.0 ' Top Right Of The Texture And Quad DATA 1.0, 1.0, 1.0 ' Top Left Of The Texture And Quad DATA 1.0, -1.0, 1.0 ' Bottom Left Of The Texture And Quad ' Left Face DATA -1.0, -1.0, -1.0 ' Bottom Left Of The Texture And Quad DATA -1.0, -1.0, 1.0 ' Bottom Right Of The Texture And Quad DATA -1.0, 1.0, 1.0 ' Top Right Of The Texture And Quad DATA -1.0, 1.0, -1.0 ' Top Left Of The Texture And Quad
Ubnd = 0 Varb = 0 I = 0 J = 0
Ubnd = 23 REDIM QubePnts(Ubnd, 2)
FOR I = 0 TO Ubnd FOR J = 0 TO 2 READ Varb QubePnts(I, J) = Varb NEXT J NEXT I
END FUNCTION
'--------------------------------------- '---------------------------------------
'Function toFloat( Flot ) '-- Converts a 64-bit Double to a 32-bit number. ' Struct local4, R4 As ULong
'open "oleaut32.dll" for dll as #oleaut32
' CallDLL #oleaut32, "VarR4FromR8", _ ' Flot As Double, local4 As Struct, _ ' ret As Long 'close #oleaut32 ' toFloat = local4.R4.struct 'End Function
'--------------------------------------- '---------------------------------------
FUNCTION FN.MakeDouble(Value, BYREF Dbl)
Lft$ = "" Rgt$ = "" Tpl$ = "" ValStr$ = ""
DotPos = 0 'NewVal = 0.000000000000000
NewVal = Value ValStr$ = STR$(NewVal)
DotPos = INSTR(ValStr$, ".")
ValStr$ = STR$(NewVal)
IF DotPos = 0 THEN ' NewVal = NewVal + .00000002 Lft$ = " " + ValStr$ Rgt$ = SPACE$(20) Tpl$ = SPACE$(LEN(Lft$)) + "." + SPACE$(LEN(Rgt$)) Tpl$ = REPLSTR$(Tpl$, " ", "#") NewVal = VAL(USING(Tpl$, NewVal)) Dbl = VAL(USING(Tpl$, NewVal)) FN.MakeDouble = NewVal END IF
Lft$ = " " + MID$(ValStr$, DotPos - 1) Rgt$ = MID$(ValStr$, DotPos + 1) Tpl$ = SPACE$(LEN(Lft$)) + "." Tpl$ = Tpl$ + SPACE$(20 - LEN(Rgt$)) Tpl$ = REPLSTR$(Tpl$, " ", "#") NewVal = VAL(USING(Tpl$, NewVal)) Dbl = VAL(USING(Tpl$, NewVal)) FN.MakeDouble = NewVal END FUNCTION
'Function fromFloatToDouble( Dbl ) '-- Converts a 32-bit number to a 64-bit Double. ' Struct local8, R8 As Double
'open "oleaut32.dll" for dll as #oleaut32 ' CallDLL #oleaut32, "VarR8FromR4", _ ' Dbl As ULong, local8 As Struct, _ ' ret As Long 'close #oleaut32 ' fromToDoubleFloat = local8.R8.struct 'End Function
Function FN.MakeFloat(R8) '-- Converts a 64-bit Double to a 32-bit number. Struct local1, R4 As ULong
CallDLL #OLEAUT, "VarR4FromR8", _ R8 As Double, local1 As Struct, _ ret As Long FloatVal = local1.R4.struct RetVal = FN.MakeDoublFromFloat(FloatVal) FN.MakeFloat = RetVal ' toFloat = RetVal 'toFloat = local1.R4.struct End Function
Function FN.MakeDoublFromFloat(R4) '-- Converts a 32-bit number to a 64-bit Double. Struct local1, R8 As Double 'open "oleaut32.dll" for dll as #oleaut32
CallDLL #OLEAUT, "VarR8FromR4", _ R4 As ULong, local1 As Struct, _ ret As Long FN.MakeDoublFromFloat = local1.R8.struct ' fromFloat = local1.R8.struct End Function
Function ConvertToDouble$(value, integerPart, decimalPart) 'integerPart does not Limit the integer portion; included for future Limit functionality integerPart$ = string$("#", integerPart) decimalPart$ = string$("#", decimalPart) Lz = value A$ = Trim$(RemChar$(Using(integerPart$;".";decimalPart$, value), "%")) 'ConvertToDouble$ = Trim$(RemChar$(Using(integerPart$;".";decimalPart$, value), "%")) ConvertToDouble$ = A$ End Function '____________________________________________________________________________________________________________________ '____________________________________________________________________________________________________________________
Function string$(myString$, numstring) For i = 1 To numstring string$ = string$ + myString$ Next i End Function
'
ZIP CONTENTS:
LBOGL 0.DLL LSN8_TEXTURE_000._BAS <--- above source code
LSN9_TEXTURE_000._BAS SUNSET.BMP
|
|
|
OPENGL?
Jul 30, 2023 16:46:21 GMT -5
Post by Walt Decker on Jul 30, 2023 16:46:21 GMT -5
Updated docuentation for LBOGL 0.DLL.
Select 1 of the below.
1) Anyone interested in more stuff? 2) Am I just spinning my wheels?
|
|