December 03, 2020, 08:18:42 PM

Author Topic: [bb] 2.5D Terrain Generator by Andy_A [ 1+ years ago ]  (Read 502 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] 2.5D Terrain Generator by Andy_A [ 1+ years ago ]
« on: June 29, 2017, 12:28:39 AM »
Title : 2.5D Terrain Generator
Author : Andy_A
Posted : 1+ years ago

Description : Nothing great but could be helpful to others to see how GUI can be implemented.

There are also some nice functions in the first program which stores bitmaps in 'packed' data statements.


Code :
Code: BlitzBasic
  1. There are two parts to this code.
  2. Part 1: Save necessary bitmaps to disk
  3. Part 2: Terrain Generator in BlitzPlus GUI
  4.  
  5. Part 1: (Run First!)
  6. [code]AppTitle "Data Images"
  7.  
  8. Global sw%, sh%
  9. Global maskRed%, maskGrn%, maskBlu%
  10. Global imgHandle%, imgWidth%, imgHeight%
  11. ;========== masking constants for 32 bit color =========
  12.         maskRed% = 16711680
  13.         maskGrn% = 65280
  14.         maskBlu% = 255
  15. ;========= masking constants for 16 bit (5-6-5) ========
  16. ;               maskRed% = 16252928
  17. ;               maskGrn% = 64512 ;change To 63488 For (5-5-5)
  18. ;               maskBlu% = 248
  19. ;=======================================================
  20. sw% =  800: sh% =  600
  21.  
  22. Graphics sw, sh, 32, 2
  23. SetBuffer BackBuffer()
  24.  
  25. Dim vecs(1) ;vector array (true dimension size in image data)
  26. Dim pal%(1) ;Color palette array (true dimension size in image data)
  27. Dim pow%(5) ;array to hold powers of two for HEX2DEC function
  28. pow(0)=1        : pow(1)=16
  29. pow(2)=256      : pow(3)=4096
  30. pow(4)=65536    : pow(5)=1048576
  31.  
  32. ;filenames to store on disk
  33. Dim name$(4)
  34. name$(1) = "TG.bmp"
  35. name$(2) = "ltArrow.bmp"
  36. name$(3) = "rtArrow.bmp"
  37. name$(4) = "okButton.bmp"
  38.  
  39.  
  40. ;=======================================================
  41.  
  42.  
  43. Cls
  44. Color 0,192,255
  45.  
  46. st = MilliSecs()
  47. For i% = 1 To 4
  48.         Select i%
  49.                 Case 1: Restore TG
  50.                 Case 2: Restore ltArrow
  51.                 Case 3: Restore rtArrow
  52.                 Case 4: Restore okButton
  53.         End Select
  54.         getImgData()
  55.         temp% = CreateImage(imgWidth, imgHeight)
  56.         SetBuffer ImageBuffer(temp%)
  57.         displayImg(0,0,imgWidth, imgHeight)
  58.         SaveImage(temp%,name$(i%))
  59.         SetBuffer BackBuffer()
  60.         Text 20,i*20,name$(i%)+" saved."
  61.         Flip
  62.         FreeImage temp%: temp% = 0
  63. Next
  64.  
  65. Color 0,192,255
  66. et = MilliSecs()-st
  67. Text 20,sh-100,"Time to save .bmp's: "+et
  68. Text 20,sh-80,"Click to exit."
  69. Flip           
  70.  
  71. WaitMouse()
  72. End
  73.  
  74. Function getImgData%()
  75.         Local numVecs%, palSize%, inc%, palData$
  76.         Local i%, vecData$, double$, vecLen%, idx%
  77.         Read imgWidth           ;global var
  78.         Read imgHeight  ;global var
  79.         Read numVecs
  80.         Read palSize
  81.         Dim vecs(numVecs)
  82.         Dim pal(palSize-1)
  83.         inc = 0
  84.         While inc% < palSize-1
  85.                 Read palData$
  86.                 For i = 1 To Len(palData$) Step 6
  87.                         pal(inc%) = HexDec(Mid$(palData$,i,6))
  88.                         inc = inc + 1
  89.                 Next
  90.         Wend
  91.         inc% = 0
  92.         While inc < numVecs
  93.                 Read vecData$
  94.                 For i = 1 To Len(vecData$) Step 8
  95.                         double$ = Mid$(vecData$,i,8)
  96.                         vecLen = hexDec(Left$(double$,4))
  97.                         vecs(inc) = vecLen
  98.                         inc = inc% + 1
  99.                         idx = hexDec(Right$(double$,4))
  100.                         vecs(inc) = pal(idx)
  101.                         inc = inc + 1
  102.                 Next
  103.         Wend
  104. End Function
  105.  
  106. Function displayImg(x%, y%, imgWidth%, imgHeight%)
  107.         Local angle%, angle2%, vCount%, i%
  108.         Local p#, q#, r#, s#
  109.         Local lineLen%, vecLen%, red%, grn%, blu%
  110.         angle = 0
  111.         angle2 = 90
  112.         vCount% = 0
  113.         For i% = 1 To imgHeight
  114.                 p# = Cos(angle2)*(i-1)+x
  115.                 q# = Sin(angle2)*(i-1)+y
  116.                 lineLen% = 0
  117.                 While lineLen < imgWidth
  118.                         vecLen = vecs(vCount)
  119.                         lineLen = linelen + vecLen
  120.                         ;========== masking constants for 32-bit color =========
  121.                         red% = (vecs(vCount + 1) And maskRed) Shr 16
  122.                         grn% = (vecs(vCount + 1) And maskGrn) Shr 8
  123.                         blu% =  vecs(vCount + 1) And maskBlu
  124.                         ;======= un-comment next 3 lines for 16-bit color ======
  125.                         ;red = red Shr 3 Shl 3
  126.                         ;grn = grn Shr 2 Shl 2 ;change to Shr 3 Shl 3 for (5-5-5)
  127.                         ;blu = blu Shr 3 Shl 3
  128.                         ;=======================================================
  129.  
  130.                         Color red,grn,blu
  131.                         r# = Cos(angle)*vecLen+p
  132.                         s# = Sin(angle)*vecLen+q
  133.                         Line p,q,r,s
  134.                         vCount = vCount+2
  135.                         p=r
  136.                         q=s
  137.                 Wend
  138.         Next
  139. End Function
  140.  
  141.  
  142. Function wordHex$(decValue)
  143.         Local hexVal%, hexStr$, i%
  144.         hexStr$ = Str( Hex (decValue))
  145.         hexStr$ = Right$(hexStr$, 4)
  146.         Return  hexStr$
  147. End Function
  148.  
  149. Function byte3Hex$(decValue)
  150.         Local hexVal%, hexStr$
  151.         hexStr$ = Str( Hex (decValue))
  152.         hexStr$ = Right$(hexStr$, 6)
  153.         Return hexStr$
  154. End Function
  155.  
  156. Function HexDec(HexVal$)
  157.         Local HexChar$, numLen%, i%
  158.         Local rev%, h$, decVal%, accumul8%
  159.     HexVal$ = Upper$(HexVal$)
  160.     HexChar$="0123456789ABCDEF"
  161.     numLen=Len(HexVal$)
  162.     If numLen <= 8 Then
  163.         For i = numLen-1 To 0 Step -1
  164.             rev = numLen-i
  165.             h$ = Mid$(HexVal$,rev,1)
  166.             decVal = Instr(HexChar$,h$)-1
  167.             accumul8 = accumul8 + decVal*pow(i)
  168.         Next
  169.     Else
  170.         accumul8 = 0
  171.     End If
  172.         Return accumul8
  173. End Function
  174.  
  175. .TG
  176. Data 178,134,3352,13
  177. Data "0080FFFFFF00FFFFFF7FBF7FBFDF3F9FCF5F004040BFCF109FB7187F9F20FFFFBFFFFF9FFFFF7F"
  178. Data "00B2000000B2000000B2000000B2000000B2000000B2000000B2000000B2000000B20000002400000011000100410000000500010037000000240000"
  179. Data "0011000100410000000500010037000000240000001100010041000000050001003700000024000000110001004100000005000100370000002A0000"
  180. Data "0005000100830000002A000000050001006C00000001000200160000002A000000050001000C00000001000300020004000300010002000400010003"
  181. Data "000600000005000100020000000100050001000400020001000200000005000100020000000100050001000400020001000200000001000300010005"
  182. Data "0002000400040001000200040001000500070000000500010004000000050001000200000001000500010004000200010001000400010005000E0000"
  183. Data "0003000200150000002A000000050001000B000000010004000900010001000400050000000500010001000300010004000400010002000000050001"
  184. Data "00010003000100040004000100020000000C00010001000300050000000500010004000000050001000100030007000100010004000C000000050002"
  185. Data "00140000002A0000000500010009000000010003000C00010001000400040000000B000100020000000B000100020000000D00010001000300040000"
  186. Data "0005000100040000000E000100010005000A00000007000200130000002A000000050001000900000001000400040001000100050002000000010003"
  187. Data "000500010001000300030000000B000100020000000B000100020000000D000100010004000400000005000100040000000E00010001000400090000"
  188. Data "0009000200120000002A0000000500010008000000010003000400010001000500040000000100030004000100010004000300000005000100010004"
  189. Data "000100030006000000050001000100040001000300060000000100010001000400010005000100030003000000010003000100040005000100040000"
  190. Data "00050001000400000005000100010004000100030001000000010003000100040005000100080000000B000200110000002A00000005000100080000"
  191. Data "000100040004000100060000000500010003000000050001000800000005000100110000000500010004000000050001000400000005000100040000"
  192. Data "000100030005000100070000000D000200100000002A000000050001000800000010000100030000000500010008000000050001000A000000010003"
  193. Data "00020005000200040007000100040000000500010004000000050001000500000005000100060000000E000200100000002A00000005000100080000"
  194. Data "0010000100030000000500010008000000050001000800000001000300010004000C0001000400000005000100040000000500010005000000050001"
  195. Data "0005000000100002000F0000002A0000000500010008000000100001000300000005000100080000000500010007000000010003000E000100040000"
  196. Data "00050001000400000005000100050000000500010004000000120002000E0000002A0000000500010008000000050001000E00000005000100080000"
  197. Data "000500010007000000010004000400010001000400010005000100030002000000050001000400000005000100040000000500010005000000050001"
  198. Data "0003000000140002000D0000002A00000005000100080000000100040004000100010005000800000001000300010001000300000005000100080000"
  199. Data "00050001000700000005000100050000000500010004000000050001000400000005000100050000000500010002000000160002000C0000002A0000"
  200. Data "000500010008000000010005000500010001000400010003000300000001000300010005000100040002000100030000000500010008000000050001"
  201. Data "000700000005000100010005000200000001000300010005000500010004000000050001000400000005000100050000000500010001000000180002"
  202. Data "000B0000002A0000000500010009000000010004000E00010003000000050001000800000005000100070000000F0001000400000005000100040000"
  203. Data "000500010005000000050001001A0002000A0000002A0000000500010009000000010003000E00010003000000050001000800000005000100070000"
  204. Data "00010005000E0001000400000005000100040000000500010005000000050001001B000200090000002A000000050001000B000000010004000B0001"
  205. Data "000100040003000000050001000800000005000100080000000100040007000100010004000500010004000000050001000400000005000100050000"
  206. Data "00050001001C000200080000002A000000050001000C0000000100030001000500010004000500010001000400010005000100030004000000050001"
  207. Data "000800000005000100090000000100050001000400040001000100050001000000050001000400000005000100040000000500010005000000050001"
  208. Data "001D000200070000008A0000002200020006000000890000002400020005000000880000002600020004000000870000002800020003000000860000"
  209. Data "002900020003000000850000002B00020002000000840000002D00020001000000830000002F00020082000000300002008100000031000200800000"
  210. Data "00320002007F000000330002007E000000340002007D0000003500020019000000010003000100050001000400050001000100040001000500010003"
  211. Data "00580000000F00020003000600240002001700000001000300010004000B000100010004000100050055000000020006000300020005000100060002"
  212. Data "00040006002300020016000000010005000F000100540000000400060002000200050001000600020006000600210002001500000001000500100001"
  213. Data "005300000006000600010002000500010006000200080006001F00020014000000010003000600010001000400010003000300000001000300010005"
  214. Data "000400010052000000070006000100020005000100050002000A00060014000200020006000800020014000000010004000500010001000300080000"
  215. Data "000100050002000100510000000900060005000100050002000C000600110002000900060002000200130000000100030005000100010003000A0000"
  216. Data "000100030001000100070000000100030002000400030001000200040001000300060000000500010002000000010005000100040002000100010004"
  217. Data "000100050009000000010003000200040003000100020004000100030006000000050001000200000001000500010004000200010002000000010003"
  218. Data "000100050002000400040001000200070001000800050006000C000100050006000100090002000700030001000200070001000A0007000200050001"
  219. Data "000200020001000B00010007000200010008000600130000000100050004000100010004001300000001000400090001000100040005000000050001"
  220. Data "00010003000700010001000400070000000100040009000100010004000500000005000100010003000100040004000100020000000C000100010009"
  221. Data "00030006000C000100030006000100090001000700090001000100070001000A00050002000500010001000A0001000C000400010008000600130000"
  222. Data "0001000400040001000100030011000000010003000C00010001000400040000000E0001000100050004000000010003000C00010001000400040000"
  223. Data "000B000100020000000D00010001000900020006000C00010002000600010009000D00010001000A00040002000B0001000800060013000000050001"
  224. Data "000D000000010002000400000001000400040001000100050002000000010003000500010001000300030000000E0001000100040004000000010004"
  225. Data "00040001000100050002000000010003000500010001000300030000000B000100020000000D00010001000700020006000C000100020006000E0001"
  226. Data "000100070001000600030002000B00010008000600130000000500010005000000090001000100020002000000010003000400010001000500040000"
  227. Data "000100030004000100010004000300000005000100010004000100030001000000010003000100040005000100030000000100030004000100010005"
  228. Data "000400000001000300040001000100040003000000050001000100040001000300060000000100010001000400010005000100030001000000020006"
  229. Data "000100090001000700050001000400060005000100040002000200060001000800050001000100080003000600010008000500010001000800010006"
  230. Data "00020002000500010001000C0001000A000C000600130000000500010005000000090001000200020001000000010004000400010006000000050001"
  231. Data "000300000005000100040000000100030005000100030000000100040004000100060000000500010003000000050001000C00000005000600050001"
  232. Data "0004000600050001000400020002000600010007000400010001000800050006000100080004000100010007000300060005000100020002000C0006"
  233. Data "001300000005000100010003000400000009000100030002001000010003000000050001000500000005000100030000001000010003000000050001"
  234. Data "000A00000001000300020008000200070007000100040006000500010001000600020002000300060005000100010009000500060001000900050001"
  235. Data "000300060005000100020002000C00060013000000010004000400010001000300040000000900010003000200100001000300000005000100050000"
  236. Data "0005000100030000001000010003000000050001000800000001000300010004000C0001000400060005000100020006000100020003000600050001"
  237. Data "0007000600050001000300060005000100010002000D0006001300000001000400040001000100040008000000050001000300020010000100030000"
  238. Data "000500010005000000050001000300000010000100030000000500010007000000010003000E00010004000600050001000600060005000100070006"
  239. Data "00050001000300060005000100010002000D0006001300000001000300050001000100030006000000010002000500010003000200050001000E0000"
  240. Data "0005000100050000000500010003000000050001000E0000000500010007000000010004000400010001000700010008000100090002000600050001"
  241. Data "00040006000500010006000600050001000100090005000600010009000500010003000600050001000E000600140000000600010001000500040000"
  242. Data "0002000200050001000300020001000C0004000100010005000800000001000300010001000300000005000100050000000500010003000000010004"
  243. Data "000400010001000500080000000100030001000100030000000500010007000000050001000500060005000100040006000500010006000600010007"
  244. Data "0004000100010008000500060001000800040001000100070003000600050001000E0006001400000001000300060001000100040001000500010003"
  245. Data "0003000200050001000300020001000B0005000100010004000100030003000000010003000100050001000400020001000300000005000100050000"
  246. Data "000500010003000000010005000500010001000400010003000300000001000300010005000100040002000100030000000500010006000000010006"
  247. Data "000500010001000800020006000100090001000800050001000400060005000100010007000200060001000900010001000100060001000800050001"
  248. Data "000100080001000900010006000100090001000800050001000100080003000600050001000E0006001500000001000400100001000400020001000C"
  249. Data "000E0001000300000005000100050000000500010004000000010004000E000100030000000500010005000000020006000F000100040006000A0001"
  250. Data "0002000600010007000E00010004000600050001000E00060016000000010004000F0001000400020001000A000E0001000300000005000100050000"
  251. Data "000500010004000000010003000E00010003000000050001000400000003000600010008000E00010004000600010008000900010002000600010009"
  252. Data "000D0001000100090004000600050001000E00060017000000010003000D00010001000B000600020001000C000B0001000100040003000000050001"
  253. Data "00050000000500010006000000010004000B000100010004000300000005000100030000000500060001000700070001000100070005000100050006"
  254. Data "00010007000800010003000600010009000100070009000100010007000100090005000600050001000E00060019000000010003000100040001000C"
  255. Data "000400010002000C0001000B0001000A000900020001000A0001000B0001000C00050001000100040001000500010003000400000005000100050000"
  256. Data "000500010007000000010003000100050001000400050001000100040001000500010003000400000005000100020000000700060001000800010007"
  257. Data "000400010001000800010006000500010006000600010008000100070004000100010007000100080005000600010009000200070003000100020007"
  258. Data "000100090007000600050001000E0006001A00000019000200340000004B000600190000001B000200320000004C000600190000001C000200300000"
  259. Data "004D000600180000001E0002002E0000004E00060017000000200002002C0000004F00060016000000220002002A0000005000060015000000250002"
  260. Data "0027000000510006001400000027000200250000005200060014000000280002002300000053000600130000002A0002002100000054000600120000"
  261. Data "002C0002001F000000550006001100000020000200010006000D0002001D00000056000600100000000A0002000100060014000200050006000A0002"
  262. Data "00020006001B000000570006000F00000009000200040006001200020008000600070002000400060019000000580006000F00000007000200060006"
  263. Data "00110002000A0006000400020007000600170000000E000600010009000100080001000700040001000200070001000900110006000E000100040006"
  264. Data "000A000100020007000100080001000900100006000E00000006000200090006000E0002000E0006000100020009000600150000000E0006000B0001"
  265. Data "0001000700100006000E000100040006000E00010001000700010009000E0006000D000000050002000C0006000C0002001A000600130000000F0006"
  266. Data "000C000100010007000F0006000E0001000400060010000100010008000D0006000C000000050002000E0006000A0002001C00060011000000100006"
  267. Data "000D000100010008000E0006000E0001000400060011000100010008000C0006000B0000000400020011000600070002001F0006000F000000110006"
  268. Data "00020001000100070001000800030006000100080005000100010007000E000600050001000D00060005000100040006000100090001000800010007"
  269. Data "0006000100010009000B0006000A00000001000600020002001300060006000200210006000D00000012000600010001000100090006000600010008"
  270. Data "00050001000E000600050001000D00060005000100070006000100080005000100010007000B0006000A000000010002001600060004000200230006"
  271. Data "000B0000001C000600050001000E000600050001000D00060005000100080006000100080005000100010009000A0006000900000019000600010002"
  272. Data "0026000600090000001D000600050001000E000600050001000D00060005000100090006000100070004000100010008000A00060008000000420006"
  273. Data "00070000001D0006000100090004000100010007000E0006000900010001000700010008000100090006000600050001000900060001000800040001"
  274. Data "00010007000A0006000700000044000600050000001E0006000100070004000100010008000E0006000C000100010007000500060005000100090006"
  275. Data "0001000900050001000A0006000600000046000600030000001E00060001000900050001000F0006000D0001000100070004000600050001000A0006"
  276. Data "00050001000A0006000500000048000600010000001E0006000100090005000100010008000F0006000E0001000100080003000600050001000A0006"
  277. Data "00050001000A000600050000006700060001000700040001000100070010000600010001000100070002000900030006000100090001000700050001"
  278. Data "000100070003000600050001000900060001000900050001000A00060004000000670006000100070004000100010007001A00060001000800050001"
  279. Data "000300060005000100090006000100090004000100010007000A00060003000000660006000100090005000100010007001C00060005000100030006"
  280. Data "0005000100090006000100070004000100010008000A00060002000000660006000100090005000100010007001D0006000500010003000600050001"
  281. Data "00080006000100080005000100010009000A00060001000000660006000100080005000100010007000A000600050001000400060001000100010008"
  282. Data "00080006000100080004000100010007000300060005000100070006000100080005000100010007000B000600660006000100070005000100010008"
  283. Data "000B00060005000100040006000300010001000800010009000300060001000900010007000500010001000800030006000500010004000600010009"
  284. Data "000100080001000700060001000C00060065000600010007000F0001000300060005000100040006000F0001000400060011000100010009000C0006"
  285. Data "0065000600100001000300060005000100040006000E000100010009000400060010000100010009000D000600650006001000010003000600050001"
  286. Data "00040006000C0001000100070001000900050006000E000100010007000F000600650006001000010003000600050001000500060001000900010008"
  287. Data "0002000700040001000200070001000900070006000A00010002000700010008000100090010000600B2000600B2000600B2000600B2000600B20006"
  288. Data "00B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B20006"
  289. Data "00B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B2000600B20006"
  290.  
  291.  
  292. .ltArrow
  293. Data 93,50,468,3
  294. Data "0000FF000045FFFFFF"
  295. Data "005D0000005D000000020000002800010001000200300001000200000002000000270001000200020030000100020000000200000025000100040002"
  296. Data "003000010002000000020000002300010006000200300001000200000002000000210001000800020030000100020000000200000020000100090002"
  297. Data "003000010002000000020000001E0001000B0002003000010002000000020000001C0001000D0002003000010002000000020000001A0001000F0002"
  298. Data "003000010002000000020000001800010011000200300001000200000002000000170001001200020030000100020000000200000015000100140002"
  299. Data "003000010002000000020000001300010016000200300001000200000002000000110001001800020030000100020000000200000010000100190002"
  300. Data "003000010002000000020000000E000100430002000800010002000000020000000C000100450002000800010002000000020000000A000100470002"
  301. Data "000800010002000000020000000800010049000200080001000200000002000000070001004A000200080001000200000002000000050001004C0002"
  302. Data "00080001000200000002000000030001004E000200080001000200000002000000010001005000020008000100020000000200000001000100500002"
  303. Data "00080001000200000002000000030001004E000200080001000200000002000000050001004C000200080001000200000002000000070001004A0002"
  304. Data "0008000100020000000200000008000100490002000800010002000000020000000A000100470002000800010002000000020000000C000100450002"
  305. Data "000800010002000000020000000E00010043000200080001000200000002000000100001004100020008000100020000000200000011000100400002"
  306. Data "000800010002000000020000001300010016000200300001000200000002000000150001001400020030000100020000000200000017000100120002"
  307. Data "0030000100020000000200000018000100110002003000010002000000020000001A0001000F0002003000010002000000020000001C0001000D0002"
  308. Data "003000010002000000020000001E0001000B000200300001000200000002000000200001000900020030000100020000000200000021000100080002"
  309. Data "003000010002000000020000002300010006000200300001000200000002000000250001000400020030000100020000000200000027000100020002"
  310. Data "00300001000200000002000000280001000100020030000100020000005D0000005D0000"
  311.  
  312. .rtArrow
  313. Data 93,50,468,3
  314. Data "0000FF000045FFFFFF"
  315. Data "005D0000005D000000020000003000010001000200280001000200000002000000300001000200020027000100020000000200000030000100040002"
  316. Data "002500010002000000020000003000010006000200230001000200000002000000300001000800020021000100020000000200000030000100090002"
  317. Data "00200001000200000002000000300001000B0002001E0001000200000002000000300001000D0002001C0001000200000002000000300001000F0002"
  318. Data "001A00010002000000020000003000010011000200180001000200000002000000300001001200020017000100020000000200000030000100140002"
  319. Data "001500010002000000020000003000010016000200130001000200000002000000300001001800020011000100020000000200000030000100190002"
  320. Data "0010000100020000000200000008000100430002000E000100020000000200000008000100450002000C000100020000000200000008000100470002"
  321. Data "000A00010002000000020000000800010049000200080001000200000002000000080001004A000200070001000200000002000000080001004C0002"
  322. Data "00050001000200000002000000080001004E000200030001000200000002000000080001005000020001000100020000000200000008000100500002"
  323. Data "00010001000200000002000000080001004E000200030001000200000002000000080001004C000200050001000200000002000000080001004A0002"
  324. Data "00070001000200000002000000080001004900020008000100020000000200000008000100470002000A000100020000000200000008000100450002"
  325. Data "000C000100020000000200000008000100430002000E0001000200000002000000080001004100020010000100020000000200000008000100400002"
  326. Data "001100010002000000020000003000010016000200130001000200000002000000300001001400020015000100020000000200000030000100120002"
  327. Data "001700010002000000020000003000010011000200180001000200000002000000300001000F0002001A0001000200000002000000300001000D0002"
  328. Data "001C0001000200000002000000300001000B0002001E0001000200000002000000300001000900020020000100020000000200000030000100080002"
  329. Data "002100010002000000020000003000010006000200230001000200000002000000300001000400020025000100020000000200000030000100020002"
  330. Data "00270001000200000002000000300001000100020028000100020000005D0000005D0000"
  331.  
  332. .okButton
  333. Data 101,51,734,3
  334. Data "0000FF000045FFFFFF"
  335. Data "00650000006500000002000000610001000200000002000000610001000200000002000000610001000200000002000000110001000B0002001B0001"
  336. Data "000700020012000100050002000C00010002000000020000000E00010012000200150001000A0002000F000100090002000A00010002000000020000"
  337. Data "000C00010015000200140001000B0002000C0001000C0002000900010002000000020000000B00010017000200120001000D000200090001000F0002"
  338. Data "000800010002000000020000000A00010019000200110001000E0002000600010011000200080001000200000002000000090001001B000200100001"
  339. Data "000E0002000500010013000200070001000200000002000000080001001D0002000F0001000F00020003000100140002000700010002000000020000"
  340. Data "00070001001F0002000E0001000F000200010001001600020007000100020000000200000006000100210002000D0001002600020007000100020000"
  341. Data "000200000005000100230002000C0001002600020007000100020000000200000005000100240002000B000100260002000700010002000000020000"
  342. Data "0005000100240002000B0001002600020007000100020000000200000005000100240002000B00010025000200080001000200000002000000040001"
  343. Data "00250002000B0001002400020009000100020000000200000004000100260002000A000100220002000B000100020000000200000004000100110002"
  344. Data "0003000100120002000A000100210002000C0001000200000002000000040001001000020005000100110002000A0001001F0002000E000100020000"
  345. Data "0002000000040001000F00020007000100100002000A0001001D000200100001000200000002000000040001000F00020007000100100002000A0001"
  346. Data "001C000200110001000200000002000000040001000F00020007000100100002000A0001001A000200130001000200000002000000040001000F0002"
  347. Data "0007000100100002000A00010019000200140001000200000002000000040001000F00020007000100100002000A0001001700020016000100020000"
  348. Data "0002000000040001000F00020007000100100002000A00010019000200140001000200000002000000040001000F00020007000100100002000A0001"
  349. Data "001A000200130001000200000002000000040001000F00020007000100100002000A0001001C00020011000100020000000200000004000100100002"
  350. Data "0005000100110002000A0001001D000200100001000200000002000000040001001100020003000100120002000A0001001F0002000E000100020000"
  351. Data "000200000004000100260002000A000100200002000D000100020000000200000004000100260002000A000100210002000C00010002000000020000"
  352. Data "0004000100260002000A000100220002000B000100020000000200000005000100240002000B00010024000200090001000200000002000000050001"
  353. Data "00240002000B0001002600020007000100020000000200000005000100240002000B0001002700020006000100020000000200000006000100220002"
  354. Data "000C0001002800020005000100020000000200000006000100220002000C0001000E0002000100010019000200050001000200000002000000070001"
  355. Data "00200002000D0001000E0002000300010017000200050001000200000002000000080001001E0002000E0001000E0002000400010016000200050001"
  356. Data "000200000002000000090001001C0002000F0001000E00020006000100140002000500010002000000020000000B00010019000200100001000E0002"
  357. Data "0007000100130002000500010002000000020000000D00010016000200120001000D0002000800010011000200060001000200000002000000100001"
  358. Data "0010000200150001000D0002000900010010000200060001000200000002000000370001000A0002000B0001000E0002000700010002000000020000"
  359. Data "00610001000200000002000000610001000200000065000000650000"


