home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 461.lha / EffectsMachine / EffectsMachine.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-12-06  |  43.5 KB  |  1,119 lines
  1. '
  2. ' The Effects Machine
  3. ' Written by Robert Slater, 1988-1990
  4. ' ©1990 Amiga Computing
  5. '
  6. Clmemm%=0:POKEL 0,0
  7. DEFLNG T,S
  8. DEFINT p,RT
  9. DIM NBuf&(20),BufLen&(20),St&(20),E&(20),Pi&(20),Reps&(20),Start&(20),EndPos&(20),Res&(20),p(255),Per&(20),Grf%,Vol&(20),Ins$(20),Gr(5),Octs%(10),Key$(24),Keyf(24),Keyb$(24),Fred(7),Fgre(7),Fblu(7),Blit1%(66),Nam$(255),Sta$(255)
  10. FOR A%=1 TO 20:Grf%=0:Reps&(A%)=1:BufLen&(A%)=0:Vol&(A%)=64:NEXT
  11. Fred(0)=0:Fgre(0)=0:Fblu(0)=0
  12. Fred(1)=1:Fgre(1)=1:Fblu(1)=1
  13. Fred(2)=.53:Fgre(2)=.53:Fblu(2)=.53
  14. Fred(3)=.26:Fgre(3)=.26:Fblu(3)=.26
  15. Fred(4)=.86:Fgre(4)=0:Fblu(4)=0
  16. Fred(5)=1:Fgre(5)=.73:Fblu(5)=0
  17. Fred(6)=0:Fgre(6)=.6:Fblu(6)=1
  18. Fred(7)=1:Fgre(7)=.46:Fblu(7)=.4
  19. LIBRARY "df0:libs/dos.library"
  20. LIBRARY "df0:libs/exec.library"
  21. LIBRARY "df0:libs/intuition.library"
  22. WINDOW CLOSE 3
  23. WINDOW CLOSE 4
  24. SCREEN 1,640,256,3,2
  25. WINDOW 1,"Effects Machine",(0,0)-(625,200),0,1
  26. WINDOW OUTPUT 1
  27. bless&=2^11:gmzero&=2^10:w.base&=WINDOW(7):w.modi&=w.base&+24
  28. Mode&=PEEKL(w.modi&):Mode&=Mode& AND (2^26-1-gmzero&)
  29. Mode&=Mode& OR bless& :POKEL w.modi&,Mode&
  30. CALL RefreshWindowFrame(w.base&)
  31. FOR i%=0 TO 7 :PALETTE i%,0,0,0:NEXT
  32.   DECLARE FUNCTION AllocMem& LIBRARY             
  33.   DECLARE FUNCTION AvailMem& LIBRARY
  34.   DECLARE FUNCTION xOpen& LIBRARY
  35.   DECLARE FUNCTION xWrite& LIBRARY
  36.   DECLARE FUNCTION xRead& LIBRARY
  37.   DECLARE FUNCTION Examine& LIBRARY
  38.   DECLARE FUNCTION Lock& LIBRARY
  39.   DECLARE FUNCTION Rename% LIBRARY
  40.   DECLARE FUNCTION ExNext& LIBRARY
  41.   DECLARE FUNCTION IoErr& LIBRARY
  42. RT=1 :S=0 :NFilt%=1 :ILock%=0
  43. MemType&=65538& :Stat$="CHIP Memory" :Octs%=1:Rpt%=0 :Playing%=0
  44. Infobytes&=252
  45. Inflop&=AllocMem&(Infobytes&,MemType&)
  46. Info2&=AllocMem&(4&,MemType&)
  47. GOSUB InitFreqs
  48. SpecMem&=AllocMem&(306&,65537&)
  49. LoadDolby
  50. Vol&=64 :Meml&=2&:Oxy=6:Oxy2=2:Dir$="df0:"+CHR$(0)
  51. Ech%=1:Ech1%=1:GOSUB Infobits
  52. GET(0,42)-(320,42),Blit1%:Hack%=0:Bay%=20:Try%=20:WINDOW 2,"Hello",(0,0)-(10,10),0,1:WINDOW OUTPUT 2:WINDOW CLOSE 2:WINDOW OUTPUT 1:LINE(0,0)-(40,20),2,bf
  53. FOR j=0 TO 16:Fac!=j/16:FOR i%=0 TO 7:PALETTE i%,Fred(i%)*Fac!,Fgre(i%)*Fac!,Fblu(i%)*Fac!:NEXT:NEXT
  54. GOTO MenuInit
  55. Infobits: COLOR 5,3:LINE (7,112)-(407,167),3,bf:LINE(0,33)-(610,41),0,bf
  56. LOCATE 15,2:PRINT"Memfree :";AvailMem&(Meml&)
  57. LOCATE 16,2:PRINT"Length :":LOCATE 17,2:PRINT"Address :":LOCATE 18,2:PRINT"Finish  :"
  58. LOCATE 19,2:PRINT"Period  :":LOCATE 20,2:PRINT"Channel :":LOCATE 18,27:PRINT"Status :"
  59. LOCATE 15,27:PRINT"Start:":LOCATE 17,27:PRINT"Sampling period:":LOCATE 19,27:PRINT"Play length:"
  60. LOCATE 16,27:PRINT"End  :":LOCATE 21,2 :PRINT"Name=  ":COLOR 1,2:RETURN
  61. MenuInit:
  62. MENU 1,0,1,"Project"
  63. MENU 1,1,1,"LOAD & Catalogue"
  64. MENU 1,2,1,"Quick LOAD"
  65. MENU 1,3,1,"LOAD as DUMP"
  66. MENU 1,4,1,"Rename File"
  67. MENU 1,5,1,"Delete File"
  68. MENU 1,6,1,"SAVE as IFF"
  69. MENU 1,7,1,"SAVE as DUMP"
  70. MENU 1,8,1,"QUIT"
  71. MENU 3,0,1,"Effects"
  72. MENU 3,1,1,"Metallic"
  73. MENU 3,2,1,"Backwards"
  74. MENU 3,3,1,"Flip"
  75. MENU 3,4,1,"Mix"
  76. MENU 3,5,1,"Expand"
  77. MENU 3,6,1,"Compress"
  78. MENU 3,7,1,"Treble Waah"
  79. MENU 3,8,1,"FadeIn"
  80. MENU 3,9,1,"FadeOut"
  81. MENU 3,10,1,"Echo"
  82. MENU 3,11,1,"Alter Volume"
  83. MENU 3,12,1,"Waah In"
  84. MENU 3,13,1,"Interpolate"
  85. MENU 3,14,1,"Distort"
  86. MENU 4,0,1,"Special1"
  87. MENU 4,1,1,"Spectrum graph"
  88. MENU 4,2,1,"Invert Sound"
  89. MENU 4,3,1,"SPECTRUM Analysis"
  90. MENU 4,4,1,"Harmonic Filter"
  91. MENU 2,0,1,"General"
  92. MENU 2,1,1,"Play Start"
  93. MENU 2,2,1,"Play End"
  94. MENU 2,3,1,"Play Pitch"
  95. MENU 2,4,1,"NEW Channel"
  96. MENU 2,5,1,"SYNTHESIZE"
  97. MENU 2,6,1,"REPEAT PLAY (Y/N)?"
  98. MENU 2,7,1,"Filter Mode Switch"
  99. MENU 2,8,1,"Get Volumes"
  100. MENU 2,9,1,"Memory Hack ON"
  101. MENU 2,10,1,"Keyboard"
  102. MENU 2,11,1,"Octave"
  103. MENU 2,12,1,"Filter Correct ON"
  104. MENU 2,13,1,"Set Sampling Period"
  105. MENU 6,0,1,"MEMORY"
  106. MENU 6,1,1,"CHIP Memory"
  107. MENU 6,2,1,"FAST Memory"
  108. MENU 6,3,1,"FAST to CHIP"
  109. MENU 6,4,1,"CHIP to FAST"
  110. MENU 6,5,1,"Edit Waveform"
  111. MENU 6,6,1,"Cut Sample"
  112. MENU 6,7,1,"DELETE Sample"
  113. MENU 6,8,1,"Copy to New Channel"
  114. MENU 6,9,1,"ADD Channel to Channel"
  115. MENU 6,10,1,"CLEAR MEMORY"
  116. MENU 5,0,1,"Special2"
  117. MENU 5,1,1,"Smooth Waveform"
  118. MENU 5,2,1,"Low-Pass Filter"
  119. MENU 5,3,1,"High-Pass Filter"
  120. MENU 5,4,1,"BASS boost"
  121. MENU 5,5,1,"Centralise"
  122. MENU 5,6,1,"Brighten Sound"
  123. MENU 5,7,1,"TREBLE boost"
  124. MENU 5,8,1,"Band Pass Filter"
  125. MENU 5,9,1,"Tremolo"
  126. ON MENU GOSUB Mem
  127. MENU ON
  128. BBoost%=0:PBP=0:PBP2=608:PYY=115:Occy=3:DmCh%=1:Froct=2^(3-7):Dma%=1:Dma2%=0:FCor%=0
  129. Con&=14676118&:Ad&=Con&+10+Dma2%:Le&=Ad&+4:Pe&=Ad&+6:Vo&=Ad&+8:Xla%=0:Yla%=0
  130. PXP=350:LINE(PXP,33)-(PXP,41),7:TT%=0
  131. LoopB: A1&=0:B1&=2:IF Rpt%=1 THEN A1&=St&(RT):B1&=NBuf&(RT)/2 
  132. LoopC: X=MOUSE(1):Y=MOUSE(2):A$=INKEY$:IF PEEK(&Hbfec01)=97 AND RT>1 THEN RT=RT-1:Plonk:GOSUB Pat
  133. IF PEEK(&Hbfec01)=99 AND RT<20 THEN RT=RT+1:Plonk:GOSUB Pat
  134. IF MOUSE(0)=0 THEN GOTO LoopB
  135. IF Y>32 AND Y<42 AND X<613 THEN GOTO CPit
  136. IF X>608 THEN GOTO LoopB
  137. IF Y>168 AND Y<177 THEN GOTO Csta
  138. IF Y>177 AND Y<186 THEN GOTO Cend
  139. IF Y>42 AND Y<107 THEN GOTO MemoryPos
  140. IF X>579 AND X<598 AND Y>114 AND Y<160 THEN GOTO AltVol
  141. IF X>453 AND X<569 AND Y>115 AND Y<160 THEN GOTO IconJobby
  142. GOTO LoopB
  143. SUB PlaySample(X1&,X2&,X3&,X4&,X5&,X6&,X7&) STATIC
  144. END SUB
  145. IconJobby: Ic%=0:B%=1
  146. FOR Y%=115 TO 130 STEP 15:FOR X%=453 TO 513 STEP 60
  147. IF X>X% AND X<(X%+56) AND Y>Y% AND Y<(Y%+15) THEN Ic%=B%
  148. B%=B%+1:NEXT:NEXT
  149. FOR Y%=145 TO 152 STEP 7:FOR X%=453 TO 513 STEP 60
  150. IF X>X% AND X<(X%+56) AND Y>Y% AND Y<(Y%+15) THEN Ic%=B%
  151. B%=B%+1:NEXT:NEXT
  152. IF Ic%=0 THEN Xla%=X:YLa%=Y:GOTO LoopB
  153. IF Ic%=1 THEN GOSUB Play
  154. IF Ic%=2 THEN CALL Stopp:Playing%=0:Yla%=Y:XLa%=X
  155. IF Ic%=3 THEN Grf%=1:GOSUB Graph
  156. IF Ic%=4 THEN GOSUB ResetIt:Yla%=Y:Xla%=X
  157. IF Ic%=5 AND St&(RT)>Start&(RT) THEN St&(RT)=St&(RT)-1:NBuf&(RT)=E&(RT)-St&(RT):GOSUB DrawIt
  158. IF Ic%=6 AND St&(RT)<E&(RT) THEN St&(RT)=St&(RT)+1:NBuf&(RT)=E&(RT)-St&(RT):GOSUB DrawIt2
  159. IF Ic%=7 AND E&(RT)>St&(RT) THEN E&(RT)=E&(RT)-1:NBuf&(RT)=E&(RT)-St&(RT):GOSUB DrawIt3
  160. IF Ic%=8 AND E&(RT)<EndPos&(RT) THEN E&(RT)=E&(RT)+1:NBuf&(RT)=E&(RT)-St&(RT):GOSUB DrawIt4
  161. GOTO LoopB
  162. DrawIt: IF (St&(RT)/2) <> INT(St&(RT)/2) THEN St&(RT)=St&(RT)-1
  163. LINE(0,169)-(608,176),0,bf:X=(St&(RT)-Start&(RT))/(BufLen&(RT)/608):LINE(X,169)-(X,176),7:COLOR 7,3:LOCATE 15,33:PRINT St&(RT);"       ":LOCATE 19,39:PRINT E&(RT)-St&(RT);"   ":COLOR 1,2:RETURN
  164. DrawIt2: IF (St&(RT)/2) <> INT(St&(RT)/2) THEN St&(RT)=St&(RT)+1
  165. LINE(0,169)-(608,176),0,bf:X=(St&(RT)-Start&(RT))/(BufLen&(RT)/608):LINE(X,169)-(X,176),7:COLOR 7,3:LOCATE 15,33:PRINT St&(RT);"       ":LOCATE 19,39:PRINT E&(RT)-St&(RT);"   ":COLOR 1,2:RETURN 
  166. DrawIt3: IF (E&(RT)/2) <> INT(E&(RT)/2) THEN E&(RT)=E&(RT)-1
  167. LINE(0,178)-(608,185),0,bf:X=(E&(RT)-Start&(RT))/(BufLen&(RT)/608):LINE(X,178)-(X,185),7:COLOR 7,3:LOCATE 16,33:PRINT E&(RT);"       ":LOCATE 19,39:PRINT E&(RT)-St&(RT);"   ":COLOR 1,2:RETURN
  168. DrawIt4: IF (E&(RT)/2) <> INT(E&(RT)/2) THEN E&(RT)=E&(RT)+1
  169. LINE(0,178)-(608,185),0,bf:X=(E&(RT)-Start&(RT))/(BufLen&(RT)/608):LINE(X,178)-(X,185),7:COLOR 7,3:LOCATE 16,33:PRINT E&(RT);"       ":LOCATE 19,39:PRINT E&(RT)-St&(RT);"   ":COLOR 1,2:RETURN 
  170.  
  171. ResetIt:
  172. St&(RT)=Start&(RT):E&(RT)=EndPos&(RT):NBuf&(RT)=BufLen&(RT)
  173. LINE(0,169)-(608,176),0,bf:LINE(0,178)-(608,185),0,bf:LINE(0,169)-(0,176),7:LINE(608,178)-(608,185),7:COLOR 7,3:LOCATE 15,33:PRINT St&(RT);"       ":LOCATE 16,33:PRINT E&(RT);"        ":LOCATE 19,39:PRINT E&(RT)-St&(RT);"   ":COLOR 1,2
  174. RETURN
  175. MemoryPos:
  176. AA&=St&(RT)+INT(X*(NBuf&(RT)/608)):LOCATE 1,1:PRINT"Address= ";AA&;"               ":GOTO LoopB
  177. Csta:
  178. Xoff&=Start&(RT)+(X*(BufLen&(RT)/608))
  179. IF Xoff&>E&(RT) THEN GOTO LoopB
  180. St&(RT)=Xoff&:LINE(0,169)-(608,176),0,bf:LINE(X,169)-(X,176),7:IF (St&(RT)/2) <> INT(St&(RT)/2) THEN St&(RT)=St&(RT)-1
  181. NBuf&(RT)=E&(RT)-Xoff&:COLOR 7,3
  182. LOCATE 15,33 :PRINT St&(RT);"        "
  183. IF (NBuf&(RT)/2) <> INT(NBuf&(RT)/2) THEN NBuf&(RT)=NBuf&(RT)-1:E&=St&(RT)+NBuf&(RT)
  184. LOCATE 19,39:PRINT NBuf&(RT);"   ":COLOR 1,2:GOTO LoopB
  185. Cend:
  186. Xoff&=Start&(RT)+(X*(BufLen&(RT)/608))
  187. IF Xoff&<St&(RT) THEN GOTO LoopB
  188. E&(RT)=Xoff&:LINE(0,178)-(608,185),0,bf:LINE(X,178)-(X,185),7:IF (E&(RT)/2) <> INT(E&(RT)/2) THEN E&(RT)=E&(RT)-1
  189. NBuf&(RT)=E&(RT)-St&(RT):COLOR 7,3:LOCATE 16,33 :PRINT E&(RT);"        "
  190. IF (NBuf&(RT)/2) <> INT(NBuf&(RT)/2) THEN NBuf&(RT)=NBuf&(RT)-1:E&=St&(RT)+NBuf&(RT)
  191. LOCATE 19,39:PRINT NBuf&(RT);"   ":COLOR 1,2:GOTO LoopB
  192. SUB Stopp STATIC
  193. SHARED Con&
  194. POKEW Con&,15
  195. END SUB
  196. SUB Player(X1&,X2&,X3&,X4&,X5&,X6&) STATIC
  197. SHARED Dma%,Con&,Ad&,Rpt%
  198. Per%=X3&:Volu%=X4&:IF X2&>65534 THEN X5&=X1&+131068:X6&=X2&-65534:X2&=65534
  199. IF (X2&+X6&)>131068 THEN LOCATE 2,1 :PRINT "Sorry, too large.":EXIT SUB
  200. Ad&=Ad&+16:Dma2%=Dma2%+1:Dma%=2^Dma2%:IF Ad&>14676176 THEN Ad&=Con&+10:Dma%=1:Dma2%=0
  201. IF X5&>X1& THEN POKEW Con&,Dma%:FOR T%=1 TO 500:NEXT:POKEL Ad&+2,X2&:POKEL Ad&,X1&:POKEW Ad&+6,Per%:POKEW Ad&+8,Volu%:POKEW Con&,&H8200+Dma%:FOR T%=1 TO 500:NEXT:POKEL Ad&+2,X6&:POKEL Ad&,X5&:EXIT SUB
  202. POKEW Con&,Dma%:FOR T%=1 TO 500:NEXT:POKEL Ad&+2,X2&:POKEL Ad&,X1&:POKEW Ad&+6,Per%:POKEW Ad&+8,Volu%
  203. Dmc%=&H8200+Dma%:POKEW Con&,Dmc%:FOR T%=1 TO 500:NEXT
  204. IF Rpt%=0 THEN POKEW Ad&+4,2:POKEL Ad&,0
  205. END SUB
  206. CPit:
  207. Playing%=1:COLOR 7,3
  208. Pitch%=(.9*X)+124 :Pi&(RT)=Pitch%:LOCATE 19,11 :PRINT Pi&(RT);"  ":COLOR 1,2
  209. LINE(0,33)-(610,41),0,bf:PXP=X:LINE(X,33)-(X,41),7
  210. Buff&=NBuf&(RT)/2 :IF (Buff&/2) <> INT(Buff&/2) THEN Buff&=Buff&-1
  211. A1&=0:B1&=2 :Playing%=1
  212. IF Rpt%=1 THEN A1&=St&(RT):B1&=Buff&
  213. CALL Player(St&(RT),Buff&,Pi&(RT),Vol&(RT),A1&,B1&)
  214. PitchLoop:
  215. X%=MOUSE(1):Pi&(RT)=(.9*X%)+124:LINE(X,33)-(X,41),7:LINE(PXP,33)-(PXP,41),0:PXP=X:LINE(X,33)-(X,41),7
  216. POKEW Ad&+6,Pi&(RT):IF MOUSE(0)=-1 THEN PitchLoop
  217. GOTO LoopB
  218. Pat: GOSUB InfoBits:COLOR 7,3
  219. LOCATE 17,11:PRINT Start&(RT):LOCATE 19,11:PRINT Pi&(RT);"    "
  220. LOCATE 16,11:PRINT BufLen&(RT):LOCATE 20,11:PRINT RT;" "
  221. NBuf&(RT)=E&(RT)-St&(RT):LOCATE 15,33 :PRINT St&(RT);"   "
  222. LOCATE 16,33 :PRINT E&(RT);"   ":LOCATE 15,11 :PRINT AvailMem&(Meml&)
  223. LOCATE 18,11:PRINT EndPos&(RT):LOCATE 17,43 :PRINT Per&(RT)
  224. LOCATE 18,35 :PRINT Stat$:LOCATE 21,8 :PRINT Ins$(RT):LOCATE 19,39:PRINT NBuf&(RT)
  225. COLOR 1,2:GOTO Graph
  226. Play:
  227. IF Playing%=1 THEN CALL Stopp
  228. Buff&=NBuf&(RT)/2:IF (Buff&/2) <> INT(Buff&/2) THEN Buff&=Buff&-1
  229. A1&=0:B1&=2 :Playing%=1
  230. IF Rpt%=1 THEN A1&=St&(RT):B1&=Buff&
  231. CALL Player(St&(RT),Buff&,Pi&(RT),Vol&(RT),A1&,B1&)
  232. PlayLoopo: IF MOUSE(0)=-1 THEN PlayLoopo
  233. RETURN
  234. Pitch:IF Playing%=1 THEN CALL Stopp
  235. COLOR 7,3:LOCATE 19,11:INPUT " ",Pi&(RT) :Buff&=NBuf&(RT)/2 :IF (Buff&/2) <> INT(Buff&/2) THEN Buff&=Buff&-1
  236. A1&=0:B1&=2 :Playing%=1:COLOR 1,2
  237. IF Rpt%=1 THEN A1&=St&(RT):B1&=Buff&
  238. CALL Player(St&(RT),Buff&,Pi&(RT),Vol&(RT),A1&,B1&)
  239. RETURN
  240. Rep:
  241. IF Rpt%=0 THEN Rpt%=1 ELSE Rpt%=0
  242. RETURN
  243. Start:
  244. COLOR 7,3:LOCATE 15,33:INPUT " ",St&(RT)
  245. IF Hack%=1 THEN StartOk
  246. IF St&(RT)<Start&(RT) OR St&(RT)>EndPos&(RT) THEN St&(RT)=Start&(RT)
  247. StartOk:
  248. IF (St&(RT)/2)<>INT(St&(RT)/2) THEN St&(RT)=St&(RT)-1
  249. NBuf&(RT)=E&(RT)-St&(RT):COLOR 1,2:GOTO Pat
  250. Fin:
  251. COLOR 7,3:LOCATE 16,33:INPUT " ",E&(RT)
  252. IF Hack%=1 THEN FinOk
  253. IF E&(RT)<St&(RT) OR E&(RT)>EndPos&(RT) THEN E&(RT)=EndPos&(RT)
  254. FinOk:
  255. IF (E&(RT)/2)<>INT(E&(RT)/2) THEN E&(RT)=E&(RT)-1
  256. NBuf&(RT)=E&(RT)-St&(RT):COLOR 1,2:GOTO Pat
  257. Graph:
  258. LINE(0,44)-(609,106),0,bf:LINE(0,43)-(609,43),3:LINE(0,75)-(609,75),3:LINE(0,107)-(609,107),3
  259. IF NBuf&(RT)=0 OR Grf%=0 THEN RETURN
  260. Y%=PEEK(St&(RT)):IF Y%>127 THEN Y%=Y%-256
  261. Frac=NBuf&(RT)/608
  262. FOR X%=0 TO 608:X1%=X%:Y1%=Y%:Y%=PEEK(St&(RT)+INT(X%*Frac)):IF Y%>127 THEN Y%=Y%-256
  263. LINE (X1%,75-(Y1%/4))-(X%+1,75-(Y%/4)),6:NEXT:Grf%=0
  264. Graphloopo: IF MOUSE(0)=-1 THEN GraphLoopo
  265. RETURN
  266. SUB Plonk STATIC
  267. SHARED BufLen&(),St&(),Start&(),E&(),RT
  268. LINE(0,169)-(608,176),0,bf:LINE(0,178)-(608,185),0,bf
  269. IF BufLen&(RT)=0 THEN EXIT SUB
  270. X=(St&(RT)-Start&(RT))/(BufLen&(RT)/608):LINE(X,169)-(X,176),7:X=(E&(RT)-Start&(RT))/(BufLen&(RT)/608):LINE(X,178)-(X,185),7
  271. END SUB
  272. Mem:
  273. Unc%=0 :Abc%=0 :Botch%=0 :LDump%=0
  274. LINE(0,0)-(620,31),2,bf:LOCATE 10,30 :COLOR 1,3:PRINT"PROCESSING - Please Wait...":COLOR 1,2:LOCATE 1,1
  275. MenDuf%=MENU(0):MenDuf1%=MENU(1)
  276. ON MenDuf% GOSUB Fst,Scn,Thr,Frt,Ffth,Sixth
  277. LOCATE 1,1 :PRINT"                          "
  278. IF (NBuf&(RT)/2) <> INT(NBuf&(RT)/2) THEN NBuf&(RT)=NBuf&(RT)-1:E&(RT)=St&(RT)+NBuf&(RT)
  279. LINE(0,0)-(615,23),2,bf:LINE(0,33)-(610,41),0,bf:LINE(0,169)-(608,176),0,bf:LINE(0,178)-(608,185),0,bf:LINE(0,44)-(609,106),0,bf:LINE(0,43)-(609,43),3:LINE(0,75)-(609,75),3:LINE(0,107)-(609,107),3:X%=(Pi&(RT)-124)/.9:LINE(X%,33)-(X%,41),7
  280. CALL Plonk:LOCATE 2,1 :PRINT "First Graph Sample = ";:Y%=PEEK(St&(RT)):IF Y%>127 THEN Y%=-256+Y%
  281. Y1%=PEEK(E&(RT)):IF Y1%>127 THEN Y1%=-256+Y1%
  282. PRINT Y%:LOCATE 3,1 :PRINT "Last Graph Sample = ";Y1%:IF FCor%=1 THEN POKE Start&(RT),0:POKE EndPos&(RT),0
  283. RETURN
  284. QJobby:
  285. LOCATE 1,1 :INPUT "Are you sure you want to quit? (Y/N) : ",A$
  286. IF A$="Y" OR A$="y" THEN GOSUB Clmem:SCREEN CLOSE 1:END
  287. RETURN
  288. Fst:
  289. ON MenDuf1% GOSUB Ldr,Qlo,LDump,Renm,KilFile,Sav,Savd,QJobby
  290. RETURN
  291. Scn:
  292. ON MenDuf1% GOSUB Start,Fin,Pitch,Ch1,CreSin,Rep,Nfon,GetVol,GetHack,KeyBoard,OccyWoccy,FiltCorrect,SetPerd
  293. fhandle&=0
  294. RETURN
  295. Thr:
  296. ON MenDuf1% GOSUB Wibble,Backw,Flip,Mixat,DoubCycle,HalfCycle,twaah,Fdin,Fdou,Echo,Nams,Waah,Nspd,NeWav
  297. RETURN
  298. Frt:
  299. ON MenDuf1% GOSUB Spegraph,Invt,FFT2,HarFilt
  300. RETURN
  301. Ffth:
  302. ON MenDuf1% GOSUB Fltr,Fltr2,HighPass,BoBass,Centralise,UnFltr,DoBTreb,GetTone,Tremolo
  303. RETURN
  304. Sixth: Clmemm%=1
  305. ON MenDuf1% GOSUB Chip,Fast,FCHIP,CFAST,Edform,Cut,Filter,Nslot,Acc,ClMem
  306. COLOR 7,3:LOCATE 18,35 :PRINT Stat$:Clmemm%=0
  307. LOCATE 15,11 :PRINT AvailMem&(Meml&);"   ":COLOR 1,2
  308. RETURN
  309. Tremolo: IF NBuf&(RT)=0 THEN RETURN
  310. LOCATE 1,1:PRINT "Enter cycle length (1-";NBuf&(RT);") : ";:INPUT Cyc&
  311. IF Cyc&<1 OR Cyc&>NBuf&(RT) THEN BEEP:RETURN
  312. INPUT "Enter depth (0-127): ",Fdep :IF Fdep<0 OR Fdep>127 THEN BEEP:RETURN
  313. Frac=3.1415926*2/Cyc&
  314. FOR T=St&(RT) TO E&(RT):Y%=PEEK(T):IF Y%>127 THEN Y%=Y%-256
  315. Fa=ABS(SIN(T*Frac)):Fmul=(127-(ABS(SIN(T*Frac))*Fdep))/127
  316. Y%=Y%*Fmul:IF Y%<0 THEN Y%=Y%+256
  317. POKE T,Y%:NEXT:RETURN
  318. SetPerd: 
  319. LOCATE 1,1 :INPUT "Enter new sampling period : ",Per&(RT)
  320. IF Per&(RT)<124 THEN BEEP:Per&(RT)=350
  321. GOTO PlayIt
  322. DoBTreb: IF NBuf&(RT)=0 THEN RETURN
  323. LOCATE 1,1 :INPUT "Enter Treble Volume (0-800%): ",FBass
  324. IF FBass<0 OR FBass>800 THEN BEEP:RETURN
  325. FBass=FBass/100:CALL Sharp(NBuf&(RT),St&(RT),FBass)
  326. RETURN
  327. tWaah: IF NBuf&(RT)=0 THEN RETURN
  328. LOCATE 1,1 :INPUT "Enter brightness multiplier (2-?): ",Fbri
  329. IF Fbri<2 THEN BEEP:RETURN
  330. l&=NBuf&(RT)/Fbri:B&=E&(RT):S&=St&(RT):Fgra=Fbri/(B&-S&):Bu&=l&-1
  331. FOR T=S& TO B& STEP l& :Fbrt=(T-S&)*Fgra:CALL Sharp(Bu&,T,Fbrt):NEXT:RETURN
  332. SUB Sharp(Buff&,Sta&,Fmul)
  333. SHARED MemType&
  334. AlloAc&=AllocMem&(Buff&,MemType&)
  335. IF AlloAc&<=0 THEN BEEP:PRINT "Not enough memory!":EXIT SUB
  336. CALL CopyMem(Sta&,AlloAc&,Buff&)
  337. En&=Sta&+Buff&:SS&=AlloAc&+1:EE&=AlloAc&+Buff&-1:CALL Dolb2(SS&,EE&):Dis&=AlloAc&-Sta&
  338. FOR T=Sta& TO En&:Y%=PEEK(T+Dis&):Y1%=PEEK(T):IF Y%>127 THEN Y%=Y%-256
  339. IF Y1%>127 THEN Y1%=Y1%-256
  340. Y1%=((Y1%-Y%)*Fmul)+Y%:IF Y1%>127 THEN Y1%=127
  341. IF Y1%<-128 THEN Y1%=-128
  342. IF Y1%<0 THEN Y1%=Y1%+256
  343. POKE T,Y1%:NEXT
  344. CALL FreeMem&(AlloAc&,Buff&)
  345. END SUB
  346. Fltr2: SS&=St&(RT)+1:EE&=E&(RT)-1:CALL Dolb2(SS&,EE&)
  347. RETURN
  348. FiltCorrect:
  349. IF FCor%=0 THEN FCor%=1:MENU 2,12,1,"Filter Correct OFF":RETURN
  350. FCor%=0:MENU 2,12,1,"Filter Correct ON":RETURN
  351. GetHack:
  352. IF Hack%=0 THEN Hack%=1:MENU 2,9,1,"Memory Hack OFF":RETURN
  353. Hack%=0:MENU 2,9,1,"Memory Hack ON":RETURN
  354. GetVol :Q&=0:Q1&=0:IF NBuf&(RT)=0 THEN RETURN
  355. FOR T=St&(RT) TO E&(RT) :Y%=PEEK(T):IF Y%>127 THEN Y%=Y%-256
  356. Q&=Q&+ABS(Y%):Q1&=Q1&+Y%:NEXT:A%=Q&/NBuf&(RT):B%=Q1&/NBuf&(RT)
  357. LOCATE 4,1 :PRINT "Resultant Volume= ";A%:RETURN
  358. KeyBoard: Period&=60000&:IF NBuf&(RT)=0 THEN RETURN
  359. Buff&=NBuf&(RT)/2 :IF (Buff&/2) <> INT(Buff&/2) THEN Buff&=Buff&-1
  360. A1&=0:B1&=2 :Playing%=1:LOCATE 1,1 :PRINT "Press Shift AND 'z' to exit"
  361. PRINT "Press keys on keyboard to play tune":IF Rpt%=1 THEN A1&=St&(RT):B1&=Buff&
  362. Board2: A$=INKEY$:IF A$="" THEN Board2
  363. FOR T%=1 TO 24:IF Keyb$(T%)=A$ THEN Period&=INT(3579545&/(Keyf(T%)*50))*Oxy2:CALL Player(St&(RT),Buff&,Period&,Vol&(RT),A1&,B1&)
  364. NEXT:IF A$<>"Z" THEN Board2
  365. RETURN
  366. OccyWoccy:
  367. LOCATE 1,1 :PRINT "Current Octave= ";Oxy;" "
  368. INPUT "Enter Octave (1-8): ",Oxy :IF Oxy<1 OR Oxy>8 THEN Oxy=6
  369. Oxy2=2^(7-Oxy):RETURN
  370. StopIt:
  371. CALL Stopp
  372. RETURN
  373. SUB scan1(X1&) STATIC
  374. SHARED T,RT,E&(),T1,A1%,A2%,B1%,Tbot%
  375. A1%=0:B1%=0:A%=0:B%=0:C%=0:TT=X1&:Y1%=PEEK(TT):IF Y1%>127 THEN Y1%=Y1%-256
  376. Peak1&=T:Peak2&=T1
  377. WHILE (C%=0):Y%=PEEK(TT):IF Y%>127 THEN Y%=Y%-256
  378. IF Y%<Y1% AND B%=0 THEN B%=1:Peak1&=TT-1:A1%=Y1%:Y1%=Y%:A%=0
  379. IF Y%>Y1% AND B%=1 AND A%=0 THEN A%=1:B1%=Y1%
  380. IF Y%<Y1% AND A%=1 THEN C%=1:Peak2&=TT-1:A2%=Y1%
  381. IF TT=E&(RT) THEN C%=1:Peak2&=TT:Tbot%=1
  382. Y1%=Y%:TT=TT+1:WEND:T=Peak1&:T1=peak2&:END SUB
  383. SUB scan0(X1&) STATIC
  384. SHARED T,RT,E&(),T1,A1%,A2%
  385. A%=0:B%=0:C%=0:TT=X1&:Y1%=PEEK(TT):IF Y1%>127 THEN Y1%=Y1%-256
  386. Peak1&=T:Peak2&=T1
  387. WHILE (C%=0):Y%=PEEK(TT):IF Y%>127 THEN Y%=Y%-256
  388. IF Y%>Y1% AND A%=0 THEN A%=1
  389. IF Y%<Y1% AND A%=1 AND B%=0 THEN B%=1:C%=1:Peak1&=TT-1:A1%=Y1%:Y1%=Y%:A%=0
  390. IF TT=E&(RT) THEN C%=1:Peak2&=TT:Tbot%=1
  391. Y1%=Y%:TT=TT+1:WEND:T=Peak1&:END SUB
  392. SpeGraph: IF NBuf&(RT)=0 THEN RETURN
  393. LINE(0,43)-(609,107),0,bf:IF Pi&(RT)=0 THEN BEEP:RETURN
  394. LINE(0,0)-(620,31),2,bf:FTime=512/(3579545&/Pi&(RT)):FOR Har%=0 TO 304 :Y%=PEEK(Har%+SpecMem&):IF Y%<>0 THEN LINE(Har%*2,107)-((Har%*2)+1,107-Y%),4,b
  395. NEXT:LOCATE 2,1 :PRINT "  - Press mouse button at horiz. position to find Frequencies - ":PRINT "Click on top bar to exit"
  396. MoFrLo3: X%=MOUSE(1):Y%=MOUSE(2):IF MOUSE(0)=0 THEN MoFrLo3
  397. LOCATE 1,1:PRINT "Frequency = ";INT(X%/2)/Ftime;"   Harmonic Content = ";PEEK(INT(X%/2)+SpecMem&)*2.53165;"       ":LOCATE 4,1:PRINT "Wavelength = ";INT(512/INT((X%+2)/2));" bytes":IF Y%<>0 THEN MoFrLo3
  398. LINE(0,0)-(620,31),2,bf:RETURN
  399. FFT2: IF NBuf&(RT)=0 THEN RETURN
  400. LOCATE 1,1:INPUT "How many harmonics do you want? (1-304): ",Hs%:IF Hs%<1 OR Hs%>304 THEN BEEP:RETURN
  401. LOCATE 2,20:PRINT "Analysing Spectrum of 1st 512 bytes"
  402. Fpi=3.1415926*2/512:T=St&(RT):FOR Har%=1 TO Hs%:Ftota=0:Ftotb=0:FOR X%=0 TO 511:Y%=PEEK(X%+T):IF Y%>127 THEN Y%=Y%-256
  403. Fra=Har%*Fpi*X%:Ftota=Ftota+(Y%*COS(Fra)):Ftotb=Ftotb+(Y%*SIN(Fra)):NEXT:POKE Har%+SpecMem&,INT((Ftota^2+Ftotb^2)^.5*.001543):NEXT:GOTO SpeGraph
  404. HarFilt: IF NBuf&(RT)=0 THEN RETURN
  405. IF Pi&(RT)=0 THEN RETURN
  406. FTime=512/(3579545&/Pi&(RT)):WvL%=512:Fdt=Ftime/WvL%:Fpi=3.1416*2/FTime
  407. LOCATE 1,1 :PRINT "What Frequency minimum? (0-";512/FTime;") :";:INPUT " ",FHar
  408. IF FHar<0 OR FHar>(512/FTime) THEN BEEP:RETURN
  409. Har1%=FHar*FTime:PRINT "What Frequency maximum? (";FHar;" -";512/FTime;") :";:INPUT " ",FHar2
  410. IF FHar2<FHar OR FHar2>(512/FTime) THEN BEEP:RETURN
  411. Har2%=FHar2*FTime:INPUT "Amplify by (-10 to 10) (-1 = remove) : ",Fmu :IF Fmu<-10 OR Fmu>10 THEN BEEP:RETURN
  412. Fmu=2*Fmu/WvL%:FOR Har%=Har1% TO Har2%:Fhar=Har%*Fpi:LOCATE 1,1:PRINT Har2%-Har%:FOR T=St&(RT) TO E&(RT) STEP 512:T1=T+512:Fdtim=0:Ftota=0:Ftotb=0
  413. FOR TT=T TO T1 :Y%=PEEK(TT):IF Y%>127 THEN Y%=Y%-256
  414. Fba=FHar*Fdtim:Ftota=Ftota+(Y%*COS(Fba)):Ftotb=Ftotb+(Y%*SIN(Fba)):Fdtim=Fdtim+Fdt:NEXT:Bn%=Fmu*Ftotb:An%=Fmu*Ftota
  415. Fdtim=0:FOR TT=T TO (T1-1) :YY%=PEEK(TT):IF YY%>127 THEN YY%=YY%-256
  416. Fba=FHar*Fdtim:Y%=An%*COS(Fba):Y1%=Bn%*SIN(Fba):YY%=YY%+Y%+Y1%:IF YY%>127 THEN YY%=127
  417. IF YY%<-128 THEN YY%=-128
  418. IF YY%<0 THEN YY%=YY%+256
  419. POKE TT,YY%:Fdtim=Fdtim+Fdt:NEXT:NEXT:NEXT:RETURN
  420. GetTone: IF NBuf&(RT)=0 OR Pi&(RT)=0 THEN RETURN
  421. T2=St&(RT):T1=T2:T=T2:Co&=0:Tper&=0:Freq=0:Co2&=0:A1%=0:A2%=0:B1%=0:Fde%=1
  422. LOCATE 1,1 :INPUT "Enter Frequency filter range FROM (0-15000 Hz)= ",Y
  423. LOCATE 2,1 :PRINT"Enter Frequency filter range TO (";Y;"-15000)= ";:INPUT Y1
  424. IF NFilt%=0 THEN LOCATE 3,1 :INPUT "Enter filter depth (1-10) : ",Fde%
  425. LOCATE 4,1 :INPUT "Enter Volume minimum to filter (1-255) : ",Vmi%
  426. IF Y<=0 OR Y>15000 OR Y1<Y OR Y1>15000 OR Fde%<1 OR Fde%>10 OR Vmi%<1 OR Vmi%>255 THEN BEEP:RETURN
  427. CALL Scan0(T2):T2=T
  428. WHILE (T2<E&(RT))
  429. CALL Scan1(T2):Co&=Co&+1:T2=T1:Vo%=ABS(A1%-B1%):IF T1<>T THEN Freq=1/(((T1-T)/(3579545&/Pi&(RT))))
  430. IF Freq>=Y AND Freq<=Y1 AND Vo%<=Vmi% THEN DoFiltJob
  431. GOTO GToneE
  432. DoFiltJob: Co2&=Co2&+1:IF NFilt%=0 THEN CALL Dolb2(T+1,T1-1):GOTO GToneE
  433. Dis&=T1-T:FGra=(A2%-A1%)/Dis&
  434. FOR T3=0 TO Dis& :YY%=(T3*FGra)+A1%:IF YY%<0 THEN YY%=YY%+256
  435. POKE T3+T,YY%:NEXT
  436. GToneE: WEND :LOCATE 1,1 :PRINT "  -- The frequency was found ";Co2&;" times."
  437. RETURN
  438. BoBass: IF NBuf&(RT)=0 THEN RETURN
  439. LOCATE 1,1 :INPUT "Enter Bass Volume (0-400%): ",FBass
  440. IF FBass<0 OR FBass>400 THEN BEEP:RETURN
  441. FBass=FBass/100
  442. AlloAc&=AllocMem&(NBuf&(RT),MemType&)
  443. IF AlloAc&<=0 THEN BEEP:PRINT "Not enough memory!":RETURN
  444. CALL CopyMem(St&(RT),AlloAc&,NBuf&(RT))
  445. SS&=AlloAc&+1:EE&=AlloAc&+NBuf&(RT)-1:FOR A%=1 TO 6:CALL Dolb2(SS&,EE&):NEXT:Dis&=AlloAc&-St&(RT)
  446. FOR T=St&(RT) TO E&(RT):Y%=PEEK(T):Y1%=PEEK(T+Dis&):IF Y%>127 THEN Y%=Y%-256
  447. IF Y1%>127 THEN Y1%=Y1%-256
  448. Y%=Y%-Y1%:Y1%=Y1%*FBass:Y%=Y%+Y1%:IF Y%>127 THEN Y%=127
  449. IF Y%<-128 THEN Y%=-128
  450. IF Y%<0 THEN Y%=256+Y%
  451. POKE T,Y%:NEXT:CALL FreeMem&(AlloAc&,NBuf&(RT))
  452. RETURN
  453. Centralise: Ytot&=0:IF NBuf&(RT)=0 THEN RETURN
  454. FOR T=St&(RT) TO E&(RT):Y%=PEEK(T):IF Y%>127 THEN Y%=Y%-256
  455. Ytot&=YTot&+Y%:NEXT:Av%=Ytot&/NBuf&(RT):IF Av%>-1 AND Av%<2 THEN LOCATE 1,1 :PRINT "Sample is Central":RETURN
  456. Dis%=-Av%-1:CALL Mamp(St&(RT),E&(RT),Dis%):LOCATE 1,1:PRINT "Sample was moved by ";Dis%;" ":RETURN
  457. HighPass: IF NBuf&(RT)=0 THEN RETURN
  458. AlloAc&=AllocMem&(NBuf&(RT),MemType&)
  459. IF AlloAc&<=0 THEN BEEP:PRINT "Not enough memory!":RETURN
  460. CALL CopyMem(St&(RT),AlloAc&,NBuf&(RT))
  461. SS&=AlloAc&+1:EE&=AlloAc&+NBuf&(RT)-1:FOR A%=1 TO 6:CALL Dolb2(SS&,EE&):NEXT:Dis&=AlloAc&-St&(RT)
  462. FOR T=St&(RT) TO E&(RT):Y%=PEEK(T):Y1%=PEEK(T+Dis&):IF Y%>127 THEN Y%=Y%-256
  463. IF Y1%>127 THEN Y1%=Y1%-256
  464. Y%=Y%-Y1%:IF Y%>127 THEN Y%=127
  465. IF Y%<-128 THEN Y%=-128
  466. IF Y%<0 THEN Y%=256+Y%
  467. POKE T,Y%:NEXT:CALL FreeMem&(AlloAc&,NBuf&(RT))
  468. RETURN
  469. Waah: IF NBuf&(RT)=0 THEN RETURN
  470. LOCATE 1,1 :INPUT "Enter waah depth (2-?): ",Wa&
  471. IF Wa&<2 THEN BEEP:RETURN
  472. l&=NBuf&(RT)/Wa&:B&=E&(RT)-l&:S&=St&(RT)+1
  473. FOR T=1 TO (Wa&-1):CALL Dolb2(S&,B&) :B&=B&-l&:NEXT
  474. RETURN
  475. Nspd:IF NBuf&(RT)=0 THEN RETURN
  476. LOCATE 1,1 :INPUT "Enter period multiplier (0-20): ",Frac
  477. INPUT "Enter new channel: ",Ch%
  478. IF Frac<=0 OR Frac>20 THEN BEEP:RETURN
  479. IF Ch%<1 OR Ch%>20 THEN BEEP:RETURN
  480. Buf&=NBuf&(RT)/Frac
  481. MemTry&=AllocMem&(Buf&,MemType&)
  482. IF MemTry&<=0 THEN BEEP:LOCATE 4,1:PRINT "No Memory free":RETURN
  483. Tp=MemTry& :INPUT "Anti-alias? (Y/N): ",An$
  484. IF An$="y" OR An$="Y" THEN GOSUB FiltIn:GOTO Blpe
  485. GOSUB NormIn
  486. Blpe: Ch1%=RT:RT=Ch%:BufLen&(RT)=Buf&:Per&(RT)=Per&(Ch1%)*Frac:Pi&(RT)=Per&(Ch1%)*Frac:GOSUB PlayIt
  487. RETURN
  488. ClMem:
  489. FOR T%=1 TO 20
  490. IF BufLen&(T%)=0 THEN NeCl
  491. CALL FreeMem&(Start&(T%),BufLen&(T%))
  492. BufLen&(T%)=0:Start&(T%)=0:EndPos&(T%)=0:St&(T%)=0:E&(T%)=0:Ins$(T%)=""
  493. NeCl: NEXT
  494. Clmemm%=0
  495. RETURN
  496. Nfon:
  497. IF NFilt%=1 THEN NFilt%=0 ELSE NFilt%=1
  498. IF NFilt%=1 THEN LOCATE 4,1 :PRINT "NORMAL filter mode ON":RETURN
  499. LOCATE 4,1 :PRINT "DETAILED filter mode ON"
  500. RETURN
  501. DoubCycle:
  502. PPl%=0:IF NBuf&(RT)=0 THEN RETURN
  503. LOCATE 1,1 :INPUT "Enter New Channel: ",Ch%
  504. IF Ch%<1 OR Ch%>20 THEN BEEP:RETURN
  505. LOCATE 2,1 :INPUT "How Many times longer do you want the sample to be?: ",Lng%
  506. IF Lng%<2 THEN BEEP:RETURN
  507. LOCATE 3,1 :INPUT "Enter Wavelength (10-512) : ",WvLen&
  508. IF WvLen&<10 OR WvLen&>512 THEN BEEP:RETURN
  509. AcLenRout:
  510. T2=St&(RT):T=St&(RT)
  511. Buffer&=NBuf&(RT)*Lng%
  512. MemTry&=AllocMem&(Buffer&+512,MemType&)
  513. IF MemTry&<=0 THEN BEEP:RETURN
  514. MemBit&=MemTry&
  515. WHILE (T<E&(RT))
  516. FOR Q=1 TO Lng%:Dis&=MemBit&-T:FOR T3=T TO (T+WvLen&) :POKE T3+Dis&,PEEK(T3):NEXT:MemBit&=MemBit&+WvLen&:NEXT
  517. T=T+WvLen&:WEND
  518. BufLen&(Ch%)=Buffer&:Per&(Ch%)=Per&(RT):Pi&(Ch%)=Pi&(RT)
  519. RT=Ch%:GOTO PlayIt
  520. FiltIn: FOR T2=0 TO Buf&:Fx=Frac*T2:IF Fx=INT(Fx) THEN POKE(T2+Tp),PEEK(Fx+St&(RT)):GOTO Blpe2
  521. Y1%=PEEK(INT(Fx)+St&(RT)):Y2%=PEEK(INT(Fx)+St&(RT)+1):IF Y1%>127 THEN Y1%=Y1%-256
  522. IF Y2%>127 THEN Y2%=Y2%-256
  523. Av%=((Fx-INT(Fx))*(Y2%-Y1%))+Y1%:IF Av%<0 THEN Av%=256+Av%
  524. POKE T2+Tp,Av%
  525. Blpe2: NEXT:RETURN 
  526. NormIn: FOR T2=0 TO Buf&:Fx=Frac*T2:POKE(T2+Tp),PEEK(Fx+St&(RT)):NEXT:RETURN
  527. CreSin:
  528. LOCATE 1,1 :PRINT " 1 - Sine Wave":PRINT " 2 - Square Wave":PRINT " 3 - Ramp Wave"
  529. INPUT " Enter Number of wave type to Synthesize: ",Wvn%
  530. IF  Wvn%<1 OR Wvn%>3 THEN BEEP:RETURN
  531. LINE(0,0)-(630,31),2,bf:LOCATE 1,1:INPUT "Enter sampling period (124 - 1000) : ",Spr%:IF Spr%<124 OR Spr%>1000 THEN BEEP:RETURN
  532. LINE(0,0)-(630,31),2,bf:LOCATE 1,1 :INPUT "Enter New Channel: ",Ch%
  533. IF Ch%<1 OR Ch%>20 THEN BEEP:RETURN
  534. LINE(0,0)-(630,31),2,bf:LOCATE 1,1:INPUT "Enter Vol (1-127): ",NVol
  535. INPUT "Enter Note (in capitals): ",No$
  536. INPUT "Enter Octave (0-10): ",Ocv%
  537. INPUT "How long do you want sample to be? (bytes): ",Buf&
  538. IF Ocv%<0 OR Ocv%>10 THEN BEEP:RETURN
  539. IF Buf&<1 THEN BEEP:RETURN
  540. TTT%=0
  541. FOR T%=1 TO 12
  542. IF No$=Key$(T%) THEN TTT%=T%
  543. NEXT T%
  544. IF TTT%=0 THEN LOCATE 1,1:PRINT"not a note":RETURN
  545. Hz=Keyf(TTT%)
  546. Hz=Hz*(2^(Ocv%-1))
  547. IF NVol<1 OR NVol>127 THEN BEEP:RETURN
  548. CyClen&=(3579545&/Spr%)/Hz
  549. MemTry&=AllocMem&(Buf&,MemType&)
  550. IF MemTry&<=0 THEN BEEP:LOCATE 1,1:PRINT "Too Big":RETURN
  551. IF Wvn%=1 THEN SinWave
  552. IF Wvn%=2 THEN SquWave
  553. IF Wvn%=3 THEN RamWave
  554. SinWave:
  555. FPi=6.28318531# :Fstoofp=FPi/CyClen&
  556. Fstoof=-FPi
  557. FOR T=MemTry& TO (MemTry&+Buf&)
  558. A%=SIN(Fstoof)*NVol:IF A%<0 THEN A%=256+A%
  559. POKE T,A%:Fstoof=Fstoof+Fstoofp
  560. NEXT
  561. RT=Ch%:BufLen&(RT)=Buf&:Per&(RT)=Spr%:Pi&(RT)=Spr%
  562. GOTO PlayIt
  563. SquWave:
  564. Fp%=1:Fstoof&=0:Cll&=CyClen&/2
  565. FOR T=MemTry& TO (MemTry&+Buf&)
  566. A%=Fp%*NVol:IF A%<0 THEN A%=256+A%
  567. POKE T,A%:Fstoof&=Fstoof&+1:IF Fstoof&=Cll& THEN Fp%=-1
  568. IF Fstoof&=CyClen& THEN Fstoof&=0:Fp%=1
  569. NEXT
  570. RT=Ch%:BufLen&(RT)=Buf&:Per&(RT)=Spr%:Pi&(RT)=Spr%
  571. GOTO PlayIt
  572. RamWave: Fgra=255/CyClen&:Fstoof&=0:Frac=NVol/127:Bot%=Frac*-128
  573. FOR T=MemTry& TO (MemTry&+Buf&)
  574. A%=(Fgra*Fstoof&*Frac)+Bot%:IF A%<0 THEN A%=256+A%
  575. POKE T,A%:Fstoof&=Fstoof&+1:IF Fstoof&=CyClen& THEN Fstoof&=0
  576. NEXT:RT=Ch%:BufLen&(RT)=Buf&:Per&(RT)=Spr%:Pi&(RT)=Spr%
  577. GOTO PlayIt
  578.  
  579. AltVol: 
  580. LINE(580,PYY)-(597,159),0,bf:NVol%=(64/44)*(159-Y):PYY=Y:LINE(580,Y)-(597,159),4,bf
  581. POKEW Ad&+8,NVol%:Vol&(RT)=NVol%:GOTO LoopB
  582. Mixat: IF NBuf&(RT)=0 THEN RETURN
  583. LOCATE 1,1 :INPUT "Enter Channel to mix: ",Ch%
  584. INPUT "Enter Channel to be mixed into: ",Ch1%
  585. INPUT "Enter Mix position address: ",MixPos&
  586. INPUT "New Channel= ",NCh%
  587. IF Ch%<1 OR Ch%>20 OR Ch1%<1 OR Ch1%>20 OR NCh%<1 OR NCh%>20 THEN BEEP:RETURN
  588. IF MixPos&<Start&(Ch1%) OR MixPos&>EndPos&(Ch1%) THEN BEEP:RETURN
  589. Buf1&=NBuf&(Ch%) :Buf2&=BufLen&(Ch1%)
  590. MixDis&=MixPos&-Start&(Ch1%) :Buffer&=Buf2&
  591. IF (MixDis&+Buf1&)>Buf2& THEN Buffer&=MixDis&+Buf1&
  592. MemTry&=AllocMem&(Buffer&,MemType&)
  593. IF MemTry&<=0 THEN BEEP:RETURN
  594. RT=NCh% :Per&(RT)=Per&(Ch1%):BufLen&(RT)=Buffer&
  595. CALL CopyMem(Start&(Ch1%),MemTry&,Buf2&)
  596. MixPos&=MemTry&+MixDis&
  597. CALL Mixa(MixPos&,St&(Ch%),Buf1&)
  598. Pi&(Ch%)=352:GOTO PlayIt
  599. SUB Mixa(X1&,X2&,X3&) STATIC
  600. En&=X1&+X3&:Dis&=X2&-X1&
  601. FOR T=X1& TO En&:Y%=PEEK(T):Y1%=PEEK(T+Dis&):IF Y%>127 THEN Y%=Y%-256
  602. IF Y1%>127 THEN Y1%=Y1%-256
  603. Y2%=Y%+Y1%:IF Y2%>127 THEN Y2%=127
  604. IF Y2%<-128 THEN Y2%=-128
  605. IF Y2%<0 THEN Y2%=256+Y2%
  606. POKE T,Y2%:NEXT:END SUB
  607. Backw:IF NBuf&(RT)=0 THEN RETURN
  608. LOCATE 1,1 :PRINT "Enter backwards step (2-";NBuf&(RT)
  609. INPUT TT
  610. IF TT<2 OR TT>NBuf&(RT) THEN BEEP:RETURN
  611. FOR T=St&(RT) TO (E&(RT)-TT) STEP TT:FOR T1=T TO T+(TT/2):RTY=PEEK(T+T+TT-T1):RTYY=PEEK(T1):POKE T1,RTY:POKE T+T+TT-T1,RTYY:NEXT:NEXT
  612. RETURN
  613. Renm:
  614. LOCATE 1,1 :PRINT"Enter file to change"
  615. INPUT Fi$
  616. PRINT "Enter new name"
  617. INPUT Fi1$
  618. File0$=Fi$+CHR$(0)
  619. anew$=Fi1$+CHR$(0)
  620. suc%=Rename%(SADD(File0$),SADD(anew$))
  621. IF suc%<>-1 THEN
  622. PRINT "Rename unsuccessful!!"
  623. END IF
  624. RETURN
  625. SUB Mamp(X1&,X2&,X3%) STATIC
  626. FOR T=X1& TO X2&:Y%=PEEK(T):IF Y%>127 THEN Y%=Y%-256
  627. Y%=Y%+X3%:IF Y%>127 THEN Y%=127
  628. IF Y%<-128 THEN Y%=-128
  629. IF Y%<0 THEN Y%=256+Y%
  630. POKE T,Y%:NEXT
  631. END SUB
  632. Edform: IF NBuf&(RT)=0 THEN RETURN
  633. LOCATE 1,1 :PRINT "Enter Edit address:"
  634. INPUT Ed&
  635. IF Ed&<Start&(RT) OR Ed&>EndPos&(RT) THEN BEEP:RETURN
  636. TT%=320
  637. IF (Ed&+TT%)>EndPos&(RT) THEN TT%=EndPos&(RT)-Ed&
  638. LINE(0,0)-(320,106),0,bf :X%=0:Y%=PEEK(Ed&)
  639. LINE(321,0)-(321,107),3:LINE(0,53)-(320,53),3
  640. FOR T=Ed& TO (Ed&+TT%) :X1%=X%:Y1%=Y%:Y%=PEEK(T):IF Y%>127 THEN Y%=Y%-256
  641. LINE(X1%,53-(Y1%*.4140625))-(X%,53-(Y%*.4140625)),4:X%=X%+1:NEXT
  642. Mlooped:
  643. X=MOUSE(1):Y1=MOUSE(2)
  644. IF INKEY$="q" OR INKEY$="Q" THEN Lastbbit
  645. LOCATE 1,41 :PRINT "Edit address: ";INT(Ed&+X);" "
  646. IF MOUSE(0)=0 THEN Mlooped
  647. IF (Ed&+X)>EndPos&(RT) OR (Ed&+X)>(Ed&+TT%) OR Y1>106 THEN Mlooped
  648. Y=(53-Y1):IF (Y/.4140625)<-128 THEN Y=-53
  649. IF (Y/.4140625)>127 THEN Y=52.5
  650. Y%=Y/.4140625 :IF Y%<0 THEN Y%=256+Y%
  651. POKE Ed&+X,Y%:LINE(X,0)-(X,106),0:PSET(X,53),3:PSET(X,Y1),4:GOTO Mlooped
  652. Lastbbit:
  653. LINE(0,42)-(330,42),1:CALL Refart:GOSUB Infobits :GOTO Pat
  654. RETURN
  655. SUB Cyco(X1&,X2&) STATIC
  656. SHARED RT,E&():A%=0:B%=0:C%=0:WHILE (C%=0):Y%=PEEK(X1&):IF Y%>127 THEN Y%=Y%-256
  657. IF Y%>0 AND A%=0 AND B%=0 THEN A%=1
  658. IF Y%<0 AND A%=1 AND B%=0 THEN B%=1
  659. IF Y%>=0 AND B%=1 THEN C%=1:POKEL X2&,X1&
  660. IF X1&>=E&(RT) THEN C%=1:POKEL X2&,X1&
  661. X1&=X1&+1:WEND:END SUB
  662. NeWav:
  663. FOR T=St&(RT) TO E&(RT) :Y%=PEEK(T):IF Y%>127 THEN POKE T,255-Y%
  664. NEXT:GOSUB Centralise
  665. RETURN
  666. Invt: IF NBuf&(RT)=0 THEN RETURN
  667. CALL Inve(St&(RT),E&(RT))
  668. RETURN
  669. SUB Inve(X1&,X2&) STATIC
  670. FOR T=X1& TO X2&:Y%=PEEK(T):IF Y%>127 THEN Y%=Y%-256
  671. IF Y%=-128 THEN Y%=-127
  672. Y%=-Y%:IF Y%<0 THEN Y%=256+Y%
  673. POKE T,Y%:NEXT
  674. END SUB
  675. KilFile:
  676. LOCATE 1,1 :INPUT "Enter File name: ",Nam$
  677. IF Nam$="" THEN RETURN
  678. LOCATE 2,1 :PRINT "Are you sure you want to delete ";Nam$;"? (Y/N)"
  679. INPUT A$
  680. IF A$="y" OR A$="Y" THEN Deletey
  681. RETURN
  682. Deletey:
  683. KILL Nam$
  684. RETURN
  685. Chip:
  686. MemType&=65538& :Stat$="CHIP Memory" :Meml&=2&:RETURN
  687. Fast:
  688. MemType&=65540& :Stat$="FAST Memory" :Meml&=4&:RETURN
  689. FCHIP:
  690. IF St&(RT)<10000000& THEN BEEP:RETURN
  691. LOCATE 1,1 :PRINT"Enter new CHIP Channel(SLOT):"
  692. INPUT NCA :NNBf&=NBuf&(RT)
  693. IF NCA<1 OR NCA>20 THEN BEEP:RETURN
  694. MemTry&=AllocMem&(NNBf&,65538&)
  695. IF MemTry&<=0 THEN BEEP:RETURN
  696. MemC&=MemTry&
  697. CALL CopyMem(St&(RT),MemTry&,NNBf&)
  698. Per&(NCA)=Per&(RT):RT=NCA :BufLen&(RT)=NNBf& :Pi&(RT)=350 
  699. EndPos&(RT)=MemTry&+BufLen&(RT)
  700. GOTO PlayIt
  701. CFAST:
  702. IF St&(RT)>10000000& THEN BEEP:RETURN
  703. LOCATE 1,1 :PRINT"Enter new FAST Channel(SLOT):"
  704. INPUT NCA :NNBf&=NBuf&(RT)
  705. IF NCA<1 OR NCA>20 THEN BEEP:RETURN
  706. MemTry&=AllocMem&(NNBf&,65540&)
  707. IF MemTry&<=0 THEN BEEP:RETURN
  708. MemC&=MemTry&
  709. CALL CopyMem(St&(RT),MemTry&,NNBf&)
  710. Per&(NCA)=Per&(RT):RT=NCA:BufLen&(RT)=NNBf& :Pi&(RT)=350
  711. EndPos&(RT)=MemTry&+BufLen&(RT)
  712. GOTO PlayIt
  713. Fltr:IF NBuf&(RT)=0 THEN RETURN
  714. CALL Dolb(St&(RT),NBuf&(RT)-1)
  715. RETURN
  716. SUB Dolb(X1&,X2&) STATIC
  717. X3&=X1&+X2&
  718. FOR T=X1& TO X3&:X%=PEEK(T):Y%=PEEK(T+1):IF X%>127 THEN X%=X%-256
  719. IF Y%>127 THEN Y%=Y%-256
  720. X%=(X%+Y%)/2:IF X%<0 THEN X%=X%+256
  721. POKE T,X%:NEXT:END SUB
  722. SUB Dolb2(X1&,X2&) STATIC
  723. FOR T=X1& TO X2&:X%=PEEK(T-1):Y%=PEEK(T+1):IF X%>127 THEN X%=X%-256
  724. IF Y%>127 THEN Y%=Y%-256
  725. X%=(X%+Y%)/2:IF X%<0 THEN X%=X%+256
  726. POKE T,X%:NEXT:END SUB
  727. UnFltr: IF NBuf&(RT)=0 THEN RETURN
  728. CALL Bright(E&(RT),St&(RT)+1)
  729. RETURN
  730. SUB Bright(X1&,X2&) STATIC
  731. FOR T=X1& TO X2& STEP -1:Y%=PEEK(T):Y1%=PEEK(T-1):IF Y%>127 THEN Y%=Y%-256
  732. IF Y1%>127 THEN Y1%=Y1%-256
  733. Y2%=(2*Y1%)-Y%:IF Y2%>127 THEN Y2%=127
  734. IF Y2%<-128 THEN Y2%=-128
  735. IF Y2%<0 THEN Y2%=256+Y2%
  736. POKE T-1,Y2%:NEXT:END SUB
  737. Filter:
  738. IF BufLen&(RT)=0 THEN BEEP:RETURN
  739. CALL FreeMem&(Start&(RT),BufLen&(RT))
  740. Start&(RT)=0:BufLen&(RT)=0:GOTO PlayIt
  741. RETURN
  742. Savd: IF NBuf&(RT)=0 THEN RETURN
  743. LOCATE 2,4:PRINT "SAVE FILE (DUMP):"
  744. INPUT "Name= ",SV$
  745. IF SV$="" THEN RETURN
  746. Plop&=Lock&(SADD(SV$+CHR$(0)),-2)
  747. IF Plop&=0 THEN CALL UnLock&(Plop&):GOTO ItsFine2
  748. CALL UnLock&(Plop&)
  749. LOCATE 2,4 :PRINT SV$;" already exists. Do you want to overwrite? (Y/N)"
  750. INPUT A$ :IF A$="Y" OR A$="y" THEN ItsFine2
  751. RETURN
  752. ItsFine2:
  753. fhandle& = xOpen&(SADD(SV$+CHR$(0)),1006)
  754. wLen&=xWrite&(fhandle&,St&(RT),NBuf&(RT))
  755. CALL xClose(fhandle&)
  756. RETURN
  757. Sav: IF NBuf&(RT)=0 THEN RETURN
  758. LOCATE 1,4:PRINT "SAVE FILE (IFF):"
  759. INPUT " Enter file Name: ",SV$
  760. IF SV$="" THEN RETURN
  761. Plop&=Lock&(SADD(SV$+CHR$(0)),-2)
  762. IF Plop&=0 THEN CALL UnLock&(Plop&):GOTO ItsFine
  763. CALL UnLock&(Plop&)
  764. LOCATE 2,1 :PRINT SV$;" already exists. Do you want to overwrite? (Y/N)"
  765. INPUT A$ :IF A$="Y" OR A$="y" THEN ItsFine
  766. RETURN
  767. ItsFine:
  768. fhandle& = xOpen&(SADD(SV$+CHR$(0)),1006)
  769. IF fhandle&=0 THEN BEEP:RETURN
  770. A$="FORM":B$="8SVX":C$="VHDR":D$="NAME":E$="BODY"
  771. NamStr$="Slatsy Samples":NmLen&=14
  772. Fsize&=66+NBuf&(RT)
  773. Vhd&=20
  774. OSHS&=NBuf&(RT)
  775. RHS&=0
  776. SPHC&=0
  777. SPS%=INT(3579545&/Pi&(RT))
  778. POKE Inflop&,Octs%
  779. sComp%=0
  780. sFvol&=65536&
  781. wLen&=xWrite&(fhandle&,SADD(A$),4)
  782. wLen&=xWrite&(fhandle&,VARPTR(Fsize&),4)
  783. wLen&=xWrite&(fhandle&,SADD(B$),4)
  784. wLen&=xWrite&(fhandle&,SADD(C$),4)
  785. wLen&=xWrite&(fhandle&,VARPTR(Vhd&),4)
  786. wLen&=xWrite&(fhandle&,VARPTR(OSHS&),4)
  787. wLen&=xWrite&(fhandle&,VARPTR(RHS&),4)
  788. wLen&=xWrite&(fhandle&,VARPTR(SPHC&),4)
  789. wLen&=xWrite&(fhandle&,VARPTR(SPS%),2)
  790. wLen&=xWrite&(fhandle&,Inflop&,1)
  791. wLen&=xWrite&(fhandle&,VARPTR(sComp%),1)
  792. wLen&=xWrite&(fhandle&,VARPTR(sFvol&),4)
  793. wLen&=xWrite&(fhandle&,SADD(D$),4)
  794. wLen&=xWrite&(fhandle&,VARPTR(NmLen&),4)
  795. wLen&=xWrite&(fhandle&,SADD(NamStr$),NmLen&)
  796. wLen&=xWrite&(fhandle&,SADD(E$),4)
  797. wLen&=xWrite&(fhandle&,VARPTR(NBuf&(RT)),4)
  798. wLen&=xWrite&(fhandle&,St&(RT),NBuf&(RT))
  799. CALL xClose(fhandle&)
  800. RETURN
  801. Acc: 
  802. LOCATE 1,1 :PRINT "Enter Chan to be added to:"
  803. INPUT FC%
  804. LOCATE 2,1 :PRINT "Enter Chan to add:"
  805. INPUT SC%
  806. LOCATE 3,1 :PRINT "Enter New Channel:"
  807. INPUT NC%
  808. NNBf&=NBuf&(FC%)+NBuf&(SC%):IF FC%<1 OR FC%>20 OR SC%<1 OR SC%>20 OR NC%<1 OR NC%>20 THEN BEEP:RETURN
  809. MemT&=AllocMem&(NNBf&,MemType&):R&=MemT&-St&(FC%):R1&=(MemT&+NBuf&(FC%))-St&(SC%)
  810. IF MemT&<=0 THEN BEEP:RETURN
  811. CALL CopyMem&(St&(FC%),MemT&,NBuf&(FC%))
  812. CALL CopyMem&(St&(SC%),MemT&+NBuf&(FC%),NBuf&(SC%))
  813. MemTry&=MemT&:Per&(NC%)=Per&(RT):RT=NC%:BufLen&(RT)=NNBf&:GOTO PlayIt
  814. Ch1:
  815. LOCATE 2,1 :PRINT "Enter Channel (1-20)"
  816. INPUT RY
  817. IF RY<1 OR RY>20 THEN BEEP:LOCATE 3,1 :PRINT"                  ":GOTO Ch1
  818. RT=RY:GOTO Pat
  819. Flip: IF NBuf&(RT)=0 THEN RETURN
  820. CALL Flipy(St&(RT),NBuf&(RT))
  821. RETURN
  822. SUB Flipy(X1&,X2&) STATIC
  823. FOR T=0 TO (X2&/2):Y%=PEEK(T+X1&):POKE T+X1&,PEEK(X1&+X2&-T):POKE X1&+X2&-T,Y%:NEXT:END SUB
  824. Fdin: IF NBuf&(RT)=0 THEN RETURN
  825. D&=E&(RT)-St&(RT):IF D&=0 THEN BEEP:RETURN
  826. FGra=80/D&
  827. FOR T=0 TO D&:Fmul=(T*FGra)/80:Y%=PEEK(St&(RT)+T):IF Y%>127 THEN Y%=Y%-256
  828. Y%=Y%*Fmul:IF Y%<0 THEN Y%=256+Y%
  829. POKE St&(RT)+T,Y%:NEXT
  830. RETURN
  831. Wibble: IF NBuf&(RT)=0 THEN RETURN
  832. LOCATE 1,1 :PRINT "Enter distort step"
  833. INPUT RTT :IF RTT<1 THEN RETURN
  834. FOR T=St&(RT) TO (E&(RT)-(RTT*2)) STEP (RTT*2):FOR T1=T TO (T+RTT-1):Y%=PEEK(T1):IF Y%>127 THEN Y%=-256+Y%
  835. Y%=-Y%:IF Y%<0 THEN Y%=256+Y%
  836. POKE T1,Y%:NEXT:NEXT
  837. RETURN
  838. Fdou: IF NBuf&(RT)=0 THEN RETURN
  839. D&=E&(RT)-St&(RT):IF D&=0 THEN BEEP:RETURN
  840. FGra=80/D&
  841. FOR T=0 TO D&:Fmul=(80-(T*FGra))/80:Y%=PEEK(St&(RT)+T):IF Y%>127 THEN Y%=Y%-256
  842. Y%=Y%*Fmul:IF Y%<0 THEN Y%=256+Y%
  843. POKE St&(RT)+T,Y%:NEXT
  844. RETURN
  845. Cut: IF NBuf&(RT)=0 THEN RETURN 
  846. FOR T=St&(RT) TO E&(RT):POKE T,0:NEXT:GOTO Graph
  847. Echo:
  848. Abc%=1:IF NBuf&(RT)=0 THEN RETURN
  849. LOCATE 1,1 :INPUT"Enter Number of Echoes: ",Ech%
  850. INPUT"Enter Echo rate: ",Ech1%
  851. PRINT"Enter Decay Rate (1-64): ";:INPUT DECR%
  852. INPUT"Destination Channel: ",Dest%
  853. IF Ech%<1 OR Ech1%<1 OR DECR%<1 OR DECR%>64 OR Dest%<1 OR Dest%>20 THEN BEEP:RETURN
  854. Ebf&=BufLen&(RT) :Efac&=Ebf&+(Ech%*(Ebf&/Ech1%))
  855. NSize&=Efac& :Abc%=0:FDeca=DECR%/64:Fmu=FDeca:NSe&=NSize&
  856. MemTry&=AllocMem&(NSe&,MemType&)
  857. IF MemTry&<=0 THEN BEEP:RETURN
  858. Per&(Dest%)=Per&(RT):Pi&(Dest%)=Pi&(RT)
  859. CALL CopyMem(Start&(RT),MemTry&,BufLen&(RT))
  860. D&=Ebf&/Ech1%:Ee&=Ebf&+Start&(RT)
  861. CALL Echoi(Start&(RT),MemTry&,Ee&,D&)
  862. RT=Dest%:BufLen&(RT)=NSe&:Start&(RT)=MemTry&:GOTO PlayIt
  863. SUB Echoi(X1&,X2&,X3&,X4&) STATIC
  864. SHARED FDeca,Fmu,Ech%
  865. FOR A%=1 TO Ech%:TT=X2&+(A%*X4&):FOR T=X1& TO X3&:Y%=PEEK(T):Y1%=PEEK(TT):IF Y%>127 THEN Y%=Y%-256
  866. IF Y1%>127 THEN Y1%=Y1%-256
  867. Y1%=Y1%+(Y%*Fmu):IF Y1%>127 THEN Y1%=127
  868. IF Y1%<-128 THEN Y1%=-128
  869. IF Y1%<0 THEN Y1%=Y1%+256
  870. POKE TT,Y1%:TT=TT+1:NEXT:Fmu=Fmu*FDeca:NEXT
  871. END SUB
  872. Lo:
  873. LOCATE 2,1 :PRINT "File Type is IFF   "
  874. Leng&=0 :At$="ANNO"
  875. rLen&=xRead&(fhandle&,Inflop&,4)
  876. rLen&=xRead&(fhandle&,Inflop&,4)
  877. rLen&=xRead&(fhandle&,Inflop&,4)
  878. rLen&=xRead&(fhandle&,Inflop&,4)
  879. rLen&=xRead&(fhandle&,Inflop&,4)
  880. rLen&=xRead&(fhandle&,Inflop&,4)
  881. rLen&=xRead&(fhandle&,Inflop&,4)
  882. rLen&=xRead&(fhandle&,Inflop&,2)
  883. RecRate&=PEEKW(Inflop&)
  884. LOCATE 1,5 :PRINT "Record Rate= ";RecRate&;" "
  885. rLen&=xRead&(fhandle&,Inflop&,1)
  886. rLen&=xRead&(fhandle&,Inflop&,1)
  887. rLen&=xRead&(fhandle&,Inflop&,4)
  888. rLen&=xRead&(fhandle&,SADD(At$),4)
  889. IF At$="BODY" THEN BodyLoader
  890. At$="CHAN"
  891. rLen&=xRead&(fhandle&,VARPTR(Leng&),4)
  892. IF (Leng&/2)<>INT(Leng&/2) THEN Leng&=Leng&+1
  893. rLen&=xRead&(fhandle&,Inflop&,Leng&)
  894. rLen&=xRead&(fhandle&,SADD(At$),4)
  895. IF At$="BODY" THEN BodyLoader
  896. At$="POOP"
  897. rLen&=xRead&(fhandle&,VARPTR(Leng&),4)
  898. IF (Leng&/2)<>INT(Leng&/2) THEN Leng&=Leng&+1
  899. rLen&=xRead&(fhandle&,Inflop&,Leng&)
  900. Leng&=0
  901. rLen&=xRead&(fhandle&,Inflop&,4)
  902. BodyLoader:
  903. rLen&=xRead&(fhandle&,Inflop&,4)
  904. Length&=PEEKL(Inflop&):SoundSize&=Length&
  905. COLOR 7,3:LOCATE 16,11 :PRINT Length&;"  ":COLOR 1,2
  906. Ebf&=SoundSize& :Efac&=Ebf&+(Ebf&*(Ech%*(1/Ech1%)))
  907. IF Abc%=1 THEN SoundSize&=Efac&:Abc%=0
  908. MemTry& = AllocMem&(SoundSize&,MemType&)
  909. MemSize& = 0
  910. IF MemTry& <= 0 THEN BEEP:LOCATE 2,1 :PRINT "No Mem for IFF  ":CALL Refart:RETURN
  911. rLen&=xRead&(fhandle&,MemTry&,SoundSize&)
  912. IF rLen&=0 THEN BEEP:CALL Refart:RETURN
  913. MemSize& = Ebf&
  914. BufLen&(RT) = SoundSize&
  915. CALL xClose(fhandle&) 
  916. FinLoad:
  917. SoundSize&=BufLen&(RT):CALL Refart
  918. Ins$(RT)=SV$:IF LEN(Ins$(RT))>32 THEN Ins$(RT)=LEFT$(Ins$(RT),32)
  919. IF RecRate& = 0 THEN Pi&(RT)=350:LOCATE 2,5 :PRINT "No playback rate specified: 350 used":Per&(RT)=350:BufLen&(RT)=SoundSize&:GOTO PlayIt   
  920. Per&(RT)= INT(3579545& / RecRate&)
  921. IF Per&(RT)>1000 THEN Per&(RT)=350:LOCATE 2,5 :PRINT "Unreasonable playback rate specified: 350 used"
  922. Pi&(RT)=Per&(RT)
  923. PlayIt:
  924. St&(RT)=MemTry&:E&(RT)=MemTry&+BufLen&(RT):Start&(RT)=MemTry&:EndPos&(RT)=MemTry&+BufLen&(RT)
  925. GOTO Pat
  926. LDump:
  927. LDump%=1
  928. Qlo:
  929. WINDOW 2,"LOAD",(0,0)-(270,25),0,1:WINDOW OUTPUT 2
  930. PRINT "Enter File:"
  931. GOTO Qlom
  932. Ldr:
  933. LOCATE 1,1 :ReRoo%=0:Anus%=0:Dood%=0
  934. INPUT "Enter Drawer : ",T$
  935. IF T$="" THEN T$=LEFT$(Dir$,LEN(Dir$)-1) 
  936. Count1%=-1:Hello%=-2:Dir$=T$+CHR$(0)
  937. Lock2&=Lock&(SADD(Dir$),Hello%)
  938. IF Lock2&=0 THEN CALL UnLock&(Lock2&) :LOCATE 2,1 :PRINT "Big Mistake!":CALL Refart:RETURN
  939. suc&=Examine&(Lock2&,Inflop&)
  940. FOR Loopy%=1 TO 2 :DirName&=Inflop&+8:FOR search%=0 TO 29:check=PEEK(DirName&+search%)
  941. IF check<>0 THEN
  942.     check$=check$+CHR$(check)
  943.     ELSE
  944.     search%=29
  945. END IF
  946. NEXT search%
  947. DirName$=check$:check$="":type&=PEEKL(Inflop&+120)
  948. IF type&<0 THEN
  949. DirType$="F" 
  950. ELSEIF Count1%=-1 THEN
  951. DirName$="        ---- "+DirName$+" ----":DirType$="P"
  952. ELSE
  953. DirType$="D"
  954. END IF
  955. IF DirType$="D" THEN DirName$=" ["+DirName$+"]"
  956. Count1%=Count1%+1:IF DirName$=Nam$(Count1%) THEN Dood%=Count1%
  957. suc&=ExNext&(Lock2&,Inflop&)
  958. NEXT Loopy%:IF Dood%=1 THEN printthem
  959. more3: Dir$=T$+CHR$(0)
  960. Lock2&=Lock&(SADD(Dir$),Hello%)
  961. suc&=Examine&(Lock2&,Inflop&)
  962. FOR T%=0 TO 255:Nam$(T%)="":Sta$(T%)="":NEXT:DosCount%=0
  963. more:
  964. DirName&=Inflop&+8:FOR search%=0 TO 29:check=PEEK(DirName&+search%)
  965. IF check<>0 THEN
  966.     check$=check$+CHR$(check)
  967.     ELSE
  968.     search%=29
  969. END IF
  970. NEXT search%
  971. DirName$=check$:check$="":type&=PEEKL(Inflop&+120)
  972. IF type&<0 THEN
  973. DirType$="F" 
  974. ELSEIF DosCount%=0 THEN
  975. DirName$="        ---- "+DirName$+" ----":DirType$="P"
  976. ELSE
  977. DirType$="D"
  978. END IF
  979. IF DirType$="D" THEN DirName$=" ["+DirName$+"]"
  980. DirComm$=check$:check$="":Nam$(DosCount%)=DirName$:Sta$(DosCount%)=DirType$
  981. suc&=ExNext&(Lock2&,Inflop&)
  982. IF suc&=0 THEN printthem  
  983. DosCount%=DosCount%+1:GOTO more
  984. printthem: Y2%=400:LINE(0,0)-(400,106),0,bf:COLOR 6,0:LOCATE 13,1:PRINT "LOAD: ":COLOR 5,4:LOCATE 13,47:PRINT "OK":Fil%=0
  985. Top%=0:Bot%=11:Fra=255/86:Siz%=86-(DosCount%/Fra):COLOR 7,0:LINE(401,0)-(401,106),3:LINE(385,0)-(385,106),3:LINE(386,0)-(400,106),4,bf:COLOR 1,0 :LOCATE 1,50:PRINT "+":LOCATE 13,50:PRINT "-"
  986. LINE(385,7)-(400,7),3:LINE(385,95)-(400,95),3:Y%=0:COLOR 7,0:LINE(386,Y%+8)-(400,Y%+8+Siz%),1,bf:GOSUB PrLoo
  987. Piggy: X%=MOUSE(1):Y1%=MOUSE(2):IF MOUSE(0)=0 THEN Piggy
  988. IF X%>367 AND X%<386 AND Y1%>95 AND Y1%<107 THEN AllSet
  989. IF X%>0 AND X%<365 AND Y1%>95 AND Y1%<107 THEN AllSet2
  990. IF X%<385 AND Y1%<96 THEN GetBog
  991. IF Y1%=(Y%+8) THEN Piggy
  992. IF X%>385 AND X%<401 AND Y1%>7 AND Y1%<(95-Siz%) THEN LINE(386,Y%+8)-(400,Y%+8+Siz%),4,bf:Y%=Y1%-8:LINE(386,Y%+8)-(400,Y%+8+Siz%),1,bf:Top%=Y%*Fra:GOSUB PrLoo
  993. IF X%>385 AND X%<404 AND Y1%<8 AND Top%>0 THEN Top%=Top%-1:GOSUB PrLoo
  994. IF X%>385 AND X%<404 AND Y1%>95 AND Y1%<107 AND Top%<DosCount% THEN Top%=Top%+1:GOSUB PrLoo
  995. GOTO Piggy
  996. GetBog:
  997. IF Y2%=Y1% THEN Piggy
  998. FOR T%=0 TO 88 STEP 8 :IF Y1%>T% AND Y1%<(T%+8) THEN Fil%=Top%+(T%/8):COLOR 1:LINE(48,95)-(360,106),0,bf:LOCATE 13,7:PRINT Nam$(Fil%):COLOR 7
  999. NEXT :Y2%=Y1%:GOTO Piggy
  1000. AllSet2: IF Y1%=Y2% THEN Piggy
  1001. Y2%=Y1%:COLOR 1:LINE(48,95)-(360,106),0,bf:LOCATE 13,6:INPUT " ",SV$ :IF SV$="" THEN COLOR 7:GOTO Piggy
  1002. Anus%=1:GOTO Piggy
  1003. AllSet: IF Y1%=Y2% THEN GOTO Piggy
  1004. IF ReRoo%=1 THEN ReRoo%=0:Y2%=Y1%:GOTO Piggy
  1005. Y2%=Y1%:IF Anus%=1 THEN Fil%=255:Nam$(Fil%)=SV$:Sta$(Fil%)="F"
  1006. IF Fil%=0 THEN LINE(0,42)-(402,42),1:LINE(0,43)-(401,106),0,bf:CALL Refart:COLOR 1,2:RETURN
  1007. IF Sta$(Fil%)="P" THEN Fil%=0:GOTO AllSet
  1008. IF Sta$(Fil%)="D" THEN B$=RIGHT$(Nam$(Fil%),LEN(Nam$(Fil%))-2):CHDIR T$:T$=LEFT$(B$,LEN(B$)-1):ReRoo%=1:GOTO more3
  1009. Doodo: CHDIR T$
  1010. SV$=Nam$(Fil%):LINE(0,42)-(402,42),1:LINE(0,43)-(401,106),0,bf:CALL Refart:COLOR 1,2:GOTO QLom4
  1011. PrLoo: LINE (0,0)-(384,95),0,bf:LOCATE 1,1:FOR T%=Top% TO (Top%+Bot%):PRINT Nam$(T%):NEXT:RETURN
  1012. Qlom:
  1013. COLOR 3,2
  1014. INPUT SV$
  1015. IF SV$="" THEN WINDOW CLOSE 2:CALL Refart:RETURN
  1016. WINDOW CLOSE 2
  1017. QLom4:
  1018. IF BufLen&(RT)<>0 THEN GOSUB Filter
  1019. GOTO Los
  1020. RETURN
  1021. SUB Refart STATIC
  1022. SHARED Blit1%()
  1023. PUT(0,42),Blit1%,PSET:LINE(0,0)-(620,31),2,bf:LINE(0,32)-(402,32),3:LINE(0,107)-(402,107),3:LINE(0,33)-(600,41),0,bf:LINE(0,43)-(401,43),3:LINE(0,75)-(401,75),3:LINE(0,42)-(401,42),1
  1024. END SUB 
  1025. Los:
  1026. At$="":AA=0:BB=0
  1027. fhandle& = xOpen&(SADD(SV$+CHR$(0)),1005)
  1028. IF fhandle&=0 THEN LOCATE 1,1 :PRINT"Loading Error!":CALL xClose(fhandle&) :CALL Refart:RETURN
  1029. rLen&=xRead&(fhandle&,Info2&,4)
  1030. IF PEEK(Info2&)=70 AND PEEK(Info2&+1)=79 AND PEEK(Info2&+2)=82 AND PEEK(Info2&+3)=77 THEN BB=1
  1031. IF LDump%=1 THEN BB=0
  1032. IF BB=1 THEN GOTO Lo
  1033. CALL xClose(fhandle&)
  1034. LOCATE 2,1 :PRINT "Unknown File Format"
  1035. SoundName$=SV$+CHR$(0)
  1036. DosLock&=Lock&(SADD(SoundName$),-2)
  1037. IF DosLock&=0 THEN BEEP:LOCATE 2,1 :PRINT "Can't lock file!":CALL Refart:RETURN
  1038. Dummy&=Examine&(DosLock&,Inflop&)
  1039. IF PEEKL(Inflop&+4)>0 THEN
  1040. BEEP :LOCATE 3,1 :PRINT "Crummy Error"
  1041. CALL UnLock&(DosLock&)
  1042. CALL Refart:RETURN
  1043. END IF
  1044. Length&=PEEKL(Inflop&+124)
  1045. CALL UnLock&(DosLock&)
  1046. LOCATE 16,11 :PRINT Length&;"  "
  1047. BufLen&(RT)=Length&
  1048. RecRate&=0
  1049. Bufs&=BufLen&(RT):Efac&=Bufs&+(Bufs&*(Ech%*(1/Ech1%)))
  1050. IF Abc%=1 THEN Ebf&=BufLen&(RT):BufLen&(RT)=Efac&:Abc%=0
  1051. fhandle& = xOpen&(SADD(SV$+CHR$(0)),1005)
  1052. IF fhandle&=0 THEN LOCATE 1,1 :PRINT"Loading Error!":CALL xClose(fhandle&) :CALL Refart:RETURN
  1053. MemTry&=AllocMem&(BufLen&(RT),MemType&)
  1054. IF MemTry&<=0 THEN BEEP:CALL xClose(fhandle&) :LOCATE 3,1 :PRINT"Can't get Unknown mem!":CALL Refart:RETURN
  1055. rLen& = xRead&(fhandle&,MemTry&,Bufs&)
  1056. CALL xClose(fhandle&)
  1057. GOTO FinLoad
  1058. SUB LoadDolby STATIC
  1059. file$="Piccy2"+CHR$(0)
  1060. fhandle&=xOpen&(SADD(file$),1005)
  1061. IF fhandle&=0 THEN PRINT "Can't find it" :CALL xClose(fhandle&):END
  1062. BitMp&=PEEKL(WINDOW(7)+46)+184
  1063. Bplane0&=PEEKL(BitMp&+8):Bplane1&=PEEKL(BitMp&+12):Bplane2&=PEEKL(BitMp&+16)
  1064. rLen&=xRead&(fhandle&,Bplane0&,20480&)
  1065. rLen&=xRead&(fhandle&,Bplane1&,20480&)
  1066. rLen&=xRead&(fhandle&,Bplane2&,20480&)
  1067. CALL xClose(fhandle&)
  1068. END SUB
  1069. Nslot: 
  1070. LOCATE 1,1 :PRINT"Copy Play Range to new Channel"
  1071. INPUT "Enter Range Channel: ",RC
  1072. INPUT "Enter new Channel: ",NC
  1073. IF RC<1 OR RC>20 THEN BEEP:RETURN
  1074. IF NC<1 OR NC>20 THEN BEEP:RETURN
  1075. MemTry&=AllocMem&(NBuf&(RC),MemType&)
  1076. IF MemTry&<=0 THEN BEEP:RETURN
  1077. D&=MemTry&-St&(RC)
  1078. CALL CopyMem(St&(RC),MemTry&,NBuf&(RC))
  1079. Per&(NC)=Per&(RC):RT=NC:BufLen&(RT)=NBuf&(RC):EndPos&(RT)=E&(RC):Pi&(RT)=Per&(RT)
  1080. GOTO PlayIt
  1081. Nams: IF NBuf&(RT)=0 THEN RETURN
  1082. LOCATE 1,1 :INPUT "Enter new volume (0-800%): ",Nv%
  1083. IF Nv%<0 OR Nv%>800 THEN BEEP:RETURN
  1084. Fov=Nv%/100:IF Fov=1 THEN RETURN
  1085. FOR T=St&(RT) TO E&(RT):Y%=PEEK(T):IF Y%>127 THEN Y%=Y%-256
  1086. Y%=Y%*Fov:IF Y%>127 THEN Y%=127
  1087. IF Y%<-128 THEN Y%=-128
  1088. IF Y%<0 THEN Y%=Y%+256
  1089. POKE T,Y%:NEXT
  1090. RETURN
  1091. HalfCycle: IF NBuf&(RT)=0 THEN RETURN
  1092. LOCATE 1,1 :INPUT "Enter New Channel: ",Ch%
  1093. IF Ch%<1 OR Ch%>20 THEN BEEP:RETURN
  1094. LOCATE 2,1 :INPUT "How many times smaller? (2-8): ",Ms%
  1095. IF Ms%<2 OR Ms%>8 THEN BEEP:RETURN
  1096. LOCATE 3,1 :INPUT "Enter Wavelength (10-512) : ",WvLen&
  1097. IF WvLen&<10 OR WvLen&>512 THEN BEEP:RETURN
  1098. T2=St&(RT)
  1099. Buffer&=NBuf&(RT)/Ms%
  1100. MemTry&=AllocMem&(Buffer&+512,MemType&)
  1101. IF MemTry&<=0 THEN BEEP:RETURN
  1102. MemBit&=MemTry&:T=St&(RT):MemEnd&=MemTry&+Buffer&-2
  1103. WHILE (MemBit&<MemEnd&)
  1104. Dis&=MemBit&-T:FOR T3=T TO (T+WvLen&) :POKE T3+Dis&,PEEK(T3):NEXT:MemBit&=MemBit&+WvLen&
  1105. FOR X%=1 TO Ms%:T=T+WvLen&:NEXT:WEND
  1106. BufLen&(Ch%)=Buffer&:Per&(Ch%)=Per&(RT):Pi&(Ch%)=Pi&(RT)
  1107. RT=Ch%
  1108. GOTO PlayIt
  1109. InitFreqs:
  1110. FOR T%=1 TO 24
  1111. READ Key$(T%),Keyf(T%),Keyb$(T%)
  1112. NEXT
  1113. RETURN
  1114. DATA "C",261.7,"q","C#",277.2,"2","D",293.7,"w","D#",311.2,"3","E",329.7,"e"
  1115. DATA "F",349.3,"r","F#",370,"5","G",392,"t","G#",415.3,"6","A",440,"y","A#",466.2,"7"
  1116. DATA "B",493.9,"u","C",130.85,"z","C#",138.6,"s","D",146.85,"x","D#",155.6,"d"
  1117. DATA "E",164.85,"c","F",174.65,"v","F#",185,"g","G",196,"b","G#",207.65,"h"
  1118. DATA "A",220,"n","A#",233.1,"j","B",246.95,"m"
  1119.