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(rnd(100)+50,rnd(100)+150,0) 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,1000 set ambient light 50 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 case 2 ink rgb(10,40,10),0 set text size 14 text 270,666, "Brush Width" text 360,666, ": " + str$( BD(0).Width ) text 270,693, "Brush Length" text 360,693, ": " + str$( BD(0).Length ) text 270,720, "Magnitude" text 360,720, ": " + str$( BD(0).Magnitude ) endcase rem Paint Menu case 3 if OD(0).MainAction <>3 SetDefaultBrush() OD(0).MainAction = 3 CreateTexture() endif ink rgb(10,40,10),0 set text size 14 text 270,666, "Brush Width" text 360,666, ": " + str$( BD(0).Width ) text 270,693, "Brush Length" text 360,693, ": " + str$( BD(0).Length ) text 270,720, "Texture" text 360,720, ": " + str$( BD(0).Texture ) Tnum = BD(0).Texture - 1 set text size 12 ink rgb(10,40,10),0 text 470,666, "BG:" ink rgb(255,100,50),0:center text 510,666,str$(Textures(Tnum).BackColourR) ink rgb(50,200,50),0:center text 540,666,str$(Textures(Tnum).BackColourG) ink rgb(100,150,255),0:center text 570,666,str$(Textures(Tnum).BackColourB) Col = rgb(Textures(Tnum).BackColourR,Textures(Tnum).BackColourG,Textures(Tnum).BackColourB) ink 0,0 box 592,661,612,683 ink Col,0 box 594,663,610,681 ink rgb(10,40,10),0 text 470,694, "D1:" ink rgb(255,100,50),0:center text 510,694,str$(Textures(Tnum).Dot1ColourR) ink rgb(50,200,50),0:center text 540,694,str$(Textures(Tnum).Dot1ColourG) ink rgb(100,150,255),0:center text 570,694,str$(Textures(Tnum).Dot1ColourB) Col = rgb(Textures(Tnum).Dot1ColourR,Textures(Tnum).Dot1ColourG,Textures(Tnum).Dot1ColourB) ink 0,0 box 592,689,612,711 ink Col,0 box 594,691,610,709 ink rgb(10,40,10),0 text 470,722, "D2:" ink rgb(255,100,50),0:center text 510,722,str$(Textures(Tnum).Dot2ColourR) ink rgb(50,200,50),0:center text 540,722,str$(Textures(Tnum).Dot2ColourG) ink rgb(100,150,255),0:center text 570,722,str$(Textures(Tnum).Dot2ColourB) Col = rgb(Textures(Tnum).Dot2ColourR,Textures(Tnum).Dot2ColourG,Textures(Tnum).Dot2ColourB) ink 0,0 box 592,717,612,739 ink Col,0 box 594,719,610,737 ink rgb(10,40,10),0 text 750,694, "Count:" text 785,694,str$(Textures(Tnum).Dot1Count) text 750,720, "Count:" text 785,720,str$(Textures(Tnum).Dot2Count) ink 0,0 box 914,666,982,734 Inum = BD(0).Texture + 99 if not image exist(Inum) then CreateTexture() set current bitmap 1 paste image Inum, 0,0 copy bitmap 1,0,0,128,128,0,916,668,980,732 endcase case 4 ink rgb(10,40,10),0 set text size 12 text 270,660, "Welcome to the 007 Terrain Editor by McLaine." text 270,676, "In 'FILE' mode, move and turn by clicking and dragging in the viewport. 'W' & 'S' or mousewheel to zoom." text 270,692, "In 'MOLD' mode, Left Click in viewport to raise ground. Right Click to lower ground." text 270,708, "In 'MOLD'or 'PAINT' mode, hold control to allow camera movement as in 'FILE' mode." text 270,724, "Use the 'SMOOTH' function with the right mouse button to add roughness." endcase endselect ShowButtons( OD(0).Group ) endfunction function PerformCurrentAction() select OD(0).Menu case 1 OD(0).MainAction = 1 BD(0).Changed = 0 FileAction() endcase case 2 if OD(0).MainAction <>2 SetDefaultBrush() OD(0).MainAction = 2 endif BD(0).Changed = 0 MoldAction() endcase case 3 BD(0).Changed = 0 PaintAction() endcase endselect endfunction function FileAction() if OD(0).RepeatCount <= 0 select OD(0).Action rem Load Terrain case 1 set cursor 550,666 input "Load file: ", fn$ endcase rem Save Terrain case 2 set cursor 550,666 input "Save as: ", fn$ endcase rem New Terrain case 3 set cursor 550,666 input "New filename: ", FD(0).Name set cursor 550,692 input "Segments: ", FD(0).Segments set cursor 550,718 input "Segment Size: ", FD(0).SegSize CreateTerrain() Buttons(13).State = 1 FD(0).Wireframe = 1 set object wireframe 1, FD(0).Wireframe endcase endselect endif ClearButtonGroup( "FILE", -1 ) OD(0).Action = -1 endfunction function MoldAction() if OD(0).Action >=1 and OD(0).Action <=6 if OD(0).RepeatCount <=0 ChangeBrushSize() BD(0).Changed = 0 endif ClearButtonSubGroup( "MBSIZE", -1 ) endif if OD(0).Action = 7 or OD(0).Action = 8 if OD(0).RepeatCount <=0 select OD(0).Action case 7 FD(0).Wireframe = 0 endcase case 8 FD(0).Wireframe = 1 endcase endselect endif set object wireframe 1, FD(0).Wireframe ClearButtonSubGroup( "TTYPE", OD(0).LastButton ) endif if OD(0).Action = 9 or OD(0).Action = 10 if OD(0).RepeatCount <=0 select OD(0).Action case 9 BD(0).MBShape = 2 endcase case 10 BD(0).MBShape = 3 endcase endselect texture object 2, BD(0).MBShape endif ClearButtonSubGroup( "MBSHAPE", OD(0).LastButton ) endif if OD(0).Action = 11 or OD(0).Action = 12 if OD(0).RepeatCount <=0 select OD(0).Action case 11 rem Brush adds to current terrain height BD(0).MBBase = 1 endcase case 12 rem Brush adds to an absolute base and only changes terrain rem if the new height exceeds the current terrain height rem in the relative direction BD(0).MBBase = 0 endcase endselect endif ClearButtonSubGroup( "MBBASE", OD(0).LastButton ) endif if OD(0).Action = 13 or OD(0).Action = 14 if OD(0).RepeatCount <=0 select OD(0).Action case 13 rem Brush adds a fixed constant value BD(0).MBIncType = 1 endcase case 14 rem Brush adds a random value based on magnitude BD(0).MBIncType = 0 endcase endselect endif ClearButtonSubGroup( "MBINC", OD(0).LastButton ) endif if OD(0).Action >= 15 and OD(0).Action <=18 if OD(0).RepeatCount <=0 select OD(0).Action case 15 rem set Plateau operation (Default) BD(0).MBOperation = 1 endcase case 16 rem set smoothing operation BD(0).MBOperation = 2 endcase case 17 rem set hill operation BD(0).MBOperation = 3 endcase case 18 rem set peak operation BD(0).MBOperation = 4 endcase endselect endif ClearButtonSubGroup( "MBOP", OD(0).LastButton ) endif OD(0).Action = -1 endfunction function PaintAction() if OD(0).Action >=1 and OD(0).Action <=6 if OD(0).RepeatCount <=0 ChangeBrushSize() endif ClearButtonSubGroup( "MBSIZE", -1 ) endif if OD(0).Action >=7 and OD(0).Action <=19 if OD(0).RepeatCount <=0 ChangeTextureSettings() endif ClearButtonSubGroup( "PBTSET", -1 ) endif if OD(0).Action = 20 if OD(0).RepeatCount <=0 CreateTexture() else OD(0).RepeatCount = 1 endif ClearButtonSubGroup( "PBFIX", -1 ) endif endfunction function ApplyTexture( BrushX, BrushZ ) Inum = BD(0).Texture + 99 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 - 1 and BrushZ + z >=0 and BrushZ + z <= FD(0).Segments - 1 Tiles( BrushX + x, BrushZ + z ) = Inum endif next x next z scale = 32 BSize = FD(0).Segments * scale if bitmap exist(2) then delete bitmap 2 create bitmap 2, BSize, BSize cls rgb(200,200,200) set current bitmap 1 for z = 0 to FD(0).Segments-1 for x = 0 to FD(0).Segments-1 Inum = Tiles( x, z ) if Inum >= 100 paste image Inum,0,0,0 l = (x * scale) t = (z * scale) r = (l + scale) b = (t + scale) copy bitmap 1,0,0,128,128,2,l,t,r,b endif next x next z create bitmap 3,512,512 copy bitmap 2,0,0,BSize,BSize,3,0,0,512,512 if image exist(99) then delete image 99 get image 99,0,0,512,512 delete bitmap 3 texture object 1,99 endfunction function CreateTexture() Tnum = BD(0).Texture - 1 Inum = BD(0).Texture + 99 set current bitmap 1 Col = rgb(Textures(Tnum).BackColourR, Textures(Tnum).BackColourG, Textures(Tnum).BackColourB) cls Col Col = rgb(Textures(Tnum).Dot1ColourR, Textures(Tnum).Dot1ColourG, Textures(Tnum).Dot1ColourB) ink Col,0 for l = 1 to Textures(Tnum).Dot1Count * 10 dot rnd(126)+1,rnd(126)+1 next l Col = rgb(Textures(Tnum).Dot2ColourR, Textures(Tnum).Dot2ColourG, Textures(Tnum).Dot2ColourB) ink Col,0 for l = 1 to Textures(Tnum).Dot2Count * 10 dot rnd(124)+2,rnd(124)+2 next l if image exist(Inum) then delete image Inum get image Inum,0,0,128,128 endfunction function ChangeTextureSettings() Tnum = BD(0).Texture - 1 select OD(0).Action case 7 if Buttons(34).State = 1 if Textures(Tnum).BackColourR > 0 then dec Textures(Tnum).BackColourR endif if Buttons(35).State = 1 if Textures(Tnum).BackColourG > 0 then dec Textures(Tnum).BackColourG endif if Buttons(36).State = 1 if Textures(Tnum).BackColourB > 0 then dec Textures(Tnum).BackColourB endif endcase case 8 if Buttons(34).State = 1 if Textures(Tnum).BackColourR < 255 then inc Textures(Tnum).BackColourR endif if Buttons(35).State = 1 if Textures(Tnum).BackColourG < 255 then inc Textures(Tnum).BackColourG endif if Buttons(36).State = 1 if Textures(Tnum).BackColourB < 255 then inc Textures(Tnum).BackColourB endif endcase case 9 if Buttons(34).State = 1 if Textures(Tnum).Dot1ColourR > 0 then dec Textures(Tnum).Dot1ColourR endif if Buttons(35).State = 1 if Textures(Tnum).Dot1ColourG > 0 then dec Textures(Tnum).Dot1ColourG endif if Buttons(36).State = 1 if Textures(Tnum).Dot1ColourB > 0 then dec Textures(Tnum).Dot1ColourB endif endcase case 10 if Buttons(34).State = 1 if Textures(Tnum).Dot1ColourR < 255 then inc Textures(Tnum).Dot1ColourR endif if Buttons(35).State = 1 if Textures(Tnum).Dot1ColourG < 255 then inc Textures(Tnum).Dot1ColourG endif if Buttons(36).State = 1 if Textures(Tnum).Dot1ColourB < 255 then inc Textures(Tnum).Dot1ColourB endif endcase case 11 if Buttons(34).State = 1 if Textures(Tnum).Dot2ColourR > 0 then dec Textures(Tnum).Dot2ColourR endif if Buttons(35).State = 1 if Textures(Tnum).Dot2ColourG > 0 then dec Textures(Tnum).Dot2ColourG endif if Buttons(36).State = 1 if Textures(Tnum).Dot2ColourB > 0 then dec Textures(Tnum).Dot2ColourB endif endcase case 12 if Buttons(34).State = 1 if Textures(Tnum).Dot2ColourR < 255 then inc Textures(Tnum).Dot2ColourR endif if Buttons(35).State = 1 if Textures(Tnum).Dot2ColourG < 255 then inc Textures(Tnum).Dot2ColourG endif if Buttons(36).State = 1 if Textures(Tnum).Dot2ColourB < 255 then inc Textures(Tnum).Dot2ColourB endif endcase case 16 if Textures(Tnum).Dot1Count > 0 then dec Textures(Tnum).Dot1Count endcase case 17 if Textures(Tnum).Dot1Count < 1000 then inc Textures(Tnum).Dot1Count endcase case 18 if Textures(Tnum).Dot2Count > 0 then dec Textures(Tnum).Dot2Count endcase case 19 if Textures(Tnum).Dot2Count < 1000 then inc Textures(Tnum).Dot2Count endcase endselect endfunction function ChangeBrushSize() select OD(0).Action rem Decrease Brush Width case 1 if BD(0).Width > 1 then dec BD(0).Width endcase rem Increase Brush Width case 2 if BD(0).Width < FD(0).Segments + 1 then inc BD(0).Width endcase rem Decrease Brush Length case 3 if BD(0).Length > 1 then dec BD(0).Length endcase rem Increase Brush Length case 4 if BD(0).Length < FD(0).Segments + 1 then inc BD(0).Length endcase rem Decrease Brush Magnitude or Decrement Texture case 5 if OD(0).MainAction = 2 if BD(0).Magnitude > 1 then dec BD(0).Magnitude else if BD(0).Texture > 1 then dec BD(0).Texture endif endcase rem Increase Brush Magnitude case 6 if OD(0).MainAction = 2 if BD(0).Magnitude < 100 then inc BD(0).Magnitude else if BD(0).Texture < 256 then inc BD(0).Texture ArrIndex = array count( Textures(Tnum) ) if ArrIndex < BD(0).Texture - 1 array insert at bottom Textures(Tnum), ArrIndex endif endif endcase endselect endfunction rem ************************************************** INIT_VariablesAndDatastructures: type Camera XPos# as float YPos# as float ZPos# as float XAng# as float YAng# as float ZAng# as float Pitch# as float Yaw# as float Roll# as float Slide# as float Speed# as float endtype type Button Group as string SubGroup as string Title as string Action as integer Xpos as integer Ypos as integer Width as integer Height as integer State as integer UpImage as integer DnImage as integer endtype type File Name as String Segments as integer SegSize as float Saved as integer Wireframe as integer endtype type Operation Menu as integer Group as string MainAction as integer Action as integer LastButton as integer RepeatCount as integer RepeatDelay as integer endtype type Brush Xpos as float Ypos as float Zpos as float Changed as integer Width as integer Length as integer Magnitude as integer MBShape as integer MBBase as integer MBIncType as integer MBOperation as integer Texture as integer endtype type Texture BackColourR as integer BackColourG as integer BackColourB as integer Dot1ColourR as integer Dot1ColourG as integer Dot1ColourB as integer Dot1Count as integer Dot2ColourR as integer Dot2ColourG as integer Dot2ColourB as integer Dot2Count as integer endtype type Vertex Flipped as integer Height as float HtBase as float HtInc as float NormX as float NormY as float NormZ as float TexU as float TexV as float endtype dim PD(0) as Camera dim FD(0) as File dim OD(0) as Operation dim BD(0) as Brush BD(0).Texture = 1 dim Textures(0) as Texture dim ButtonCount(0) as integer ButtonCount(0)= 41 dim Buttons( ButtonCount(0) ) as Button return rem ************************************************** ButtonData: data "MAIN", "MAIN", "FILE", 1, 28, 656, 64, 24 data "MAIN", "MAIN", "MOLD", 2, 102, 656, 64, 24 data "MAIN", "MAIN", "PAINT", 3, 176, 656, 64, 24 data "FILE", "FILE", "LOAD", 1, 450, 660, 64, 24 data "FILE", "FILE", "SAVE", 2, 450, 688, 64, 24 data "FILE", "FILE", "NEW", 3, 450, 716, 64, 24 data "MOLD", "MBSIZE", "-", 1, 400, 660, 24, 24 data "MOLD", "MBSIZE", "+", 2, 430, 660, 24, 24 data "MOLD", "MBSIZE", "-", 3, 400, 688, 24, 24 data "MOLD", "MBSIZE", "+