Part 2:
Code: [Select]

Global sw%, sh%, can1%
;=================================================
; Set screen res here
; recommend: 800x600 to Maximum monitor resolution
;=================================================
sw% = GraphicsWidth() : sh% = GraphicsHeight()
;=================================================

Dim c%(15,3), hz%(1,1)
SeedRnd MilliSecs()
arial9B% = LoadFont("Arial",18,True,False,False)
arial12% = LoadFont("Arial",24,False,False,False)
arial12U% = LoadFont("Arial",24,False,False,True)
arial24B% = LoadFont("Arial",48,True,False,False)

ok% = LoadImage("okButton.bmp")
lt% = LoadImage("ltArrow.bmp")
rt% = LoadImage("rtArrow.bmp")
Global TGen% = LoadImage("TG.bmp")
If (ok=0) Or (lt=0) Or (rt=0) Or (TGen=0) Then
RuntimeError "A required bitmap image is missing!"
End If


; Create main window
dw% = GadgetWidth(Desktop())
dh% = GadgetHeight(Desktop())
x% = (dw%-sw%) Shr 1
y% = (dh%-sh%) Shr 1
tg% = CreateWindow("Terrain Generator 2.5D", x%, y%, sw%, sh%, 0, 5)
; Create the drawing canvas'
can0% = CreateCanvas(   0, 1,     178,    134, tg%)
can1% = CreateCanvas( 180, 1, sw%-192, sh%-10, tg%)

