Advertisement
Dr_Davenstein

Old Pathfinder...

Jun 9th, 2020
372
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 19.42 KB | None | 0 0
  1. #lang "qb"
  2.  
  3. '$DYNAMIC
  4. defint A-Z
  5. declare function checkbounds% ()
  6. declare sub makedungeon (IsFirstMaze%)
  7. declare sub fixwalls ()
  8. declare sub fixmaze ()
  9. declare sub randomizemonsters ()
  10. declare sub waiter (Amount#)
  11. declare sub square (X%, Y%, Col%)
  12. declare sub drawmaze ()
  13. declare sub findpath (M%, StartX%, StartY%, TargX%, TargY%)
  14.  
  15. common shared MazeLength, MazeHeight, TotalMonsters, TotalRooms
  16. const true = -1, OpenL = 1, CloseL = -1, null = 0
  17. const GryHi = 15, BluHi = 1, RedHi = 4, GrnHi = 2
  18.  
  19. screen 12
  20. width 80, 60
  21. randomize timer
  22.  
  23. MazeLength = 50
  24. MazeHeight = 50
  25. TotalMonsters = 16
  26. TotalRooms = 16
  27.  
  28. type MonsterStuff
  29. X as integer
  30. Y as integer
  31. Hp as integer
  32. TargX as integer
  33. TargY as integer
  34. TempX as integer
  35. TempY as integer
  36. WalkCnt as integer
  37. AMoves as integer
  38. HitTarg as integer
  39. end type
  40.  
  41. type MazeStuff
  42. AssY as integer
  43. Exposed as integer
  44. InRad as integer
  45. Col as integer
  46. Typ as integer
  47. end type
  48.  
  49. type RoomStuff
  50. X as integer
  51. Y as integer
  52. Sx as integer
  53. Sy as integer
  54. Lit as integer
  55. end type
  56.  
  57. type PathStuff
  58. Cs as integer
  59. Px as integer
  60. Py as integer
  61. F as integer
  62. G as integer
  63. H as single
  64. P as integer
  65. end type
  66.  
  67. type WalkStuff
  68. X as integer
  69. Y as integer
  70. end type
  71.  
  72. dim shared Rm(TotalRooms) as RoomStuff, Sort(1 to MazeLength, 1 to MazeHeight) as integer
  73. dim shared Maz(1 to MazeLength, 1 to MazeHeight) as MazeStuff, Mark(1 to MazeLength, 1 to MazeHeight) as integer
  74. dim shared Mnstr(1 to TotalMonsters) as MonsterStuff
  75. dim shared Path(1 to MazeLength, 1 to MazeHeight) as PathStuff
  76. dim shared Walk(1 to ((MazeLength * MazeHeight) \ 2)) as WalkStuff, TPath(1 to TotalMonsters, 1 to TotalMonsters) as WalkStuff
  77.  
  78.  
  79. do
  80. color (15)
  81. locate 58, 1
  82. print "Building maze, Please Wait.."
  83. makedungeon 1
  84. locate 58, 1
  85. print string$(28, 32)
  86.  
  87. randomizemonsters
  88. for M = 1 to TotalMonsters
  89. Fx = Mnstr(M).X
  90. Fy = Mnstr(M).Y
  91. Tx = Mnstr(M).TargX
  92. Ty = Mnstr(M).TargY
  93. findpath M, Tx, Ty, Fx, Fy
  94. next
  95. drawmaze
  96.  
  97. do
  98. In$ = inkey$
  99. GoodCnt = 0
  100. GotPath = false
  101. StartAt = StartAt + 1
  102. if StartAt > TotalMonsters then StartAt = 1
  103. Fx = Mnstr(StartAt).X
  104. Fy = Mnstr(StartAt).Y
  105. Tx = Mnstr(StartAt).TargX
  106. Ty = Mnstr(StartAt).TargY
  107. findpath StartAt, Tx, Ty, Fx, Fy
  108.  
  109. for M = 1 to TotalMonsters
  110. Mnstr(M).HitTarg = false
  111. Ox = Mnstr(M).X
  112. Oy = Mnstr(M).Y
  113. OWalkCnt = Mnstr(M).WalkCnt
  114. Mnstr(M).WalkCnt = Mnstr(M).WalkCnt + 1
  115. if Mnstr(M).WalkCnt > Mnstr(M).AMoves then
  116. Mnstr(M).WalkCnt = Mnstr(M).AMoves
  117. end if
  118. Mnstr(M).TempX = TPath(M, Mnstr(M).WalkCnt).X
  119. Mnstr(M).TempY = TPath(M, Mnstr(M).WalkCnt).Y
  120.  
  121. if Mnstr(M).X < Mnstr(M).TempX then Mnstr(M).X = Mnstr(M).X + 1
  122. if Mnstr(M).X > Mnstr(M).TempX then Mnstr(M).X = Mnstr(M).X - 1
  123. if Mnstr(M).Y < Mnstr(M).TempY then Mnstr(M).Y = Mnstr(M).Y + 1
  124. if Mnstr(M).Y > Mnstr(M).TempY then Mnstr(M).Y = Mnstr(M).Y - 1
  125.  
  126. select case Maz(Mnstr(M).X, Mnstr(M).Y).AssY
  127. case 24, 25, 176, 234
  128. 'These are walkable tiles...
  129. case else
  130. 'These are walls...
  131. Mnstr(M).X = Ox
  132. Mnstr(M).Y = Oy
  133. Mnstr(M).WalkCnt = OWalkCnt
  134. end select
  135.  
  136.  
  137. if Mnstr(M).X = Mnstr(M).TargX and Mnstr(M).Y = Mnstr(M).TargY then
  138. Mnstr(M).X = Ox
  139. Mnstr(M).Y = Oy
  140. Mnstr(M).HitTarg = true
  141. end if
  142.  
  143. for C = 1 to TotalMonsters
  144. if C <> M then
  145. if Mnstr(C).Hp > 0 then
  146. if Mnstr(M).X = Mnstr(C).X and Mnstr(M).Y = Mnstr(C).Y then
  147. Mnstr(M).X = Ox
  148. Mnstr(M).Y = Oy
  149. Mnstr(M).WalkCnt = OWalkCnt
  150. if Mnstr(C).HitTarg then Mnstr(M).HitTarg = true
  151. end if
  152. end if
  153. end if
  154. next
  155.  
  156. color (Maz(Ox, Oy).Col)
  157. locate Oy, Ox
  158. print chr$(Maz(Ox, Oy).AssY)
  159. MonCol = M - 1
  160. if MonCol = 0 then MonCol = 15
  161. color (MonCol)
  162. locate Mnstr(M).Y, Mnstr(M).X
  163. print chr$(2)
  164. square Mnstr(M).TargX, Mnstr(M).TargY, 7
  165. if Mnstr(M).X = Ox and Mnstr(M).Y = Oy then
  166. if Mnstr(M).HitTarg then
  167. GoodCnt = GoodCnt + 1
  168. end if
  169. end if
  170. next
  171.  
  172. 'waiter .075
  173. sleep 100,1
  174. if In$ = chr$(27) then goto Ender
  175. Loops = Loops + 1
  176. if Loops >= 250 then exit do
  177. loop until GoodCnt >= TotalMonsters
  178. Loops = 0
  179. loop
  180.  
  181. Ender:
  182. system
  183.  
  184. rem $static
  185. function checkbounds%
  186. 'This function scans the entire level and returns true if it's good...
  187.  
  188. TotalDots = 0
  189. for Y = 1 to MazeHeight
  190. for X = 1 to MazeLength
  191. Sort(X, Y) = true
  192. Mark(X, Y) = true
  193. next
  194. next
  195.  
  196. for Y = 2 to MazeHeight - 1
  197. for X = 2 to MazeLength - 1
  198. if Maz(X, Y).AssY = 0 then
  199. TotalDots = TotalDots + 1
  200. Sort(X, Y) = 1
  201. Mark(X, Y) = 0
  202. end if
  203. next
  204. next
  205.  
  206.  
  207.  
  208. Tys = MazeHeight - 1
  209. Txs = MazeLength - 1
  210.  
  211. for Y = 2 to Tys
  212. for X = 2 to Txs
  213. if Sort(X, Y) <> true and not GotTheMark then
  214. GotTheMark = true
  215. Mark(X, Y) = true
  216. end if
  217. next
  218. next
  219.  
  220.  
  221. for Y1 = 2 to Tys
  222. for X1 = 2 to Txs
  223. YBegin = Y1 - (Tys - (Tys - Y1))
  224. YFinal = Y1 + (Tys - Y1)
  225. XBegin = X1 - (Txs - (Txs - X1))
  226. XFinal = X1 + (Txs - X1)
  227. Cnt1 = 0: Cnt2 = 0
  228. FakeDots = FakeDots + 1
  229. for Y2 = YBegin to YFinal
  230. for X2 = XBegin to XFinal
  231. if X2 >= 2 and X2 <= Txs and Y2 >= 2 and Y2 <= Tys then
  232. Ok1 = Sort(X2 - 1, Y2) <> true and Mark(X2 - 1, Y2)
  233. Ok2 = Sort(X2 + 1, Y2) <> true and Mark(X2 + 1, Y2)
  234. Ok3 = Sort(X2, Y2 - 1) <> true and Mark(X2, Y2 - 1)
  235. Ok4 = Sort(X2, Y2 + 1) <> true and Mark(X2, Y2 + 1)
  236. Ok = Ok1 or Ok2 or Ok3 or Ok4
  237. if Ok and Sort(X2, Y2) <> true then
  238. Mark(X2, Y2) = true
  239. Cnt1 = Cnt1 + 1
  240. if Sort(X2, Y2) = 1 then
  241. Cnt2 = Cnt2 + 1
  242. CountDots = CountDots + 1
  243. Sort(X2, Y2) = 0
  244. if CountDots = TotalDots then goto Finale
  245. end if
  246. end if
  247. end if
  248. next
  249. next
  250.  
  251. if Cnt1 = OCnt1 and Cnt2 = OCnt2 then goto Finale
  252. OCnt1 = Cnt1
  253. OCnt2 = Cnt2
  254. next
  255. next
  256.  
  257. Finale:
  258. if TotalDots = CountDots then checkbounds% = true
  259.  
  260.  
  261. end function
  262.  
  263. sub drawmaze
  264.  
  265. for Y = 1 to MazeHeight
  266. for X = 1 to MazeLength
  267. color (Maz(X, Y).Col)
  268. locate Y, X
  269. print chr$(Maz(X, Y).AssY)
  270. next
  271. next
  272. end sub
  273.  
  274. sub findpath (M%, StartX%, StartY%, TargX%, TargY%)
  275. if StartX = TargX and StartY = TargY then
  276. AlreadyThere = true
  277. goto Finalize
  278. end if
  279. redim Path(1 to MazeLength, 1 to MazeHeight) as PathStuff
  280. Path(StartX, StartY).Cs = OpenL
  281. for C = 1 to TotalMonsters
  282. if C <> M then
  283. if Mnstr(C).Hp > 0 then
  284. 'This gives a penalty to the nodes that are taken by the other monsters.
  285. 'It encourages the algo to find another path.
  286. Path(Mnstr(C).X, Mnstr(C).Y).P = 1000
  287. end if
  288. end if
  289. next
  290. OnOpenList = 1
  291. Walk(1).X = StartX
  292. Walk(1).Y = StartY
  293.  
  294.  
  295. do
  296. OCurX = CurX
  297. OCurY = CurY
  298. CurScore = 10000
  299. for C = 1 to OnOpenList
  300. if Walk(C).X > 0 and Walk(C).Y > 0 then
  301. if Path(Walk(C).X, Walk(C).Y).Cs = OpenL then
  302. if Path(Walk(C).X, Walk(C).Y).F <= CurScore then
  303. CurX = Walk(C).X
  304. CurY = Walk(C).Y
  305. CurScore = Path(Walk(C).X, Walk(C).Y).F
  306. TempC = C
  307. end if
  308. end if
  309. end if
  310. next
  311.  
  312. Path(CurX, CurY).Cs = CloseL
  313. Walk(TempC).X = 0
  314. Walk(TempC).Y = 0
  315.  
  316. if CurX = TargX and CurY = TargY then exit do
  317. if CurX = OCurX and CurY = OCurY then exit do
  318. OldHole = false
  319. for Y = -1 to 1
  320. for X = -1 to 1
  321. Tx = X + CurX
  322. Ty = Y + CurY
  323. if X = 0 or Y = 0 then MoveCost = 10 else MoveCost = 14
  324. if Tx = CurX and Ty = CurY then goto SkipNode
  325.  
  326.  
  327. select case Maz(Tx, Ty).AssY
  328. case 24, 25, 176, 234
  329.  
  330. case else
  331. goto SkipNode
  332. end select
  333.  
  334.  
  335. if Path(Tx, Ty).Cs = null then
  336. Path(Tx, Ty).Cs = OpenL
  337. Path(Tx, Ty).Px = CurX
  338.  
  339. Path(Tx, Ty).Py = CurY
  340. Path(Tx, Ty).G = Path(CurX, CurY).G + MoveCost
  341. Path(Tx, Ty).H = sqr( (Tx - TargX)^2+(Ty - TargY)^2)*10' (abs(Tx - TargX) + abs(Ty - TargY)) * 10
  342. Path(Tx, Ty).F = Path(Tx, Ty).G + Path(Tx, Ty).H + Path(Tx, Ty).P
  343. if OldHole then
  344. OnOpenList = OnOpenList + 1
  345. Walk(OnOpenList).X = Tx
  346. Walk(OnOpenList).Y = Ty
  347. else
  348. OldHole = true
  349. Walk(TempC).X = Tx
  350. Walk(TempC).Y = Ty
  351. end if
  352. end if
  353. SkipNode:
  354. next
  355. next
  356.  
  357. loop
  358.  
  359. Finalize:
  360. Mnstr(M).WalkCnt = 0
  361. Mnstr(M).AMoves = 1
  362. if AlreadyThere then
  363. TPath(M, 1).X = StartX
  364. TPath(M, 1).Y = StartY
  365. exit sub
  366. end if
  367. Tx = Mnstr(M).X
  368. Ty = Mnstr(M).Y
  369. for C = 1 to TotalMonsters
  370. TPath(M, C).X = Path(Tx, Ty).Px
  371. TPath(M, C).Y = Path(Tx, Ty).Py
  372. Tx2 = Path(Tx, Ty).Px
  373. Ty2 = Path(Tx, Ty).Py
  374. Tx = Tx2
  375. Ty = Ty2
  376. if C > 1 then
  377. Mnstr(M).AMoves = C - 1
  378. end if
  379. if Tx = 0 or Ty = 0 then
  380. exit for
  381. end if
  382. next
  383. end sub
  384.  
  385. sub fixmaze
  386.  
  387. for Y = 1 to MazeHeight
  388. for X = 1 to MazeLength
  389. Sort(X, Y) = 0
  390. Maz(X, Y).Typ = 0
  391. if Maz(X, Y).AssY = true then
  392. Sort(X, Y) = true
  393. end if
  394. next
  395. next
  396.  
  397. for Y = 1 to MazeHeight
  398. for X = 1 to MazeLength
  399. Nw = 0
  400. Nr = 0
  401. Ne = 0
  402. ws = 0
  403. ES = 0
  404. Sw = 0
  405. St = 0
  406. Se = 0
  407.  
  408. if X > 1 and Y > 1 then
  409. Nw = Sort(X - 1, Y - 1) = true
  410. end if
  411. if Y > 1 then
  412. Nr = Sort(X, Y - 1) = true
  413. end if
  414. if Y > 1 and X < MazeLength then
  415. Ne = Sort(X + 1, Y - 1) = true
  416. end if
  417. if X > 1 then
  418. ws = Sort(X - 1, Y) = true
  419. end if
  420. Md = Sort(X, Y) = true
  421. if X < MazeLength then
  422. ES = Sort(X + 1, Y) = true
  423. end if
  424. if X > 1 and Y < MazeHeight then
  425. Sw = Sort(X - 1, Y + 1) = true
  426. end if
  427. if Y < MazeHeight then
  428. St = Sort(X, Y + 1) = true
  429. end if
  430. if X < MazeLength and Y < MazeHeight then
  431. Se = Sort(X + 1, Y + 1) = true
  432. end if
  433.  
  434.  
  435. TLcn = not Nr and not ws and St and ES and Md
  436. BLcn = not St and not ws and Nr and ES and Md
  437. TRcn = not Nr and not ES and St and ws and Md
  438. BRcn = not St and not ES and Nr and ws and Md
  439. Hori = not Nr and not St and ws and ES and Md
  440. Vert = not ws and not ES and Nr and St and Md
  441. TopT = not Nr and St and ws and ES and Md
  442. BotT = not St and Nr and ws and ES and Md
  443. LevT = not ws and ES and Nr and St and Md
  444. RigT = not ES and ws and Nr and St and Md
  445. Tend = not ES and not ws and not Nr and St and Md
  446. Bend = not ES and not ws and not St and Nr and Md
  447. Lend = not Nr and not St and not ws and ES and Md
  448. Rend = not Nr and not St and not ES and ws and Md
  449. Cros = Nr and St and ES and ws and Md
  450. Midl = Md and not Nr and not St and not ES and not ws
  451.  
  452.  
  453. if TLcn then Maz(X, Y).AssY = 201: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  454. if BLcn then Maz(X, Y).AssY = 200: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  455. if TRcn then Maz(X, Y).AssY = 187: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  456. if BRcn then Maz(X, Y).AssY = 188: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  457. if Hori then Maz(X, Y).AssY = 205: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  458. if Vert then Maz(X, Y).AssY = 186: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  459. if TopT then Maz(X, Y).AssY = 203: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  460. if BotT then Maz(X, Y).AssY = 202: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  461. if LevT then Maz(X, Y).AssY = 204: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  462. if RigT then Maz(X, Y).AssY = 185: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  463. if Tend then Maz(X, Y).AssY = 186: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  464. if Bend then Maz(X, Y).AssY = 186: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  465. if Lend then Maz(X, Y).AssY = 205: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  466. if Rend then Maz(X, Y).AssY = 205: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  467. if Cros then Maz(X, Y).AssY = 206: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  468. if Midl then Maz(X, Y).AssY = 254: Maz(X, Y).Col = BluHi: Maz(X, Y).Typ = true
  469. if Maz(X, Y).AssY = 0 then Maz(X, Y).AssY = 176: Maz(X, Y).Col = 8: Maz(X, Y).Typ = 0
  470. next
  471. next
  472.  
  473. for Y1 = 1 to MazeHeight
  474. for X1 = 1 to MazeLength
  475. if Maz(X1, Y1).AssY < 0 then
  476. Maz(X1, Y1).AssY = 177 + int(rnd * 2)
  477. Maz(X1, Y1).Typ = true
  478. Maz(X1, Y1).Col = 8
  479. end if
  480. next
  481. next
  482.  
  483. for R = 1 to TotalRooms
  484. for Y = Rm(R).Y - 1 to Rm(R).Y + Rm(R).Sy + 1
  485. for X = Rm(R).X - 1 to Rm(R).X + Rm(R).Sx + 1
  486. InXBox = X >= Rm(R).X and X <= Rm(R).X + Rm(R).Sx
  487. InYBox = Y >= Rm(R).Y and Y <= Rm(R).Y + Rm(R).Sy
  488. Corner1 = X = Rm(R).X - 1 and Y = Rm(R).Y - 1
  489. Corner2 = X = Rm(R).X + Rm(R).Sx + 1 and Y = Rm(R).Y - 1
  490. Corner3 = X = Rm(R).X - 1 and Y = Rm(R).Y + Rm(R).Sy + 1
  491. Corner4 = X = Rm(R).X + Rm(R).Sx + 1 and Y = Rm(R).Y + Rm(R).Sy + 1
  492. OnCorner = Corner1 or Corner2 or Corner3 or Corner4
  493.  
  494. if not InXBox or not InYBox then
  495. if Maz(X, Y).AssY = 176 and not OnCorner then
  496. Maz(X, Y).AssY = 234
  497. Maz(X, Y).Col = 9
  498. Maz(X, Y).Typ = true
  499. end if
  500. end if
  501. next
  502. next
  503. next
  504. end sub
  505.  
  506. sub fixwalls
  507. for Y = 1 to MazeHeight
  508. for X = 1 to MazeLength
  509. if Maz(X, Y).AssY <> 0 then
  510. Maz(X, Y).AssY = -3
  511. end if
  512. next
  513. next
  514.  
  515. for Y = 1 to MazeHeight
  516. for X = 1 to MazeLength
  517. for Y2 = Y - 1 to Y + 1
  518. for X2 = X - 1 to X + 1
  519. if X2 >= 1 and Y2 >= 1 and X2 <= MazeLength and Y2 <= MazeHeight then
  520. if Maz(X, Y).AssY = 0 then
  521. if Maz(X2, Y2).AssY <> 0 then
  522. Maz(X2, Y2).AssY = -1
  523. end if
  524. end if
  525. end if
  526. next
  527. next
  528. next
  529. next
  530. end sub
  531.  
  532. sub makedungeon (IsFirstMaze%)
  533. StartAgain:
  534. for Y = 1 to MazeHeight
  535. for X = 1 to MazeLength
  536. Maz(X, Y).AssY = true
  537. Maz(X, Y).Exposed = false
  538. next
  539. next
  540.  
  541. if IsFirstMaze% = 1 then
  542. StartRooms = 1
  543. else
  544. StartRooms = 2
  545. if not StartAgainFlag then
  546. Rm(1).X = Rm(TotalRooms).X
  547. Rm(1).Y = Rm(TotalRooms).Y
  548. Rm(1).Sx = Rm(TotalRooms).Sx
  549. Rm(1).Sy = Rm(TotalRooms).Sy
  550. end if
  551. for Ry = Rm(1).Y to Rm(1).Y + Rm(1).Sy
  552. for Rx = Rm(1).X to Rm(1).X + Rm(1).Sx
  553. Maz(Rx, Ry).AssY = 0
  554. next
  555. next
  556. end if
  557.  
  558. StartAgainFlag = true
  559.  
  560. for Rooms = StartRooms to TotalRooms
  561. Rm(Rooms).X = -1000
  562. Rm(Rooms).Y = -1000
  563. Rm(Rooms).Sx = 1
  564. Rm(Rooms).Sy = 1
  565. Rm(Rooms).Lit = false
  566. if int(rnd * 100) >= 75 then Rm(Rooms).Lit = true
  567. next
  568.  
  569. Rooms = StartRooms
  570. RandomRooms:
  571. do
  572. randomize timer
  573. Rm(Rooms).X = 2 + int(rnd * (MazeLength - 2))
  574. Rm(Rooms).Y = 2 + int(rnd * (MazeHeight - 2))
  575. Rm(Rooms).Sx = 3 + int(rnd * 5)
  576. Rm(Rooms).Sy = 3 + int(rnd * 5)
  577. if Rm(Rooms).X + Rm(Rooms).Sx > MazeLength - 1 then goto RandomRooms
  578. if Rm(Rooms).Y + Rm(Rooms).Sy > MazeHeight - 1 then goto RandomRooms
  579.  
  580. for R2 = 1 to TotalRooms
  581. if R2 <> Rooms then
  582. InX = Rm(R2).X + (Rm(R2).Sx + 3) >= Rm(Rooms).X and Rm(R2).X <= Rm(Rooms).X + (Rm(Rooms).Sx + 3)
  583. InY = Rm(R2).Y + (Rm(R2).Sy + 3) >= Rm(Rooms).Y and Rm(R2).Y <= Rm(Rooms).Y + (Rm(Rooms).Sy + 3)
  584. InBox = InX and InY
  585. if InBox then goto RandomRooms
  586. end if
  587. next
  588.  
  589. for Ey = Rm(Rooms).Y to Rm(Rooms).Y + Rm(Rooms).Sy
  590. for Ex = Rm(Rooms).X to Rm(Rooms).X + Rm(Rooms).Sx
  591. if Ex >= 2 and Ex <= MazeLength - 1 and Ey >= 2 and Ey <= MazeHeight - 1 then
  592. Maz(Ex, Ey).AssY = 0
  593. end if
  594. next
  595. next
  596. Rooms = Rooms + 1
  597. loop until Rooms >= TotalRooms + 1
  598.  
  599. AtX = Rm(1).X + (Rm(1).Sx \ 2)
  600. AtY = Rm(1).Y + (Rm(1).Sy \ 2)
  601.  
  602. for Rooms = 1 to TotalRooms
  603. TryRoomsAgain:
  604.  
  605. for Fy = 1 to MazeHeight
  606. for Fx = 1 to MazeLength
  607. Sort(Fx, Fy) = Maz(Fx, Fy).AssY
  608. next
  609. next
  610.  
  611. AtX = Rm(Rooms).X + int(rnd * ((Rm(Rooms).Sx)))
  612. AtY = Rm(Rooms).Y + int(rnd * ((Rm(Rooms).Sy)))
  613. if Rooms < TotalRooms then
  614. TargX = Rm(Rooms + 1).X + int(rnd * (Rm(Rooms + 1).Sx))
  615. TargY = Rm(Rooms + 1).Y + int(rnd * (Rm(Rooms + 1).Sy))
  616. else
  617. TargX = Rm(1).X + int(rnd * (Rm(1).Sx))
  618. TargY = Rm(1).Y + int(rnd * (Rm(1).Sy))
  619. end if
  620.  
  621. HitTarget = 0
  622.  
  623.  
  624. do
  625. AddX = 0
  626. AddY = 0
  627. if AtX < TargX then AddX = 1
  628. if AtX > TargX then AddX = -1
  629. if AtY < TargY then AddY = 1
  630. if AtY > TargY then AddY = -1
  631.  
  632. for R = 1 to TotalRooms
  633. InX = AtX >= Rm(R).X - 1 and AtX <= Rm(R).X + Rm(R).Sx + 1
  634. InY = AtY >= Rm(R).Y - 1 and AtY <= Rm(R).Y + Rm(R).Sy + 1
  635. OnXBorder = AtX = Rm(R).X - 1 or AtX = Rm(R).X + Rm(R).Sx + 1
  636. OnYBorder = AtY = Rm(R).Y - 1 or AtY = Rm(R).Y + Rm(R).Sy + 1
  637. OnBorder = InX and InY
  638. if OnBorder then exit for
  639. next
  640.  
  641. if OnBorder then
  642. if OnXBorder and not OnYBorder then AddY = 0
  643. if OnYBorder and not OnXBorder then AddX = 0
  644. end if
  645.  
  646. if AddX <> 0 and AddY <> 0 then
  647. RandGo = int(rnd * 2)
  648. if RandGo = 0 then AddX = 0
  649. if RandGo = 1 then AddY = 0
  650. end if
  651. if AddX = 0 and AddY = 0 then goto TryRoomsAgain
  652.  
  653. AtX = AtX + AddX
  654. AtY = AtY + AddY
  655.  
  656. for AtY2 = AtY - 1 to AtY + 1
  657. for AtX2 = AtX - 1 to AtX + 1
  658. if AtX2 >= 2 and AtX2 <= MazeLength - 1 and AtY2 >= 2 and AtY2 <= MazeHeight - 1 then
  659. InX = AtX2 >= Rm(Rooms).X and AtX2 <= Rm(Rooms).X + Rm(Rooms).Sx
  660. InY = AtY2 >= Rm(Rooms).Y and AtY2 <= Rm(Rooms).Y + Rm(Rooms).Sy
  661. InStartBox = InX and InY
  662. if Sort(AtX2, AtY2) = 0 then
  663. if not InStartBox then
  664. if AtX2 = AtX or AtY2 = AtY then
  665. HitTarget = true
  666. end if
  667. end if
  668. end if
  669. end if
  670. next
  671. next
  672.  
  673. Sort(AtX, AtY) = 3
  674.  
  675. if AtX = TargX and AtY = TargY then HitTarget = true
  676. if not HitTarget then
  677. for R = 1 to TotalRooms
  678. Corner1 = AtX = Rm(R).X - 1 and AtY = Rm(R).Y - 1
  679. Corner2 = AtX = Rm(R).X + Rm(R).Sx + 1 and AtY = Rm(R).Y - 1
  680. Corner3 = AtX = Rm(R).X - 1 and AtY = Rm(R).Y + Rm(R).Sy + 1
  681. Corner4 = AtX = Rm(R).X + Rm(R).Sx + 1 and AtY = Rm(R).Y + Rm(R).Sy + 1
  682. OnCorner5 = Corner1 or Corner2 or Corner3 or Corner4
  683. OnCorner = OnCorner5 and Rooms <> R
  684. if OnCorner then
  685. goto TryRoomsAgain
  686. end if
  687. next
  688. end if
  689.  
  690. loop until HitTarget
  691.  
  692. for FixY = 1 to MazeHeight
  693. for FixX = 1 to MazeLength
  694. if Sort(FixX, FixY) = 3 then
  695. Maz(FixX, FixY).AssY = 3
  696. Sort(FixX, FixY) = 0
  697. end if
  698. next
  699. next
  700. next
  701.  
  702.  
  703. for FixY = 1 to MazeHeight
  704. for FixX = 1 to MazeLength
  705. if Maz(FixX, FixY).AssY = 3 then
  706. Maz(FixX, FixY).AssY = 0
  707. end if
  708. next
  709. next
  710.  
  711.  
  712. if not checkbounds% then goto StartAgain
  713.  
  714. for Y = 1 to MazeHeight
  715. for X = 1 to MazeLength
  716. if Y = 1 or Y = MazeHeight or X = 1 or X = MazeLength then
  717. Maz(X, Y).AssY = true
  718. end if
  719. next
  720. next
  721.  
  722. fixwalls
  723. fixmaze
  724.  
  725. X1 = Rm(1).X + (Rm(1).Sx \ 2)
  726. Y1 = Rm(1).Y + (Rm(1).Sy \ 2)
  727. X2 = Rm(TotalRooms).X + (Rm(TotalRooms).Sx \ 2)
  728. Y2 = Rm(TotalRooms).Y + (Rm(TotalRooms).Sy \ 2)
  729.  
  730. Maz(X1, Y1).AssY = 24
  731. Maz(X1, Y1).Col = RedHi
  732.  
  733. Maz(X2, Y2).AssY = 25
  734. Maz(X2, Y2).Col = BluHi
  735.  
  736. end sub
  737.  
  738. sub randomizemonsters
  739. RandomTarg:
  740. TargX = 1 + int(rnd * MazeLength)
  741. TargY = 1 + int(rnd * MazeHeight)
  742. select case Maz(TargX, TargY).AssY
  743. case 24, 25, 176, 234
  744. case else
  745. goto RandomTarg
  746. end select
  747.  
  748. for M = 1 to TotalMonsters
  749. RandomPos:
  750. Mnstr(M).X = 1 + int(rnd * MazeLength)
  751. Mnstr(M).Y = 1 + int(rnd * MazeHeight)
  752. Mnstr(M).TargX = TargX
  753. Mnstr(M).TargY = TargY
  754. Mnstr(M).Hp = 100
  755. Mnstr(M).HitTarg = false
  756. select case Maz(Mnstr(M).X, Mnstr(M).Y).AssY
  757. case 24, 25, 176, 234
  758. case else
  759. goto RandomPos
  760. end select
  761. if Mnstr(M).X = TargX and Mnstr(M).Y = TargY then goto RandomPos
  762. for M2 = 1 to TotalMonsters
  763. if M2 <> M then
  764. if Mnstr(M).X = Mnstr(M2).X and Mnstr(M).Y = Mnstr(M2).X then goto RandomPos
  765. end if
  766. next
  767. next
  768.  
  769. end sub
  770.  
  771. sub square (X%, Y%, Col%)
  772. color (15)
  773. locate Y, X
  774. print "X"
  775. end sub
  776.  
  777. sub waiter (Amount#)
  778. TTime# = timer + Amount#
  779. do: loop until timer > TTime#
  780. end sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement