|
OPENGL?
Aug 14, 2023 17:47:27 GMT -5
Post by Walt Decker on Aug 14, 2023 17:47:27 GMT -5
Perspective landscape. Make sure the graphic control has the focus by clicking on it.
The bigest holdup is in function FN.MakeColors(); I originally had FN.FindMapElev() starting at the last elevation found then, if the target elevation was not found it would start at the beginning of the elevations and go to the last elevation found. That was missing about 1/4 of the elevations. The original code is still in FN.FindMapElev(). Someone may want to work on it to speed things up.
Anyway:
' NOMAINWIN OPEN "User32.dll" FOR DLL AS #USER OPEN "LBOGL 0.DLL" FOR DLL AS #LBOGL
[GLOBALS] DIM Map(-1, -1) DIM Samp(-1, -1) DIM Rgba$(-1, -1) DIM Uscale(2) DIM Rotate(1)
GLOBAL MapUbdx, _ MapUbdy, _ ClrUbdx, _ ClrUbdy
GLOBAL GfxDc, _ WinRc
[INIT.GLOBALS] Uscale(0) = 0.142 Uscale(1) = 0.142 Uscale(2) = 0.0095
Rotate(0) = -45.0 Rotate(1) = 0
MapUbdx = 64 MapUbdy = 64
GfxHndl = 0 WinDc = 0 GfxDc = 0 WinHndl = 0
Mpwide = 300 Mphigh = 400
TxtIn$ = ""
[BEGIN] RetVal = FN.CreateInfo()
RetVal = FN.RandomMap(MapUbdy, MapUbdx)
TxtIn$ = SPACE$(256) GfxHndl = HWND(#INF.STAINFO) TxtIn$ = SPACE$(256) CALLDLL #USER, "GetWindowTextA", GfxHndl AS ULONG, TxtIn$ AS STRUCT, 256 AS LONG, RetVal AS LONG TxtIn$ = LEFT$(TxtIn$, RetVal) TxtIn$ = TxtIn$ + CHR$(13) + CHR$(10) + "GATHERING SAMPLES" #INF.STAINFO, TxtIn$
RetVal = FN.GetSamples(MapUbdy, MapUbdx)
CALLDLL #USER, "GetWindowTextA", GfxHndl AS ULONG, TxtIn$ AS STRUCT, 256 AS LONG, RetVal AS LONG TxtIn$ = LEFT$(TxtIn$, RetVal) TxtIn$ = TxtIn$ + CHR$(13) + CHR$(10) + "CONTOURING" #INF.STAINFO, TxtIn$
RetVal = FN.Contour(MapUbdy, MapUbdx, RetVal, Zmax, Zmin)
REDIM Samp(-1, -1)
ClrUbd = FN.MakeColors(MapUbdy, MapUbdx, Zmin, Zmax)
CLOSE #INF
WinHndl = FN.CreateWindow("PERSPECTIVE", Mpwide, Mphigh, GfxHndl) RetVal = FN.CreateInstructions("#GL")
GfxRc = FN.GetPixelFormat(GfxHndl, WinDc) WinRc = GfxRc GfxDc = WinDc
RetVal = FN.PlotContour(MapUbdy, MapUbdx)
RetVal = FN.DefineOglWindow(Mpwide, Mphigh, MapUbdy, MapUbdx) RetVal = FN.RenderScene(GfxDc, MapUbdy, MapUbdx) '#GL, "SETFOCUS" #GL.GFX, "SETFOCUS" [WAITING] WAIT
'------------------------------ '------------------------------
SUB CLOSE.GL.WIN GlHndl$
Rc = WinRc Dc = GfxDc CALLDLL #LBOGL, "GLMakeCurrent", 0 AS ULONG, 0 AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLDeleteContext", Rc AS ULONG, RetVal AS VOID
CLOSE #USER CLOSE #LBOGL CLOSE #INS CLOSE #GlHndl$ END
END SUB
'------------------------------ '------------------------------
SUB SET.PARAMS GfxHndl$, KeyPressed$
RetVal = 0 WinDc = GfxDc Imgsizex = MapUbdx Imgsizey = MapUbdy
Rx = -5 Rz = -10
Key$ = LEFT$(UPPER$(KeyPressed$), 1) 'PRINT Key$
SELECT CASE Key$ CASE "L" Rotate(1) = Rotate(1) - Rz CASE "R" Rotate(1) = Rotate(1) + Rz CASE "U" Rotate(0) = Rotate(0) + Rx CASE "D" Rotate(0) = Rotate(0) - Rx CASE "B" Uscale(0) = Uscale(0) + .002 Uscale(1) = Uscale(1) + .002 CASE "S" Uscale(0) = Uscale(0) - .002 Uscale(1) = Uscale(1) - .002 CASE ELSE EXIT SUB END SELECT
RetVal = FN.RenderScene(WinDc, Imgsizey, Imgsizex) '#GL.GFX, "when characterInput SET.PARAMS" 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 #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" #GL.GFX, "when characterInput SET.PARAMS" CtlHndl = HWND(#GL.GFX) FN.CreateWindow = WinHndl END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateInfo()
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000") WS.GROUP = HEXDEC("&H00020000") WS.TABSTOP = HEXDEC("&H00010000")
SS.SUNKEN = HEXDEC("&H00001000")
CR$ = CHR$(13) + CHR$(10)
RetVal = 0
Cx = 0 Cy = 0 Wx = 165 Wy = 280
STYLEBITS #INF.STAINFO, SS.SUNKEN, 0, 0, 0
STATICTEXT #INF.STAWAIT, "Please wait." + CR$ + "With an image size of 64 X 64 this " + _ "will take about 4 minutes.", _ 5, 5, 150, 45 STATICTEXT #INF.STAINFO, "", 5, 50, 150, 195
RetVal = FN.ScreenCenter(Cx, Cy) RetVal = FN.SetWinPos(Cx - INT(Wx / 2), Cy - INT(Wy / 2)) RetVal = FN.SetWinSize(Wx, Wy)
STYLEBITS #INF, DS.ABSALIGN, WS.SYSMENU, 0, 0 OPEN "PLEASE WAIT" FOR DIALOG AS #INF
#INF.STAINFO "CREATIONG RANDOM MAP" END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateInstructions(WinHndl$)
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000") WS.GROUP = HEXDEC("&H00020000") WS.TABSTOP = HEXDEC("&H00010000")
WS.EX.TOPMOST = HEXDEC("&H00000008")
SS.SUNKEN = HEXDEC("&H00001000")
CR$ = CHR$(13) + CHR$(10) Ux = 0 Uy = 0 Xw = 0 Yh = 0
RetVal = 0 Hndl = 0
STYLEBITS #INS.STA, SS.SUNKEN, 0, 0, 0 STATICTEXT #INS.STA, "L = Rotate LEFT" + CR$ + _ "R = Rotate RIGHT" + CR$ + _ "U = Rotate UP" + CR$ + _ "D = Rotate DOWN" + CR$ + _ "B = BIGGER image" + CR$ + _ "S = SMALLER image", _ 5, 5, 125, 100
Hndl = HWND(#WinHndl$) RetVal = FN.GetWinRect(Hndl, Ux, Uy, 0, 0)
RetVal = FN.SetWinPos(Ux - 140, Uy) RetVal = FN.SetWinSize(140, 140)
STYLEBITS #INS, DS.ABSALIGN, WS.SYSMENU, WS.EX.TOPMOST, 0 OPEN "INSTRUCTIONS" FOR DIALOG AS #INS
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.DefineOglWindow(Wide, High, ImgSizey, ImgSizex)
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")
GL.PERSPECTIVE.CORRECTION.HINT = HEXDEC("&H0C50") GL.NICEST = HEXDEC("&H1102") GL.LESS = HEXDEC("&H0201")
RetVal = 0 Aspect = 0.0
Fov = 0.0000 Near = 0.0000 Far = 0.0000
R = 0.000000 G = 0.000000 B = 0.000000
R = VAL(USING("###.########", 0.1500)) G = VAL(USING("###.########", 0.2500)) B = VAL(USING("###.########", 0.0100))
ClearBits = GL.DEPTH.BUFFER.BIT OR GL.COLOR.BUFFER.BIT OR GL.ACCUM.BUFFER.BIT OR _ GL.STENCIL.BUFFER.BIT Aspect = MIN(Wide, High) / MAX(Wide, High)
Fov = MAX(ImgSizex, ImgSizey) * Aspect Near = 0.008 Far = MAX(Wide, High)
CALLDLL #LBOGL, "GLBkgColor", R AS DOUBLE, G AS DOUBLE, B AS DOUBLE, 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, "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
Fov = 1.0 CALLDLL #LBOGL, "GLDepth", Fov AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLDepthFunction", GL.LESS AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "EnableGL", GL.DEPTH.TEST AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLPolyMode", GL.FRONT.AND.BACK AS ULONG, GL.FILL AS ULONG, _ RetVal AS VOID CALLDLL #LBOGL, "GLShade", GL.SMOOTH AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "HintGL", GL.PERSPECTIVE.CORRECTION.HINT AS ULONG, GL.NICEST AS ULONG, _ RetVal AS VOID
END FUNCTION
'------------------------------ '------------------------------
FUNCTION FN.RenderScene(GfxDc, Imgsizey, Imgsizex)
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") GL.TRIANGLES = HEXDEC("&H0004")
ColorBits = 0 RetVal = 0 Elev = 0.0
Imgcx = Imgsizex * 0.5 Imgcy = Imgsizey * 0.5
Mx = 0.0 My = 0.0 Mz = 0.0
P1 = 1.0 P2 = 0.0
I = 0 J = 0 R = 0 G = 0 B = 0
ColorBits = GL.COLOR.BUFFER.BIT OR GL.DEPTH.BUFFER.BIT OR _ GL.ACCUM.BUFFER.BIT OR GL.STENCIL.BUFFER.BIT
Mz = -15.0
CALLDLL #LBOGL, "GLPushMat", RetVal AS VOID
CALLDLL #LBOGL, "GLMoveObj", Mx AS DOUBLE, My AS DOUBLE, Mz AS DOUBLE, RetVal AS VOID
RetVal = FN.RotateF(Rotate(0), P1, P2, P2)
IF Rotate(1) THEN RetVal = FN.RotateF(Rotate(1), P2, P2, P1) END IF
RetVal = FN.Scale3f(Uscale(0), Uscale(1), Uscale(2))
FOR I = 0 TO Imgsizey - 1 CALLDLL #LBOGL, "GLStart", GL.TRIANGLES AS ULONG, RetVal AS VOID
FOR J = 0 TO Imgsizex - 1 R = ASC(LEFT$(Rgba$(I, J + 1), 1)) G = ASC(MID$(Rgba$(I, J + 1), 2, 1)) B = ASC(RIGHT$(Rgba$(I, J + 1), 1)) Elev = Map(I, J + 1)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J + 1 - Imgcx, I - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I, J), 1)) G = ASC(MID$(Rgba$(I, J), 2, 1)) B = ASC(RIGHT$(Rgba$(I, J), 1)) Elev = Map(I, J)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J - Imgcx, I - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I + 1, J), 1)) G = ASC(MID$(Rgba$(I + 1, J), 2, 1)) B = ASC(RIGHT$(Rgba$(I + 1, J), 1)) Elev = Map(I + 1, J)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J - Imgcx, I + 1 - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I + 1, J), 1)) G = ASC(MID$(Rgba$(I + 1, J), 2, 1)) B = ASC(RIGHT$(Rgba$(I + 1, J), 1)) Elev = Map(I + 1, J)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J - Imgcx, I + 1 - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I + 1, J + 1), 1)) G = ASC(MID$(Rgba$(I + 1, J + 1), 2, 1)) B = ASC(RIGHT$(Rgba$(I + 1, J + 1), 1)) Elev = Map(I + 1, J + 1)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J + 1 - Imgcx, I + 1 - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I, J + 1), 1)) G = ASC(MID$(Rgba$(I, J + 1), 2, 1)) B = ASC(RIGHT$(Rgba$(I, J + 1), 1)) Elev = Map(I, J + 1)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J + 1 - Imgcx, I - Imgcy, Elev) NEXT J CALLDLL #LBOGL, "GLStop", RetVal AS VOID NEXT I
CALLDLL #LBOGL, "GLPopMat", RetVal AS VOID CALLDLL #LBOGL, "GLSwap", GfxDc AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLClearBuffers", ColorBits AS ULONG, 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.RotateF(Deg, P1, P2, P3)
RetVal = 0 CALLDLL #LBOGL, "GL3fRotate", Deg AS DOUBLE, P1 AS DOUBLE, P2 AS DOUBLE, _ P3 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.Scale3f(Sx, Sy, Sz)
RetVal = 0 CALLDLL #LBOGL, "GL3fScale", Sx AS DOUBLE, Sy AS DOUBLE, Sz AS DOUBLE, RetVal AS VOID
END FUNCTION '---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.RandomMap(RootSizey, RootSizex) '#INF.STAINFO, "CREATIONG RANDOM MAP" ColMax = 0 Xpoint = 0 PntCnt = 0 NumPnts = 0 RndPnts = 0 I = 0 J = 0 Z = 0
ElvMax = 0.0 ElvMin = 0.0 Elv = 0.0
ColMax = RootSizex RndPnts = 5 ElvMax = 225.0 ElvMin = ElvMax * 0.35 - 1
REDIM Map(RootSizey, RootSizex)
Elv = RND(0) RANDOMIZE Elv Zmax = 0 Zmin = 1000 FOR I = 0 TO RootSizey Xpoint = 0
DO NumPnts = INT(RND(0) * (RndPnts - 1) + 1) IF NumPnts + Xpoint > ColMax THEN NumPnts = ColMax - Xpoint FOR J = Xpoint TO Xpoint + NumPnts - 1 Elv = RND(0) * ElvMax - ElvMin Zmax = MAX(Zmax, Elv) Zmin = MIN(Zmin, Elv) Map(I, J) = Elv PntCnt = PntCnt + 1 'Xpoint = Xpoint + 1 NEXT J Xpoint = Xpoint + PntCnt PntCnt = 0 IF J >= ColMax THEN EXIT DO LOOP UNTIL Z <> 0 NEXT I
END FUNCTION
'------------------------------------- '-------------------------------------
FUNCTION FN.GetSamples(Ubdy, Ubdx) 'tSamp() AS Samp_Struct, Map() AS SINGLE)
TxtIn$ = "" Ubnd = 0 Sbnd = 0
X = 0 Y = 0 I = 0
'Z = HWND(#INF.STAINFO)
Z = Rnd(0)
Ubnd = MAX(Ubdy, Ubdx) Sbnd = Ubnd + INT(Ubnd * 0.15)
REDIM Samp(Sbnd, 2)
RANDOMIZE Z
FOR I = 0 TO Sbnd
[AGAIN] '
Y = VAL(USING("####", RND(0) * Ubdy)) X = VAL(USING("####", RND(0) * Ubdx))
IF Samp(I, 0) THEN GOTO [AGAIN]
Samp(I, 0) = X Samp(I, 1) = Y Samp(I, 2) = Map(Y, X) NEXT I
FN.GetSamples = Sbnd END FUNCTION
'-------------------------------------- '--------------------------------------
FUNCTION FN.Contour(MapHigh, MapWide, Ubnd, BYREF Zmax, BYREF Zmin)
K = 0 M = 0
Ih = 0 Ic = 0 I = 0 J = 0 L = 0
Dx1 = 0.0 Dx2 = 0.0 XX2 = 0.0 XX1 = 0.0 Small = 0.0 S1 = 0.0 S2 = 0.0 D = 0.0
Zmax = -3e36 Zmin = 3e36
REDIM Map(MapHigh, MapWide)
Ih = Ubnd
DIM Dist(Ih)
Dx1 = MapWide / (MapWide - 1) Dx2 = MapHigh / (MapHigh - 1) Small = (Dx1 * Dx1 + Dx2 * Dx2) / 10000
XX2 = 0
FOR I = 0 TO MapHigh XX1 = 0 FOR J = 0 TO MapWide
FOR K = 0 TO Ih Dist(K) = (XX1 - Samp(K, 0))^2 + (XX2 - Samp(K, 1))^2 NEXT K
S1 = 0.0 S2 = 0.0
FOR L = 1 TO 4
Ic = 0 FOR M = 1 TO Ih IF Dist(M) < Dist(Ic) THEN Ic = M NEXT M
IF Dist(Ic) < Small THEN GOTO [Set.Amap] D = SQR(Dist(Ic)) S1 = S1 + Samp(Ic, 2) / D S2 = S2 + 1.0 / D Dist(Ic) = 9.0E35 NEXT L
Map(I, J) = S1 / S2 GOTO [Inc.XX1] [Set.Amap] ' Map(I, J) = Samp(Ic, 2)
[Inc.XX1] ' XX1 = XX1 + Dx1
Zmax = MAX(Zmax, Map(I, J)) Zmin = MIN(Zmin, Map(I, J))
NEXT J XX2 = XX2 + Dx2 NEXT I
FN.Contour = MapWide * MapHigh END FUNCTION
'--------------------------------- '---------------------------------
FUNCTION FN.MakeColors(UbY, UbX, Zmin, Zmax) 'Map() AS SINGLE, tC() AS Color_Struct)
R = 0 G = 0 B = 0 I = 0 J = 0 Q = 0
CR$ = CHR$(13) + CHR$(10) C3$ = CHR$(0) + CHR$(0) + CHR$(0) C0$ = C3$ TxtIn$ = ""
RetVal = 0
GfxHndl = HWND(#INF.STAINFO)
Flag = 0 Row = 0
ContIncr = 0.0 LowCIncr = 0.0
WaterMin = 0.0 WaterMax = 0.0 WaterLow = 0.0
Elv = 0.0 Ratio = 0.0
LandMin = 0.0 LandMax = 0.0
DIM Amap(-1, -1)
LandMin = 0.0 ContIncr = 5.0 LowCIncr = 0.0
LandMax = Zmax - Zmax MOD ContIncr WaterMin = Zmin - Zmin MOD ContIncr - ContIncr WaterLow = WaterMin WaterMax = -0.00999
REDIM Rgba$(UbY, UbX) REDIM Amap(UbY, UbX)
TxtIn$ = SPACE$(256) CALLDLL #USER, "GetWindowTextA", GfxHndl AS ULONG, TxtIn$ AS STRUCT, 256 AS LONG, RetVal AS LONG TxtIn$ = LEFT$(TxtIn$, RetVal) TxtIn$ = TxtIn$ + CR$ + "GATHERING WATER COLOR INFO" #INF.STAINFO, TxtIn$
MapCount = 0
FOR I = 0 TO UbY FOR J = 0 TO UbX MapCount = MapCount + 1 Amap(I, J) = Map(I, J) NEXT J NEXT I
Elv = RND(0) RANDOMIZE Elv
[BEGCLRS] I = 0 J = 0 Row = 0 Col = 0
WaterIncr = WaterMin + ContIncr
B = 255 R = 0 Row = 0 Col = 0 ColorCount = 0 [WATER] DO Flag = FN.FindMapElev(WaterMin, WaterIncr, Row, Col, UbY, UbX) ' IF Flag THEN ColorCount = ColorCount + 1 Elv = Amap(Row, Col) Amap(Row, Col) = 10000 Ratio = WaterLow - Elv Ratio = ABS(Ratio / WaterLow) G = INT(255 * Ratio + 0.4) 'VAL(USING("###", 255 * Ratio)) C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$
END IF
[NXT.WATER] IF Flag = 0 THEN WaterMin = WaterMin + ContIncr
IF WaterMin > WaterMax THEN EXIT DO
WaterIncr = WaterMin + ContIncr END IF
LOOP UNTIL ZZ > 0
TxtIn$ = SPACE$(256) CALLDLL #USER, "GetWindowTextA", GfxHndl AS ULONG, TxtIn$ AS STRUCT, 256 AS LONG, RetVal AS LONG TxtIn$ = LEFT$(TxtIn$, RetVal) TxtIn$ = TxtIn$ + CR$ + "GATHERING LAND COLOR INFO" #INF.STAINFO, TxtIn$
FOR I = 0 TO UbY FOR J = 0 TO UbX Amap(I, J) = Map(I, J) NEXT J NEXT I
Row = 0 Col = 0 LandIncr = LandMin + ContIncr
[BEGIN.LAND] DO Flag = 0 Flag = FN.FindMapElev(LandMin, LandIncr, Row, Col, UbY, UbX) Elv = Amap(Row, Col)
SELECT CASE CASE (Elv >= 0.0) AND (Elv <= 5.0) Amap(Row, Col) = -10000
R = RND(0) * (235 - 220) + 220 G = RND(0) * (195 - 175) + 175 B = RND(0) * (115 - 100) + 100
C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
CASE (Elv >= 5.0) AND (Elv <= 10.0) Amap(Row, Col) = -10000 R = 0 G = 127 B = 0 C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
CASE (Elv >= LandMin) AND (Elv <= LandMax - 30) Amap(Row, Col) = -10000 G = 127 Ratio = Elv / LandMax G = G + 128 * Ratio B = 128 * Ratio R = G * Ratio C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
CASE (Elv >= LandMax - 30) AND (Elv <= LandMax - 10) Amap(Row, Col) = -10000 R = RND(0) * (145 - 115) + 115 G = RND(0) * (84 - 54) + 54 B = RND(0) * (52 - 22) + 22 C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
CASE (Elv >= LandMax - 10) AND (Elv <= LandMax + ContIncr) Amap(Row, Col) = -10000 R = RND(0) * (255 - 200) + 200 G = RND(0) * (253 - 200) + 200 B = RND(0) * (254 - 200) + 200 C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
END SELECT
[NEXT.LAND]
IF Flag = 0 THEN LandMin = LandMin + ContIncr
IF LandMin > LandMax + ContIncr THEN EXIT DO
LandIncr = LandMin + ContIncr END IF LOOP UNTIL ZZ > 0
PRINT "LAND DONE" PRINT "MAP COUNT = "; MapCount; " COLORS = "; ColorCount
END FUNCTION
'--------------------------------- '---------------------------------
FUNCTION FN.FindMapElev(LowElv, HighElv, BYREF Roe, BYREF Coll, Uy, Ux)
I = 0 J = 0 Flag = 0 Elev = 0
FOR I = 0 TO Uy FOR J = 0 TO Ux Elev = Amap(I, J) IF Elev >= LowElv THEN IF Elev <= HighElv THEN Flag = 1 Roe = I Coll = J FN.FindMapElev = Flag EXIT FUNCTION END IF END IF NEXT J NEXT I EXIT FUNCTION
FOR I = Roe TO Uy FOR J = Roe TO Ux Elev = Amap(I, J) IF Elev >= LowElv THEN IF Elev <= HighElv THEN Flag = 1 Roe = I Coll = J FN.FindMapElev = Flag EXIT FUNCTION END IF END IF NEXT J NEXT I
FN.FindMapElev = Flag 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.PlotContour(Uby, Ubx)
R = 0 G = 0 B = 0 Y = 0 X = 0 I = 0 J = 0
FOR Y = 0 TO Uby FOR X = 0 TO Ubx R = ASC(LEFT$(Rgba$(Y, X), 1)) G = ASC(MID$(Rgba$(Y, X), 1)) B = ASC(RIGHT$(Rgba$(Y, X), 1))
#GL.GFX, "COLOR ";R;" ";G;" ";B #GL.GFX, "DOWN" #GL.GFX, "SET ";X; " ";Y NEXT X NEXT Y END FUNCTION '
|
|
|
OPENGL?
Aug 16, 2023 18:02:34 GMT -5
Post by Walt Decker on Aug 16, 2023 18:02:34 GMT -5
I found the problem with display lists; stupid error, I recently graduated from UoD (University of Duh).
So here is LB with an OpenGL display list: ' NOMAINWIN RetVal = 0
OPEN "User32.dll" FOR DLL AS #USER OPEN "LBOGL 0.DLL" FOR DLL AS #LBOGL 'F:\LB_FORMS\OPENGL\
CALLDLL #LBOGL, "FN_GLVersion", RetVal AS VOID
[GLOBALS] DIM Map(-1, -1) DIM Samp(-1, -1) DIM Rgba$(-1, -1) DIM Uscale(2) DIM Rotate(1) DIM DispList(-1)
GLOBAL MapUbdx, _ MapUbdy, _ ClrUbdx, _ ClrUbdy
GLOBAL GfxDc, _ WinRc
[INIT.GLOBALS] Uscale(0) = 0.142 Uscale(1) = 0.142 Uscale(2) = 0.0095
Rotate(0) = -45.0 Rotate(1) = 0
MapUbdx = 64 MapUbdy = 64
GfxHndl = 0 WinDc = 0 GfxDc = 0 WinHndl = 0
Mpwide = 300 Mphigh = 400
TxtIn$ = ""
[BEGIN.PREPROSSEING] RetVal = FN.CreateInfo()
RetVal = FN.RandomMap(MapUbdy, MapUbdx)
TxtIn$ = SPACE$(256) GfxHndl = HWND(#INF.STAINFO) TxtIn$ = SPACE$(256) CALLDLL #USER, "GetWindowTextA", GfxHndl AS ULONG, TxtIn$ AS STRUCT, 256 AS LONG, RetVal AS LONG TxtIn$ = LEFT$(TxtIn$, RetVal) TxtIn$ = TxtIn$ + CHR$(13) + CHR$(10) + "GATHERING SAMPLES" #INF.STAINFO, TxtIn$
RetVal = FN.GetSamples(MapUbdy, MapUbdx)
CALLDLL #USER, "GetWindowTextA", GfxHndl AS ULONG, TxtIn$ AS STRUCT, 256 AS LONG, RetVal AS LONG TxtIn$ = LEFT$(TxtIn$, RetVal) TxtIn$ = TxtIn$ + CHR$(13) + CHR$(10) + "CONTOURING" #INF.STAINFO, TxtIn$
RetVal = FN.Contour(MapUbdy, MapUbdx, RetVal, Zmax, Zmin)
REDIM Samp(-1, -1)
ClrUbd = FN.MakeColors(MapUbdy, MapUbdx, Zmin, Zmax)
CLOSE #INF
WinHndl = FN.CreateWindow("PERSPECTIVE", Mpwide, Mphigh, GfxHndl) RetVal = FN.CreateInstructions("#GL")
GfxRc = FN.GetPixelFormat(GfxHndl, WinDc) WinRc = GfxRc GfxDc = WinDc
RetVal = FN.GetDisplayList(3) RetVal = FN.PlotContour(MapUbdy, MapUbdx)
RetVal = FN.DefineOglWindow(Mpwide, Mphigh, MapUbdy, MapUbdx) RetVal = FN.CreateDispList(DispList(0), MapUbdy, MapUbdx) RetVal = FN.RenderScene(GfxDc, DispList(0)) [WAITING] WAIT
'------------------------------ '------------------------------
SUB CLOSE.GL.WIN GlHndl$
Rc = WinRc Dc = GfxDc CALLDLL #LBOGL, "GLMakeCurrent", 0 AS ULONG, 0 AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLDeleteContext", Rc AS ULONG, RetVal AS VOID
CLOSE #USER CLOSE #LBOGL CLOSE #INS CLOSE #GlHndl$ END
END SUB
'------------------------------ '------------------------------
SUB SET.PARAMS GfxHndl$, KeyPressed$
RetVal = 0 WinDc = GfxDc Imgsizex = MapUbdx Imgsizey = MapUbdy
Rx = -5 Rz = -10
Key$ = LEFT$(UPPER$(KeyPressed$), 1) 'PRINT Key$
SELECT CASE Key$ CASE "L" Rotate(1) = Rotate(1) - Rz CASE "R" Rotate(1) = Rotate(1) + Rz CASE "U" Rotate(0) = Rotate(0) + Rx CASE "D" Rotate(0) = Rotate(0) - Rx CASE "B" Uscale(0) = Uscale(0) + .002 Uscale(1) = Uscale(1) + .002 CASE "S" Uscale(0) = Uscale(0) - .002 Uscale(1) = Uscale(1) - .002 CASE ELSE EXIT SUB END SELECT
RetVal = FN.RenderScene(WinDc, DispList(0)) 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 #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" #GL.GFX, "when characterInput SET.PARAMS" CtlHndl = HWND(#GL.GFX) FN.CreateWindow = WinHndl END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateInfo()
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000") WS.GROUP = HEXDEC("&H00020000") WS.TABSTOP = HEXDEC("&H00010000")
SS.SUNKEN = HEXDEC("&H00001000")
CR$ = CHR$(13) + CHR$(10)
RetVal = 0
Cx = 0 Cy = 0 Wx = 165 Wy = 280
STYLEBITS #INF.STAINFO, SS.SUNKEN, 0, 0, 0
STATICTEXT #INF.STAWAIT, "Please wait." + CR$ + "With an image size of 64 X 64 this " + _ "will take about 4 minutes.", _ 5, 5, 150, 45 STATICTEXT #INF.STAINFO, "", 5, 50, 150, 195
RetVal = FN.ScreenCenter(Cx, Cy) RetVal = FN.SetWinPos(Cx - INT(Wx / 2), Cy - INT(Wy / 2)) RetVal = FN.SetWinSize(Wx, Wy)
STYLEBITS #INF, DS.ABSALIGN, WS.SYSMENU, 0, 0 OPEN "PLEASE WAIT" FOR DIALOG AS #INF
#INF.STAINFO "CREATIONG RANDOM MAP" END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.CreateInstructions(WinHndl$)
DS.ABSALIGN = 1 WS.CAPTION = HEXDEC("&H00C00000") WS.SYSMENU = HEXDEC("&H00080000") WS.GROUP = HEXDEC("&H00020000") WS.TABSTOP = HEXDEC("&H00010000")
WS.EX.TOPMOST = HEXDEC("&H00000008")
SS.SUNKEN = HEXDEC("&H00001000")
CR$ = CHR$(13) + CHR$(10) Ux = 0 Uy = 0 Xw = 0 Yh = 0
RetVal = 0 Hndl = 0
STYLEBITS #INS.STA, SS.SUNKEN, 0, 0, 0 STATICTEXT #INS.STA, "L = Rotate LEFT" + CR$ + _ "R = Rotate RIGHT" + CR$ + _ "U = Rotate UP" + CR$ + _ "D = Rotate DOWN" + CR$ + _ "B = BIGGER image" + CR$ + _ "S = SMALLER image", _ 5, 5, 125, 100
Hndl = HWND(#WinHndl$) RetVal = FN.GetWinRect(Hndl, Ux, Uy, 0, 0)
RetVal = FN.SetWinPos(Ux - 140, Uy) RetVal = FN.SetWinSize(140, 140)
STYLEBITS #INS, DS.ABSALIGN, WS.SYSMENU, WS.EX.TOPMOST, 0 OPEN "INSTRUCTIONS" FOR DIALOG AS #INS
END FUNCTION
'-------------------------- '--------------------------
FUNCTION FN.DefineOglWindow(Wide, High, ImgSizey, ImgSizex)
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")
GL.PERSPECTIVE.CORRECTION.HINT = HEXDEC("&H0C50") GL.NICEST = HEXDEC("&H1102") GL.LESS = HEXDEC("&H0201")
RetVal = 0 Aspect = 0.0
Fov = 0.0000 Near = 0.0000 Far = 0.0000
R = 0.000000 G = 0.000000 B = 0.000000
R = VAL(USING("###.########", 0.1500)) G = VAL(USING("###.########", 0.2500)) B = VAL(USING("###.########", 0.0100))
ClearBits = GL.DEPTH.BUFFER.BIT OR GL.COLOR.BUFFER.BIT OR GL.ACCUM.BUFFER.BIT OR _ GL.STENCIL.BUFFER.BIT Aspect = MIN(Wide, High) / MAX(Wide, High)
Fov = MAX(ImgSizex, ImgSizey) * Aspect Near = 0.008 Far = MAX(Wide, High)
CALLDLL #LBOGL, "GLBkgColor", R AS DOUBLE, G AS DOUBLE, B AS DOUBLE, 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, "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
Fov = 1.0 CALLDLL #LBOGL, "GLDepth", Fov AS DOUBLE, RetVal AS VOID CALLDLL #LBOGL, "GLDepthFunction", GL.LESS AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "EnableGL", GL.DEPTH.TEST AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "GLPolyMode", GL.FRONT.AND.BACK AS ULONG, GL.FILL AS ULONG, _ RetVal AS VOID CALLDLL #LBOGL, "GLShade", GL.SMOOTH AS ULONG, RetVal AS VOID CALLDLL #LBOGL, "HintGL", GL.PERSPECTIVE.CORRECTION.HINT AS ULONG, GL.NICEST AS ULONG, _ RetVal AS VOID
END FUNCTION
'------------------------------ '------------------------------
'FUNCTION FN.RenderScene(GfxDc, Imgsizey, Imgsizex) FUNCTION FN.RenderScene(GfxDc, ListNum)
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") GL.TRIANGLES = HEXDEC("&H0004")
ColorBits = 0 RetVal = 0 Elev = 0.0
Imgcx = Imgsizex * 0.5 Imgcy = Imgsizey * 0.5
Mx = 0.0 My = 0.0 Mz = 0.0
P1 = 1.0 P2 = 0.0
I = 0 J = 0 R = 0 G = 0 B = 0
ColorBits = GL.COLOR.BUFFER.BIT OR GL.DEPTH.BUFFER.BIT OR _ GL.ACCUM.BUFFER.BIT OR GL.STENCIL.BUFFER.BIT
Mz = -15.0
CALLDLL #LBOGL, "GLPushMat", RetVal AS VOID
CALLDLL #LBOGL, "GLMoveObj", Mx AS DOUBLE, My AS DOUBLE, Mz AS DOUBLE, RetVal AS VOID
RetVal = FN.RotateF(Rotate(0), P1, P2, P2)
IF Rotate(1) THEN RetVal = FN.RotateF(Rotate(1), P2, P2, P1) END IF
RetVal = FN.Scale3f(Uscale(0), Uscale(1), Uscale(2)) TRACE 2 CALLDLL #LBOGL, "CallListGL", ListNum AS LONG, 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
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.RotateF(Deg, P1, P2, P3)
RetVal = 0 CALLDLL #LBOGL, "GL3fRotate", Deg AS DOUBLE, P1 AS DOUBLE, P2 AS DOUBLE, _ P3 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.Scale3f(Sx, Sy, Sz)
RetVal = 0 CALLDLL #LBOGL, "GL3fScale", Sx AS DOUBLE, Sy AS DOUBLE, Sz AS DOUBLE, RetVal AS VOID
END FUNCTION '---------------------------------------------------------------- '----------------------------------------------------------------
FUNCTION FN.RandomMap(RootSizey, RootSizex)
ColMax = 0 Xpoint = 0 PntCnt = 0 NumPnts = 0 RndPnts = 0 I = 0 J = 0 Z = 0
ElvMax = 0.0 ElvMin = 0.0 Elv = 0.0
ColMax = RootSizex RndPnts = 5 ElvMax = 225.0 ElvMin = ElvMax * 0.35 - 1
REDIM Map(RootSizey, RootSizex)
Elv = RND(0) RANDOMIZE Elv Zmax = 0 Zmin = 1000 FOR I = 0 TO RootSizey Xpoint = 0
DO NumPnts = INT(RND(0) * (RndPnts - 1) + 1) IF NumPnts + Xpoint > ColMax THEN NumPnts = ColMax - Xpoint FOR J = Xpoint TO Xpoint + NumPnts - 1 Elv = RND(0) * ElvMax - ElvMin Zmax = MAX(Zmax, Elv) Zmin = MIN(Zmin, Elv) Map(I, J) = Elv PntCnt = PntCnt + 1 'Xpoint = Xpoint + 1 NEXT J Xpoint = Xpoint + PntCnt PntCnt = 0 IF J >= ColMax THEN EXIT DO LOOP UNTIL Z <> 0 NEXT I
END FUNCTION
'------------------------------------- '-------------------------------------
FUNCTION FN.GetSamples(Ubdy, Ubdx)
TxtIn$ = "" Ubnd = 0 Sbnd = 0
X = 0 Y = 0 I = 0
Z = Rnd(0)
Ubnd = MAX(Ubdy, Ubdx) Sbnd = Ubnd + INT(Ubnd * 0.15)
REDIM Samp(Sbnd, 2)
RANDOMIZE Z
FOR I = 0 TO Sbnd
[AGAIN] '
Y = VAL(USING("####", RND(0) * Ubdy)) X = VAL(USING("####", RND(0) * Ubdx))
IF Samp(I, 0) THEN GOTO [AGAIN]
Samp(I, 0) = X Samp(I, 1) = Y Samp(I, 2) = Map(Y, X) NEXT I
FN.GetSamples = Sbnd END FUNCTION
'-------------------------------------- '--------------------------------------
FUNCTION FN.Contour(MapHigh, MapWide, Ubnd, BYREF Zmax, BYREF Zmin)
K = 0 M = 0
Ih = 0 Ic = 0 I = 0 J = 0 L = 0
Dx1 = 0.0 Dx2 = 0.0 XX2 = 0.0 XX1 = 0.0 Small = 0.0 S1 = 0.0 S2 = 0.0 D = 0.0
Zmax = -3e36 Zmin = 3e36
REDIM Map(MapHigh, MapWide)
Ih = Ubnd
DIM Dist(Ih)
Dx1 = MapWide / (MapWide - 1) Dx2 = MapHigh / (MapHigh - 1) Small = (Dx1 * Dx1 + Dx2 * Dx2) / 10000
XX2 = 0
FOR I = 0 TO MapHigh XX1 = 0 FOR J = 0 TO MapWide
FOR K = 0 TO Ih Dist(K) = (XX1 - Samp(K, 0))^2 + (XX2 - Samp(K, 1))^2 NEXT K
S1 = 0.0 S2 = 0.0
FOR L = 1 TO 4
Ic = 0 FOR M = 1 TO Ih IF Dist(M) < Dist(Ic) THEN Ic = M NEXT M
IF Dist(Ic) < Small THEN GOTO [Set.Amap] D = SQR(Dist(Ic)) S1 = S1 + Samp(Ic, 2) / D S2 = S2 + 1.0 / D Dist(Ic) = 9.0E35 NEXT L
Map(I, J) = S1 / S2 GOTO [Inc.XX1] [Set.Amap] ' Map(I, J) = Samp(Ic, 2)
[Inc.XX1] ' XX1 = XX1 + Dx1
Zmax = MAX(Zmax, Map(I, J)) Zmin = MIN(Zmin, Map(I, J))
NEXT J XX2 = XX2 + Dx2 NEXT I
FN.Contour = MapWide * MapHigh END FUNCTION
'--------------------------------- '---------------------------------
FUNCTION FN.MakeColors(UbY, UbX, Zmin, Zmax) 'Map() AS SINGLE, tC() AS Color_Struct)
R = 0 G = 0 B = 0 I = 0 J = 0 Q = 0
CR$ = CHR$(13) + CHR$(10) C3$ = CHR$(0) + CHR$(0) + CHR$(0) C0$ = C3$ TxtIn$ = ""
RetVal = 0
GfxHndl = HWND(#INF.STAINFO)
Flag = 0 Row = 0
ContIncr = 0.0 LowCIncr = 0.0
WaterMin = 0.0 WaterMax = 0.0 WaterLow = 0.0
Elv = 0.0 Ratio = 0.0
LandMin = 0.0 LandMax = 0.0
DIM Amap(-1, -1)
LandMin = 0.0 ContIncr = 5.0 LowCIncr = 0.0
LandMax = Zmax - Zmax MOD ContIncr WaterMin = Zmin - Zmin MOD ContIncr - ContIncr WaterLow = WaterMin WaterMax = -0.00999
REDIM Rgba$(UbY, UbX) REDIM Amap(UbY, UbX)
TxtIn$ = SPACE$(256) CALLDLL #USER, "GetWindowTextA", GfxHndl AS ULONG, TxtIn$ AS STRUCT, 256 AS LONG, RetVal AS LONG TxtIn$ = LEFT$(TxtIn$, RetVal) TxtIn$ = TxtIn$ + CR$ + "GATHERING WATER COLOR INFO" #INF.STAINFO, TxtIn$
MapCount = 0
FOR I = 0 TO UbY FOR J = 0 TO UbX MapCount = MapCount + 1 Amap(I, J) = Map(I, J) NEXT J NEXT I
Elv = RND(0) RANDOMIZE Elv
[BEGCLRS] I = 0 J = 0 Row = 0 Col = 0
WaterIncr = WaterMin + ContIncr
B = 255 R = 0 Row = 0 Col = 0 ColorCount = 0 [WATER] DO Flag = FN.FindMapElev(WaterMin, WaterIncr, Row, Col, UbY, UbX) ' IF Flag THEN ColorCount = ColorCount + 1 Elv = Amap(Row, Col) Amap(Row, Col) = 10000 Ratio = WaterLow - Elv Ratio = ABS(Ratio / WaterLow) G = INT(255 * Ratio + 0.4) C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$
END IF
[NXT.WATER] IF Flag = 0 THEN WaterMin = WaterMin + ContIncr
IF WaterMin > WaterMax THEN EXIT DO
WaterIncr = WaterMin + ContIncr END IF
LOOP UNTIL ZZ > 0
TxtIn$ = SPACE$(256) CALLDLL #USER, "GetWindowTextA", GfxHndl AS ULONG, TxtIn$ AS STRUCT, 256 AS LONG, RetVal AS LONG TxtIn$ = LEFT$(TxtIn$, RetVal) TxtIn$ = TxtIn$ + CR$ + "GATHERING LAND COLOR INFO" #INF.STAINFO, TxtIn$
FOR I = 0 TO UbY FOR J = 0 TO UbX Amap(I, J) = Map(I, J) NEXT J NEXT I
Row = 0 Col = 0 LandIncr = LandMin + ContIncr
[BEGIN.LAND] DO Flag = 0 Flag = FN.FindMapElev(LandMin, LandIncr, Row, Col, UbY, UbX) Elv = Amap(Row, Col)
SELECT CASE CASE (Elv >= 0.0) AND (Elv <= 5.0) Amap(Row, Col) = -10000
R = INT(RND(0) * (235 - 220)) + 220 G = INT(RND(0) * (195 - 175)) + 175 B = INT(RND(0) * (115 - 100)) + 100
C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
CASE (Elv >= 5.0) AND (Elv <= 10.0) Amap(Row, Col) = -10000 R = 0 G = 127 B = 0 C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
CASE (Elv >= LandMin) AND (Elv <= LandMax - 30) Amap(Row, Col) = -10000 G = 127 Ratio = Elv / LandMax G = G + INT(128 * Ratio) B = INT(128 * Ratio) R = INT(G * Ratio) C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
CASE (Elv >= LandMax - 30) AND (Elv <= LandMax - 10) Amap(Row, Col) = -10000 R = INT(RND(0) * (145 - 115)) + 115 G = INT(RND(0) * (84 - 54)) + 54 B = INT(RND(0) * (52 - 22)) + 22 C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
CASE (Elv >= LandMax - 10) AND (Elv <= LandMax + ContIncr) Amap(Row, Col) = -10000 R = INT(RND(0) * (255 - 200)) + 200 G = INT(RND(0) * (253 - 200)) + 200 B = INT(RND(0) * (254 - 200)) + 200 C3$ = CHR$(R) + CHR$(G) + CHR$(B) Rgba$(Row, Col) = C3$ ColorCount = ColorCount + 1
END SELECT
[NEXT.LAND]
IF Flag = 0 THEN LandMin = LandMin + ContIncr
IF LandMin > LandMax + ContIncr THEN EXIT DO
LandIncr = LandMin + ContIncr END IF LOOP UNTIL ZZ > 0
PRINT "LAND DONE" PRINT "MAP COUNT = "; MapCount; " COLORS = "; ColorCount
END FUNCTION
'--------------------------------- '---------------------------------
FUNCTION FN.FindMapElev(LowElv, HighElv, BYREF Roe, BYREF Coll, Uy, Ux)
I = 0 J = 0 Flag = 0 Elev = 0
FOR I = Roe TO Uy FOR J = Coll TO Ux Elev = Amap(I, J) IF Elev >= LowElv THEN IF Elev <= HighElv THEN Flag = 1 Roe = I Coll = J FN.FindMapElev = Flag EXIT FUNCTION END IF END IF NEXT J NEXT I
FOR I = 0 TO Uy FOR J = 0 TO Ux Elev = Amap(I, J) IF Elev >= LowElv THEN IF Elev <= HighElv THEN Flag = 1 Roe = I Coll = J FN.FindMapElev = Flag EXIT FUNCTION END IF END IF NEXT J NEXT I
FN.FindMapElev = Flag 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.PlotContour(Uby, Ubx)
R = 0 G = 0 B = 0 Y = 0 X = 0 I = 0 J = 0
FOR Y = 0 TO Uby FOR X = 0 TO Ubx R = ASC(LEFT$(Rgba$(Y, X), 1)) G = ASC(MID$(Rgba$(Y, X), 1)) B = ASC(RIGHT$(Rgba$(Y, X), 1))
#GL.GFX, "COLOR ";R;" ";G;" ";B #GL.GFX, "DOWN" #GL.GFX, "SET ";X; " ";Y NEXT X NEXT Y END FUNCTION
'----------------------------- '-----------------------------
FUNCTION FN.GetDisplayList(NumLists)
List$ = SPACE$(256)
RetVal = 0 I = 0
CALLDLL #LBOGL, "FN_GenListIds", NumLists AS LONG, List$ AS STRUCT, RetVal AS LONG
IF RetVal < 1 THEN NOTICE "LIST ERROR" + CHR$(13) + "An error occured while attempting to create " + _ "one or more OpenGL display lists." EXIT FUNCTION END IF
List$ = TRIM$(List$)
REDIM DispList(NumLists - 1)
FOR I = 1 TO NumLists DispList(I - 1) = VAL(WORD$(List$, I, ",")) NEXT I
FN.GetDisplayList = NumLists END FUNCTION
'----------------------------- '-----------------------------
FUNCTION FN.CreateDispList(ListNum, Imgsizey, Imgsizex)
GL.COMPILE = HEXDEC("&H1300") GL.COMPILE.AND.EXECUTE = HEXDEC("&H1301")
GL.TRIANGLES = HEXDEC("&H0004")
RetVal = 0
I = 0 J = 0 R = 0 G = 0 B = 0
Imgcx = Imgsizex * 0.5 Imgcy = Imgsizey * 0.5
PRINT "NEW LIST = "; ListNum, Imgsizey, Imgsizex TRACE 2 CALLDLL #LBOGL, "NewListGL", ListNum AS LONG, GL.COMPILE.AND.EXECUTE AS ULONG, RetVal AS VOID
FOR I = 0 TO Imgsizey - 1 CALLDLL #LBOGL, "GLStart", GL.TRIANGLES AS ULONG, RetVal AS VOID
FOR J = 0 TO Imgsizex - 1 R = ASC(LEFT$(Rgba$(I, J + 1), 1)) G = ASC(MID$(Rgba$(I, J + 1), 2, 1)) B = ASC(RIGHT$(Rgba$(I, J + 1), 1)) Elev = Map(I, J + 1)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J + 1 - Imgcx, I - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I, J), 1)) G = ASC(MID$(Rgba$(I, J), 2, 1)) B = ASC(RIGHT$(Rgba$(I, J), 1)) Elev = Map(I, J)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J - Imgcx, I - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I + 1, J), 1)) G = ASC(MID$(Rgba$(I + 1, J), 2, 1)) B = ASC(RIGHT$(Rgba$(I + 1, J), 1)) Elev = Map(I + 1, J)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J - Imgcx, I + 1 - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I + 1, J), 1)) G = ASC(MID$(Rgba$(I + 1, J), 2, 1)) B = ASC(RIGHT$(Rgba$(I + 1, J), 1)) Elev = Map(I + 1, J)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J - Imgcx, I + 1 - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I + 1, J + 1), 1)) G = ASC(MID$(Rgba$(I + 1, J + 1), 2, 1)) B = ASC(RIGHT$(Rgba$(I + 1, J + 1), 1)) Elev = Map(I + 1, J + 1)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J + 1 - Imgcx, I + 1 - Imgcy, Elev)
R = ASC(LEFT$(Rgba$(I, J + 1), 1)) G = ASC(MID$(Rgba$(I, J + 1), 2, 1)) B = ASC(RIGHT$(Rgba$(I, J + 1), 1)) Elev = Map(I, J + 1)
IF Elev < 0 THEN Elev = 0
RetVal = FN.Bcolor(R, G, B) RetVal = FN.Vertexf(J + 1 - Imgcx, I - Imgcy, Elev) NEXT J CALLDLL #LBOGL, "GLStop", RetVal AS VOID NEXT I
CALLDLL #LBOGL, "GLStopList", RetVal AS VOID
END FUNCTION '
|
|