; Identify the 'root' menu for the window that we just created.
; All our menus must be attached to this
menu=WindowMenu(tg)
; Create "File" menu on "Menu Bar"
file=CreateMenu("File", 0, menu)
CreateMenu(     "Load Terrain BMP",  1, file)
CreateMenu(     "Save Terrain BMP",  2, file)
CreateMenu(                     "", 98, file)
CreateMenu("Load Terrain Settings",  3, file)
CreateMenu("Save Terrain Settings",  4, file)
CreateMenu(                     "", 99, file)
CreateMenu(                 "Exit",  5, file)

; Create "Map View" menu on "Menu Bar"
view=CreateMenu("Map View", 0, menu)
chkNormal = CreateMenu("Normal View", 6, view)
chkPoster = CreateMenu( "Posterized", 7, view)
  chkWire = CreateMenu( "Wire Frame", 8, view)
terrainView = 1

; Create "Color Scheme" menu on "Menu Bar"
pal=CreateMenu("Color Scheme", 0, menu)
    chkSea = CreateMenu("Sea and Turf", 9,pal)
   chkSand = CreateMenu(  "Sand Dunes",10,pal)
  chkPolar = CreateMenu(   "Polar Ice",11,pal)
   chkMars = CreateMenu(        "Mars",12,pal)
  chkVenus = CreateMenu(       "Venus",13,pal)
