Challenge:
Winner?:
No
Code Snippet:
Rem Project: 007Terrain Rem Created: 23/05/2006 01:02:57 Rem ***** Main Source File ***** rem ************************************************** Gosub INIT_VariablesAndDatastructures InitDisplay() CreateMain() CreateButtons() CreateBrushTexture() DefaultTerrain() create bitmap 1,128,128 rem ************************************************** rem ************************************************** rem ************************************************** do set current bitmap 0 rem ************************************************** rem Refresh main GUI to enable menu change rem ************************************************** paste image 1,0,0,1 rem ************************************************** rem Check for new action rem ************************************************** MseBtn = mouseclick() TSize# = ( FD(0).Segments * FD(0).SegSize ) / 2 BrushX = RoundOff( ( BD(0).Xpos + TSize# ) / FD(0).SegSize ) BrushZ = RoundOff( ( BD(0).Zpos + TSize# ) / FD(0).SegSize ) if mousex() >= 24 and mousex() <=1000 and mousey() >= 24 and mousey() <=640 rem Actions when mouse in viewport select OD(0).MainAction case 1 ZoomCamera() MoveCamera( MseBtn ) endcase case 2 ZoomCamera() if controlkey() MoveCamera( MseBtn ) else if ClickHeld = 0 or BrushMoved = 1 SetBaseHeights( MseBtn, BrushX, BrushZ ) ClickHeld = 1 endif AdjustTerrainData( MseBtn, BrushX, BrushZ ) endif if BD(0).Changed = 0 CreateBrushMesh() BD(0).Changed = 1 endif oldx# = BD(0).Xpos oldz# = BD(0).ZPos PositionBrush() MoldBrushToTerrain() if BD(0).Xpos <> oldx# or BD(0).ZPos <> oldz# BrushMoved = 1 else BrushMoved = 0 endif endcase case 3 ZoomCamera() if controlkey() MoveCamera( MseBtn ) else if MseBtn if ClickHeld = 0 or BrushMoved = 1 ApplyTexture( BrushX, BrushZ ) ClickHeld = 1 endif endif endif if BD(0).Changed = 0 CreateBrushMesh() BD(0).Changed = 1 endif PositionBrush() MoldBrushToTerrain() endcase endselect else rem Check for a menu button press if MseBtn Button = CheckMainButtons() if Button <> -1 Buttons(Button).State = 1 ClearButtonGroup( "MAIN", Button ) OD(0).Menu = Buttons(Button).Action OD(0).Group = Buttons(Button).Title else if OD(0).Menu <> -1 Button = CheckSubButtons( OD(0).Group ) if Button <> - 1 rem ************************************************** rem Instigate a repeat delay rem ************************************************** if OD(0).LastButton = Button if Button < 34 and Button > 36 Buttons(Button).State = 1 else if ClickHeld = 0 if Buttons(Button).State = 1 Buttons(Button).State = 0 else Buttons(Button).State = 1 endif ClickHeld = 1 endif endif OD(0).Action = Buttons(Button).Action if OD(0).RepeatCount = -1 OD(0).RepeatCount = 1 else inc OD(0).RepeatCount if OD(0).RepeatCount >= OD(0).RepeatDelay OD(0).RepeatCount = 0 OD(0).RepeatDelay = 0 endif endif else if OD(0).RepeatCount = -1 if Button < 34 and Button > 36 Buttons(Button).State = 1 else if ClickHeld = 0 if Buttons(Button).State = 1 Buttons(Button).State = 0 else Buttons(Button).State = 1 endif ClickHeld = 1 endif endif OD(0).Action = Buttons(Button).Action OD(0).LastButton = Button endif endif endif endif endif else OD(0).Action = -1 OD(0).RepeatCount = -1 OD(0).LastButton = -1 OD(0).RepeatDelay = 5 endif endif if not MseBtn ClickHeld = 0 null = mousemovex() null = mousemovey() null = mousemovez() endif rem ************************************************** rem Display menu's and buttons in current state rem ************************************************** ShowButtons( "MAIN" ) if OD(0).Menu <> -1 DisplaySubMenu() endif rem ************************************************** rem Show brush co-ordinates and range rem ************************************************** BrushX$ = str$( BrushX ): if BD(0).Width > 1 then BrushX$ = BrushX$ + " - " + str$( BrushX + BD(0).Width - 1 ) BrushZ$ = str$( BrushZ ): if BD(0).Length > 1 then BrushZ$ = BrushZ$ + " - " + str$( BrushZ + BD(0).Length - 1 ) set text size 16 center text 64,700,"Brush X": center text 64,720,BrushX$ center text 128,700,"Brush Z": center text 128,720,BrushZ$ rem ************************************************** rem Perform current action if any rem ************************************************** if OD(0).Action <> -1 PerformCurrentAction() endif rem ************************************************** rem ************************************************** sync loop rem ************************************************** rem ************************************************** rem ************************************************** function SetBaseHeights( MseBtn, BrushX, BrushZ ) rem If base mode is absolute, find the base in the brush area if BD(0).MBBase <> 1 BaseSet = 0 for z = 0 to BD(0).Width-1 for x = 0 to BD(0).Length - 1 if BrushX + x > 0 and BrushX + x < FD(0).Segments and BrushZ + z > 0 and BrushZ + z < FD(0).Segments if BaseSet = 0 Base# = VertexData( BrushX + x, BrushZ + z ).Height BaseSet = 1 endif rem Are we raising or lowering the terrain if MseBtn = 1 rem Raising, so find lowest height in brush area if VertexData( BrushX + x, BrushZ + z ).Height < Base# Base# = VertexData( BrushX + x, BrushZ + z ).Height endif else rem Lowering, so find highest height in brush area if VertexData( BrushX + x, BrushZ + z ).Height > Base# Base# = VertexData( BrushX + z, BrushZ + z ).Height endif endif endif next x next z endif rem Set the base height and reset the increase on vertices in brush area for z = 0 to BD(0).Width-1 for x = 0 to BD(0).Length - 1 if BrushX + x >= 0 and BrushX + x <= FD(0).Segments and BrushZ + z >= 0 and BrushZ + z <= FD(0).Segments if BD(0).MBBase = 1 VertexData( BrushX + x, BrushZ + z ).HtBase = VertexData( BrushX + x, BrushZ + z ).Height else VertexData( BrushX + x, BrushZ + z ).HtBase = Base# endif VertexData( BrushX + x, BrushZ + z ).HtInc = 0 endif next x next z endfunction function SmoothRough( MseBtn, BrushX, BrushZ ) cx# = ( BD(0).Width - 1 ) / 2 cz# = ( BD(0).Length - 1 ) / 2 for z = 0 to BD(0).Length-1 for x = 0 to BD(0).Width-1 if BrushX + x >0 and BrushX + x < FD(0).Segments and BrushZ + z >0 and BrushZ + z < FD(0).Segments dx# = x - cx# dz# = z - cz# pd# = ( (dx#^2)/(cx#^2) ) + ( (dz#^2)/(cz#^2) ) if BD(0).MBShape = 3 Rad# = 1 else Rad# = 2 endif if pd# <= Rad# h1# = VertexData( BrushX + x, BrushZ + z ).Height if MseBtn = 1 h2# = VertexData( BrushX + x + 1, BrushZ + z ).Height h3# = VertexData( BrushX + x, BrushZ + z + 1 ).Height h4# = VertexData( BrushX + x - 1, BrushZ + z + 1 ).Height h5# = VertexData( BrushX + x - 1, BrushZ + z ).Height h6# = VertexData( BrushX + x, BrushZ + z - 1 ).Height h7# = VertexData( BrushX + x + 1, BrushZ + z - 1 ).Height AvgHt# = (h2#+h3#+h4#+h5#+h6#+h7#)/6 HtDif# = h1# - AvgHt# NewHt# = h1# - ( HtDif# / BD(0).Magnitude ) else RndHt# = rnd( BD(0).Magnitude * 2 ) - BD(0).Magnitude NewHt# = h1# + ( RndHt# / 10 ) endif VertexData( BrushX + x, BrushZ + z ).Height = NewHt# endif endif next x next z endfunction function RaiseLower( MseBtn, BrushX, BrushZ ) cx# = ( BD(0).Width - 1 ) / 2 cz# = ( BD(0).Length - 1 ) / 2 for z = 0 to BD(0).Length-1 for x = 0 to BD(0).Width-1 if BrushX + x >=0 and BrushX + x <= FD(0).Segments and BrushZ + z >=0 and BrushZ + z <= FD(0).Segments dx# = x - cx# dz# = z - cz# pd# = ( (dx#^2)/(cx#^2) ) + ( (dz#^2)/(cz#^2) ) if BD(0).MBShape = 3 Rad# = 1 else Rad# = 2 endif Adjust# = BD(0).Magnitude if BD(0).MBOperation = 4 Adjust# = Adjust# / ( (pd#+.5)^2 ) endif if BD(0).MBOperation = 3 ang# = (pd# / Rad#) * 180 if ang# < 0 then ang# = 0 if ang# > 180 then ang# = 180 Adjust# = Adjust# + ( Adjust# * sin( ang# + 90 ) ) endif if MseBtn = 2 then Adjust# = Adjust# * -1 Adjust# = Adjust# / 10.0 inc VertexData( BrushX + x, BrushZ + z ).HtInc, Adjust# Base# = VertexData( BrushX + x, BrushZ + z ).HtBase Increase# = VertexData( BrushX + x, BrushZ + z ).HtInc if BD(0).MBBase = 1 if pd# <= Rad# then VertexData( BrushX + x, BrushZ + z ).Height = Base# + Increase# else if MseBtn = 1 if Base# + Increase# > VertexData( BrushX + x, BrushZ + z ).Height if VertexData( BrushX + x, BrushZ + z ).Height < Base# if pd# <= Rad# then inc VertexData( BrushX + x, BrushZ + z ).Height, Increase# dec VertexData( BrushX + x, BrushZ + z ).HtInc, Adjust# else if pd# <= Rad# then VertexData( BrushX + x, BrushZ + z ).Height = Base# + Increase# endif endif else if Base# + Increase# < VertexData( BrushX + x, BrushZ + z ).Height if VertexData( BrushX + x, BrushZ + z ).Height > Base# if pd# <= Rad# then inc VertexData( BrushX + x, BrushZ + z ).Height, Increase# dec VertexData( BrushX + x, BrushZ + z ).HtInc, Adjust# else if pd# <= Rad# then VertexData( BrushX + x, BrushZ + z ).Height = Base# + Increase# endif endif endif endif endif next x next z endfunction function CalculateNormals( BrushX, BrushZ ) rem ******************************************************************** rem Initialise vectors rem ******************************************************************** Prime = 1 Vert2 = 2 Vert3 = 3 FaceNormal = 4 FinalNormal = 5 null = make vector3( Prime ) null = make vector3( Vert2 ) null = make vector3( Vert3 ) null = make vector3( FaceNormal ) null = make vector3( FinalNormal ) rem ******************************************************************** rem Loop through all vertices in brush area rem ******************************************************************** for z = 0 to BD(0).Length-1 for x = 0 to BD(0).Width-1 if BrushX + x >=0 and BrushX + x + 1 <= FD(0).Segments and BrushZ + z >=0 and BrushZ + z + 1 <= FD(0).Segments rem ******************************************************************** rem Calc normal for first triangle rem ******************************************************************** lft# = ( BrushX + x ) * FD(0).SegSize rgt# = ( BrushX + x + 1 ) * FD(0).SegSize btm# = ( BrushZ + z ) * FD(0).SegSize top# = ( BrushZ + z + 1 ) * FD(0).SegSize set vector3 Prime, lft#, VertexData( BrushX + x, BrushZ + z ).Height, btm# set vector3 Vert2, lft#, VertexData( BrushX + x, BrushZ + z + 1 ).Height, top# set vector3 Vert3, rgt#, VertexData( BrushX + x + 1, BrushZ + z ).Height, btm# subtract vector3 Vert2, Vert2, Prime subtract vector3 Vert3, Vert3, Prime cross product vector3 FaceNormal, Vert2, Vert3 add vector3 FinalNormal, FinalNormal, FaceNormal endif if BrushX + x -1 >=0 and BrushX + x <= FD(0).Segments and BrushZ + z >=0 and BrushZ + z + 1 <= FD(0).Segments rem ******************************************************************** rem Calc normal for second triangle rem ******************************************************************** lft# = ( BrushX + x - 1 ) * FD(0).SegSize rgt# = ( BrushX + x ) * FD(0).SegSize set vector3 Vert2, lft#, VertexData( BrushX + x - 1, BrushZ + z + 1 ).Height, top# set vector3 Vert3, rgt#, VertexData( BrushX + x, BrushZ + z + 1 ).Height, top# subtract vector3 Vert2, Vert2, Prime subtract vector3 Vert3, Vert3, Prime cross product vector3 FaceNormal, Vert2, Vert3 add vector3 FinalNormal, FinalNormal, FaceNormal rem ******************************************************************** rem Calc normal for third triangle rem ******************************************************************** set vector3 Vert2, lft#, VertexData( BrushX + x - 1, BrushZ + z ).Height, btm# set vector3 Vert3, lft#, VertexData( BrushX + x - 1, BrushZ + z + 1 ).Height, top# subtract vector3 Vert2, Vert2, Prime subtract vector3 Vert3, Vert3, Prime cross product vector3 FaceNormal, Vert2, Vert3 add vector3 FinalNormal, FinalNormal, FaceNormal endif if BrushX + x -1 >=0 and BrushX + x <= FD(0).Segments and BrushZ + z -1 >=0 and BrushZ + z <= FD(0).Segments rem ******************************************************************** rem Calc normal for fourth triangle rem ******************************************************************** btm# = ( BrushZ + z - 1 ) * FD(0).SegSize top# = ( BrushZ + z ) * FD(0).SegSize set vector3 Vert2, rgt#, VertexData( BrushX + x, BrushZ + z -1 ).Height, btm# set vector3 Vert3, lft#, VertexData( BrushX + x - 1, BrushZ + z ).Height, top# subtract vector3 Vert2, Vert2, Prime subtract vector3 Vert3, Vert3, Prime cross product vector3 FaceNormal, Vert2, Vert3 add vector3 FinalNormal, FinalNormal, FaceNormal endif if BrushX + x >=0 and BrushX + x + 1 <= FD(0).Segments and BrushZ + z -1 >=0 and BrushZ + z <= FD(0).Segments rem ******************************************************************** rem Calc normal for fifth triangle rem ******************************************************************** lft# = ( BrushX + x ) * FD(0).SegSize rgt# = ( BrushX + x + 1 ) * FD(0).SegSize btm# = ( BrushZ + z - 1 ) * FD(0).SegSize top# = ( BrushZ + z ) * FD(0).SegSize set vector3 Vert2, rgt#, VertexData( BrushX + x + 1, BrushZ + z - 1 ).Height, btm# set vector3 Vert3, lft#, VertexData( BrushX + x, BrushZ + z - 1 ).Height, btm# subtract vector3 Vert2, Vert2, Prime subtract vector3 Vert3, Vert3, Prime cross product vector3 FaceNormal, Vert2, Vert3 add vector3 FinalNormal, FinalNormal, FaceNormal rem ******************************************************************** rem Calc normal for sixth triangle rem ******************************************************************** set vector3 Vert2, rgt#, VertexData( BrushX + x + 1, BrushZ + z ).Height, top# set vector3 Vert3, rgt#, VertexData( BrushX + x + 1, BrushZ + z - 1 ).Height, btm# subtract vector3 Vert2, Vert2, Prime subtract vector3 Vert3, Vert3, Prime cross product vector3 FaceNormal, Vert2, Vert3 add vector3 FinalNormal, FinalNormal, FaceNormal endif if BrushX + x >=0 and BrushX + x <= FD(0).Segments and BrushZ + z >=0 and BrushZ + z <= FD(0).Segments rem ******************************************************************** rem Normalise the result rem ******************************************************************** normalize vector3 FinalNormal, FinalNormal VertexData( BrushX + x, BrushZ + z ).NormX = x vector3( FinalNormal ) VertexData( BrushX + x, BrushZ + z ).NormY = y vector3( FinalNormal ) VertexData( BrushX + x, BrushZ + z ).NormZ = z vector3( FinalNormal ) endif next x next z endfunction function AdjustTerrainData( MseBtn, BrushX, BrushZ ) if MseBtn rem Pre - adjust the height of a vertex in the height array rem according to current brush settings select BD(0).MBOperation case 1 RaiseLower( MseBtn, BrushX, BrushZ ) CalculateNormals( BrushX, BrushZ ) ApplyBrushToTerrain( BrushX, BrushZ ) endcase case 2 SmoothRough( MseBtn, BrushX, BrushZ ) CalculateNormals( BrushX, BrushZ ) ApplyBrushToTerrain( BrushX, BrushZ ) endcase case 3 RaiseLower( MseBtn, BrushX, BrushZ ) CalculateNormals( BrushX, BrushZ ) ApplyBrushToTerrain( BrushX, BrushZ ) endcase case 4 RaiseLower( MseBtn, BrushX, BrushZ ) CalculateNormals( BrushX, BrushZ ) ApplyBrushToTerrain( BrushX, BrushZ ) endcase endselect endif endfunction function ApplyBrushToTerrain( BrushX, BrushZ ) TSize# = ( FD(0).Segments * FD(0).SegSize ) / 2 TWidth_Offset = ( FD(0).Segments * 6 ) lock vertexdata for limb 1,0,1 for z = 0 to BD(0).Length-1 for x = 0 to BD(0).Width-1 vert_x = BrushX + x vert_z = BrushZ + z if vert_x >= 0 and vert_x <= FD(0).Segments and vert_z >=0 and vert_z <= FD(0).Segments rem 1st vertex prime_index = ( vert_x * 6 ) + ( vert_z * TWidth_Offset ) if vert_x < FD(0).Segments and vert_z < FD(0).Segments UpdateVertex( prime_index, vert_x, vert_z ) endif if vert_x > 0 and vert_z < FD(0).Segments rem 2nd vertex vert_index = prime_index - 1 if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z ) rem 3rd vertex vert_index = prime_index - 4 if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z ) endif if vert_z > 0 if vert_x > 0 rem 4th vertex vert_index = prime_index - ( TWidth_Offset + 2 ) if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z ) endif if vert_x < FD(0).Segments rem 5th vertex vert_index = prime_index - ( TWidth_Offset - 1 ) if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z ) rem 6th vertex vert_index = prime_index - ( TWidth_Offset - 3 ) if vert_index >=0 then UpdateVertex( vert_index, vert_x, vert_z ) endif endif endif next x next z unlock vertexdata endfunction function ChangeVertexHeight( vert_index, NewHeight# ) vx# = get vertexdata position x( vert_index ) vy# = get vertexdata position y( vert_index ) vz# = get vertexdata position z( vert_index ) set vertexdata position vert_index, vx#, NewHeight#, vz# endfunction function UpdateVertex( vert_index, vert_x, vert_z ) vx# = get vertexdata position x( vert_index ) vy# = get vertexdata position y( vert_index ) vz# = get vertexdata position z( vert_index ) set vertexdata position vert_index, vx#, VertexData( vert_x, vert_z ).Height, vz# nx# = VertexData( vert_x, vert_z ).NormX ny# = VertexData( vert_x, vert_z ).NormY nz# = VertexData( vert_x, vert_z ).NormZ set vertexdata normals vert_index, nx#, ny#, nz# endfunction function CircleFill( cx,cy,rad ) radsq = rad^2 for x = 0 to rad y = sqrt( radsq - ( x^2 ) ) line cx+x, cy+y, cx+x, cy-1-y line cx-1-x, cy+y, cx-1-x, cy-1-y next x endfunction function IsEven( CheckNum# ) if CheckNum# / 2 = Int(CheckNum# / 2) Result = 1 else Result = 0 endif endfunction Result function PositionBrush() CamXpos# = camera position x() CamYpos# = camera position y() CamZpos# = camera position z() CamXang# = camera angle x() roughd# = CamYpos# pick screen mousex(), mousey(), roughd# bx# = get pick vector x() by# = get pick vector y() bz# = get pick vector z() Factor# = -( CamYpos# / by# ) bx#=bx#*Factor# by#=by#*Factor# bz#=bz#*Factor# off# = FD(0).SegSize / -2 boffx# = (BD(0).Width - 1) * off# boffz# = (BD(0).Length - 1) * off# if OD(0).MainAction = 3 boffx# = boffx# + off# boffz# = boffz# + off# off#=0 endif BD(0).Xpos = RoundOff( (CamXpos# + bx# + boffx# ) / FD(0).SegSize ) * FD(0).SegSize + off# BD(0).Zpos = RoundOff( (CamZpos# + bz# + boffz# ) / FD(0).SegSize ) * FD(0).SegSize + off# BD(0).YPos = 0.1: rem CamYpos# + by# position object 2, BD(0).Xpos, BD(0).YPos, BD(0).Zpos endfunction function RoundOff( Value# ) IntPart = floor(Value#) Decimal# = Value# - IntPart if Decimal# >= 0.5 Result = ceil(Value#) else Result = floor(Value#) endif endfunction Result function MoveCamera( MoveType ) Xpos# = camera position x() Ypos# = camera position y() Zpos# = camera position z() Xang# = camera angle x() Yang# = camera angle y() Zang# = camera angle z() XSpeed# = mousemovex() ZSpeed# = mousemovey() SpeedScale# = ( Ypos# / 100 ) if SpeedScale# > 1.0 then SpeedScale# = 1.0 if SpeedScale# < 0.05 then SpeedScale# = 0.05 select MoveType case 1 XSpeed# = XSpeed# * SpeedScale# ZSpeed# = ZSpeed# * SpeedScale# Xpos# = newxvalue( Xpos#, Yang#, ZSpeed# ) Zpos# = newzvalue( Zpos#, Yang#, ZSpeed# ) Xpos# = newxvalue( Xpos#, wrapvalue( Yang# + 90 ), -XSpeed# ) Zpos# = newzvalue( Zpos#, wrapvalue( Yang# + 90 ), -XSpeed# ) endcase case 2 inc YAng#, XSpeed# inc Xang#, ZSpeed# rem if wrapvalue(XAng#) >85 then XAng# = 85 rem if wrapvalue(XAng#) <10 then XAng# = 10 endcase endselect position camera Xpos#, Ypos#, Zpos# rotate camera XAng#, YAng#, ZAng# endfunction function ZoomCamera() Xpos# = camera position x() Ypos# = camera position y() Zpos# = camera position z() YSpeed# = mousemovez() / - 10.0 rem Also need zoom keys in case there is no mouse wheel if YSpeed# = 0 YSpeed# = ( keystate(31) - keystate(17) ) endif SpeedScale# = ( Ypos# / 100 ) if SpeedScale# > 1.0 then SpeedScale# = 1.0 if SpeedScale# < 0.05 then SpeedScale# = 0.05 if YSpeed# <0 then YSpeed# = YSpeed# * SpeedScale# Ypos# = Ypos# + YSpeed# position camera Xpos#, Ypos#, Zpos# endfunction function DefaultTerrain() FD(0).Name = "Default" FD(0).Segments = 50 FD(0).SegSize = 10 FD(0).Saved = 0 CreateTerrain() BD(0).Width = 1 BD(0).Length = 1 BD(0).Magnitude = 1 OD(0).Menu = 4 OD(0).MainAction = 1 endfunction function MoldBrushToTerrain() BWidth_Offset = ( BD(0).Width * 12 ) TSize# = ( FD(0).Segments * FD(0).SegSize ) / 2 BSegSize# = FD(0).SegSize / 2 BrushX = RoundOff( ( BD(0).Xpos + TSize# ) / FD(0).SegSize ) BrushZ = RoundOff( ( BD(0).Zpos + TSize# ) / FD(0).SegSize ) BSegX# = BD(0).Width * 2 BSegZ# = BD(0).Length * 2 BSizeX# = BD(0).Width * FD(0).SegSize BSizeZ# = BD(0).Length * FD(0).SegSize lock vertexdata for limb 2,0,1 for z = 0 to BSegZ#-1 for x = 0 to BSegX#-1 Brush_Vx# = BD(0).Xpos + ( x * BSegSize# ) Brush_Vz# = BD(0).Zpos + ( z * BSegSize# ) rem **************************************************** rem Calculate heights rem **************************************************** if Brush_Vx# >= -TSize# and Brush_Vx# < TSize# and Brush_Vz# >= -TSize# and Brush_Vz# < TSize# Hx = BrushX + floor( x/2 ) Hz = BrushZ + floor( z/2 ) if OD(0).MainAction = 2 MoldPaint = 0 else MoldPaint = 1 endif if Hx > 0 lftht# = VertexData( Hx-1 + MoldPaint, Hz ).Height else lftht# = 0 endif if Hx < FD(0).Segments rgtht# = VertexData( Hx+1, Hz ).Height else rgtht# = 0 endif if Hz < FD(0).Segments topht# = VertexData( Hx, Hz+1 ).Height else topht# = 0 endif if Hz > 0 btmht# = VertexData( Hx, Hz-1 + MoldPaint ).Height else btmht# = 0 endif if Hx < FD(0).Segments and Hz > 0 btmrgtht# = VertexData( Hx+1, Hz-1 + MoldPaint ).Height else btmrgtht# = 0 endif if Hx > 0 and Hz < FD(0).Segments toplftht# = VertexData( Hx-1 + MoldPaint, Hz+1 ).Height else toplftht# = 0 endif if IsEven(x+1)=1 and IsEven(z+1)=1 Height1# = VertexData( Hx, Hz ).Height Height2# = ( VertexData( Hx, Hz ).Height + topht# ) / 2 Height3# = ( VertexData( Hx, Hz ).Height + rgtht# ) / 2 Height4# = ( topht# + rgtht# ) / 2 endif if IsEven(x+1)=1 and IsEven(z+1)=0 Height1# = ( VertexData( Hx, Hz ).Height + btmht# ) / 2 Height2# = VertexData( Hx, Hz ).Height Height3# = ( VertexData( Hx, Hz ).Height + btmrgtht# ) / 2 Height4# = ( VertexData( Hx, Hz ).Height + rgtht# ) / 2 endif if IsEven(x+1)=0 and IsEven(z+1)=1 Height1# = ( lftht# + VertexData( Hx, Hz ).Height ) / 2 Height2# = ( toplftht# + VertexData( Hx, Hz ).Height ) / 2 Height3# = VertexData( Hx, Hz ).Height Height4# = ( VertexData( Hx, Hz ).Height + topht# ) / 2 endif if IsEven(x+1)=0 and IsEven(z+1)=0 Height1# = ( lftht# + btmht# ) / 2 Height2# = ( lftht# + VertexData( Hx, Hz ).Height ) / 2 Height3# = ( VertexData( Hx, Hz ).Height + btmht# ) / 2 Height4# = VertexData( Hx, Hz ).Height endif else Height1# = 0 Height2# = 0 Height3# = 0 Height4# = 0 endif rem **************************************************** rem Set heights rem **************************************************** rem 1st vertex prime_index = ( x * 6 ) + ( z * BWidth_Offset ) ChangeVertexHeight( prime_index, Height1# ) rem 2nd vertex vert_index = prime_index + 1 ChangeVertexHeight( vert_index, Height2# ) rem 3rd vertex vert_index = prime_index + 2 ChangeVertexHeight( vert_index, Height3# ) rem 4th vertex vert_index = prime_index + 3 ChangeVertexHeight( vert_index, Height2# ) rem 5th vertex vert_index = prime_index + 4 ChangeVertexHeight( vert_index, Height4# ) rem 6th vertex vert_index = prime_index + 5 ChangeVertexHeight( vert_index, Height3# ) next x next z unlock vertexdata endfunction function CreateBrushMesh() BSegSize# = FD(0).SegSize / 2 BSegX# = BD(0).Width * 2 BSegZ# = BD(0).Length * 2 Memblock=1 VertexCount = BSegX# * BSegZ# * 6 make memblock Memblock, ( VertexCount * 36 ) + 12 write memblock dword Memblock, 0, 338 write memblock dword Memblock, 4, 36 write memblock dword Memblock, 8, VertexCount PTR=12 for z = 0 to BSegZ# - 1 for x = 0 to BSegX# - 1 lft# = x*BSegSize# rgt# = (x+1)*BSegSize# btm# = z*BSegSize# top# = (z+1)*BSegSize# lftU# = x / BSegX# rgtU# = (x+1) / BSegX# btmV# = z / BSegZ# topV# = (z+1) / BSegZ# col = rgb(255,255,255) rem First triangle PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, btm#, 0, 1, 0, col, lftU#, btmV# ) PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# ) PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# ) rem Second Triangle PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# ) PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, top#, 0, 1, 0, col, rgtU#, topV# ) PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# ) next x next z make mesh from memblock 1, 1 delete memblock 1 if object exist(2) change mesh 2, 0, 1 else make object 2, 1, 0 endif delete mesh 1 texture object 2,BD(0).MBShape ghost object on 2 fade object 2, 75 endfunction function CreateBrushTexture() create bitmap 2,256,256 ink rgb(200,200,255),rgb(200,200,255) box 0,0,256,256 get image 2,0,0,256,256,1 cls 0 CircleFill( 128,128,127 ) get image 3,0,0,256,256,1 endfunction function CreateTerrain() undim VertexData(0) dim VertexData( FD(0).Segments, FD(0).Segments ) as Vertex dim Tiles( FD(0).Segments - 1, FD(0).Segments - 1 ) TSize = FD(0).Segments * FD(0).SegSize offset# = TSize / -2 if object exist(1) then delete object 1 CreateMeshFromHeights( 0, 0, FD(0).Segments, FD(0).Segments, FD(0).SegSize ) make object 1, 1, 0 delete mesh 1 set object wireframe 1,1 set object cull 1,1 position object 1, offset#,0,offset# position camera 0,100,0 xrotate camera 10 endfunction function WriteVertexToMemblock( Memblock, PTR, X#, Y#, Z#, NX#, NY#, NZ#, COL, U#, V# ) Rem Vertex Xpos write memblock float Memblock, PTR, X# inc PTR,4 Rem Vertex Ypos write memblock float Memblock, PTR, Y# inc PTR,4 Rem Vertex Zpos write memblock float Memblock, PTR, Z# inc PTR,4 rem Vertex Normal X write memblock float Memblock, PTR, NX# inc PTR,4 rem Vertex Normal Y write memblock float Memblock, PTR, NY# inc PTR,4 rem Vertex Normal Z write memblock float Memblock, PTR, NZ# inc PTR,4 rem Vertex Colour write memblock dword Memblock, PTR, COL inc PTR,4 rem Vertex Texture U Co-ord write memblock float Memblock, PTR, U# inc PTR,4 rem Vertex Texture V Co-ord write memblock float Memblock, PTR, V# inc PTR,4 endfunction PTR function CreateMeshFromHeights( StartX, StartZ, SegX#, SegZ#, SegSize ) Memblock=1 VertexCount = ( SegX# * SegZ# )*6 make memblock Memblock, (VertexCount * 36) + 12 write memblock dword Memblock, 0, 338 write memblock dword Memblock, 4, 36 write memblock dword Memblock, 8, VertexCount PTR=12 for z = 0 to SegZ#-1 for x = 0 to SegX#-1 lft# = x*SegSize rgt# = (x+1)*SegSize btm# = z*SegSize top# = (z+1)*SegSize lftU# = x / SegX# rgtU# = (x+1) / SegX# btmV# = z / SegZ# topV# = (z+1) / SegZ# col = rgb(255,255,255) rem First triangle PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, btm#, 0, 1, 0, col, lftU#, btmV# ) PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# ) PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# ) rem Second Triangle PTR = WriteVertexToMemblock( Memblock, PTR, lft#, 0, top#, 0, 1, 0, col, lftU#, topV# ) PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, top#, 0, 1, 0, col, rgtU#, topV# ) PTR = WriteVertexToMemblock( Memblock, PTR, rgt#, 0, btm#, 0, 1, 0, col, rgtU#, btmV# ) next x next z make mesh from memblock 1, 1 delete memblock 1 endfunction function CreateButtons() sync restore ButtonData for l = 0 to ButtonCount(0) read Buttons( l ).Group read Buttons( l ).SubGroup read Buttons( l ).Title read Buttons( l ).Action read Buttons( l ).Xpos read Buttons( l ).Ypos read Buttons( l ).Width read Buttons( l ).Height Buttons( l ).State = -1 if bitmap exist(2) = 1 delete bitmap 2 endif create bitmap 2, Buttons( l ).Width, Buttons( l ).Height Buttons( l ).UpImage = CreateButton( l, (l*2)+4, 0, rgb( 100,50,50), rgb(255,255,0) ) Buttons( l ).DnImage = CreateButton( l, (l*2)+5, 1, rgb( 100,50,50), rgb(255,255,0) ) delete bitmap 2 next l endfunction function CreateButton( BI, ImageNum, State, BackColour, TextColour ) cls BackColour set text font "Arial" set text to bold set text size 14 x = ( Buttons( BI ).Width / 2 ) y = ( Buttons( BI ).Height / 2 ) - 7 Width = Buttons( BI ).Width Height = Buttons( BI ).Height ink 0,0 center text x, y, Buttons( BI ).Title blur bitmap 2,6 if state = 0 ink rgb(255,255,255),0 else ink 0,0 endif line 1,1,1,Height-1 line 1,1,Width-1,1 if state = 0 ink 0,0 else ink rgb(255,255,255),0 endif line Width-3,Height-3,Width-3,1 line Width-3,Height-3,1,Height-3 ink rgb(1,1,1),0 center text x, y, Buttons( BI ).Title blur bitmap 2,6 line 0,0,Width,0 line 0,0,0,Height line 0,Height,Width,Height line Width,Height,Width,0 ink TextColour,0 center text x, y, Buttons( BI ).Title get image ImageNum, 0, 0, Width, Height endfunction ImageNum function CheckMainButtons() ButtonPressed = -1 for l = 0 to 2 xmin = Buttons( l ).Xpos ymin = Buttons( l ).Ypos xmax = xmin + Buttons( l ).Width ymax = ymin + Buttons( l ).Height if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax ButtonPressed = l endif next l endfunction ButtonPressed function CheckSubButtons( Group$ ) ButtonPressed = -1 for l = 3 to ButtonCount(0) if Buttons(l).Group = Group$ xmin = Buttons( l ).Xpos ymin = Buttons( l ).Ypos xmax = xmin + Buttons( l ).Width ymax = ymin + Buttons( l ).Height if mousex() >= xmin and mousex() <= xmax and mousey() >= ymin and mousey() <= ymax ButtonPressed = l endif endif next l endfunction ButtonPressed function ClearButtonGroup( Group$, Selected ) for l = 0 to ButtonCount(0) if Buttons(l).Group = Group$ if l <> Selected then Buttons(l).State = -1 endif next l endfunction function ClearButtonSubGroup( SubGroup$, Selected ) for l = 0 to ButtonCount(0) if Buttons(l).SubGroup = SubGroup$ if l <> Selected then Buttons(l).State = -1 endif next l endfunction function ShowButtons( Group$ ) set current bitmap 0 for l = 0 to ButtonCount(0) if Buttons( l ).Group = Group$ if Buttons( l ).State = 1 img = Buttons( l ).DnImage else img = Buttons( l ).UpImage endif paste image img, Buttons( l ).Xpos, Buttons( l ).Ypos endif next l endfunction function InitDisplay() set display mode 1024,768,32 autocam off sync on sync rate 0 set camera view 24,24,1000,640 set ambient light 15 fog on fog color 100,100,200 fog distance 2000 backdrop on color backdrop rgb(100,100,125) position light 0,0,1000,0 set ambient light 0 endfunction function CreateMain() create bitmap 1,1024,768 cls rgb(100,100,100) ink rgb(1,1,1),0 box 3,3,1021,765 ink rgb(100,150,100),0 box 4,4,1020,764 rem Viewport ink rgb(1,1,1),0 box 22,22,1002,642 ink 0,0 box 24,24,1000,640 rem sub action panel ink rgb(1,1,1),0 box 254,654,1002,746 ink rgb(90,110,90),0 box 256,656,1000,744 get image 1,0,0,1024,768 delete bitmap 1 endfunction function SetDefaultBrush() if Buttons(12).State <> 1 and Buttons(13).State <>1 Buttons(13).State = 1 FD(0).Wireframe = 1 set object wireframe 1, FD(0).Wireframe endif if Buttons(14).State <> 1 and Buttons(15).State <>1 Buttons(14).State = 1 BD(0).MBShape = 2 endif if Buttons(16).State <> 1 and Buttons(17).State <>1 Buttons(16).State = 1 BD(0).MBBase = 1 endif if Buttons(18).State <> 1 and Buttons(19).State <>1 Buttons(18).State = 1 BD(0).MBIncType = 1 endif if Buttons(20).State <> 1 and Buttons(21).State <>1 and Buttons(22).State <>1 and Buttons(23).State <>1 Buttons(20).State = 1 BD(0).MBOperation = 1 endif if BD(0).Texture < 1 then BD(0).Texture = 1 endfunction function DisplaySubMenu() select OD(0).Menu rem File Menu case 1 if object exist(2) then delete object 2 ink rgb(10,40,10),0 set text size 14 text 270,666, "Filename" text 340,666, ": " + FD(0).Name text 270,692, "Segments" text 340,692, ": " + str$( FD(0).Segments ) text 270,718, "Seg Size" text 340,718, ": " + str$( FD(0).SegSize ) endcase rem Mold Menu