Brandan

Untitled

Mar 7th, 2014
187
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Imports System.IO
  2. Imports OpenTK.Graphics.OpenGL
  3. Imports OpenTK
  4.  
  5. Public Class OpenGL_Render
  6.  
  7.     Private m As New map
  8.     Private Sub OpenGL_Render_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  9.         m.Load(Populous.Populous.Info.InstallPath & "\levels\levl2007.dat", map.MapType.DAT)
  10.  
  11.         TribeCust.Show()
  12.     End Sub
  13.  
  14.     Private OpenGL_Load = False
  15.     Private Sub GlControl1_Load(sender As Object, e As EventArgs) Handles GlControl1.Load
  16.         OpenGL_Load = True
  17.         GL.ClearColor(Color.Black)
  18.     End Sub
  19.  
  20.     Private Sub GlControl1_Paint(sender As Object, e As PaintEventArgs) Handles GlControl1.Paint
  21.         ' render graphics
  22.         GL.Clear(ClearBufferMask.ColorBufferBit Or ClearBufferMask.DepthBufferBit)
  23.  
  24.         'Basic Setup for viewing
  25.         Dim perspective As Matrix4 = Matrix4.CreatePerspectiveFieldOfView(1, 1, 1, 10000) 'Setup Perspective
  26.         Dim lookat As Matrix4 = Matrix4.LookAt(0, 0, -116, 0, 0, 0, 0, 1, 0) 'Setup camera
  27.         GL.MatrixMode(MatrixMode.Projection) 'Load Perspective
  28.         GL.LoadIdentity()
  29.         GL.LoadMatrix(perspective)
  30.         GL.MatrixMode(MatrixMode.Modelview) 'Load Camera
  31.         GL.LoadIdentity()
  32.         GL.LoadMatrix(lookat)
  33.         GL.Viewport(0, 0, GlControl1.Width, GlControl1.Height) 'Size of window
  34.         GL.Enable(EnableCap.DepthTest) 'Enable correct Z Drawings
  35.         GL.DepthFunc(DepthFunction.Less) 'Enable correct Z Drawings
  36.  
  37.         ' GL.Rotate(mousepos.X, 0, 1, 0)
  38.         ' GL.Rotate(mousepos.Y, 0, 0, 1)
  39.  
  40.  
  41.         'GL.Rotate(0, 0, 1, 0)
  42.  
  43.         GL.Translate(New Vector3(-64, -64, 0))
  44.  
  45.         GL.Begin(PrimitiveType.Points)
  46.  
  47.         For Each point In m.Map_Loaded
  48.             If point.height > 0 Then
  49.                 GL.Color3(Color.FromArgb(0, 100, 0))
  50.                 GL.Vertex3(point.X, point.Y, point.height / 50)
  51.             Else
  52.                 GL.Color3(Color.FromArgb(0, 0, 100))
  53.                 GL.Vertex3(point.X, point.Y, 0)
  54.             End If
  55.         Next
  56.  
  57.  
  58.         GL.[End]()
  59.         GlControl1.SwapBuffers()
  60.     End Sub
  61.  
  62.  
  63.  
  64.     Private Sub OpenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles OpenToolStripMenuItem.Click
  65.         Dim savefiledialog As New OpenFileDialog()
  66.  
  67.         savefiledialog.InitialDirectory = Populous.Populous.Info.InstallPath & "\levels\"
  68.         savefiledialog.Filter = "Populous Levels (levl*.dat)|levl*.dat|XML (levl*.xml)|levl*.xml|CSV (levl*.csv)|levl*.csv|Bitmap (levl*.bmp)|levl*.bmp|All files (*.*)|*.*"
  69.         savefiledialog.FilterIndex = 0
  70.         savefiledialog.RestoreDirectory = True
  71.  
  72.         If savefiledialog.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
  73.             Try
  74.                 If Path.GetExtension(savefiledialog.FileName).ToLower.Contains(".dat") Then
  75.                     m.Load(savefiledialog.FileName, map.MapType.DAT)
  76.                     GlControl1.Invalidate()
  77.                 Else
  78.                     MsgBox("Invalid Format!")
  79.                 End If
  80.             Catch Ex As Exception
  81.                 MessageBox.Show("Cannot read file from disk. Original error: " & Ex.Message)
  82.             End Try
  83.         End If
  84.  
  85.     End Sub
  86.  
  87.     Private Sub SaveToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SaveToolStripMenuItem.Click
  88.         Dim savefiledialog As New SaveFileDialog()
  89.  
  90.         savefiledialog.InitialDirectory = Populous.Populous.Info.InstallPath & "\levels\"
  91.         savefiledialog.Filter = "Populous Levels (levl*.dat)|levl*.dat|XML (levl*.xml)|levl*.xml|CSV (levl*.csv)|levl*.csv|Bitmap (levl*.bmp)|levl*.bmp|All files (*.*)|*.*"
  92.         savefiledialog.FilterIndex = 0
  93.         savefiledialog.RestoreDirectory = True
  94.  
  95.         If savefiledialog.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
  96.             Try
  97.                 If Path.GetExtension(savefiledialog.FileName).ToLower.Contains(".dat") Then
  98.                     m.Save(savefiledialog.FileName, map.MapType.DAT)
  99.                 Else
  100.                     MsgBox("Invalid Format!")
  101.                 End If
  102.             Catch Ex As Exception
  103.                 MessageBox.Show("Cannot read file from disk. Original error: " & Ex.Message)
  104.             End Try
  105.         End If
  106.     End Sub
  107.  
  108.     Private Sub ExitToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ExitToolStripMenuItem.Click
  109.         End
  110.     End Sub
  111.  
  112.  
  113. End Class
  114.  
  115. Public Class map
  116.     Public Structure Points
  117.         Public ID As Integer
  118.         Public X As Integer
  119.         Public Y As Integer
  120.         Public height As Short
  121.     End Structure
  122.  
  123.     Public Structure Objects
  124.         Public ID As Integer
  125.         Public X As Integer
  126.         Public Y As Integer
  127.         Public height As Short
  128.     End Structure
  129.  
  130.     Public Structure NoAccessBlocks
  131.         Public ID As Integer
  132.         Public X As Integer
  133.         Public Y As Integer
  134.         Public disabled As Integer
  135.     End Structure
  136.  
  137.     Public Structure SunLightBlocks
  138.         Public ID As Integer
  139.         Public X As Integer
  140.         Public Y As Integer
  141.         Public disabled As Integer
  142.     End Structure
  143.  
  144.     Public Structure SavePlayerInfo
  145.         Public ID As Integer
  146.         Public X As Integer
  147.         Public Y As Integer
  148.         Public tribe As Populous.Populous.tribe
  149.     End Structure
  150.  
  151.     Private MapSize As Size = New Size(128, 128)
  152.     Public Map_Loaded(MapSize.Height * MapSize.Width) As Points
  153.     Public NoAccess(MapSize.Height * MapSize.Width) As NoAccessBlocks
  154.     Public SunLight(MapSize.Height * MapSize.Width) As SunLightBlocks
  155.     Public SavePlayer(64) As SavePlayerInfo
  156.     Public Obj(2000 - 1) As Objects
  157.  
  158.     Public Enum MapType
  159.         DAT
  160.         XML
  161.         CSV
  162.         BITMAP
  163.     End Enum
  164.  
  165.     Public Sub Load(ByVal filepath As String, ByVal filetypep As MapType)
  166.  
  167.         If filetypep = MapType.DAT Then
  168.             Dim reader As New BinaryReader(File.Open(filepath, FileMode.Open))
  169.  
  170.             Dim Point = 0
  171.             For x As Integer = 0 To MapSize.Height - 1
  172.                 For y As Integer = 0 To MapSize.Width - 1
  173.  
  174.                     ' Load height UShort is unsigned Word, and Short is signed word
  175.                     Dim Height As Short = reader.ReadUInt16()
  176.  
  177.  
  178.                     If Point > 0 Then
  179.                         Map_Loaded(Point).ID = Point + 1
  180.                     End If
  181.                     Map_Loaded(Point).X = x
  182.                     Map_Loaded(Point).Y = y
  183.                     Map_Loaded(Point).height = Height
  184.  
  185.                     Point = Point + 1
  186.                 Next
  187.             Next
  188.  
  189.             reader.Close()
  190.  
  191.         ElseIf filetypep = MapType.XML Then
  192.  
  193.         ElseIf filetypep = MapType.CSV Then
  194.  
  195.         ElseIf filetypep = MapType.BITMAP Then
  196.  
  197.         End If
  198.  
  199.     End Sub
  200.  
  201.     Public Sub Save(ByVal filepath As String, ByVal filetypep As MapType)
  202.  
  203.         If filetypep = MapType.DAT Then
  204.  
  205.             If Not My.Computer.FileSystem.FileExists(filepath) Then
  206.                 File.Create(filepath).Dispose()
  207.             End If
  208.  
  209.             Dim writer As New BinaryWriter(File.Open(filepath, FileMode.Open))
  210.  
  211.             For x As Integer = 0 To MapSize.Width - 1
  212.                 For y As Integer = 0 To MapSize.Height - 1
  213.  
  214.                     For Point = 0 To Map_Loaded.Length - 1
  215.                         If (Map_Loaded(Point).X = x And Map_Loaded(Point).Y = y) Then
  216.                             writer.Write(Map_Loaded(Point).height)
  217.                             Exit For
  218.                         End If
  219.                     Next
  220.  
  221.  
  222.                 Next
  223.             Next
  224.  
  225.             ' Unused Data, 0 byte it
  226.             Do Until (writer.BaseStream.Position >= 65535)
  227.                 writer.Write(0)
  228.             Loop
  229.  
  230.             ' No Access Blocks 1 = No Access 0 = Free Roam
  231.             Do Until (writer.BaseStream.Position >= 81983)
  232.                 writer.Write(0)
  233.             Loop
  234.  
  235.             ' Save Player Info
  236.             Do Until (writer.BaseStream.Position >= 81919)
  237.                 writer.Write(0)
  238.             Loop
  239.  
  240.             ' Sunlight Info
  241.             Do Until (writer.BaseStream.Position >= 81986)
  242.                 writer.Write(0)
  243.             Loop
  244.  
  245.             ' Objects
  246.             Do Until (writer.BaseStream.Position >= 191986)
  247.                 writer.Write(0)
  248.             Loop
  249.  
  250.             ' End Padding
  251.             Do Until (writer.BaseStream.Position >= 192136)
  252.                 writer.Write(0)
  253.             Loop
  254.  
  255.  
  256.             writer.Close()
  257.         ElseIf filetypep = MapType.XML Then
  258.  
  259.         ElseIf filetypep = MapType.CSV Then
  260.  
  261.         ElseIf filetypep = MapType.BITMAP Then
  262.  
  263.         End If
  264.  
  265.     End Sub
  266.  
  267.  
  268. End Class
RAW Paste Data