chkNeptune = CreateMenu(     "Neptune",14,pal)
   chkGray = CreateMenu(    "Midnight",15,pal)
colorScheme = 1

; Create "Help" menu on "Menu Bar"
help=CreateMenu("Help", 0, menu)
CreateMenu( "Help",20,help)
CreateMenu("About",21,help)



; Shows which items on "Map View" and "Color Scheme" are checked
CheckMenu chkNormal
oldView = chkNormal
CheckMenu chkSea
oldColor = chkSea

; Create Draw Button
draw = CreateButton("Draw Terrain!",30,141,128,40,tg)


; Finally, once all menus are set up / updated, we call
; UpdateWindowMenu to tell the OS about the menu
UpdateWindowMenu tg%

; Draw the image on canvas0
SetBuffer CanvasBuffer(can0%)
DrawBlock TGen%,0,0
FlipCanvas(can0%)

;Set canvas1 as the drawing canvas
SetBuffer CanvasBuffer(can1%)

;Create text boxes
tBox1 = CreateTextField(96, 196, 50, 25, tg)
tBox2 = CreateTextField(96, 241, 50, 25, tg)
tBox3 = CreateTextField(96, 286, 50, 25, tg)
tBox4 = CreateTextField(96, 331, 50, 25, tg)
tBox5 = CreateTextField(96, 376, 50, 25, tg)
tBox6 = CreateTextField(96, 421, 50, 25, tg)
tBox7 = CreateTextField(96, 466, 50, 25, tg)
tBox8 = CreateTextField(96, 511, 50, 25, tg)
;Fill the text boxes with default values
SetGadgetText tbox1, "200" :     Xsize% = 200
SetGadgetText tbox2, "160" :     Ysize% = 160
SetGadgetText tbox3,   "3" :      Blur% =   3
SetGadgetText tbox4,   "2" :     Water% =   2
SetGadgetText tbox5,   "3" : Pixelsize% =   3
SetGadgetText tbox6,   "6" :     Scale% =   6
SetGadgetText tbox7,   "4" :    Height% =   4
SetGadgetText tbox8,   "0" :      Skew# =   0.0

