December 03, 2020, 08:37:10 PM

Author Topic: [bb] Ultimate Mushroom Collector 2004 by Damien Sturdy [ 1+ years ago ]  (Read 411 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
Title : Ultimate Mushroom Collector 2004
Author : Damien Sturdy
Posted : 1+ years ago

Description : Boulderdash with computer players playing too.... chav fight for 'shrooms!

Code :
Code: BlitzBasic
  1. Global ss_channelcount%
  2. Global ss_bpsample%=16
  3.  
  4. Global ss_maxchans=50
  5. Global ss_buffersize=1000
  6. Global ss_maxenvs=30
  7. Global ss_sndtype=8
  8. Global ss_lfocount=2
  9.  
  10. Dim ss_sounds(ss_maxchans)
  11. Dim ss_volume#(ss_maxchans)
  12. Dim ss_schan(ss_maxchans)
  13. Dim ss_sLength#(ss_maxchans)
  14. Dim ss_started(ss_maxchans)
  15. Dim ss_actualvol#(ss_maxchans)
  16. Dim ss_attackdone(ss_maxchans)
  17. Dim ss_decaydone(ss_maxchans)
  18.  
  19. Dim ss_attack#(ss_maxchans)
  20. Dim ss_decay#(ss_maxchans)
  21. Dim ss_sustain#(ss_maxchans)
  22. Dim ss_release#(ss_maxchans)
  23. Dim ss_currentpitch#(ss_maxchans)
  24. Dim ss_envelope(ss_maxchans)
  25.  
  26. Dim ss_defattack#(ss_maxenvs)
  27. Dim ss_defdecay#(ss_maxenvs)
  28. Dim ss_defsustain#(ss_maxenvs)
  29. Dim ss_defrelease#(ss_maxenvs)
  30. Dim ss_attackchange#(ss_maxenvs)
  31. Dim ss_decaychange#(ss_maxenvs)
  32. Dim ss_sustainchange#(ss_maxenvs)
  33. Dim ss_releasechange#(ss_maxenvs)
  34.  
  35. Dim ss_lfoattack#(ss_lfocount,ss_maxenvs)
  36. Dim ss_lfodecay#(ss_lfocount,ss_maxenvs)
  37. Dim ss_lfosustain#(ss_lfocount,ss_maxenvs)
  38. Dim ss_lforelease#(ss_lfocount,ss_maxenvs)
  39.  
  40. Dim ss_lfo#(ss_lfocount,ss_maxchans)
  41. Dim ss_lfofreq#(ss_lfocount,ss_maxenvs)
  42. Dim ss_lfocounter#(ss_maxchans)
  43. Dim ss_bufferchan(ss_maxchans,ss_buffersize)
  44. Dim ss_buffervol#(ss_maxchans,ss_buffersize)
  45. Dim ss_bufferenv#(ss_maxchans,ss_buffersize)
  46. Dim ss_bufferpitch(ss_maxchans,ss_buffersize)
  47. Dim ss_bufferlength(ss_maxchans,ss_buffersize)
  48. Dim ss_bufferpointer(ss_maxchans)
  49. Dim ss_buffercount(ss_maxchans)
  50. Dim ss_chancheck(ss_maxchans)
  51. Dim ss_channelloop(ss_maxchans)
  52. Dim ss_samplecnt(ss_maxchans)
  53. Dim ss_soundbank(ss_sndtype),ss_samplecntbank(ss_sndtype)
  54. Global forcesoundupdate=0
  55. Global ss_stimer#=100
  56. Global audiotimer=MilliSecs(),updateperiod#=1
  57. Dim wavdata(0,0)
  58. initsoundsystem()
  59.  
  60.  
  61. updateperiod#=15
  62. For n=1 To ss_maxchans
  63. soundshape n,1
  64. Next
  65.  
  66. Global Nxtchan=1
  67. Global dirx,diry
  68. Type path
  69. Field x
  70. Field y
  71. End Type
  72.  
  73. Type boulder
  74. Field sx,sy
  75. Field x,y
  76. Field player
  77. Field reposition
  78. Field timer
  79. Field triggered
  80. Field rocknumber
  81. End Type
  82. Global  ignoreboulders
  83.  
  84. Global Lastspread
  85. Global scx#=640,scy#=480
  86. scx=800
  87. scy=600
  88.  
  89. Global Topbit=50
  90. Graphics scx,scy,16,2
  91. Global gametimer=CreateTimer(80)
  92. Global basey=Topbit
  93. TFormFilter 0
  94. Global maxx=40
  95. Global maxy=30
  96. maxx=40/1.3
  97. maxy=30/1.3
  98. ;maxx=40*2
  99. ;maxy=30*2
  100. Global scrollmode
  101. Global camx=0,ocamx
  102. Global camy=0,ocamy
  103. Global cammvx,cammvy
  104.  
  105. Global szx#=(scx/(maxx))
  106. Global szy#=((scy-Topbit)/(maxy))
  107. szx=32
  108. szy=32
  109. ;szx=16
  110. ;szy=16
  111. maxx=maxx-1
  112. maxy=maxy-1
  113. Global Textcnt=8
  114. Dim Charimg(256,Textcnt)
  115. Dim map(maxx+1,maxy+1)
  116. Dim map2(maxx+1,maxy+1) ;Stores walkable area. Used to ensure players arent put where they cant get to or from.
  117. Dim map3(maxx+1,maxy+1) ;Mushroom layer
  118. Dim map4(maxx+1,maxy+1);AI layer
  119. ;Dim map4(m
  120. Dim alive(maxx+1,maxy+1)
  121. Dim mapc(4),mapd(4)
  122. mapc(1)=1:mapd(1)=0
  123. mapc(2)=0:mapd(2)=1
  124. mapc(3)=-1:mapd(3)=0
  125. mapc(4)=0:mapd(4)=-1
  126. Global stack
  127. Dim stackx(maxx*maxy)
  128. Dim stacky(maxx*maxy)
  129. Dim stackc(maxx*maxy)
  130. Dim stackd(maxx*maxy)
  131. Global mushrooms
  132. Global mushlife=7
  133. Global images=8
  134. Dim img(images)
  135. Global maxplayers=16
  136. Global players=1
  137. Dim playertype(maxplayers)
  138. playertype(1)=1
  139. Dim px#(maxplayers),py#(maxplayers),pc#(maxplayers),pd#(maxplayers)
  140. Dim fr#(maxplayers)
  141. Dim ok2move(maxplayers)
  142. Dim score(maxplayers)
  143. Dim lives(maxplayers),energy#(maxplayers)
  144. Dim sx(maxplayers)
  145. Dim sy(maxplayers)
  146. Dim diecounter(maxplayers)
  147. Dim dead(maxplayers)
  148. Dim mushs(maxplayers)
  149. Dim playername$(maxplayers)
  150. Dim Lastupdate(maxplayers)
  151. For n=1 To maxplayers
  152. playername$(n)="Player"+Str$(n)
  153. Next
  154. Dim upkey(maxplayers),downkey(maxplayers),Leftkey(maxplayers),Rightkey(maxplayers),dropkey(maxplayers)
  155.  
  156. Leftkey(1)=203
  157. rightkey(1)=205
  158. upkey(1)=200
  159. downkey(1)=208
  160.  
  161. Dim red(maxplayers),green(maxplayers),blue(maxplayers)
  162. Dim pdx(maxplayers),pdy(maxplayers)
  163. Dim cfx(maxplayers),cfy(maxplayers),ctx(maxplayers),cty(maxplayers)
  164. Dim playerimg(maxplayers,2)
  165. For o=0 To maxplayers
  166. red(o)=0
  167. green(o)=255
  168. blue(o)=0
  169. Next
  170. Read numcols
  171. For o=1 To numcols
  172. Read red(o)
  173. Read green(o)
  174. Read blue(o)
  175. Next
  176. Global hatred=100,hatgreen=200,hatblue=0
  177.  
  178.  
  179. ;setup text
  180. Global txsize#=16,txscale#=2,txxdis#=.5
  181. setuptext()
  182. rszx=szx
  183. rszy=szy
  184. Global level=1
  185.  
  186. .restart
  187. ;setup music
  188. setupmusic
  189. Repeat:Until KeyDown(1)=0
  190. level=1
  191. SetBuffer BackBuffer()
  192. menuoption=0
  193. Cls
  194.  
  195. createlevel(100)
  196. camx=0:camy=0
  197.  
  198. quit=0
  199. Repeat
  200. by=(scy/2)
  201. option=option-(KeyHit(200)-KeyHit(208))
  202. If option<0 Then option=2
  203. If option>2 Then option=0
  204. yy=by+option*32
  205.  
  206. text2 scx/2,scy/10,"ULTIMATE MUSHROOM COLLECTOR 2004",1,1
  207. Text2 scx/2,(scy/8)+42,"Collect as many mushrooms as you can!",1,1
  208.  
  209. Text2 scx/2,(scy/8)+64,"Be the Last surviving player!",1,1
  210. Text2 scx/3,yy,">>"
  211. Text2 scx/2.5,by,"START"
  212. done=0
  213. kh=KeyHit(57)
  214. If KH And option=0 Then done=1
  215. If KH And option=1 Then sel=sel+1:If sel>1 Then sel=0
  216. If kh And option=2 Then quit=1
  217. If sel=0 Then scrollmode=0:Op$="Non-Scrolling" Else scrollmode=1:op$="Scrolling mode"
  218. Text2 scx/2.5,by+32,op$
  219. Text2 scx/2.5,by+64,"Quit"
  220. updatesound
  221. Flip
  222. Cls
  223. Until done Or KeyDown(1) Or quit=1
  224.  
  225. If scrollmode=0 Then
  226.         szx=(scx/(maxx+1))
  227.         szy=((scy-basey)/(maxy+1))
  228. Else
  229.         szx=rszx
  230.         szy=rszy
  231. EndIf
  232. If KeyDown(1) Or quit=1 Then End
  233.  
  234. ;do graphics
  235. Global inv=Rand(1,4)
  236.  
  237. For o=0 To images
  238. img(o)=creategfx(o)
  239. Next
  240. img(0)=img(3)
  241.  
  242.  
  243. SetBuffer BackBuffer()
  244.  
  245. For o=1 To maxplayers
  246. hatred=red(o)
  247. hatgreen=green(o)
  248. hatblue=blue(o)
  249. If o=1 Then vr=1 Else vr=Rand(2,3)
  250. playerimg(o,1)=creategfx(255,vr)
  251. playerimg(o,2)=creategfx(256,vr)
  252. Next
  253.  
  254. For n=1 To players
  255. playertype(n)=1
  256. lives(n)=3
  257. Next
  258.  
  259. For n=players+1 To maxplayers
  260. lives(n)=3
  261. Next
  262.  
  263.  
  264. SeedRnd MilliSecs()
  265. .nextlevel
  266. Delete Each boulder
  267. createlevel(level)
  268. ;findpath(px(1),py(1),px(2),py(2))
  269. ;map(px(1),py(1))=1
  270. ;map(px(2),py(2))=1
  271.  
  272.  
  273. Flip
  274. drawmap()
  275. Flip
  276. drawmap()
  277. Flip
  278.  
  279. SetBuffer BackBuffer()
  280. Global starting=MilliSecs()+5000
  281. Global gamestarted=0
  282. acnt=0
  283. finished=0
  284. finishtimer=0
  285. Global updbuffer
  286. If (maxx*szx)<scx And (maxy*szy)<scy Then scrollmode=0 Else scrollmode=1
  287. won=0
  288. Repeat
  289. updbuffer=0
  290. If (MilliSecs()-lstbf)>1000/30 Then updbuffer=1:lstbf=MilliSecs()
  291. ;updbuffer=1
  292.  
  293. ;updbuffer=(updbuffer+1) Mod 2
  294. spread
  295. If gamestarted=0 Then drawmap()
  296. If gamestarted=0 And starting<MilliSecs() Then gamestarted=1:DRAWMAP
  297.  
  298. dfloor
  299.  
  300. dfx=camx
  301. dfy=camy
  302. dfx=dfx+(scx/2)
  303. dfy=dfy+(scy/2)
  304. dfx=dfx/szx
  305. dfy=dfy/szy
  306.  
  307. If scrollmode Then drawmapfrom dfx,dfy;camx,camy;px(1),py(1)
  308.  
  309.  
  310. If (finished=1 And scrollmode=0) Or dm=1 Then
  311. For x=(maxx/2)-7 To (maxx/2)+7
  312. For y=(maxy/2)-5 To (maxy/2)+2
  313. drawtile x,y
  314. Next
  315. Next
  316. EndIf
  317.  
  318. dm=0
  319.  
  320.  
  321. drawplayers
  322. If gamestarted Then updateplayers
  323.  
  324. For n=1 To maxplayers
  325. If starting>MilliSecs() And playertype(n)=1 Then
  326. mx=px(n)*szx
  327. my=py(n)*szy
  328.  
  329. Text2 mx,((my)+basey)-szy,playername$(n),1,0
  330. EndIf
  331. dm=1
  332. Next
  333.  
  334. updateboulders
  335.  
  336.  
  337. colour 0,0,0
  338. Rect 0,0,scx,basey-1,1
  339. colour 255,255,255
  340. dm=0
  341. If gamestarted=0 Then
  342. tx$="Level "+Str$(level)+"!!!"
  343. Text2 scx/2,((scy-basey)/2)-txsize,tx$,1,1
  344. tx$=Int((starting-MilliSecs())/1000)
  345. If tx$="4" Then tx$=""
  346. If tx$="0" Then tx$="GO!!!!"
  347. Text2 scx/2,(scy-basey)/2,tx$,1,1
  348. dm=1
  349. EndIf
  350. nv2=1
  351. For nv#=1 To maxplayers
  352. If lives(nv)>0 Then
  353. Text2 (scx/4)*(nv2-.5),10,playername$(nv),1,1
  354. Text2 (scx/4)*(nv2-.25),32,"x"+lives(nv),1,1
  355. Text2 (scx/4)*(nv2-.9),32,constr(score(nv),6),0,1
  356. nv2=nv2+1
  357. EndIf
  358. Next
  359.  
  360. ;won=0
  361. cnt=0
  362. ck=0
  363. For n=1 To maxplayers
  364.         If lives(n)>0 Then cnt=cnt+1:If won=0 Then ck=1
  365. Next
  366. sc=0
  367. If cnt=1 Then
  368.         If ck=1 Then
  369.                 For n2=1 To maxplayers
  370.                         If score(n2)>sc Then won=n2:sc=score(n2)
  371.                 Next
  372.         EndIf
  373. EndIf
  374.  
  375. If cnt<2 Then Text2 scx/2,(scy-basey)/2,playername$(won)+" WINS!!!",1,1:dm=1
  376. If finished=1 And lives(1)>0 And won=0 And cnt>0 Then Text2 scx/2,(scy-basey)/2,"Level Complete!",1,1:dm=1
  377. If finished=1 And lives(1)<1 Then Text2 scx/2,(scy-basey)/2,"G A M E   O V E R ! ! !",1,1:dm=1:gamestarted=1
  378.  
  379. If updbuffer=1 Then Flip 0:CopyRect 0,0,scx,scy,0,0,FrontBuffer(),BackBuffer()
  380. Repeat
  381. updatesound()
  382. Until (MilliSecs()-Lastcycle)>1000/60 Or KeyDown(1)
  383. Lastcycle=MilliSecs()
  384. ;Cls
  385. ;updatesound()
  386. If mushrooms=0 And finished=0 Then finished=1:finishedtimer=MilliSecs()+5000
  387. If lives(1)=0 And FINISHED=0 Then finished=1:finishedtimer=MilliSecs()+5000:STOPSOUND():diefx
  388. If cnt=1 And FINISHED=0 Then finished=1:finishedtimer=MilliSecs()+5000:STOPSOUND():winfx
  389.  
  390. Until KeyDown(1) Or (finished=1 And finishedtimer<MilliSecs())
  391. If lives(1)=0 Or cnt<2 Then Goto restart
  392. level=level+1
  393. If KeyDown(1) Then Goto restart
  394. Goto Nextlevel
  395. End
  396. Function colour(r1,g1,b1)
  397. r=r1:g=g1:b=b1
  398. inv=4
  399. If inv=1 Then r=b1:g=g1:b=r1
  400. If inv=2 Then r=g1:g=b1:b=r1
  401. If inv=3 Then r=r1:g=b1:b=g1
  402. If inv=4 Then r=r1:g=g1:b=b1
  403. rn#=Rnd(.75,1.5)
  404. rn=-((r-128)+(g-128)+(b-120))/3
  405. ;rn=((r-128)+(g-128)+(b-120))/6
  406. rn=rn*1.5
  407. rn=1-(rn/128)
  408. ;rn=rn*20
  409.  
  410. ;r=r*rn:g=g*rn:b=b*rn
  411. If r>255 Then r=255
  412. If g>255 Then g=255
  413. If b>255 Then b=255
  414. If r<0 Then r=0
  415. If g<0 Then g=0
  416. If b<0 Then b=0
  417. ;If r<>0 Or g<>0 Or b<>0 Then r=255-r:g=255-g:b=255-b
  418. Color r,g,b
  419. End Function
  420. Function drawmap()
  421. dfloor
  422. Local x,y
  423. For x=0 To maxx
  424. For y=0 To maxy
  425. updatesound
  426. drawtile x,y
  427. Next
  428. Next
  429. ;Flip
  430. End Function
  431.  
  432. Function drawmapfrom(x,y)
  433. Local sx,sy,ex,ey,mx,my
  434. If cammvx<>0  Or cammvy<>0 Then
  435. ;Cls
  436. scy=scy-basey
  437. sx=(scx/2)/szx+x
  438. sy=(scy/2)/szy+y
  439. ex=sx+(scx/szx)+x
  440. ey=sy+(scy/szy)+y
  441.  
  442. sx=x-(scx/2)/szx
  443. sy=y-(scy/2)/szy
  444. ex=x+(scx/2)/szx
  445. ey=y+(scy/2)/szy
  446. CopyRect 0,basey,scx,scy,cammvx,cammvy+basey
  447. xtm#=Float(cammvx)/Float(szx)
  448. ytm#=Float(cammvy)/Float(szy)
  449. If Abs(xtm)<1 Then xtm=Sgn(xtm)
  450. If Abs(ytm)<1 Then xtm=Sgn(ytm)
  451. If Abs(xtm)>3 Or Abs(ytm)>3 Then cammvx=0:cammvy=0
  452. If cammvx>0 Then ex=sx+xtm+1:sy=sy-1:ey=ey+1
  453. If cammvx<0 Then sx=(ex-xtm)-1:sy=sy-1:ey=ey+1
  454.  
  455. If cammvy>0 Then ey=(sy+ytm)+1:sy=sy-1
  456. If cammvy<0 Then sy=(ey-ytm)-2
  457. For mx=sx-1 To ex
  458. For my=sy-1 To ey
  459. If mx>-1 And mx<maxx+1 And my>-1 And my<maxy+1 Then
  460. drawtile mx,my
  461. Else
  462. EndIf
  463. Next
  464. Next
  465. scy=scy+basey
  466. cammvx=0
  467. cammvy=0
  468. EndIf
  469. End Function
  470.  
  471. Function updateplayers()
  472. For n=1 To  maxplayers
  473. If dead(n) Then Goto dontupdateplayer
  474. mx#=px(n)
  475. my#=py(n)
  476. If MX<0 Then MX=0
  477. If MX>MAXX Then MX=MAXX
  478. If MY<0 Then MY=0
  479. If MY>MAXY Then MY=MAXY
  480. If map4(mx,my-1) Then addboulder(mx,my-1,n,25)
  481. If map4(mx,my+1) And pd(n)>0 Then addboulder(mx,my+1,n,1)
  482. If ((MilliSecs()-Lastupdate(n))>50000)  Or ok2move(n)=1 Then
  483.  
  484.  
  485.  
  486. If playertype(n)=0 Then ; if AI player
  487. ignoreboulders=1
  488. If pc(n)<>0 Or pd(N)<>0 Then
  489. musha=0
  490.         For c=-1 To 1
  491.                 For d=-1 To 1
  492.                         If c=0 Or d=0 And (c<>0 Or d<>0) Then
  493.                                 If map3(mx+c,my+d)<>0 Then pc(n)=c:pd(n)=d:musha=1
  494.                         EndIf
  495.                 Next
  496.         Next
  497.         If Rnd(0,100)>60 Or musha=1 Then Goto dontdoanythingAI
  498. EndIf
  499.  
  500. mdst=500
  501. c=pc(n)
  502. d=pd(n)
  503. If map3(px(n)+c,py(n)+d )=4 Then Goto nochangecd
  504. pc(n)=0
  505. pd(n)=0
  506. tx=0:ty=0
  507. For c=-30 To 30
  508. For d=-30 To 30
  509. xx=mx+c:yy=my+d
  510. dst=Abs((xx-mx))+Abs((yy-my));/2.0
  511. If xx<0 Then xx=0 Else If xx>maxx Then xx=maxx
  512. If yy<0 Then yy=0 Else If yy>maxy Then yy=maxy
  513. ;If (c<>0 Or d<>0) And (c=0 Or d=0) Then
  514. If map3(xx,yy)<>0 And dst<=mdst Then
  515. ;       If mapok(mx+Sgn(c),my+Sgn(d)) Then pc(n)=Sgn(c):pd(n)=Sgn(d):mdst=dst:tx=mx+c:ty=my+d
  516. ok=1
  517. For c2=1 To c:For d2=1 To d
  518. If mapok(mx+c2,my+d2)=0 Then ok=0
  519. Next:Next
  520. If ok=1 Then pc(n)=Sgn(c):pd(n)=Sgn(d):mdst=dst:tx=mx+c:ty=my+d:If dst<3 Then tx=0:ty=0
  521. EndIf
  522. ;EndIf
  523. Next
  524. Next
  525. ;If mapok(mx+pc(n),my+pd(n))=0 Then pc(n)=-pc(n):pd(n)=-pd(n)
  526.  
  527. ;pc(n)=0
  528. ;pd(n)=0
  529. If Rand(0,100)>95 Then pc(n)=0:pd(n)=0
  530.  
  531. If pc(n)=0 And pd(n)=0 Then
  532.  
  533. For c=-1 To 1
  534. For d=-1 To 1
  535. xx=mx+c:yy=my+d
  536. dst=Abs((xx-mx))+Abs((yy-my))/2.0
  537. If xx<0 Then xx=0 Else If xx>maxx Then xx=maxx
  538. If yy<0 Then yy=0 Else If yy>maxy Then yy=maxy
  539. ;If (c<>0 Or d<>0) And (c=0 Or d=0) Then
  540. If mapok(xx,yy) Then
  541. pc(n)=Sgn(c):pd(n)=Sgn(d):mdst=dst
  542. EndIf
  543. ;EndIf
  544. Next
  545. Next
  546.  
  547.  
  548. EndIf
  549.  
  550. .nochangecd
  551. ;ln=findpath(cfx(n),cfy(n),ctx(n),cty(n))
  552.  
  553. ;If mapok(mx+pc(n),my+pd(n))=0 Then
  554. oka=okahead(mx,my,pc(n),pd(n))
  555. If oka<0 And oka>-3 Then
  556. lds=1
  557. opc=pc(n)
  558. opd=pd(n)
  559.  
  560. findbestdirection(mx,my)
  561. If dirx<>0 Or diry<>0 Then pc(n)=dirx:pd(n)=diry
  562.  
  563. If pc(n)=0 And pd(n)=0 Then
  564. For c=-10 To 10
  565. For d=-10 To 10
  566. xx=mx+c:yy=my+d
  567. ;dst=Abs((xx-mx))+Abs((yy-my))
  568. If xx<0 Then xx=0 Else If xx>maxx Then xx=maxx
  569. If yy<0 Then yy=0 Else If yy>maxy Then yy=maxy
  570. If (c<>0 Or d<>0) And (c=0 Or d=0) Then
  571. If map2(xx,yy)<>0 Then
  572. pc(n)=Sgn(c):pd(n)=Sgn(d):mdst=dst
  573. EndIf
  574. EndIf
  575. Next
  576. Next
  577. EndIf
  578.  
  579.  
  580. ;If OKAHEAD(Xx,yy,pc(n),pd(n))<>1 Then pc(n)=-opc:pd(n)=-opd
  581. EndIf
  582.  
  583. .justmove
  584.  
  585.  
  586. xx=mx+Sgn(pc(n))
  587. yy=my+Sgn(pd(n))
  588.  
  589.  
  590. For n2=1 To maxplayers
  591. If xx=px(n2) And yy=py(n2) Then pc(n)=-pc(n):pd(n)=-pd(n)
  592. Next
  593. ok2move(n)=0
  594. If pc(n)<>0 And pd(n)<>0 Then
  595. If Rand(2)=1 Then pc(n)=0 Else pd(n)=0
  596. EndIf
  597. ;If map3(mx,my)=4 Then map3(mx,my)=0
  598.  
  599. mapv=map(mx+pc(n),my+pd(n))
  600. If mapv<>3 And mapv<>2 Then pc(n)=0:pd(n)=0
  601.  
  602.  
  603. If (pc(n)=0 And pd(N)=0) Or mapok(mx+pc(n),my+pd(n))=0 Then
  604. findbestdirection(mx,my)
  605. If dirx<>0 Or diry<>0 Then pc(n)=dirx:pd(n)=diry
  606. EndIf
  607.  
  608.  
  609. .dontdoanythingAI
  610. ignoreboulders=0
  611.  
  612. Else
  613.  
  614. ;Player controlled stuff
  615. opc=pc(N)
  616. opd=pd(n)
  617. pc(N)=0
  618. pd(n)=0
  619. pc(n)=-(KeyDown(Leftkey(n))-KeyDown(Rightkey(n)))
  620. pd(n)=KeyDown(downkey(n))-KeyDown(upkey(n))
  621. If pc(N)<>0 And pd(N)<>0 Then
  622. If pc(n)<>opc Then pd(n)=0
  623. If pd(N)<>opd Then pc(N)=0
  624. EndIf
  625.  
  626. EndIf
  627. ignoreboulders=0
  628.  
  629. c=Sgn(pc(n))
  630. mx=px(n):my=py(N)
  631. If map4(mx+c,my)<>0 And Abs(c)<>0 Then
  632. addboulder(mx+c,my,n,10)
  633. If mx>2 And mx<maxx-2 Then
  634. If map4(mx+c*2,my)=0 And mapok(mx+c*2,my) Then map4(mx+c*2,my)=map4(mx+c,my):map4(mx+c,my)=0:addboulder(mx+c*2,my,n,10):If mapok(mx+c*3,my)=0 And mapok(mx+c*2,my+1)=0 Then map3(mx+c*2,my)=0:map2(mx+c*2,my)=0
  635. EndIf
  636. EndIf
  637.  
  638.  
  639. If mapok(px(n)+pc(n),py(n)+pd(n))=0 Then pc(n)=0:pd(N)=0
  640.  
  641.  
  642. px(n)=Int(px(n)):py(n)=Int(py(n))
  643. px(n)=px(n)+Sgn(pc(n))
  644. py(n)=py(n)+Sgn(pd(n))
  645. ok2move(n)=0
  646. lastupdate(n)=MilliSecs()
  647. EndIf
  648. .dontupdateplayer
  649. Next
  650. End Function
  651. Function drawplayers()
  652. Local n,x,y
  653.  
  654. For n=1 To maxplayers
  655. mx=px(n)
  656. my=py(n)
  657. If MAP3(MX,MY)=4 Then map3(mx,my)=0:score(n)=score(n)+10:If n=1 Then collectsfx(1)
  658. For x=mx-1 To mx+1
  659. For y=my-1 To my+1
  660. ;If scrollmode=0 Then
  661. drawtile(x,y)
  662. Next:Next
  663. Next
  664.  
  665. For n=1 To maxplayers
  666. If lives(n)<1 Then diecounter(n)=10:dead(n)=1:px(n)=0:py(N)=0:pdx(n)=0:pdy(n)=0
  667. If diecounter(n)>0 Then
  668.         diecounter(n)=diecounter(n)-1
  669.         If diecounter(n)=0 Then positionplayer(n,sx(n),sy(n)):dead(n)=0:map4(sx(n),sy(n))=0:drawmap()
  670.         Goto nxtplay
  671. EndIf
  672. If dead(n)=1 Then Goto nxtplay
  673. mx=px(n);/szx
  674. my=py(n);/szy
  675. xad#=(((px(n)*szx)-pdx(n)))
  676. yad#=(((py(n)*szy)-pdy(n)))
  677. maxm=szx/16
  678. If Abs(xad)>maxm Then xad=Sgn(xad)*maxm
  679. If Abs(yad)>maxm Then yad=Sgn(yad)*maxm
  680.  
  681. If Abs(xad)<1 And Abs(yad)<1 Then ok2move(n)=1
  682.  
  683. ok2m=0
  684. If Abs(xad)<1 Then pdx(n)=mx*szx:xad=0
  685. If Abs(yad)<1 Then pdy(n)=my*szy:yad=0
  686. ;xad=xad/10.0
  687. ;yad=yad/10.0
  688.  
  689. pdx(n)=pdx(n)+xad
  690. pdy(n)=pdy(n)+yad
  691. ;PDX(N)=PX(N)*SZX
  692. ;PDY(N)=PY(N)*SZY
  693.         ;sound 2,1,101,1
  694. ;       sound 3,1,102,1
  695.  
  696. If pc(n)<>0 Or pd(n)<>0 Then fr(n)=fr(n)+.1
  697. If fr(n)>1.9 Then fr(n)=0
  698.  
  699. If updbuffer=1 Then DrawImage playerimg(n,Floor(fr(n))+1),pdx(n)-camx,(pdy(n)-camy)+basey
  700.  If map4(Int(pdx(n)/szx),Int(pdy(n)/szy))<>0 Then
  701.         For x=mx-1 To mx+1
  702.         For y=my-1 To my+1
  703.         ;If scrollmode=0 Then
  704.         drawtile(x,y)
  705.         Next:Next
  706.         die n
  707. EndIf
  708.  
  709.  .nxtplay
  710. Next
  711.  
  712. End Function
  713.  
  714. Function Creategfx(number,variant=1)
  715. Local image=CreateImage(szx,szy),cb#,x#,y#,x1#,x2#,cnt,n#,ex#,ey#,bx#,by#,sx#
  716. cb=GraphicsBuffer()
  717. SetBuffer ImageBuffer(image)
  718. If number=1 ;brick
  719.         colour 0,220,50
  720.         colour 0,255,255
  721.         Rect 0,0,szx,szy,1
  722.         colour 0,0,0
  723.         stp=szy/4.0
  724.         cnt=0
  725.         For n=0 To szy Step 1
  726.                 cnt=(cnt+1) Mod 2
  727.                 Line 0,n,szx,n
  728.                 For p=0 To 4
  729.                         bs=cnt*(szx/8)
  730.                         Line (p*szx/4)+bs,n,(p*szx/4)+bs,stp+n
  731.                 Next
  732.                 n=n+stp-1
  733.         Next
  734. EndIf
  735.  
  736. If number=2 Then        ;mud
  737.         colour 150,100,0
  738.         Rect 0,0,szx,szy,1
  739.         colour 0,0,0
  740.         For n=0 To szx
  741.                 Plot Rnd(szx),Rnd(szy)
  742.         Next
  743. EndIf
  744.  
  745. If number=3 Then        ;grass
  746.         colour 0,170,0
  747.         Rect 0,0,szx,szy,1
  748.         colour 0,100,0
  749.         For n=0 To 50
  750.                 Plot Rnd(szx),Rnd(szy)
  751.         Next
  752. EndIf
  753.  
  754. If number=4 Then
  755. ;       colour 0,170,0
  756.         ;Rect 0,0,szx,szy,1
  757.         ;colour 0,254,200
  758.         For sx#=0 To 1 Step .05;(szx/4)*2
  759.         ex#=szx/2.0
  760.         ey#=szy/3.0
  761.         x1#=ex*sx
  762.         x2#=ey*sx
  763.         colour 0,254*sx,200*sx
  764.         bx=(szx/4)
  765.         by=(szy/3)
  766.                 Oval bx+(ex-x1)/2.0,by+(ey-x2)/2.0,x1,x2,0
  767.         Next
  768. ;       Oval szx/4,szy/3,(szx/4)*2,szy/3
  769.  
  770.         colour 0,0,0
  771.         Rect 0,(szy/2)+szy/10,szx,szy/2
  772.         colour 140,120,0
  773.         Rect (szx/2)-szx/8,(szy/3)*2,szx/4,szy/6,1
  774.         Oval (szx/2)-szx/8,(szy/2),szx/4,szy/3,1
  775.  
  776.         ;For n=0 To szx
  777.         ;x=Rnd(szx)
  778.         ;y=Rnd(szy)
  779. ;       Getcolour(x,y)
  780.         ;If colourRed()=0 And colourGreen()=170 And colourBlue()=0 Then colour 0,100,0:Plot x,y
  781. ;       Next
  782.  
  783.  
  784. EndIf
  785.  
  786. If number=5 ;red brick
  787.         colour 224,70,0
  788.         ;colour 224,50,100
  789.         Rect 0,0,szx,szy,1
  790.         colour 0,0,0
  791.         stp=szy/4.0
  792.         cnt=0
  793.         For n=0 To szy Step 1
  794.                 cnt=(cnt+1) Mod 2
  795.                 Line 0,n,szx,n
  796.                 For p=0 To 4
  797.                         bs=cnt*(szx/8)
  798.                         Line (p*szx/4)+bs,n,(p*szx/4)+bs,stp+n
  799.                 Next
  800.                 n=n+stp-1
  801.         Next
  802. EndIf
  803.  
  804. If number=6 ;edge wall
  805. For sx=1 To 0 Step -.01
  806. colour 255,255*sx,0
  807. x=sx*szx
  808. y=sx*szy
  809. Line x,y,szx-x,y
  810. Line szx-x,y,szx-x,szy-y
  811. ;Line x,y,szx/2,y
  812. ;Line x,y,x,szy/2
  813. x=szx-(sx*szx)
  814. y=szy-(sx*szy)
  815. Next
  816. colour 10,10,10
  817. Line 0,0,szx,szy
  818. Line szx,0,0,szy
  819. Rect 0,0,szx+1,szy+1,0
  820. EndIf
  821.  
  822. If number=7 ;water
  823.         colour 50,60,200
  824.         Rect 0,0,szx,szy,1
  825.         colour 100,100,255
  826.         For n=0 To szx/2.0
  827.                 Plot Rnd(szx),Rnd(szy)
  828.         Next
  829. EndIf
  830.  
  831. If number=8 Then ;rock
  832. colour 200,200,0
  833. ;Oval (scx/2)-scx/3,szy/2,(szx/2)-1,szy/2
  834. Oval 0,0,szx-1,(szy-1)/1.1
  835.  
  836. colour 255,255,0
  837. Oval 0,0,szx-1,(szy-1)/1.2
  838. EndIf
  839. If number=255 Then      ;Player walk frame 1
  840. colour 255,255,255
  841. Oval szx/4,szy/6,(szx/4.0)*3.0,szy/6+szx/2.5,0
  842. Oval (szx/2)-szx/6,0,(szx/2)+szx/12,szy/8+szy/2,0
  843.  
  844. x1=1
  845. x2=2
  846. colour hatred,hatgreen,hatblue
  847. Oval ((szx/2)-szx/6)+x1,0+x1,((szx/2)+szx/12)-x2,(szy/8+szy/2)-x2,1
  848. colour 0,250,200
  849. If variant=2 Then colour 80,120,0
  850. If variant=3 Then colour 200,200,10
  851. Oval (szx/4)+x1,(szy/6)+x1,((szx/4.0)*3.0)-x2,(szy/6+szx/2.5)-x2,1
  852.  
  853.  
  854. colour 255,255,255
  855. Line ((szx/2)+szx/3),szy/6,0,szy/6.0
  856. colour 255,0,255
  857. Oval (szx/3)+szx/12,szy/3,szx/8,szy/8,1
  858. Oval ((szx/3)*2)+szx/12,szy/3,szx/8,szy/8,1
  859. ;Plot szx/3,szy/3
  860. ;Plot (szx/3)*2,szy/3
  861.  
  862. colour 255,255,255
  863. Line szx/3,(szy/3)*2,szx/5,((szy/3)*2)+szy/12
  864. Line (szx-(szx/3))+szx/6,(szy/3)*2,(szx-(szx/5)+szx/6),((szy/3)*2)+szy/6
  865.  
  866. Line szx/2.2,(szy/3)*2,szx/2.2,((szy/3)*2)+szy/5
  867. Line (szx-(szx/2.2))+szx/6,(szy/3)*2,(szx-(szx/2.2))+szx/6,((szy/3)*2)+szy/12
  868. EndIf
  869.  
  870. If number=256 Then      ;Player walk frame 2
  871. colour 255,255,255
  872. Oval szx/4,szy/6,(szx/4.0)*3.0,szy/6+szx/2.5,0
  873. Oval (szx/2)-szx/6,0,(szx/2)+szx/12,szy/8+szy/2,0
  874.  
  875. x1=1
  876. x2=2
  877. colour hatred,hatgreen,hatblue
  878. Oval ((szx/2)-szx/6)+x1,0+x1,((szx/2)+szx/12)-x2,(szy/8+szy/2)-x2,1
  879. colour 0,250,200
  880. If variant=2 Then colour 80,120,0
  881. If variant=3 Then colour 200,200,10
  882.  
  883. Oval (szx/4)+x1,(szy/6)+x1,((szx/4.0)*3.0)-x2,(szy/6+szx/2.5)-x2,1
  884.  
  885.  
  886. colour 255,255,255
  887. Line ((szx/2)+szx/3),szy/6,0,szy/6.0
  888. colour 255,0,255
  889. Oval (szx/3)+szx/12,szy/3,szx/8,szy/8,1
  890. Oval ((szx/3)*2)+szx/12,szy/3,szx/8,szy/8,1
  891. ;Plot szx/3,szy/3
  892. ;Plot (szx/3)*2,szy/3
  893.  
  894. colour 255,255,255
  895. Line szx/3,(szy/3)*2,szx/5,((szy/3)*2)+szy/6
  896. Line (szx-(szx/3))+szx/6,(szy/3)*2,(szx-(szx/5)+szx/6),((szy/3)*2)+szy/12
  897.  
  898. Line szx/2.2,(szy/3)*2,szx/2.2,((szy/3)*2)+szy/12
  899. Line (szx-(szx/2.2))+szx/6,(szy/3)*2,(szx-(szx/2.2))+szx/6,((szy/3)*2)+szy/5
  900. EndIf
  901.  
  902. SetBuffer cb
  903. Return image
  904. End Function
  905.  
  906. Function setmap(x,y,set,mapset=1)
  907. If mapset=1 Then
  908. map(x,y)=set
  909. map(maxx-x,y)=set
  910. map(maxx-x,maxy-y)=set
  911. map(x,maxy-y)=set
  912. EndIf
  913. If mapset=2 Then
  914. map2(x,y)=set
  915. map2(maxx-x,y)=set
  916. map2(maxx-x,maxy-y)=set
  917. map2(x,maxy-y)=set
  918. EndIf
  919. If mapset=3 Then
  920. map3(x,y)=set
  921. map3(maxx-x,y)=set
  922. map3(maxx-x,maxy-y)=set
  923. map3(x,maxy-y)=set
  924. EndIf
  925. End Function
  926. Function createlevel(lev)
  927. mushrooms=0
  928. Local msx,msy
  929. SeedRnd lev
  930.  
  931. For x=0 To maxx
  932. For y=0 To maxy
  933. map(x,y)=3
  934. map2(x,y)=0
  935. map3(x,y)=0
  936. map4(x,y)=0
  937. If x=0 Or x=maxx Or y=0 Or y=maxy Then map(x,y)=6
  938. Next
  939. Next
  940.  
  941.  
  942.  
  943.  
  944. x=Rand(2,maxx-2)
  945. y=Rand(2,maxy-2)
  946. cd=0
  947. c=0:d=0
  948. For nv=3 To 0 Step -1
  949. If nv=3 Then ng=7:amt=1000
  950. If nv=2 Then ng=1:amt=500
  951. If nv=1 Then ng=5:amt=500
  952. If nv=0 Then ng=3:amt=Sqr(maxx*maxy)*Rand(3,5+(lev/3)):msx=x:msy=y
  953. difr=((maxx*maxy)/200)+1
  954. ;RuntimeError difr
  955. cnt=0
  956. For g=1 To amt
  957. ;If Rand(1,10)=10 Then x=Rand(1,maxx-1):y=Rand(1,maxy-1):Cd=1
  958. If Rand(1,difr)=Int(difr/2) And cnt>4 Then cd=1
  959. If nv<>0 And nv<>3 Then
  960.         If map(x,y)=1 Or map(x,y)=5 Then setmap(x,y,3):x=x-c:y=y-d:setmap(x,y,3):cd=1:x=x+c:y=y+d
  961.  
  962.         x=x+c:y=y+d
  963.         If x>0 And x<maxx And y>0 And y<maxy Then If map(x,y)=1 Or map(x,y)=5 Then cd=1
  964.         x=x+c:y=y+d
  965.         ;If x>0 And x<maxx And y>0 And y<maxy Then If map(x,y)=1 Or map(x,y)=5 Then cd=1
  966.         x=x-c:y=y-d
  967.         x=x-c:y=y-d
  968. EndIf
  969. cnt=cnt+1
  970. If cd=1 Then
  971. cnt=0
  972. Repeat:c=Rand(-1,1):d=Rand(-1,1):
  973. If (c=0 And d=0) Or (c<>0 And d<>0) Then c=0:d=0
  974. xx=x+c
  975. yy=y+d
  976. If xx<1 Then xx=1 Else If xx>maxx Then xx=maxx
  977. If yy<1 Then yy=1 Else If yy>maxy Then yy=maxy
  978. mp=map(xx,yy)
  979. ;If KeyDown(1) Then End
  980. Until (c<>0 Or d<>0)
  981. cd=0
  982.  
  983. EndIf
  984. If x<1 Then x=maxx-1
  985. If y<1 Then y=maxy-1
  986. If x>maxx-1 Then x=1
  987. If y>maxy-1 Then y=1
  988. setmap(x,y,ng)
  989. If ng=3 Then setmap(x,y,ng,2)
  990. If ng<>3 Then setmap(x,y,0,2)
  991. ;map(x,y)=ng
  992. ;map(x,maxy-y)=ng
  993. ;map(maxx-x,y)=ng
  994. ;map(maxx-x,maxy-y)=ng
  995. x=x+c
  996. y=y+d
  997. ;If ng=4 Then ng=3
  998. Next
  999. Next
  1000.  
  1001.  
  1002. For n=1 To maxplayers
  1003. Repeat:x=Rand(1,maxx)
  1004. y=Rand(1,maxy)
  1005. Until map2(x,y)<>0
  1006. setmap(x,y,4,3)
  1007. Next
  1008. ;setmap(x,y,0,2)
  1009. ;map(x,y)=4
  1010. ;map(x,maxy-y)=4
  1011. ;map(maxx-x,y)=4
  1012. ;map(maxx-x,maxy-y)=4
  1013. ;alive(x,y)=mushlife
  1014. ;alive(maxx-x,y)=mushlife
  1015. ;alive(x,maxy-y)=mushlife
  1016. ;alive(maxx-x,maxy-y)=mushlife
  1017.  
  1018.  
  1019.  
  1020.  
  1021.  
  1022.  
  1023. Cls
  1024. For x=0 To maxx
  1025. For y=0 To maxy
  1026. If map2(x,y)<>0 Then map(x,y)=2
  1027. ;DrawBlock img(map(x,y)),x*szx,y*szy
  1028. drawtile x,y
  1029. ;If map2(x,y)=0 Then DrawBlock img(1),x*szx,y*szy
  1030. Next
  1031. Next
  1032.  
  1033.  
  1034.  
  1035.  
  1036.  
  1037. pl=1
  1038. For n=1 To maxplayers/4
  1039. n2=4:If n+n2>maxplayers Then n2=(maxplayers Mod 4)+1
  1040. Repeat:x=Rand(1,(maxx/2)-2)
  1041. y=Rand(1,(maxy/2)-2)
  1042. ok=1
  1043. If mapok(x,y)=0 Then ok=0
  1044. For o=1 To maxplayers
  1045. If x=px(o) And y=py(o) Then ok=0
  1046. Next
  1047. If map2(x,y)=0 Then ok=0
  1048. Until  ok=1
  1049. sx(pl)=x
  1050. sy(pl)=y
  1051. pl=pl+1
  1052. If pl<maxplayers+1 Then
  1053. sx(pl)=maxx-x
  1054. sy(pl)=y
  1055. pl=pl+1
  1056. EndIf
  1057. If pl<maxplayers+1 Then
  1058. sx(pl)=x
  1059. sy(pl)=maxy-y
  1060. pl=pl+1
  1061. EndIf
  1062. If pl<maxplayers+1 Then
  1063. sx(pl)=maxx-x
  1064. sy(pl)=maxy-y
  1065. pl=pl+1
  1066. EndIf
  1067. Next
  1068.  
  1069.  
  1070. For n=1 To maxplayers
  1071. px(n)=0
  1072. py(n)=0
  1073. pdx(n)=0
  1074. pdy(n)=0
  1075. If lives(n)<>0 Then
  1076. px(n)=sx(n)
  1077. py(n)=sy(n)
  1078. pdx(n)=sx(n)*szx
  1079. pdy(n)=sy(n)*szy
  1080. EndIf
  1081. Next
  1082.  
  1083.  
  1084. CT=lev*2
  1085. If CT>1024 Then CT=1024
  1086. For n=1 To CT
  1087.  
  1088. MS=MilliSecs()
  1089. Repeat:x=Rand(1,maxx)
  1090. y=Rand(1,maxy)
  1091. ;ok=1
  1092. ok=1
  1093. If mapok(x,y-1)<>0 Then ok=0
  1094. ;If mapok(x,y-1)=0 And  mapok(x,y)=1 Then ok=1
  1095. If map4(x,y-1)<>0 Then ok=0
  1096. If mapok(x-1,y)=0 And mapok(x+1,y)=0 Then ok=0
  1097. ;If mapok(x-2,y)=0 Then ok=0
  1098. ;If mapok(x+2,y)=0 Then ok=0
  1099. If mapok(x,y)=0 Then ok=0
  1100. If mapok(x,y+1)=0 Then ok=0
  1101.  
  1102. If map4(x-1,y)<>0 Or map4(x+1,y)<>0 Then ok=0
  1103. For o=1 To maxplayers
  1104. If x=px(o) And y=py(o) Then ok=0
  1105. Next
  1106. ;If map2(x,y)=0 Then ok=0
  1107. Until  ok=1 Or KeyDown(1) Or MilliSecs()-MS>200
  1108. If MilliSecs()-MS<200 Then map4(x,y)=8:map4(maxx-x,y)=8 Else N=10250
  1109.  
  1110. Next
  1111.  
  1112.  
  1113.  
  1114. End Function
  1115. Function spread()
  1116. Local x,y,x2,y2
  1117. mushrooms=0
  1118. For x=1 To maxx-1
  1119.         For y=1 To maxy-1
  1120.                 If map4(x,y)<>0 And map3(x,y)<>0 Then map3(x,y)=0
  1121.                 If map3(x,y)<>0 Then mushrooms=mushrooms+1
  1122.         Next
  1123. Next
  1124.  
  1125. ct=0
  1126. For nn=1 To maxplayers
  1127. If lives(nn)>0 Then ct=ct+1
  1128. Next
  1129.  
  1130. For nn=1 To (maxx/16)*(ct*.7)
  1131.         x=Rand(1,maxx-1)
  1132.         y=Rand(1,maxy-1)
  1133.                 If map3(x,y)=4 Then
  1134.  
  1135.                         Repeat:c=Rand(-1,1):d=Rand(-1,1):
  1136.                                 If (c=0 And d=0) Or (c<>0 And d<>0) Then c=0:d=0
  1137.                         Until (c<>0 Or d<>0)
  1138.  
  1139.  
  1140.                         x2=x+c
  1141.                         y2=y+d
  1142.                         If map3(x2,y2)=4 Then alive(x2,y2)=mushlife
  1143.                         If map(x2,y2)=3 Or map(x2,y2)=2
  1144.                                 If Rand(100)>0 Then
  1145.                                                 ok=1
  1146.                                                
  1147.                                                 For n2=1 To maxplayers:If px(n2)=x2 And py(n2)=y2 Then ok=0
  1148.                                                 If px(n2)+pc(n2)=x2 And py(n2)+pd(n2)=y2 Then ok=0
  1149.                                                 If px(n2)-pc(n2)=x2 And py(n2)-pd(n2)=y2 Then ok=0
  1150.                                                 Next
  1151.                                                 If ok=1 Then
  1152.                                                 map3(x2,y2)=4:Lastspread=MilliSecs():alive(x2,y2)=mushlife
  1153.                                                 drawtile(x2,y2)
  1154.                                                 EndIf
  1155.                                 EndIf
  1156.                         EndIf
  1157.                 EndIf
  1158. Next
  1159.  
  1160. ;EndIf
  1161. End Function
  1162.  
  1163. Function drawtileo(x,y)
  1164. If updbuffer=1 Then
  1165.  
  1166. If map(x,y)<>0 Then DrawBlock img(map(x,y)),(x*(szx))-camx,((y*(szy))-camy)+basey
  1167. If map3(x,y)<>0 Then DrawImage img(map3(x,y)),(x*szx)-camx,((y*szy)-camy)+basey
  1168. If map4(x,y)<>0 Then DrawImage img(8),(x*szx)-camx,((y*szy)-camy)+basey
  1169. EndIf
  1170.  
  1171. End Function
  1172. Function drawtile(x,y)
  1173. Local mx=(x*szx)-camx
  1174. Local my=(y*szy)-camy
  1175. If mx>-szx And mx<scx And my>-szy And my<scy And updbuffer=1 Then
  1176. ;Local o,n=WaitTimer(audiotimer):If n>0 Then For o=1 To n::Next
  1177.  
  1178. If x>-1 And x<maxx+1 And y>-1 And y<maxy+1 Then
  1179. If map(x,y)<>0 Then DrawBlock img(map(x,y)),(x*(szx))-camx,((y*(szy))-camy)+basey
  1180. If map3(x,y)<>0 Then DrawImage img(map3(x,y)),(x*szx)-camx,((y*szy)-camy)+basey
  1181. If map4(x,y)<>0 Then DrawImage img(8),(x*szx)-camx,((y*szy)-camy)+basey
  1182.  
  1183. EndIf
  1184. EndIf
  1185. End Function
  1186.  
  1187. Function dfloor()
  1188. If DEAD(1)=0 Then
  1189. camx=pdx(1)-(scx/2)
  1190. camy=pdy(1)-(scy/2)
  1191. If camx<0 Then camx=0
  1192. If camy<0 Then camy=0
  1193. If camx>((maxx+1)*szx)-scx Then camx=((maxx+1)*szx)-scx
  1194. If camy>((maxy+1)*szy)-(scy-basey) Then camy=((maxy+1)*szy)-(scy-basey)
  1195. cammvx=-(camx-ocamx)
  1196. cammvy=-(camy-ocamy)
  1197. ocamx=camx
  1198. ocamy=camy
  1199. EndIf
  1200. End Function
  1201.  
  1202. Function mapok(x,y) ;checks for presence of anything including players
  1203. Local n
  1204. If ignoreboulders=0 Then
  1205. For n=1 To maxplayers
  1206. If px(n)=x And py(n)=y Then Return 0
  1207. If Int(pdx(n)/szx)=x And Int(pdy(n)/szy)=y Then Return 0
  1208. Next
  1209. EndIf
  1210. If ignoreboulders=0 Then If map4(x,y)<>0 Then Return 0
  1211. If x<1 Or x>maxx-1 Or y<1 Or y>maxy-1 Then Return 0
  1212. If map(x,y)=3 Or map(x,y)=2 Then Return 1
  1213. Return 0
  1214. End Function
  1215.  
  1216. Function mapok2(x,y) ;checks for presence of anything excludin players and boulders
  1217. Local n
  1218. ;If map4(x,y)<>0 Then Return 0
  1219. If x<1 Or x>maxx-1 Or y<1 Or y>maxy-1 Then Return 0
  1220. If map(x,y)=3 Or map(x,y)=2 Then Return 1
  1221. Return 0
  1222. End Function
  1223.  
  1224.  
  1225. ;Hat colours for players
  1226.  
  1227. Data 4 ;Number of colours listed
  1228. Data 100,200,0
  1229. Data 255,0,0
  1230. Data 0,0,255
  1231. Data 100,0,255
  1232.  
  1233. Data 100,255,0
  1234. Data 50,50,150
  1235. Data 255,0,255
  1236. Data 100,255,50
  1237.  
  1238. Function findpath(sx,sy,ex,ey)
  1239. For x=1 To maxx
  1240. For y=1 To maxy
  1241. ;If map4(x,y)<>0 Then map4(x,y)=0:drawtile x,y
  1242. Next
  1243. Next
  1244.  
  1245. n.path=New path
  1246. nx=sx
  1247. ny=sy
  1248. cntr=0
  1249. done=0
  1250. ;Repeat
  1251. For n.path=Each path
  1252. If done=0 Then
  1253. done=checkpath(nx,ny,ex,ey,cntr):cntr=cntr+1:Delete n
  1254. EndIf
  1255. Next
  1256. ;Until done
  1257. Return done
  1258. End Function
  1259. Function checkpath(x,y,ex,ey,cntr)
  1260. Local c,d,n.path
  1261. For c=-1 To 1
  1262. For d=-1 To 1
  1263. If c=0 Or d=0 And Abs(c)<>Abs(d) Then
  1264. If (map(x+c,y+d)=2 Or map(x+c,y+d)=3) And map4(x+c,y+d)=0 Then
  1265. map4(x+c,y+d)=cntr
  1266. drawtile(x+c,y+d)
  1267. n.path=New path
  1268. nx=x+c
  1269. ny=y+d
  1270. ;If KeyDown(1) Then End
  1271. EndIf
  1272. EndIf
  1273. Next
  1274. Next
  1275. If x=ex And y=ey Then Return 1
  1276. End Function
  1277. Function positionplayer(n,x,y)
  1278. px(n)=x:py(n)=y:pdx(n)=x*szx:pdy(n)=y*szy
  1279. End Function
  1280. Function die(player)
  1281. dead(player)=1
  1282. diecounter(player)=60
  1283. lives(player)=lives(player)-1
  1284. ;If playertype(player)<>0 Then
  1285. diefx;EndIf
  1286. End Function
  1287. Function diefx()
  1288. FLUSHCHANNEL 3
  1289. For nv#=1 To 0 Step -.4
  1290. sound 3,nv,220,15
  1291. ;sound 3,.8,100,10
  1292. Next
  1293. End Function
  1294. Function winfx()
  1295. FLUSHCHANNEL 3
  1296. FLUSHCHANNEL 4
  1297. FLUSHCHANNEL 5
  1298. For nv#=1 To 0 Step -.4
  1299. sound 3,nv,220,15,3
  1300. sound 4,nv,232,15,3
  1301. sound 5,nv,240,15,3
  1302. ;sound 3,.8,100,10
  1303. Next
  1304. End Function
  1305.  
  1306. Function okahead(x,y,c,d)
  1307. ok=-1000
  1308. x=x+c:y=y+d
  1309. cnt=0
  1310. For nn=1 To maxx
  1311. If x<0 Then x=0 Else If x>maxx Then x=maxx
  1312. If y<0 Then y=0 Else If y>maxy Then y=maxy
  1313.  
  1314. If map3(x,y)<>0 Then ok=1:dsn=cnt+9000:nn=maxx+1
  1315. If mapok(x,y)=0 And ok<>1 And nn<5 Then ok=2:dsn=cnt:nn=maxx+1
  1316.  
  1317. For c2=-1 To 1
  1318. For d2=-1 To 1
  1319. If (c2=0 Or d2=0) And (c2<>0 Or d2<>0) Then
  1320. If mapok(x+c2,y+d2) Then cnt=cnt+1
  1321. EndIf
  1322. Next
  1323. Next
  1324.  
  1325. cnt=cnt+1
  1326. x=x+c:y=y+d
  1327. Next
  1328. If ok=1 Then ok=dsn
  1329. If ok=2 Then ok=-dsn;dsn+1024
  1330.  
  1331. Return ok
  1332. End Function
  1333.  
  1334.  
  1335. Function distancehead(x,y,c,d)
  1336. ok=-1000
  1337. x=x+c:y=y+d
  1338. cnt=0
  1339. For nn=1 To maxx
  1340. If x<0 Then x=0 Else If x>maxx Then x=maxx
  1341. If y<0 Then y=0 Else If y>maxy Then y=maxy
  1342. If map3(x,y)<>0 Then dsn=cnt+1024:ok=1:nn=maxx+1
  1343. If mapok(x,y)<>0 Then dsn=cnt:ok=1:nn=maxx+1
  1344. cnt=cnt+1
  1345. x=x+c:y=y+d
  1346. Next
  1347. If ok=1 Then ok=dsn
  1348.  
  1349. Return ok
  1350. End Function
  1351.  
  1352.  
  1353. Function finddirection(x,y)
  1354. Local c,d,dst=0
  1355. odirx=dirx:odiry=diry
  1356. For bc=-1 To 1
  1357. For bd=-1 To 1
  1358. If (bc=0 Or bd=0) And (bd<>0 Or bc<>0) Then
  1359. distance=distancehead(x,y,bc,bd)
  1360. ;If distance=-1000 Then distance=0
  1361. ;If distance>0 Then distance=distance+1000
  1362. ;If distance<0 Then distance=-distance
  1363. If distance>=dst Then dst=distance:dirx=bc*dst:diry=bd*dst
  1364. EndIf
  1365. Next
  1366. Next
  1367. If dirx=0 And diry=0 Then
  1368. dst=0
  1369. For bc=-1 To 1
  1370. For bd=-1 To 1
  1371. If (bc=0 Or bd=0) And (bd<>0 Or bc<>0) Then
  1372. distance=distancehead(x,y,bc,bd)
  1373. If distance>=dst Then dst=distance:dirx=bc*dst:diry=bd*dst
  1374. EndIf
  1375. Next
  1376. Next
  1377. If dirx=0 And diry=0 Then dirx=odirx:diry=odiry
  1378. EndIf
  1379. End Function
  1380.  
  1381. Function findbestdirection(x,y)
  1382. Local c[4],d[4]
  1383.  
  1384.  
  1385. If mapok(x,y+1) Then
  1386. finddirection(x,y+1)
  1387. c[1]=dirx:d[1]=diry
  1388. EndIf
  1389.  
  1390. If mapok(x,y-1) Then
  1391. finddirection(x,y-1)
  1392. c[2]=dirx:d[2]=diry
  1393. EndIf
  1394.  
  1395. If mapok(x+1,y) Then
  1396. finddirection(x+1,y)
  1397. c[3]=dirx:d[3]=diry
  1398. EndIf
  1399.  
  1400. If mapok(x-1,y) Then
  1401. finddirection(x-1,y)
  1402. c[4]=dirx:d[4]=diry
  1403. EndIf
  1404.  
  1405. bd=0
  1406. bc=0
  1407.  
  1408. For n=1 To 4
  1409. If Abs(c[n])>abc Or Abs(d[n])>abd Then bc=c[n]:bd=d[n]:abc=Abs(bc):abd=Abs(bd):seldn=n
  1410. Next
  1411. If seldn=1 Then bc=0:bd=1
  1412. If seldn=2 Then bc=0:bd=-1
  1413. If seldn=3 Then bc=1:bd=0
  1414. If seldn=4 Then bc=-1:bd=0
  1415.  
  1416. fs=WriteFile("temp.txt")
  1417. For n=1 To 4
  1418. If c[n]<>0 Or d[n]<>0 Then fns=1
  1419. WriteLine fs,c[n]+",  "+d[n]
  1420. Next
  1421. WriteLine fs,bc+", "+bd
  1422. CloseFile fs
  1423.  
  1424. ;If fns=1 Then
  1425. ;ExecFile "temp.txt"
  1426. ;End
  1427. ;EndIf
  1428.  
  1429. dirx=bc
  1430. diry=bd
  1431. Goto Exitbit
  1432.  
  1433.  
  1434. For bc=-1 To 1
  1435.         For bd=-1 To 1
  1436.                 If (bc=0 Or bd=0) And (bd<>0 Or bc<>0) Then
  1437.                         If mapok(x+bc,y+bd)<>0 Then
  1438.  
  1439.  
  1440.  
  1441.  
  1442.  
  1443.  
  1444.                         EndIf
  1445.                 EndIf
  1446. Next
  1447. Next
  1448. .Exitbit
  1449. End Function
  1450.  
  1451. Function setuptext()
  1452. Local n,bf
  1453. For n=32 To 128
  1454. charimg(n,0)=CreateImage(txsize,txsize)
  1455. bf=GraphicsBuffer()
  1456. SetBuffer ImageBuffer(charimg(N,0))
  1457.  
  1458. colour 128,128,128
  1459. colour 0,0,0
  1460. ;colour 255,255,0
  1461. For c=-1 To 1
  1462. For d=-1 To 1
  1463. Text (txsize/2.0)-c,(txsize/2.0)-d,Chr$(n),1,1
  1464. Next:Next
  1465.  
  1466.  
  1467. colour 255,255,255
  1468. colour 255,255,0
  1469. Text (txsize/2.0),(txsize/2.0),Chr$(n),1,1
  1470. ;Text (txsize/2.0)+1,(txsize/2.0),Chr$(n),1,1
  1471. ;Text (txsize/2.0),(txsize/2.0)+1,Chr$(n),1,1
  1472. ;Text (txsize/2.0)+1,(txsize/2.0)+1,Chr$(n),1,1
  1473.  
  1474. ScaleImage charimg(n,0),txscale,txscale
  1475. MidHandle charimg(n,0)
  1476. For n2=1 To Textcnt
  1477. charimg(n,n2)=CopyImage(charimg(n,0))
  1478. MidHandle charimg(n,0)
  1479. RotateImage charimg(n,n2),((n2-1)-Textcnt/2.0)*4
  1480. Next
  1481. Next
  1482. txsize=txsize*txscale
  1483. SetBuffer bf
  1484. End Function
  1485.  
  1486. Function Text2(x,y,Txt$,centre_x=0,centre_y=0)
  1487. Local n,a,t$,drawx,drawy
  1488. If centre_x=1 Then x=x-Len(txt$)*((txsize*txxdis)/2.0)
  1489. If centre_y=1 Then y=y-txsize/2.0
  1490.  
  1491. x=x+((txsize*txxdis)/2.0)
  1492. y=y+((txsize)/2.0)
  1493.  
  1494. For n=1 To Len(Txt$)
  1495. t$=Mid$(txt$,n,1)
  1496. a=Asc(t$)
  1497. If a>32 And a<128 Then
  1498. vl#=(Sin(MilliSecs()+(n*500))/2)+.5
  1499. vl=(vl*(Textcnt-1))+1
  1500. DrawImage charimg(a,vl),x+(n-1)*(txsize*txxdis),y
  1501. EndIf
  1502. Next
  1503. End Function
  1504. Function addboulder(x,y,player,timer)
  1505. Local n.boulder,do=1,X2,Y2
  1506. For X2=X-1 To X+1
  1507. For Y2=Y-1 To Y+1
  1508. If X2>-1 And X2<MAXX+1 And Y2>-1 And Y2<MAXY+1 Then
  1509. If MAP4(X2,Y2)<>0 And ((X2=X Or Y2=Y) And (X2<>X Or Y2<>Y)) Then MAP4(X2,Y2)=0
  1510. EndIf
  1511. Next
  1512. Next
  1513. If map4(x,y+1)=0 And mapok2(x,y+1)<>0 Then
  1514. For n=Each boulder
  1515. If nx=x And ny=y Then do=0
  1516. Next
  1517. If do=1 Then
  1518. n=New boulder
  1519. nsx=x
  1520. nsy=y
  1521. nx=x:ny=y
  1522. nplayer=0
  1523. n       imer=timer
  1524. n       riggered=0
  1525. n
  1526. ocknumber=map4(x,y)
  1527. EndIf
  1528. EndIf
  1529. End Function
  1530.  
  1531. Function updateboulders()
  1532. Local n.boulder
  1533. Local oudb=updbuffer
  1534. updbuffer=1
  1535. For n=Each boulder
  1536. deld=0
  1537. ox=nx
  1538. oy=ny
  1539. If map4(nx,ny)=0 And n
  1540. eposition=0 Then Delete n:Goto nxtn
  1541. If mapok(nx,ny+1)=0 And n       riggered=0 Then Goto nxtn
  1542. If n
  1543. eposition=0 Then drawtile nx,ny
  1544. If n    imer>0 Then n   imer=n  imer-1:Goto Nxtn
  1545. If n    riggered=0 Then n       riggered=1:flushchannel 2:sound 2,1,180,20
  1546. If n
  1547. eposition=0 Then
  1548. n       imer=10
  1549.         If map4(nx,ny+1)=0 And mapok2(nx,ny+1) Then
  1550.                 map4(nx,ny+1)=n
  1551. ocknumber:map4(nx,ny)=0:drawtile nx,ny:drawtile nx,ny+1
  1552.                 ny=ny+1
  1553.         Else
  1554.         n
  1555. eposition=1
  1556.         map4(nx,ny)=0
  1557.         drawtile nx,ny
  1558.         n       imer=256
  1559.         EndIf
  1560. EndIf
  1561. If n
  1562. eposition=0 Then drawtile ox,oy
  1563. If n
  1564. eposition And n imer=0 Then
  1565. If mapok(nsx,nsy) Then map4(nsx,nsy)=n
  1566. ocknumber:map4(nx,ny)=0:drawtile nx,ny:drawtile nsx,nsy:Delete n:deld=1
  1567. EndIf
  1568. .Nxtn
  1569. Next
  1570. updbuffer=oudb
  1571. End Function
  1572.  
  1573. Function collectsfx(channel)
  1574. flushchannel channel
  1575. sound channel,1,150,6
  1576. End Function
  1577.  
  1578. Function Music(n)
  1579. Restore music1
  1580. Repeat
  1581. Read chan
  1582. If chan<>-1 Then
  1583. If chan<>0 Then chan=chan+5
  1584. ;If chan=6 Then chan=4
  1585.  
  1586. Read vol#,Pitch,Length#
  1587. If chan=6 Or chan=7 Or chan=8 Then Pitch=Pitch-48
  1588. Pitch=Pitch+48
  1589. If chan=9 Then Pitch=Pitch-48*2
  1590. ;Pitch=Pitch-24
  1591. sound chan,vol#,Pitch+48,Length*3,chan
  1592. loopchannel chan,1
  1593. EndIf
  1594. Until chan=-1
  1595. ;Repeat
  1596. ;updatesound()
  1597. ;Until KeyDown(1)
  1598. ;End
  1599. Restore
  1600. End Function
  1601. Function setupmusic()
  1602. adsr 0,1,-.05,.1,-.1
  1603. adsr 9,1,-.05,.1,-.1
  1604. adsr 10,1,-.05,.2,-.1
  1605. adsr 1,1,0,1,-.1
  1606. adsr 2,.2,-.05,.5,-.02
  1607. Pitchadsr 1,0,-16,0,16
  1608. Pitchadsr 2,-4,-1,-1,-2
  1609. Pitchadsr 3,-7,-7,-7,-7
  1610. adsr 3,1,-.01,.1,-.1
  1611. music(1)
  1612.  
  1613. soundshape 5,1
  1614. soundshape 6,1
  1615. soundshape 7,1
  1616.  
  1617. soundshape 3,2
  1618. soundshape 2,2
  1619. soundshape 1,2
  1620. ;loopchannel 2 0
  1621.  
  1622. For n=5 To 8
  1623. adsr n,.2,-.05,.5,-1
  1624. Next
  1625. End Function
  1626. Function Constr$(txt$,ln)
  1627. txt$=String$(" ",ln-Len(txt$))+txt$
  1628. Return Replace(txt$," ","0")
  1629. End Function
  1630.  
  1631.  
  1632.  
  1633. .music1
  1634.  
  1635.  
  1636. Data 1,.5,52,10
  1637. Data 2,.5,68,10
  1638. Data 3,.5,80,10
  1639. Data 1,.5,52,10
  1640. Data 2,.5,68,10
  1641. Data 3,.5,80,10
  1642.  
  1643. Data 1,.5,52,10
  1644. Data 2,.5,72,10
  1645. Data 3,.5,80,10
  1646. Data 1,.5,52,10
  1647. Data 2,.5,72,10
  1648. Data 3,.5,80,10
  1649.  
  1650. ;Data 4,1,4,5
  1651.  
  1652.  
  1653.  
  1654.  
  1655. Data 5,1,100,10
  1656. Data 5,1,100,10
  1657. Data 5,1,92,5
  1658. Data 5,1,88,5
  1659. Data 5,1,80,10
  1660. Data 5,1,72,10
  1661. Data 5,1,80,10
  1662. Data 5,1,88,10
  1663. Data 5,1,80,10
  1664. ;
  1665. Data 5,1,100,10
  1666. Data 5,1,100,10
  1667. Data 5,1,92,5
  1668. Data 5,1,88,5
  1669. Data 5,1,80,5
  1670. Data 5,1,80,45
  1671.  
  1672. Data 4,.5,52,5
  1673. ;Data 4,.5,68,5
  1674. Data 4,.5,80,5
  1675.  
  1676. Data 0,1,5,5
  1677. Data 0,0,50,15
  1678. Data 0,.5,150,10
  1679. Data 0,0,0,10
  1680. Data 0,1,5,5
  1681. Data 0,0,0,5
  1682. Data 0,1,5,5
  1683. Data 0,.5,20,5
  1684. Data 0,.5,150,10
  1685. Data 0,0,50,10
  1686.  
  1687. Data 0,1,5,5
  1688. Data 0,0,50,15
  1689. Data 0,.5,150,10
  1690. Data 0,0,0,10
  1691. Data 0,1,5,5
  1692. Data 0,0,0,5
  1693. Data 0,1,5,5
  1694. Data 0,.5,20,5
  1695. Data 0,.5,150,5
  1696. Data 0,0,150,5
  1697. Data 0,.5,150,5
  1698. Data 0,.5,150,5
  1699.  
  1700.  
  1701.  
  1702. Data -1
  1703.  
  1704.  
  1705.  
  1706. ;
  1707. ;
  1708. ; Cygnus Software's "chip" simulator...
  1709. ;
  1710. ; Programmed Oct-Nov 2004
  1711. ;
  1712. ; Feel free to use this code anywhere,
  1713. ; give credits where credits are due? I would do the same.
  1714. ; http://danjeruz.servegame.com
  1715. ; Have fun!!!!
  1716.  
  1717.  
  1718.  
  1719.  
  1720. Function initsoundsystem();channels,envelopes)
  1721. Local samples,o,nm,snd
  1722. Dim wavdata(1,4096)
  1723.  
  1724. samples=1
  1725. ss_channelcount=1
  1726.  
  1727. For o=0 To 10
  1728. wavdata(0,o)=-65525/2.1
  1729. Next
  1730. wavdata(0,1)=-65525/3
  1731. wavdata(0,2)=65525/3
  1732.  
  1733.  
  1734. samplerate=1
  1735. bpsample=16
  1736.  
  1737. wavdata(0,1)=-65525/3
  1738. wavdata(0,2)=-65525/3
  1739. wavdata(0,3)=65525/3
  1740. wavdata(0,4)=65525/3
  1741.  
  1742.  
  1743. For snd=1 To ss_sndtype
  1744. If SND=3 Then
  1745. For o=0 To 10
  1746. WAVDATA(0,O)=Sin(O*57)*65525/3.0
  1747. Next
  1748. EndIf
  1749. If SND=4 Then
  1750. For o=0 To SND*2
  1751. WAVDATA(0,O)=Sin((Float(O)/Float(SND*2))*360)*65525/3.0
  1752. Next
  1753. EndIf
  1754.  
  1755.  
  1756.  
  1757. samples=snd*4
  1758. Writewav(samples,"S"+Str$(snd)+".wav")
  1759. Next
  1760.  
  1761. For o=0 To 4096
  1762. wavdata(0,o)=Rnd(-65525/2,65525/2)
  1763. wavdata(1,o)=Rnd(-65525/2,65525/2)
  1764. Next
  1765. samples=4096
  1766. Writewav(samples,"S0.wav")
  1767.  
  1768. For o=0 To ss_sndtype
  1769. ss_soundbank(o)=LoadSound("s"+Str$(o)+".wav")
  1770. o2=o:If o=0 Then o2=5
  1771. ss_samplecntbank(o)=o2
  1772. DeleteFile "s"+Str$(o)+".wav"
  1773. LoopSound ss_soundbank(o)
  1774. Next
  1775.  
  1776. For o=0 To ss_maxchans
  1777. O2=ss_maxchans-O
  1778. nm=(((o2-1)/3) Mod ss_sndtype)+1
  1779. If o=0 Then nm=0
  1780. ss_sounds(o)=ss_soundbank(nm)
  1781. ss_samplecnt(o)=ss_samplecntbank(nm)
  1782. Next
  1783.  
  1784. For o=0 To ss_maxenvs
  1785. ss_defattack(o)=.1
  1786. ss_defdecay(o)=-.5
  1787. ss_defsustain(o)=0
  1788. ss_defrelease(o)=-.1
  1789. Next
  1790.  
  1791. For o=0 To ss_maxenvs
  1792. Next
  1793. End Function
  1794. Function sound(channel,vol#,Pitch,Length,envelope=-1)
  1795. ;channel=ss_maxchans-channel
  1796. If envelope=-1 Then envelope=channel
  1797.  
  1798. Local count
  1799. ;dim ss_bufferchan(ss_maxchans,ss_buffersize),buffervol(ss_maxchans,ss_buffersize)
  1800. ;dim ss_bufferpitch(ss_maxchans,ss_buffersize)
  1801. ;dim ss_bufferlength(ss_maxchans,ss_buffersize)
  1802. ;dim ss_buffercount(ss_maxchans)
  1803. count=ss_buffercount(channel)
  1804. If count<0 Then count=0
  1805. ss_buffercount(channel)=count
  1806. ss_buffervol(channel,count)=vol
  1807. ss_bufferpitch(channel,count)=Pitch
  1808. ss_bufferlength(channel,count)=Length
  1809. ss_bufferenv(channel,count)=envelope
  1810.  
  1811. ss_buffercount(channel)=ss_buffercount(channel)+1
  1812. If ss_buffercount(channel)>ss_buffersize-1 Then Repeat:updatesound():Until KeyDown(1) Or ss_buffercount(channel)<ss_buffersize-1 Or ss_buffercount(channel)=0;:If buffercount(channel)<0 Then buffercount(channel)=0
  1813. End Function
  1814. Function updatesound()
  1815. Local n,ct,n2
  1816. If MilliSecs()-audiotimer>updateperiod Then
  1817. audiotimer=MilliSecs()
  1818. ct=Float(MilliSecs()-audiotimer)/Float(updateperiod)
  1819. If ct>2 Then ct=0
  1820. For n=0 To ct
  1821. For n2=1 To 1
  1822. doupdatesound
  1823. updatesoundtimer()
  1824. Next
  1825. Next
  1826.  
  1827. EndIf
  1828.  
  1829. End Function
  1830. Function doupdatesound()
  1831.  
  1832. ;soundtimer()=soundtimer()+.01
  1833. Local o,count,o2,updvols=0,nx,env
  1834. Local divm#=1
  1835.  
  1836.  
  1837. For o=0 To ss_maxchans
  1838. ss_lfocounter(o)=ss_lfocounter(o)+1
  1839.  
  1840. env=ss_envelope(o)
  1841. ;env=o
  1842. updvols=1
  1843.  
  1844. pastend=0
  1845. attacked=ss_attackdone(o)
  1846. If soundtimer()-ss_started(o)>=ss_slength(o)*1 Then pastend=1
  1847.  
  1848. count=ss_buffercount(o)
  1849.  
  1850. If ss_schan(o)<>0 Then
  1851. ;ChannelVolume ss_schan(o),ss_volume(o)
  1852. If updvols=1 Then
  1853.  
  1854.  
  1855. ;Dim ss_lfo#(ss_lfocount,ss_maxchans)
  1856. ;Dim ss_lfofreq#(ss_lfocount,ss_maxchans)
  1857. ;Dim ss_lfocounter(ss_maxchans)
  1858.  
  1859. ;vlfo#=lfovalue(ss_lfocounter(o))*ss_lfofreq(2,o)*ss_lfo(2,o)
  1860. vlfo#=volumemultiplier(o)
  1861. plfo#=Pitchlfo(o)
  1862. ;plfo#=lfovalue(ss_lfocounter(o))*ss_lfofreq(1,o)*ss_lfo(1,o)
  1863. ;vlfo=1
  1864. ;plfo=1
  1865.                 ;For n=1 To ss_lfocount
  1866.                         ;If ss_lfo(n,o)<ss_lfosustain(n,env) Then ss_lfo(n,o)=ss_lfo(n,o)+ss_lfoattack(n,env) Else ss_lfo(n,o)=ss_lfosustain(n,env)
  1867.                 ;Next
  1868.                
  1869. If pastend=0 And attacked=0 Then                        ;Attack section
  1870.         If ss_volume(o)<1 Then ss_volume(o)=ss_volume(o)+ss_attack(o)
  1871.         If ss_volume(o)>=1 Then ss_volume(o)=1
  1872.  
  1873.                 For n=1 To ss_lfocount
  1874.                         If ss_lfo(n,o)<1 Then ss_lfo(n,o)=ss_lfo(n,o)+ss_lfoattack(n,env) Else ss_lfo(n,o)=1;ss_lfosustain(n,env)
  1875.                 Next
  1876.  
  1877.        
  1878.         av#=ss_volume#(o):ChannelVolume ss_schan(o),(av+vlfo)*ss_actualvol(o)
  1879.         ss_currentpitch(o)=ss_currentpitch(o)+ss_attackchange(env)
  1880.         nf=freq(ss_currentpitch(O),o)
  1881.         If nf>10 Then ChannelPitch ss_schan(o),nf
  1882. EndIf
  1883.  
  1884. If ss_volume(o)>=1 Then attacked=1:ss_attackdone(o)=1
  1885.  
  1886. If pastend=0 And attacked=1 Then                        ;Decay section
  1887.         ss_volume(o)=ss_volume(o)+ss_decay(o):If ss_volume(o)<ss_sustain(o) Then ss_volume(o)=ss_sustain(o):ss_decaydone(o)=1
  1888.  
  1889.  
  1890.                 For n=1 To ss_lfocount
  1891.                         ss_lfo(n,o)=ss_lfo(n,o)+ss_lfodecay(n,env)
  1892.                         If ss_lfo(n,o)<ss_lfosustain(n,env) Then ss_lfo(n,o)=ss_lfosustain(n,env)
  1893.                 Next
  1894.  
  1895.                 av#=ss_volume#(o):ChannelVolume ss_schan(o),(av+vlfo)*ss_actualvol(o)
  1896.                 ss_currentpitch(o)=ss_currentpitch(o)+ss_decaychange(env)
  1897.                 nf=freq(ss_currentpitch(O),o)
  1898.         If nf>10 Then ChannelPitch ss_schan(o),nf
  1899. EndIf
  1900. If ss_decaydone(o)=1 And pastend=0 Then ;Sustain section
  1901.                 ss_currentpitch(o)=ss_currentpitch(o)+ss_sustainchange(env)
  1902.                 av#=ss_volume#(o):ChannelVolume ss_schan(o),(av+vlfo)*ss_actualvol(o)
  1903.                 nf=freq(ss_currentpitch(O),o)
  1904.         If nf>10 Then ChannelPitch ss_schan(o),nf
  1905. EndIf
  1906.  
  1907. If pastend=1 Then
  1908.         ss_volume(o)=ss_volume(o)+ss_release(o):If ss_volume(o)<0 Then ss_volume(o)=0
  1909.  
  1910.                 For n=1 To ss_lfocount
  1911.                         ss_lfo(n,o)=ss_lfo(n,o)+ss_lforelease(n,env)
  1912.                         If ss_lfo(n,o)<0 Then ss_lfo(n,o)=0
  1913.                 Next
  1914.  
  1915.         av#=ss_volume#(o):ChannelVolume ss_schan(o),(av+vlfo)*ss_actualvol(o)
  1916.         ss_currentpitch(o)=ss_currentpitch(o)+ss_releasechange(env)
  1917.         nf=freq(ss_currentpitch(O),o)
  1918.         If nf>10 Then ChannelPitch ss_schan(o),nf
  1919. EndIf
  1920.  
  1921. EndIf
  1922.  
  1923.  
  1924.  
  1925.  
  1926. EndIf
  1927. If pastend=1 And forcesoundupdate=0 Then
  1928. count=ss_buffercount(o)
  1929. If count>0 And ss_buffercount(o)<ss_buffersize+1 Then
  1930. ;For nx=1 To 10
  1931. ;volume(o)=volume(o)*.9
  1932. ;ChannelVolume schan(o),volume(o)
  1933. ;Delay 1
  1934. ;Next
  1935.         If ss_channelloop(o) Then
  1936.        
  1937.                 addsound(o,ss_buffervol(o,ss_bufferpointer(o)),ss_bufferpitch(o,ss_bufferpointer(o)),ss_bufferlength(o,ss_bufferpointer(o)),ss_bufferenv(o,ss_bufferpointer(o))):ss_bufferpointer(o)=(ss_bufferpointer(o)+1) Mod count
  1938.                 ;For o2=1 To count:buffervol(o,o2-1)=buffervol(o,o2):bufferpitch(o,o2-1)=bufferpitch(o,o2):bufferlength(o,o2-1)=bufferlength(o,o2):Next:buffercount(o)=buffercount(o)-1
  1939.         EndIf
  1940.         If ss_channelloop(o)=0 Then
  1941.                 addsound(o,ss_buffervol(o,ss_bufferpointer(o)),ss_bufferpitch(o,ss_bufferpointer(o)),ss_bufferlength(o,ss_bufferpointer(o)),ss_bufferenv(o,ss_bufferpointer(o)))
  1942.                 For o2=1 To count
  1943.                 ss_buffervol(o,o2-1)=ss_buffervol(o,o2)
  1944.                 ss_bufferpitch(o,o2-1)=ss_bufferpitch(o,o2)
  1945.                 ss_bufferlength(o,o2-1)=ss_bufferlength(o,o2)
  1946.                 ss_bufferenv(o,o2-1)=ss_bufferenv(o,o2)
  1947.  
  1948.                 Next:ss_buffercount(o)=ss_buffercount(o)-1:If ss_buffercount(o)<0 Then ss_buffercount(o)=0
  1949.         EndIf
  1950.                
  1951. EndIf
  1952.  
  1953. EndIf
  1954. Next
  1955. End Function
  1956.  
  1957. Function freq(Pitch,chan)
  1958. Local p2,f
  1959. If Pitch<0 Then Pitch=Pitch+512
  1960. If Pitch>512 Then Pitch=Pitch-512
  1961. p2=(Pitch+200)+(Pitchlfo(chan));+Sin(ss_lfocounter(chan))
  1962.         f = 440 * 2^(((P2/4.0) - 58)/12)
  1963.         If f<10 Then f=10 Else If f>48000 Then f=48000
  1964. Return f*ss_samplecnt(chan)
  1965. End Function
  1966. Function lfovalue#(cnt)
  1967. ;Return (Cos#(cnt)+1)/2.0
  1968. Return (Cos#(cnt))
  1969. End Function
  1970.  
  1971. Function volumemultiplier#(channel)
  1972. ;env=ss_envelope(channel)
  1973. ;If env<0 Or env>ss_maxenvs Then RuntimeError env
  1974. Return lfovalue(ss_lfocounter(channel)*ss_lfofreq(2,ss_envelope(channel)))*ss_lfo(2,channel)
  1975. ;Return lfovalue(ss_lfocounter(channel))
  1976. End Function
  1977.  
  1978. Function Pitchlfo#(channel)
  1979. Return lfovalue(ss_lfocounter(channel)*ss_lfofreq(1,ss_envelope(channel)))*ss_lfo(1,channel)
  1980. End Function
  1981.  
  1982. Function addSound(channel,vol#,Pitch,Length#,envelope=-1)
  1983. Local p2#,o=ss_maxchans-channel,n
  1984. If envelope=-1 Then RuntimeError "sound not buffered correctly!"
  1985. ss_chancheck(channel)=0
  1986. ;Goto Endbit
  1987. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1988. If ss_sounds(channel)<>0 Then
  1989. ss_lfocounter(channel)=0
  1990. ;For n=0 To ss_lfocount
  1991. ;Next
  1992. p2=freq(pitch,channel)
  1993.  
  1994. If p2>100 Then
  1995. SoundVolume ss_sounds(channel),0
  1996. If ChannelPlaying(ss_schan(channel))=0 Then ss_schan(channel)=0 Else StopChannel ss_schan(channel):ss_schan(channel)=0
  1997. If ss_schan(channel)=0 Then If ss_sounds(channel)<>0 Then ss_schan(channel)=PlaySound(ss_sounds(channel))
  1998.  
  1999. ChannelPitch ss_schan(channel),P2;+((P2+(P2*2.0))/12.0)*4.0
  2000. ChannelVolume ss_schan(channel),ss_defattack(envelope)*vol*volumemultiplier(channel);(vol)
  2001. SoundVolume ss_sounds(channel),1
  2002. For n=1 To ss_lfocount
  2003.         ss_lfo(n,channel)=ss_lfoattack(n,channel)
  2004. Next
  2005. ss_currentpitch(channel)=Pitch
  2006. ss_volume(channel)=ss_defattack(envelope);vol
  2007. ss_actualvol(channel)=vol
  2008. ss_sLength(channel)=Length
  2009. ss_started(channel)=soundtimer()
  2010. ss_attack(channel)=(ss_defattack(envelope)/15)*updateperiod#
  2011. ss_release(channel)=(ss_defrelease(envelope)/15)*updateperiod#;-.2
  2012. ss_sustain(channel)=ss_defsustain(envelope);.2
  2013. ss_decay(channel)=(ss_defdecay(envelope)/15)*updateperiod#;-.8
  2014. ss_attackdone(channel)=0
  2015. ss_decaydone(channel)=0
  2016. ss_chancheck(channel)=soundtimer()
  2017. ss_envelope(channel)=envelope
  2018. EndIf
  2019. EndIf
  2020. forcesoundupdate=1
  2021. updatesound()
  2022. forcesoundupdate=0
  2023. .endbit
  2024. End Function
  2025.  
  2026. Function updatesoundtimer()
  2027. ;Return MilliSecs()
  2028. ss_stimer#=ss_stimer#+1
  2029. Return ss_stimer
  2030. End Function
  2031. Function soundtimer()
  2032. Return ss_stimer
  2033. End Function
  2034. Function loopchannel(channel,loop=1)
  2035. ss_channelloop(channel)=loop
  2036. End Function
  2037.  
  2038. Function LfoADSR(envelope,Lfo,cattack#,cdecay#,csustain#,crelease#)
  2039. ;ss_lfo#(lfo,ss_maxchans)
  2040. ;ss_lfo(lfo,
  2041. ss_lfoattack(lfo,envelope)=cattack
  2042. ss_lfodecay(lfo,envelope)=cdecay
  2043. ss_lfosustain(lfo,envelope)=csustain
  2044. ss_lforelease(lfo,envelope)=crelease
  2045.  
  2046. ;Dim ss_lfoattack#(ss_lfocount,ss_maxenvs)
  2047. ;Dim ss_lfodecay#(ss_lfocount,ss_maxenvs)
  2048. ;Dim ss_lfosustain#(ss_lfocount,ss_maxenvs)
  2049. ;Dim ss_lforelease#(ss_lfocount,ss_maxenvs)
  2050. ;Dim ss_lfo#(ss_lfocount,ss_maxenvs)
  2051. ;Dim ss_lfofreq#(ss_lfocount,ss_maxenvs)
  2052. End Function
  2053. Function Lfo(envelope,lfo,frequency)
  2054. ss_lfofreq#(lfo,envelope)=frequency
  2055. End Function
  2056.  
  2057. Function ADSR(envelope,cattack#,cdecay#,csustain#,crelease#)
  2058. ss_defattack(envelope)=cattack
  2059. ss_defdecay(envelope)=cdecay
  2060. ss_defsustain(envelope)=csustain
  2061. ss_defrelease(envelope)=crelease
  2062. End Function
  2063. Function PitchADSR(envelope,cattack#,cdecay#,csustain#,crelease#)
  2064. ss_attackchange(envelope)=cattack
  2065. ss_decaychange(envelope)=cdecay
  2066. ss_sustainchange(envelope)=csustain
  2067. ss_releasechange(envelope)=crelease
  2068. End Function
  2069. Function Soundshape(channel,sound)
  2070. If sound>-1 And sound<ss_sndtype+1 Then
  2071. ss_sounds(channel)=ss_soundbank(sound)
  2072. ss_samplecnt(channel)=ss_samplecntbank(sound)
  2073.  
  2074. EndIf
  2075. End Function
  2076. Function flushchannel(channel)
  2077. ss_bufferpointer(channel)=0
  2078. ss_buffercount(channel)=0
  2079. If ss_schan(channel)<>0 Then If ChannelPlaying(ss_schan(channel)) Then StopChannel ss_schan(channel):ss_schan(channel)=0
  2080. ss_started(channel)=-ss_slength(channel)
  2081. End Function
  2082. Function Stopsound()
  2083. Local n
  2084. For n=0 To ss_maxchans
  2085. flushchannel n
  2086. Next
  2087. End Function
  2088.  
  2089. Function Writewav(wavdatalen,filename$,ss_channelcount=1,samplerate=44100)
  2090. samples=wavdatalen
  2091. ;Function Writewav(nosamples,filename$)
  2092. ;wavdatalen=(ss_channelcount*nosamples*(bitspersample/8))/4
  2093. bitspersample=ss_bpsample
  2094. fs=WriteFile(filename$)
  2095. If fs=0 Then Return 0
  2096. WriteBinString fs,"RIFF"
  2097.  
  2098. wavlen=36+((wavdatalen*2)*ss_channelcount)
  2099. WriteInt fs,wavlen
  2100. Writebinstring fs,"WAVE"
  2101. Writebinstring fs,"fmt "
  2102. WriteInt fs,16
  2103.  
  2104. WriteShort fs,1
  2105.  
  2106. WriteShort fs,ss_channelcount
  2107. WriteInt fs,samplerate
  2108. bitspersample=16
  2109. byterate=SampleRate * ss_channelcount * bitspersample/8
  2110.  
  2111. WriteInt fs,byterate
  2112. WriteShort fs,ss_channelcount * bitspersample/8
  2113. WriteShort fs,bitspersample
  2114. Writebinstring fs,"data"
  2115. WriteInt fs,samples*ss_channelcount * BitsPerSample/8
  2116. ;WriteInt fs,wavdatalen*4
  2117. For p=1 To wavdatalen
  2118. If ss_bpsample=8 Then Midr=128
  2119. If ss_bpsample=16 Then Midr=Midbit/2.0
  2120. If ss_bpsample=32 Then Midr=(Midbit*255)/2.0
  2121.  
  2122. For chan=0 To ss_channelcount-1
  2123. rval=wavdata(chan,p)
  2124. rval=rval-Midr
  2125. If rval<0 Then rval=rval+(Midr*2)
  2126. If rval<0 Then rval=0 Else If rval>(Midr*2)*2 Then rval=(Midr*2)
  2127. ;If ss_bpsample>16 Then rval=rval/2.0;WriteShort fs,rval
  2128. WriteShort fs,wavdata(chan,p);rval
  2129.  
  2130. Next
  2131. Next
  2132. If ss_channelcount=1 Then ster$="Mono" Else ster$="Stereo"
  2133. ss_debugprint"Created "+filename$+" as "+ss_bpsample+" bit, "+samplerate+"hz, "+ster$+" wave file."
  2134.  
  2135. CloseFile fs
  2136. End Function
  2137.  
  2138. Function WriteBinString(filehandle,dat$)
  2139. For p=1 To Len(dat$)
  2140. WriteByte filehandle,Asc(Mid$(dat$,p,1))
  2141. Next
  2142. End Function
  2143.  
  2144. Function ss_debugprint(St$)
  2145. Print st$
  2146. End Function


Comments :


VIP3R(Posted 1+ years ago)

 This is quite impressive considering there's no media. Reminds me of those good old 8-bit days, nice one :)


PsychicParrot(Posted 1+ years ago)

 Fantastic, Mr.D! :) The music still makes me mental, though ... gets inside my head ... just keeps playing in my head after I leave the computer ... still playing ... driving me insane ... MAAAAAAAD!!! :) :)


Damien Sturdy(Posted 1+ years ago)

 hehehe. Cygnus Medialess Sound System: Coming soon!!!Nice to see y'all like it :D


Eikon(Posted 1+ years ago)

 This kicks ass. That is all...


Clyde(Posted 1+ years ago)

 That's awesome dude, greatest!:)


Idaho Razor(Posted 1+ years ago)

 I won! Great Job!!


Damien Sturdy(Posted 1+ years ago)

 Great that you won, Idaho! ^.^


wizzlefish(Posted 1+ years ago)

 Awesome. Never knew you could get practically medialess sound.


Damien Sturdy(Posted 1+ years ago)

 heh, No_Enemies, Yeah you can- You just have to write the media with code so blitz can load it :)


Neochrome(Posted 1+ years ago)

 reminds my or my old c64 and the good old ASM codes! haha!damn fine work!


Neochrome(Posted 1+ years ago)

 reminds my or my old c64 and the good old ASM codes! haha!damn fine work!


Neochrome(Posted 1+ years ago)

 reminds my or my old c64 and the good old ASM codes! haha!damn fine work!


Damien Sturdy(Posted 1+ years ago)

 Thanks, Neochrome :)


xtremegamr(Posted 1+ years ago)

 How do you have music and sound with no media?


_33(Posted 1+ years ago)

 LOL, well there are some bugs in the autoscroll mode, but otherwise it's some really interesting work done, and specially on the sound system, as it really gives the impression of tha VIC20 or something sound chip tone.  I remember I saw some code to generate waves, and I always wanted to play with that.  I'm also curious as to how much CPU the sound generation is eating up.  We're talking PokeShort in a bank, right?Cheers, and great work, very interesting concept that could of been valid for any 8-bit system of the time.xtremegamr: You make data statements, you hardcore some graphics commands in there, you take some sprite techniques...  Anyhow, it's mostly hard coded, you can't really do otherwise, unless you're doing special algorythms that generate media, like procedural textures and stuff.  Same with sound.


Damien Sturdy(Posted 1+ years ago)

 Thanks _33! :-)<div class="quote"> We're talking PokeShort in a bank, right? </div>Nope. Watch the folder the game is in carefully when you run it- watch as the wav files are generated hehe.It's all simple manipulation of wav samples that were generated in code! :) (wav save code is in the source ;) )Glad you all like. I'm half way done porting the sound system to max (hopefully cross platform..) but last time i looked a bug with looping generated sounds prevented me from continuing... so theres a version available that generates WAVs still.


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal