home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / subroutines / unlimitedbobs.amos / unlimitedbobs.amosSourceCode
AMOS Source Code  |  1991-06-11  |  4KB  |  215 lines
  1. Rem Unlimited Bobs Demo
  2. Rem by JAG of FANATIX
  3. Rem
  4. Proc MESS
  5. Procedure MESS
  6. Screen Open 3,320,256,32,Lowres : Cls 0 : Hide On 
  7. Close Workbench : Close Editor : Led Off : Break Off 
  8. Load "unlspr.abk",1
  9. Load "unlmus.abk",3
  10. Load "unlpic.abk",6
  11. Music 1
  12. Make Mask 
  13. Unpack 6 To 0 : Hide On 
  14. Dim A(3) : Dim B(3),CO(8),EQ(16)
  15. Restore EQDATA
  16. For F=1 To 16
  17. Read Q : EQ(F)=Q
  18. Next F
  19. Repeat 
  20. Dec V0 : If V0<1 Then V0=1
  21. Dec V1 : If V1<1 Then V1=1
  22. Dec V2 : If V2<1 Then V2=1
  23. Dec V3 : If V3<1 Then V3=1
  24. If Vumeter(0)>10 Then V0=16
  25. If Vumeter(1)>10 Then V1=16
  26. If Vumeter(2)>10 Then V2=16
  27. If Vumeter(3)>10 Then V3=16
  28. Colour 2,EQ(V0)
  29. Colour 3,EQ(V1)
  30. Colour 4,EQ(V2)
  31. Colour 5,EQ(V3)
  32. Wait Vbl 
  33. Until Mouse Key=1
  34. Fade 5 : Wait 75
  35. Screen Close 3
  36. Wait Vbl 
  37. For F=0 To 2
  38. Screen Open F,360,300,8,Lowres : Curs Off : Flash Off : Cls 0 : Hide On 
  39. Screen Display F,120,30,,
  40. Get Sprite Palette 
  41. Wait Vbl 
  42. Next F
  43. M=40 : CL=1
  44. Degree 
  45. ' MAIN ROUTINE 
  46. TYPE=1 : Goto FIRST
  47. MAINLOOP:
  48. Do 
  49. If Mouse Key=1 Then Gosub FCK : Inc TYPE : If TYPE>5 Then TYPE=1
  50. Gosub CLEAR
  51. If TYPE=1 Then Goto FIRST
  52. If TYPE=2 Then Goto SECOND
  53. If TYPE=3 Then Goto THIRD
  54. If TYPE=4 Then Goto FOURTH
  55. If TYPE=5 Then Goto FIFTH
  56. Loop 
  57. CLEAR:
  58. Screen To Front 0
  59. Wait Vbl 
  60. For F=0 To 2
  61. Screen F : Fade 3 : Wait 45
  62. Cls 0
  63. Dec CL : Gosub CCOL
  64. Next F
  65. Return 
  66. ' YO! THE ROUTINES 
  67. FIRST:
  68. Screen 0 : Screen To Front 0 : M=40 : I=2 : R=0
  69. A(1)=1 : A(2)=3 : A(3)=5
  70. Do 
  71. For F=0 To 2
  72. Screen F
  73. Screen To Front F
  74. Add A(F+1),6
  75. Add R,1,0 To 359
  76. If A(F+1)>360 Then A(F+1)=A(F+1)-360 : Gosub FIRSTSIZE
  77. Paste Bob(Sin(A(F+1))*M)+160,(Sin(A(F+1)+R)*M)+128,1
  78. Wait Vbl 
  79. If Mouse Key=1 Then Goto MAINLOOP
  80. If Mouse Key=2 Then Gosub CCOL
  81. Next F
  82. Loop 
  83. FIRSTSIZE:
  84. If T=0 Then Add M,2 : If M>120 Then T=1
  85. If T=1 Then M=M-2 : If M<40 Then T=0
  86. Return 
  87. '
  88. ' THE SECOND BIT LAMERS
  89. SECOND:
  90. Screen 0 : Screen To Front 0
  91. M=1 : T=0
  92. A(1)=1 : A(2)=3 : A(3)=5
  93. Do 
  94. For F=0 To 2
  95. Screen F
  96. Screen To Front F
  97. Add A(F+1),6
  98. If T=0 Then Add M,3 : If M>200 Then T=1
  99. If T=1 Then M=M-2 : If M<1 Then M=1 : T=0
  100. If A(F+1)>360 Then A(F+1)=A(F+1)-360
  101. Paste Bob(Sin(A(F+1))*M)+160,(Sin(A(F+1)+90)*M)+128,1
  102. Wait Vbl 
  103. If Mouse Key=1 Then Goto MAINLOOP
  104. If Mouse Key=2 Then Gosub CCOL
  105. Next F
  106. Loop 
  107. THIRD:
  108. Screen 0 : Screen To Front 0
  109. A(1)=1 : A(2)=3 : A(3)=5
  110. M=10 : XI=3 : YI=2 : S#=0
  111. Do 
  112. For F=0 To 2
  113. Screen F
  114. Screen To Front F
  115. Add A(F+1),6
  116. If A(F+1)>360 Then A(F+1)=A(F+1)-360
  117. S#=S#+0.072 : If S#>360 Then S#=S#-360
  118. Paste Bob(Sin(A(F+1)+XI+S#)*100)+160,(Sin(A(F+1)+YI)*100)+128,1
  119. Wait Vbl 
  120. If Mouse Key=1 Then Goto MAINLOOP
  121. If Mouse Key=2 Then Gosub CCOL
  122. Next F
  123. Loop 
  124. ' THE FOURTH BIT!! 
  125. FOURTH:
  126. Screen 0 : Screen To Front 0
  127. A(1)=1 : A(2)=3 : A(3)=5
  128. M=10 : XI=3 : YI=2 : S#=0 : T=0
  129. Do 
  130. For F=0 To 2
  131. Screen F
  132. Screen To Front F
  133. Add A(F+1),6
  134. If A(F+1)>360 Then A(F+1)=A(F+1)-360
  135. Inc XI : If XI>360 Then XI=XI-360
  136. S#=S#+0.072 : If S#>360 Then S#=S#-360
  137. Paste Bob(Sin(A(F+1)+XI+S#)*120)+160,(Sin(A(F+1))*60)+128,1
  138. Wait Vbl 
  139. If Mouse Key=1 Then Goto MAINLOOP
  140. If Mouse Key=2 Then Gosub CCOL
  141. Next F
  142. Loop 
  143. ' DA FIF BITZ
  144. FIFTH:
  145. Screen 0 : Screen To Front 0
  146. A(1)=1 : A(2)=3 : A(3)=5
  147. M=10 : XI=3 : YI=2 : S#=110 : T=0
  148. Do 
  149. For F=0 To 2
  150. Screen F
  151. Screen To Front F
  152. Add A(F+1),6
  153. If A(F+1)>360 Then A(F+1)=A(F+1)-360
  154. If T=0 Then S#=S#+0.07 : If S#>120 Then T=1
  155. If T=1 Then S#=S#-0.07 : If S#<1 Then T=0
  156. Paste Bob(Sin(A(F+1))*S#)+160,(Sin(A(F+1)+90)*S#)+128,1
  157. Wait Vbl 
  158. If Mouse Key=1 Then Goto MAINLOOP
  159. If Mouse Key=2 Then Gosub CCOL
  160. Next F
  161. Loop 
  162. FCK:
  163. Repeat 
  164. If Mouse Key=3 Then Goto DIE
  165. Wait Vbl 
  166. Until Mouse Key=0
  167. Wait Vbl 
  168. Return 
  169. CCOL:
  170. Inc CL : If CL>6 Then CL=1
  171. If CL=1 Then Restore RED
  172. If CL=2 Then Restore YELLOW
  173. If CL=3 Then Restore GREEN
  174. If CL=4 Then Restore CYAN
  175. If CL=5 Then Restore BLUE
  176. If CL=6 Then Restore PURPLE
  177. Screen 0
  178. For CT=1 To 8
  179. Read DA
  180. CO(CT)=DA
  181. Next CT
  182. Fade 3,CO(1),CO(2),CO(3),CO(4),CO(5),CO(6),CO(7),CO(8)
  183. For SLI=0 To 200
  184. Screen 1 : Get Palette 0
  185. Screen 2 : Get Palette 1
  186. Next SLI
  187. Return 
  188. RED:
  189. Data $0,$FFF,$F00,$C00,$A00,$700,$500,$300
  190. YELLOW:
  191. Data $0,$FFF,$FF0,$CC0,$AA0,$770,$550,$330
  192. GREEN:
  193. Data $0,$FFF,$F0,$C0,$A0,$70,$50,$30
  194. CYAN:
  195. Data $0,$FFF,$FF,$CC,$AA,$77,$55,$33
  196. BLUE:
  197. Data $0,$FFF,$F,$C,$A,$7,$5,$3
  198. PURPLE:
  199. Data $0,$FFF,$F0F,$C0C,$A0A,$707,$505,$303
  200. EQDATA:
  201. Data $0,$100,$200,$300,$400,$500,$600,$700,$800,$900,$A00,$B00,$C00,$D00,$E00,$F00
  202. DIE:
  203. Screen To Front 0
  204. For F=1 To 2
  205. Screen Close F
  206. Next F
  207. Screen 0
  208. Fade 5
  209. For F=63 To 0 Step -1
  210. For T=0 To 2000 : Next T : Mvolume F : Next F
  211. Music Off 
  212. Screen Close 0
  213. Mvolume 63
  214. Run "ReflectingScroll.AMOS"
  215. End Proc