;Create labels
sTxt1 = CreateLabel(    " Width",40, 201, 56, 20, tg)
sTxt2 = CreateLabel(    "Length",40, 246, 56, 20, tg)
sTxt3 = CreateLabel(      "Blur",56, 291, 40, 20, tg)
sTxt4 = CreateLabel(     "Water",40, 336, 56, 20, tg)
sTxt5 = CreateLabel("Pixel Size",16, 381, 80, 20, tg)
sTxt6 = CreateLabel(     "Scale",48, 426, 48, 20, tg)
sTxt7 = CreateLabel(    "Height",40, 471, 56, 20, tg)
sTxt8 = CreateLabel(      "Skew",48, 516, 48, 20, tg)

Repeat
; Wait for an event to occur...
id=WaitEvent()

; exit on a window close event
; and release all resources
If id=$803 Then
FreeImage TGen% : TGen% = 0
FreeImage ok%   : ok% = 0
FreeImage lt%   : lt% = 0
FreeImage rt%   : rt% = 0
FreeGadget tBox1
FreeGadget tBox2
FreeGadget tBox3
FreeGadget tBox4
FreeGadget tBox5
FreeGadget tBox6
FreeGadget tBox7
FreeGadget tBox8
FreeFont arial9B%
FreeFont arial12%
FreeFont arial12U%
FreeFont arial24B%
End
End If

; check the Draw button
If id=$401 Then
If EventSource() = draw Then
;check for valid input ranges
Xsize = Floor(TextFieldText$(tbox1))
If Xsize < 10 Or Xsize > 1600 Then
Xsize = 200
SetGadgetText tbox1,"200"
End If
Ysize = Floor(TextFieldText$(tbox2))
If Ysize < 10 Or Ysize > 1200 Then
Ysize = 160
SetGadgetText tbox2,"160"
End If
Blur = Floor(TextFieldText$(tbox3))
If Blur < 0 Or Blur > 10 Then
Blur = 3
SetGadgetText tbox3,"3"
End If
Water = Floor(TextFieldText$(tbox4))
If Water < 1 Or Water > 50 Then
Water= 2
SetGadgetText tbox4,"2"
End If
Pixelsize = Floor(TextFieldText$(tbox5))
If Pixelsize  < 1 Or Pixelsize  > 8 Then
Pixelsize  = 3
SetGadgetText tbox5,"3"
End If
Scale = Floor(TextFieldText$(tbox6))
If Scale < 1 Or Scale > 50 Then
Scale = 6
SetGadgetText tbox6,"6"
End If
Height = Floor(TextFieldText$(tbox7))
If Height < 1 Or Height > 50 Then
Height = 4
SetGadgetText tbox7,"4"
End If
Skew = Float(TextFieldText$(tbox8))
If Skew < -10.0 Or Skew > 10.0 Then
Skew = 0
SetGadgetText tbox8,"0"
End If

;create color scheme
createPalette%(colorScheme%)
;allocate enough memory for height map size
Dim hz%(Xsize% + 1, Ysize% + 1)
;make a height map using randomly placed pixels
map%(Xsize%, Ysize%, Pixelsize%, Water%)
;create smooth color gradients between different colored pixels
For i% = 1 To Blur%
   smooth%(Xsize%, Ysize%)
Next
;make the 2.5D terrain
terraGen(Xsize%, Ysize%, Scale%, terrainView%, Height%, Skew#)

FlipCanvas(can1%)
End If
End If

;handle a menu event
If id=$1001 Then
; evtID contains EventData() the menu ID specified during setup
evtID=EventData()
Select evtID
Case 1
;load saved terrain bmp
loadName$ = ""
loadName$ = RequestFile("Load Terrain BMP","bmp",False)
If loadName$ <> "" Then
pic% = LoadImage(loadName$)
Cls
DrawBlock pic%,0,0
FlipCanvas(can1%)
FreeImage pic%
pic% = 0
Else
RuntimeError "Requested file NOT found!"
End If
Case 2
;save terrain bmp to disk
saveName$ = ""
saveName$ = RequestFile("Save Terrain BMP","*.bmp",True,"Terrain001.bmp")
If saveName$ <> "" Then
pic% = CreateImage(sw%-192,sh%-10)
GrabImage pic%,0,0
fine% = SaveImage(pic%,saveName$)
If fine% = 0 Then
RuntimeError "An error occurred. Image Not saved!"
End If
FreeImage pic%
pic% = 0
End If
Case 3
;load terrain settings from ".TRS" file
loadName$ = ""
loadName$ = RequestFile("Load Terrain Settings...","trs",False,"Default.trs")
If loadName$ <> "" Then
fileIn% = ReadFile(loadName$)
temp$ = ReadLine(fileIn%)
terrainView = Floor(temp$)
temp$ = ReadLine(fileIn%)
colorScheme = Floor(temp$)
temp$ = ReadLine(fileIn%)
SetGadgetText tbox1,temp$
Xsize% = Floor(temp$)
temp$ = ReadLine(fileIn%)
SetGadgetText tbox2,temp$
Ysize% = Floor(temp$)
temp$ = ReadLine(fileIn%)
SetGadgetText tbox3,temp$
Blur% = Floor(temp$)
temp$ = ReadLine(fileIn%)
SetGadgetText tbox4,temp$
Water% = Floor(temp$)
temp$ = ReadLine(fileIn%)
SetGadgetText tbox5,temp$
Pixelsize% = Floor(temp$)
temp$ = ReadLine(fileIn%)
SetGadgetText tbox6,temp$
Scale% = Floor(temp$)
temp$ = ReadLine(fileIn%)
SetGadgetText tbox7,temp$
Height% = Floor(temp$)
temp$ = ReadLine(fileIn%)
SetGadgetText tbox8,temp$
Skew# = Float(temp$)
CloseFile(fileIn%)
Else
RuntimeError "Requested file NOT found!"
End If
Case 4
;save terrain settings to ".TRS" file
saveName$ = ""
saveName$ = RequestFile("Save Terrain Settings...","trs",True)
If saveName$ <> "" Then
fileOut% = WriteFile(saveName$)
temp$ = Str(terrainView%)
WriteLine(fileOut%,temp$)
temp$ = Str(colorScheme%)
WriteLine(fileOut%,temp$)
temp$ = Str(Xsize%)
WriteLine(fileOut%,temp$)
temp$ = Str(Ysize%)
WriteLine(fileOut%,temp$)
temp$ = Str(Blur%)
WriteLine(fileOut%,temp$)
temp$ = Str(Water%)
WriteLine(fileOut%,temp$)
temp$ = Str(PixelSize%)
WriteLine(fileOut%,temp$)
temp$ = Str(Scale%)
WriteLine(fileOut%,temp$)
temp$ = Str(Height%)
WriteLine(fileOut%,temp$)
temp$ = Str(Skew#)
WriteLine(fileOut%,temp$)
CloseFile(fileOut%)
Else
RuntimeError "Filename "+saveName$+" is NOT a valid name/location!"
End If
Case 5
;free all resources then end
FreeImage TGen% : TGen% = 0
FreeImage ok%   : ok% = 0
FreeImage lt%   : lt% = 0
FreeImage rt%   : rt% = 0
FreeGadget tBox1
FreeGadget tBox2
FreeGadget tBox3
FreeGadget tBox4
FreeGadget tBox5
FreeGadget tBox6
FreeGadget tBox7
FreeGadget tBox8
FreeFont arial9B%
FreeFont arial12%
FreeFont arial12U%
FreeFont arial24B%
End
Case 6 ;Normal View
terrainView = 1
If oldView <> chkNormal Then
UncheckMenu oldView
oldView = chkNormal
CheckMenu chkNormal
UpdateWindowMenu tg
End If
Case 7 ;Posterized
terrainView = 2
If oldView <> chkPoster Then
UncheckMenu oldView
oldView = chkPoster
CheckMenu chkPoster
UpdateWindowMenu tg
End If
Case 8 ;Wire Frame
terrainView = 3
If oldView <> chkWire Then
UncheckMenu oldView
oldView = chkWire
CheckMenu chkWire
UpdateWindowMenu tg
End If
Case 9 ;Sea and Turf
colorScheme = 1
If oldColor <> chkSea Then
UncheckMenu oldColor
oldColor = chkSea
CheckMenu chkSea
UpdateWindowMenu tg
End If
Case 10 ;Sand Dunes
colorScheme = 2
If oldColor <> chkSand Then
UncheckMenu oldColor
oldColor = chkSand
CheckMenu chkSand
UpdateWindowMenu tg
End If
Case 11 ;Polar Ice
colorScheme = 3
If oldColor <> chkPolar Then
UncheckMenu oldColor
oldColor = chkPolar
CheckMenu chkPolar
UpdateWindowMenu tg
End If
Case 12 ;Mars
colorScheme = 4
If oldColor <> chkMars Then
UncheckMenu oldColor
oldColor = chkMars
CheckMenu chkMars
UpdateWindowMenu tg
End If
Case 13 ;Venus
colorScheme = 5
If oldColor <> chkVenus Then
UncheckMenu oldColor
oldColor = chkVenus
CheckMenu chkVenus
UpdateWindowMenu tg
End If
Case 14 ;Neptune
colorScheme = 6
If oldColor <> chkNeptune Then
UncheckMenu oldColor
oldColor = chkNeptune
CheckMenu chkNeptune
UpdateWindowMenu tg
End If
Case 15 ;Midnight
colorScheme = 7
If oldColor <> chkGray Then
UncheckMenu oldColor
oldColor = chkGray
CheckMenu chkGray
UpdateWindowMenu tg
End If
Case 20 ;Help
pic% = CreateImage(sw%-192, sh%-10)
GrabImage pic%,0,0
ClsColor 255,250,196
.arrows
Cls
Color 0,0,0
help1(arial24B%, arial9B%)
DrawBlock ok%,240,482
DrawBlock rt%,485,482
Text 260,535,"Exit Help"
Text 470,535,"Help continued"
FlipCanvas(can1%)
WaitMouse()
mx% = MouseX(can1%)
my% = MouseY(can1%)
If mx% > 485 And mx% < 585 And my% > 481 And my% < 528 Then
Cls
help2(arial24B%, arial9B%)
DrawBlock ok%,240,482
DrawBlock lt%,28,482
Text 260,535,"Exit Help"
Text 60,535,"Back"
FlipCanvas(can1%)
WaitMouse()
mx% = MouseX(can1%)
my% = MouseY(can1%)
If mx% > 27 And mx% < 128 And my% >481 And my% < 528 Then Goto arrows
End If
DrawBlock pic%,0,0
FlipCanvas(can1%)
FreeImage pic%
pic% = 0
ClsColor 0,0,0
Case 21 ;About
pic% = CreateImage(sw%-192, sh%-10)
GrabImage pic%,0,0
ClsColor 255,250,196
Cls
Color 0,0,0
SetFont arial24B%
Text  70,90,"About Terrain Generator"
SetFont arial12%
Text  20,140,"Terrain Generator is based on 'Lands.Bas' by Per Larsson."
Text  20,170,"Source:"
SetFont arial12U%
Color 0,0,255
Text 90,200,"http://scottserver.net/basically/abc/1998pack.htm"
Text  90,230,"http://www.qbasic.com/classic/c2.html"
SetFont arial12%
Color 0,0,0
Text  20,280,"Optimizations and enhancements have been applied to"
Text  20,310,"this conversion to make it run on just about any modern"
Text  20,340,"Windows computer."
Text 100,420,"This version by Andy Amaya - March 12, 2007"
DrawBlock ok,240,455
SetFont arial9B%
Text 235,510,"Left-Click to Exit"
FlipCanvas(can1%)
WaitMouse()
DrawBlock pic%,0,0
FlipCanvas(can1%)
FreeImage pic%
pic% = 0
ClsColor 0,0,0
End Select
End If
Forever

Function createPalette%(colorScheme%)
Local i%
Local rgb%
Local r%
Local g%
Local b%
Select colorScheme%
Case 1  ;Sea and Turf
c%(1,1) = 0 : c%(1,2) = 60 : c%(1,3) = 128
c%(1,0) = (c%(1,2) Shl 8) + (c%(1,3) Shl 16)
For i% = 2 To 7
c%(i%,1) = 0 : c%(i%,2) = i%*8 : c%(i%,3) = 0
c%(i%,0) = (i% * 8) Shl 8
Next
c%(8,1) = 32 : c%(8,2) = 64 : c%(8,3) = 0
c%(8,0) = c%(8,1) + (c%(8,2) Shl 8)
For i% = 9 To 15
r% = i% * 5
g% = i% * 6
c%(i%,1) = r% : c%(i%,2) = g% : c%(i%,3) = 0
c%(i%,0) = r% + (g% Shl 8)
Next
Case 2 ;Sand Dunes
c%(1,1) = 96 : c%(1,2) = 64 : c%(1,3) = 16
c%(1,0) = c%(1,1) + (c%(1,2) Shl 8) + (c%(1,3) Shl 16)
For i%= 1 To 14
r% = i% * 13 + 64
g% = i% * 9 + 48
b% = i% * 2
c%(i%+1,1) = r% : c%(i%+1,2) = g% : c%(i%+1,3) = b%
c%(i%+1,0) = r% + (g% Shl 8) + (b% Shl 16)
Next
Case 3  ;Polar Ice
c%(1,1) = 0 : c%(1,2) = 16 : c%(1,3) = 65
c%(1,0) = (c%(1,2) Shl 8) + (c%(1,3) Shl 16)
For i% = 2 To 15
rgb% = i% * 12 + 75
c%(i%,1) = rgb% : c%(i%,2) = rgb% : c%(i%,3) = rgb%
c%(i%,0) = rgb% + (rgb% Shl 8) + (rgb% Shl 16)
Next
Case 4  ;Mars
c%(1,1) = 160 : c%(1,2) = 50 : c%(1,3) = 0
c%(1,0) = c%(1,1) + (c%(1,2) Shl 8)
For i% = 2 To 15
r% = i% * 12 + 75
g% = i% * 5
c%(i%,1) = r% : c%(i%,2) = g% : c%(i%,3) = 0
c%(i%,0) = r% + (g% Shl 8)
Next
Case 5  ;Venus
c%(1,1) = 65 : c%(1,2) = 0 : c%(1,3) = 49
c%(1,0) = c%(1,1) + (c%(1,3) Shl 16)
For i% = 2 To 15
r% = i% * 12 + 75
b% = i% * 9
c%(i%,1) = r% : c%(i%,2) = 0 : c%(i%,3) = b%
c%(i%,0) = r% + (b% Shl 16)
Next
Case 6  ;Neptune
c%(1,1) = 16 : c%(1,2) = 81 : c%(1,3) = 65
c%(1,0) = c%(1,1) + (c%(1,2) Shl 16) + (c%(1,3) Shl 8)
For i% = 2 To 15
g% = i% * 17
b% = i% * 17
c%(i%,1) = 0 : c%(i%,2) = g% : c%(i%,3) = b%
c%(i%,0) = (g% Shl 8) + (b% Shl 16)
Next
Case 7  ;Midnight
For i% = 1 To 15
rgb% = i% * 10
c%(i%,1) = rgb% : c%(i%,2) = rgb% : c%(i%,3) = rgb%
c%(i%,0) = rgb% + (rgb% Shl 8) + (rgb% Shl 16)
Next
End Select
End Function

; Create a height map using random pixels
Function map%(Xsize%, Ysize%, Pixelsize%, Water%)
Local i%, j%, x%, y%, value%, pen%, xPos%, count%
Cls
For i% = 0 To Ysize% + 1
hz%(0,         i%) = 1
hz%(Xsize% + 1, i%) = 1
Next
For i% = 0 To Xsize% + 1
hz%(i%,         0) = 1
hz%(i%, Ysize% + 1) = 1
Next
If Pixelsize% = 1 Then
pen% = 1
Else
pen% = Pixelsize% Shr 1
End If
Water% = Water% + 1

Color 0, 160, 255
xPos% = 10
Text(xPos%, 20,"Mapping >")
FlipCanvas(can1%)
xPos% = xPos% + 70
x% = 0
While x% < Xsize%
count% = count% + 1
If count% Mod 10 = 0 Then
xPos% = xPos% + 10
Text(xPos%, 20,">")
FlipCanvas(can1%)
End If
y% = 0
While y% < Ysize%
value% = Rand(1,Water%)
If value% = 1 Then value% = 15 Else value% = 1
If Pixelsize% = 1 Then
hz%(x%, y%) = value%
Else
For j% = y% To y% + Pixelsize%
For i% = x% To x% + Pixelsize%
If i% <= Xsize% And j% <= Ysize% Then hz%(i%, j%) = value%
Next
Next
End If
y% = y% + Pixelsize%
Wend
x% = x% + Pixelsize%
Wend

Cls
FlipCanvas(can1%)
End Function

; Smooth the raw pixels in height map by color averaging (blurring)
Function smooth%(Xsize%, Ysize%)
Local x%, y%, z%, xPos%
Cls

Color 0,160,255: xPos% = 10
Text(xPos%, 20,"Smoothing >")
FlipCanvas(can1%)
xPos% = xPos% + 80
For y% = 0 To Ysize% -1
If y% Mod 10 = 0 Then
xPos% = xPos% + 10
Text(xPos%, 20, ">")
FlipCanvas(can1%)
End If
y1% = y% + 1
For x% = 0 To Xsize% - 1
x1% = x% + 1
z% =      hz%(x1% - 1, y1% -1)  + hz%(x1%, y1% - 1) + hz%(x1% + 1, y1% - 1)
z% = z% + hz%(x1% - 1, y1%)     + hz%(x1%, y1%)     + hz%(x1% + 1, y1%)
z% = z% + hz%(x1% - 1, y1% + 1) + hz%(x1%, y1% + 1) + hz%(x1% + 1, y1% + 1)
z% = z% / 9
If z% < 1 Then z% = 1
hz%(x%,y%) = z%
Next
Next
Cls
Text(10,20,"Rendering...")
FlipCanvas(can1%)
End Function

; Three different ways to view resultant height map
Function terraGen%(Xsize%, Ysize%, Scale%, terrainView%, Height%, Skew#)
Local x%, y%, value%, value2%, value3%, x1%, y1%, x2%, y2%, pen%, yOffset%
Cls
yOffset% = Scale% * Height% + 40
Select terrainView%
Case 1 ;Normal View
For y% = 0 To Ysize%-2
For x% = 0 To Xsize%-2
value% = hz%(x%, y%)
Color c%(value%,1), c%(value%,2), c%(value%,3)
x1% = (x% * Scale% + y% * Skew#) + 8
y1% = (y% * Scale% - value% * Height%) + yOffset%
x2% = (x% * Scale% + y% * Skew#) + Scale% + 8
y2% = y% * Scale% + (Scale% -1) + yOffset%
Rect x1%, y1%, x2%-x1%, y2%-y1%, True
Next
Next
Case 2 ;Posterized
If Scale% = 1 Then
pen% = 1
Else
pen% = pen% Shr 1 + 1
End If
For y% = 0 To Ysize%-2
For x% = 0 To Xsize%-2
If hz%(x%+1,y%+1)<1 Then
value% = 1
Else
value% = hz%(x%+1, y%+1)
End If
Color c%(value%,1), c%(value%,2), c%(value%,3)
x1% = (x%+1) * Scale% + (y%+1) * Skew# + 8
y1% = (y%+1) * Scale% - (value% * Height%) + yOffset%
If Pixelsize% = 1 Then
Plot(x1%, y1%)
Else
Oval x1%-pen%, y1%-pen%, Scale% , Scale% , True
End If
Next
Next
Case 3 ;Wire Frame
For y% = 0 To Ysize%-2
For x% = 0 To Xsize%-2
If hz%(x%,y%)<1 Then value% = 1 Else value%  = hz%(x%, y%)
If hz%(x%+1,y%)<1 Then value2% = 1 Else value2% = hz%(x%+1, y%)
If hz(x%,y%+1)<1 Then value3% = 1 Else value3% = hz(x%, y%+1)
x1% = (x% * Scale% + y% * Skew#) + 8
y1% = (y% * Scale% - value% * Height%) + yOffset%
x2% = ((x% + 1) * Scale% + y% * Skew#) + 8
y2% = (y% * Scale% - value2% * Height%) + yOffset%
Color c%(value%,1), c%(value%,2), c%(value%,3)
Line x1%, y1%, x2%, y2%
x2% = x% * Scale% + (y% + 1) * Skew# + 8
y2% = (y% + 1) * Scale% - value3% * Height% + yOffset%
Line x1%, y1%, x2%, y2%
Next
Next
End Select
End Function

Function help1(arial24B%, arial9B%)
SetFont arial24B%
Text 100, 5,"Terrain Generator Help"
SetFont arial9B%
Text  10, 60, "File Menu:"
Text  10, 80, "    Load Terrain BMP - loads a saved terrain from the current folder"
Text  10,100, "    Save Terrain BMP - saves on screen terrain to the current folder"
Text  10,120, "    Load Terrain Settings - loads your saved settings (Width, Length,"
Text 215,140, "Blur, etc..) from the current folder"
Text  10,160, "    Save Terrain Settings - saves the Width, Length, Blur, etc..."
Text 215,180, "values to the current folder for later retrieval."
Text  10,200, "Map View Menu:"
Text  10,220, "    Normal View"
Text 133,220, "- fully renders the terrain"
Text  10,240, "    Posterized"
Text 133,240, "- partially renders the terrain"
Text  10,260, "    Wire Frame"
Text 133,260, "- structural render of the terrain"
Text  10,290, "Color Scheme:"
Text  10,310, "    Nature"
Text 130,310, "- renders blue water and graduated shades of green"
Text  10,330, "    Sand Dunes"
Text 130,330, "- renders in graduated shades of yellow"
Text  10,350, "    Polar Ice"
Text 130,350, "- renders blue water and graduated shades of white"
Text  10,370, "    Mars"
Text 130,370, "- renders in graduated shades of red"
Text  10,390, "    Venus"
Text 130,390, "- renders in graduated shades of magenta"
Text  10,410, "    Neptune"
Text 130,410, "- renders in graduated shades of cyan"
Text  10,430, "    Midnight"
Text 130,430, "- renders in graduated shades of gray"
Text  10,460, "Draw Terrain Button - click to render terrain at current settings"
End Function

Function help2(arial24b%, arial9B%)
SetFont arial24B%
Text 100, 5,"Terrain Generator Help"
SetFont arial9B%
Text  10, 90,"Here's how the settings affect your terrain:"
Text  10,120,"Width  - sets the width of the map used to generate the terrain"
Text  78,140,"valid range is 10 => Width <= 1600"
Text  10,160,"Length - sets the height of the map used to generate the terrain"
Text  78,180,"valid range is 10 => Length <= 1600"
Text  10,200,"Blur     - more blur creates less jagged terrains"
Text  78,220,"valid range is 0 => Blur <= 10"
Text  10,240,"Water  - sets the amount of water visible in terrain"
Text  78,260,"valid range is 1 => Water <= 50"
Text  10,280,"Pixelsize - size of pixel used to create the random map"
Text  93,300,"valid range is 1 => Pixelsize <= 8"
Text  10,320,"Scale   - makes your terrain bigger or smaller"
Text  78,340,"valid range is 1 => Scale <= 50"
Text  10,360,"Height - makes terrain mountains higher or lower"
Text  78,380,"valid range is 1 => Height <= 50"
Text  10,400,"Skew   - makes terrain lean left, right, or not at all (zero)"
Text  78,420,"valid range is -10.0 => Skew <= 10.0"
End Function
[/code]

Comments : none...

 

SimplePortal 2.3.6 © 2008-2014, SimplePortal