\ Draw yer freqencies and synthesize em \ \ get the binary speedy sin,cosine Find Qsin.Spot Not IFTrue Include Qsin IfEnd \ get 8SVX maker? find 8svxmake.spot not IFTrue Include 8SVXMAke IFEnd \ console support pack find Consupp.spot not IFTrue Include Consupp IFEnd \ \ Decimal \ 15000 Minimum.Object 512 tokens anew Drw.spot \ 512 4 1array Accum 256 4 1array Phase \ Variable N'p \ number of points in the record Variable WN'p \ working number of points in the record Variable WN'x \ working number of points in the record multiple Variable K \ Bitwise resolution \ Drw Loop Parms... Variable B'Zd \ sample Delta Variable B'Ze \ sample end Variable B'Fs \ Low Freq ( as phase shift ) Variable B'Fe \ HighFreq ( ditto ) Variable B'Fd \ Freq delta ( = H-l/128 ) Variable F'Sz \ Size of the in-core block (64K) Variable B'Zs \ BPF start Variable B'Fk \ skip number for BPF variable f'oct \ OCtaves for the file \ Variable Shutup Variable Played? Variable Button Variable Period variable ccolor Variable CDrmode Variable HowLoud \ hex 68 wconstant MDOWN \ these are returned in event message E8 wconstant MUP decimal \ Variable Dl'x Variable Dl'y \ Variable T'f \ working frequency Variable T's \ sum register Variable T'c \ sum register Variable I' \ other index variable LoopIx \ drawing loop indicies Variable Flock \ frequency lock \ Variable Fl'S \ floating scale... Variable Fid \ file id for BPF Variable BackX \ backup feature... Variable Backy \ backup feature... Variable CbaseXA \ Copy base Variable CbaseXB \ Copy base Variable CbaseYA \ Copy base Variable CbaseYB \ Copy base \ 256 Constant Bwid 128 Constant BHei 30 Constant Bdown Bdown 129 + Constant Bdown' Bdown 128 + Constant Bdown'' 5 Constant BLeft Bleft 1+ Constant BLeft' Bleft Bwid + Constant Bright \ loopix box bright 5+ Constant L'Left l'left 10 + constant l'right bdown constant L'top bdown 40 + constant l'bot \ \ define a custom screen, use defaults \ Create DrwSTitle 0," Hey! I'm Dressing!" Create DrwWTitle 0," Drw Window" struct NewScreen DrwNs DrwNs InitScreen \ copy default values to new screen 5 DrwNs +nsDepth W! 320 DrwNs +nsWidth W! 0 DrwNs +NsViewModes W! struct NewWindow DrwNw \ define a window Drwnw InitWindow \ copy default values to new window 0 Drwnw +nwLeftEdge w! 0 Drwnw +nwTopEdge w! 320 Drwnw +nwWidth w! 200 Drwnw +nwHeight w! WINDOWSIZING WINDOWDRAG | WINDOWCLOSE | ACTIVATE | Drwnw +nwFlags ! fCLOSEWINDOW MouseButtons | RawKey | Drwnw +nwIDCMPFlags ! CUSTOMSCREEN Drwnw +nwType w! \ open on a custom screen structend \ Variable MODE \ create TopMode$ 0," D R W - D S P R B W I O Q " create DoodleMode$ 0," Doodle Mode " create SynthMode$ 0," Synth Mode " create PlayMode$ 0," Play Mode " create WriteMode$ 0," Write Mode " create BPFMode$ 0," Band Pass Mode " create InputMode$ 0," Input Mode " create OutputMode$ 0," Output Mode " \ : Curx Currentwindow @ +wMouseX W@ ; : CurY Currentwindow @ +wMouseY W@ ; : ClipX Dup BLeft < if drop bleft then Dup Bright > if drop Bright then ; : ClipY dup bdown < if drop bdown then dup bdown' > if drop bdown' then ; : CurX' CurX clipx ; : CurY' cury clipy ; Variable CX' Variable CY' variable Vx variable vy \ Create T'Tx 8 allot T'Tx 8 erase : N'Text ( I X Y ) Locals| YY XX II | II <# # # # # # # # # #> T'Tx swap Cmove Rport 2 SetAPen Rport XX yY Move Rport T'Tx 8 Text drop ; : N'Text2 ( I X Y ) Locals| YY XX II | II <# # # # #> T'Tx swap Cmove Rport 2 SetAPen Rport XX yY Move Rport T'Tx 3 Text drop ; \ : Asc, [compile] Ascii , ; ?align4 create Xplan Asc, Dot_ Asc, Line asc, Ramp asc, Thin asc, Blob asc, Harm Asc, Avg_ asc, R-Up asc, R-Dn asc, Fill asc, Fil2 asc, Dec_ asc, Inc_ asc, Xcld asc, -Cut Asc, Dec0 asc, Inc0 asc, From asc, To__ asc, Copy asc, .21. asc, AMmd asc, CpFr asc, CpTm asc, Lck1 asc, Lck2 asc, Lck4 asc, Lck8 asc, Vl02 asc, Vl01 asc, Vl00 asc, .32. : getCmode Cury 25 < If Curx Bleft - 4 / 32 min 1 Max cdrmode ! cdrmode @ 280 20 N'text2 rport 240 20 Move Rport 2 setapen Rport CdrMode @ 1- 4* Xplan + 4 Text drop Rport CColor @ Setapen \ goldarn ntext busted it Mup Button ! then ; : compcm CdrMode @ 4* bleft + Locals| XX | Rport 2 SetDrMd Rport xx 18 xx 3+ 23 RectFill Rport 1 setdrmd ; \ Trace on : LoopixShow Loopix @ l'bot + 5- Locals| Me | Rport 2 setDrMd rport l'left me move rport l'right me draw rport 1 setdrmd Loopix @ negate 280 40 N'Text2 ; : GetLoopix curx l'left l'right range swap drop if \ oh boy: in range! LoopixShow cury 5+ l'bot - -31 max -1 min loopix ! loopixshow then ; : getccolor? Cury 17 < If curx bleft - 4 / 31 min 1 max ccolor ! Rport CColor @ SetAPen Rport 140 12 160 23 RectFill Mup Button ! Else CompCM GetCmode CompCm then \ how bout somothose funny parms? Cury bleft 30 - > If GetLoopix then ; \ : EventPoll ( -- t/f ) \ true if any button hit GetEvent Case MouseButtons Of ThisEvent +eCode W@ Button ! false Mode @ 1 = if Button @ Mdown = If getccolor? else BackX Off Backy off then then Endof RawKey OF ThisEvent +ecode W@ Case [ hex ] 22 of 1 Mode ! true endof \ D fer doodle 21 of 2 Mode ! true endof \ s fer Synth 19 of 3 Mode ! true endof \ p fer Play 14 of 4 Mode ! true endof \ t fer Top 10 of 5 Mode ! true endof \ Q fer Quit 11 of 6 Mode ! true endof \ W for Write 35 of 7 Mode ! true endof \ B for BPF 13 of 8 Mode ! true endof \ R for Reset 17 of 9 Mode ! true endof \ I for input screen 18 of 0A Mode ! true endof \ O for output screen [ decimal ] false endcase EndOf fCLOSEWINDOW Of \ ." CW " 5 mode ! true Endof \ elsssee.... false Endcase ; Create FileName$ 41 allot Variable F' \ : GNum ( -- # ) \ read a # from keyboard Begin 10 ask.Number until ; : GetFileName cr ." Filename?" FileName$ 40 expect 0 FileName$ Cnt @ 1- + C! cr ; Create DrwConname 0," CON:10/10/300/150/D R W Input screen" variable rf'sz : GetBpfFileName CurrentScreen @ ScreentoBack DRWCOnName ZapDosCon begin cr ." Filename of a sound file?" FileName$ 40 expect 0 FileName$ Cnt @ 1- + C! FileName$ Open ?Dup 0= if ." Can't find that file??" cr false else fid ! true then until \ other bpf stuff ." Sample start:" GNum B'Zs ! B'Zs @ B'Zd @ 8 scale + F'sz @ Min B'Ze ! ." K :" Gnum K ! 1 k @ Scale N'p ! fid @ filesize? 65536 Min RF'sz ! \ Read the sucker into the sound array... F' @@ RF'Sz @ 0 Fid @ Read.Virtual Fid @ Close UnzapDosCon CurrentScreen @ ScreenToFront ; \ Decimal : BigBegin Shutup off Mode Off 2 ccolor ! 3 CdrMode ! -1 loopIx ! -10 HowLoud ! 1 flock ! \ defaults for sampling 128 B'Zd ! B'Zd @ 8 scale B'ze ! 512 B'FD ! 4096 B'Fs ! BackX Off BackY Off B'Fs @ B'Fd @ 7 scale + B'Fe ! \ Size up the video pieces 256(x) by 128 (y) 65 1024 * F'SZ ! F'Sz @ Chip Get.Memory F' ! F' @ 0= IF False else True Then ; decimal : GetDrwParms \ flip back the screen a spell... currentscreen @ Screentoback DRWConName ZapDosCOn ." Reset sample parms Mode... " cr ." Sample Delta(" B'Zd ? ." ):" GNum 256 min 1 max B'Zd ! B'Zd @ 8 scale 65536 Min B'Ze ! ." Sample end is:" B'Ze ? cr ." Freq Delta(" B'Fd ? ." ):" Gnum b'Fd ! ." Delta in Hz:" b'fd @ 3523 * -15 scale . cr ." Freq Start(" B'Fs ? ." ):" Gnum B'Fs ! ." Start in Hz:" B'Fs @ 3523 * -15 scale . cr B'Fs @ B'Fd @ 7 scale + B'Fe ! ." Freq End in Hz:" B'Fe @ 3523 * -15 scale . cr 50 delay 3 mode ! UnzapDosCon currentscreen @ screentofront \ tell 'e the current freq etc. B'Zd @ 20 190 n'text B'Fs @ 120 190 n'text B'FE @ 220 190 N'Text ; \ create b> -4 allot \ Code B> Hex 2017 w, \ d0 get, 4880 w, \ d0 byte ext, 48c0 w, \ d0 word ext, 2E80 w, \ d0 put, 361A W, 4eF6 W, 3018 W, \ next Decimal \ End-Code \ { a forth version... Hex : B> ( byte extend ) FF and dup 7F > if FFFFFF00 + then ; Decimal } \ \ : okwindow? ( -- ) currentwindow @ 0= if currentscreen @ CloseScreen cr ." unable to open window! " abort then ; \ : rgb \ r g b --n | packs color values swap 16* or swap 8 scale or ; \ 16* is quick *, scale shifts bits ?align create ctable \ table to store new colors 15 15 15 rgb w, 08 08 08 rgb w, 00 08 08 rgb w, 01 07 08 rgb w, 02 06 08 rgb w, 03 05 08 rgb w, 04 04 07 rgb w, 05 03 06 rgb w, 06 02 05 rgb w, 07 01 04 rgb w, 08 00 04 rgb w, 09 00 04 rgb w, 10 00 04 rgb w, 11 00 04 rgb w, 12 00 04 rgb w, 13 00 04 rgb w, 14 00 04 rgb w, 15 00 04 rgb w, 15 01 04 rgb w, 15 02 04 rgb w, 15 03 04 rgb w, 15 04 04 rgb w, 15 05 04 rgb w, 15 06 04 rgb w, 15 07 04 rgb w, 15 08 04 rgb w, 15 09 04 rgb w, 15 10 04 rgb w, 15 11 04 rgb w, 15 12 04 rgb w, 15 13 04 rgb w, 15 14 04 rgb w, 15 15 04 rgb w, : loadcolors \ -- load new colors currentwindow @ ViewPortAddress \ get ViewPort address ctable \ color table address 32 \ number of colors to load LoadRGB4 ; \ call to load color values : PutUpScreen DrwSTitle DrwNs +nsDefaultTitle ! DrwWTitle DrwNw +nwTitle ! DrwNs OpenScreen verifyscreen \ open a 4 bit plane screen CurrentScreen @ DrwNw +nwScreen ! \ store screen ptr in window DrwNw OpenWindow okwindow? \ open demo window \ set the colors loadcolors ; \ : ShutUpScreen Currentscreen @ ScreenTOBack CurrentWindow @ CloseWindow CurrentScreen @ CloseScreen \ Release GM space f' @ ?DUP IF To.Heap then ; \ Variable lennn Decimal : N'Show ( Addr -- ) Locals| Add | \ another display of the waveform \ Rport 1 setapen \ Rport bleft 180 17 - Bright 180 17 + Rectfill 256 0 DO rport 1 setapen rport bleft I+ 163 move rport bleft I+ 197 draw Rport 31 SetAPen Rport Bleft I+ Add I+ C@ B> -3 scale 180 + WritePixel \ draw Loop ; Hex : EndGame \ now quasi stereo 0 Locals| U- | Button @ Mdown = IF Played? On F' @@ dup DFF0A0 ! DFF0B0 ! B'Ze @ 2/ dup DFF0A4 W! DFF0B4 W! CurrentWindow @ +wMouseY W@ 2* 7c + 7c Max dup DFF0A6 W! DFF0B6 W! \ period \ CurrentWindow @ +wMousex W@ 7c + 7c Max DFF0B6 W! \ period 3f Dff0A8 W! \ loudness 3f Dff0B8 W! \ loudness \ fire away.. 8203 Dff096 W! \ start DMA else \ Played? @ If 3 Dff096 W! \ Stop DMA Then Played? Off then \ ; Decimal : PlayMode CurrentWindow @ PlayMode$ -1 SetWindowTitles Shutup off Begin \ display "mouse std freq in Hz (freq of a b'fd sized record)" CurrentWindow @ +wMouseY W@ 2* 124 + 124 Max 170 20 n'text Endgame eventPoll Mode @ 3 = not and until ; : TopMode 0 0 locals| Z aa | CurrentWindow @ TopMode$ -1 SetWindowTitles 32 1 do Rport I SetAPen Rport BLeft I 4* + 12 BLeft I 1+ 4* + 1- 16 RectFill loop \ move the comb over 33 1 do rport 1 setapen Rport Bleft I 4* + 17 bleft I 1+ 4* + 1- 23 Rectfill rport 12 setapen Rport Bleft I 4* + 1+ 17 bleft I 1+ 4* + 2- 23 Rectfill loop CompCm \ draw the box Rport 1 setApen Rport BLeft Bdown Bright Bdown Bhei + 1+ RectFill \ tell 'e the current freq etc. B'Zd @ 20 190 n'text B'Fs @ 120 190 n'text B'FE @ 220 190 N'Text \ draw the loopix box rport l'left l'top l'right l'bot Rectfill rport 16 setapen rport l'left l'top move rport l'left l'bot draw rport l'right l'bot draw rport l'right l'top draw rport l'left l'top draw rport 1 setapen LoopixShow Loopix @ negate 280 40 N'Text2 rport ccolor @ setapen 1 mode ! ; Decimal : writeMode \ actually attempts to write 8SVX IFF file CurrentWindow @ WriteMode$ -1 SetWindowTitles CurrentScreen @ ScreentoBack drwconname ZApdoscon Getfilename ." Number Of Octaves??" Gnum 1 max 7 min f'Oct ! ." Favorite Period (124-999)?" Gnum 124 max 999 min 3579546 swap / 8Hertz ! f' @@ B'Ze @ F'Oct @ Filename$ 8svxMake if cr ." Successfully created!" else cr ." Sorry, couldn't write it!" then 30 delay unzapdoscon CurrentScreen @ ScreenToFront 3 mode ! ; \ Variable zpot Variable Pimp Variable BLIP ascii Blip blip ! \ : full@ pimp 4 zpot @ Fid @ read.virtual 4 Zpot +! pimp @ ; : full! 4 zpot @ Fid @ write.virtual 4 zpot +! ; \ structure for file: ID, time width, \ frq lo, frq width, (samples) \ : InputMode \ read screen file.. CurrentWindow @ InputMode$ -1 SetWindowTitles CurrentScreen @ ScreentoBack drwconname ZapDosCon ." Input a Screen File " cr begin Getfilename Filename$ open dup fid ! 0= if ." Can't find it! " cr then fid @ 0= not until UnzapDosCOn CurrentScreen @ ScreenToFront zpot off \ get ye parms full@ blip @ = if full@ B'zd ! B'Zd @ 8 scale 65536 Min B'Ze ! full@ b'fs ! full@ b'fd ! B'Fs @ B'Fd @ 7 scale + B'Fe ! \ now read em f' @@ f'sz @ zpot @ fid @ read.virtual fid @ close \ now show it 256 0 do I 170 20 n'text 128 0 do rport j 7 scale i+ f' @@ + C@ setapen rport bleft j + bdown i+ writepixel loop loop else ." That wasn't a good screen file " cr fid @ close then 3 mode ! \ tell me the current freq etc. B'Zd @ 20 190 n'text B'Fs @ 120 190 n'text B'FE @ 220 190 N'Text ; : OutputMode \ write screenfile CurrentWindow @ OutputMode$ -1 SetWindowTitles CurrentScreen @ ScreentoBack drwconname ZapDosCon ." Output screen file name:" Cr Getfilename UnzapDoscon CurrentScreen @ ScreenToFront \ open it for write.. filename$ new.file fid ! fid @ 0= not if zpot off blip full! b'zd Full! b'fs full! b'fd full! \ now read off those pixels into f' 256 0 do I 170 20 n'text 128 0 do rport Bleft j + bdown i+ readpixel j 7 scale i+ f' @@ + C! loop loop \ now write f' f' @@ f'sz @ zpot @ fid @ write.virtual fid @ close else ioerror? @ ." couldn't open it: code:" . cr then 3 mode ! ; \ VAriable Tharm Variable Ty Variable Lx Variable Px' Variable Py' Variable Rx Variable Lcol Variable Rcol \ : doodleMode 0 Locals| Temp | CurrentWindow @ DoodleMode$ -1 SetWindowTitles begin Curx Cx' ! CurY' FLock @ w/ FLock @ W* CY' ! CY' @ Bdown bdown' range swap drop Cx' @ Bleft bright Range swap drop and IF bdown' Cy' @ - B'fd @ * b'Fs @ + 3523 * -15 scale 170 20 n'text cx' @ clipx Cx' ! Button @ MDown = If rport ccolor @ setapen Cdrmode @ Case 1 of \ mode 1 = just draw, fella Rport CX' @ clipx CY' @ writePixel endof 2 of \ draw via line, bub Cx' @ BAckX @ > IF cx' @ 1+ BackX ! rport vx @ Clipx vy @ move Rport CX' @ clipx CY' @ clipy DRaw cx' @ vx ! cy' @ vy ! then endof 3 of \ ramp draw- add CX' @ BackX @ > If cx' @ 1+ BackX ! CColor @ to Temp 0 I' ! 2 Temp do Cx' @ I' @ - Clipx Lx ! Rport Lx @ Cy' @ readPixel i+ 31 min Rport swap SetApen Rport Lx @ Cy' @ WritePixel Cx' @ I' @ + Clipx dup lx @ = if drop else Lx ! Rport Lx @ Cy' @ readPixel i+ 31 min Rport swap SetApen Rport Lx @ Cy' @ WritePixel then 1 i' +! LoopIx @ +loop then endof 4 of Rport CX' @ clipx CY' @ clipy CX' @ 1+ clipx CY' @ 5+ clipy RectFill endof 5 of Rport CX' @ 3- clipx CY' @ 3- clipy CX' @ 3+ clipx CY' @ 3+ clipy RectFill endof 6 of \ HArmonix mode Cx' @ Backx @ > IF Backx @ 0= if cx' @ 1- backx ! cy' @ backy ! then CX' @ BackX @ DO I PX' ! \ interpolate Py from px I BackX @ - Cy' @ Backy @ - * Cx' @ BAckx @ - / Backy @ + Py' ! \ Bdown' Py' @ - B'fd @ * B'fs @ + 8/ to temp \ CUrrent phase to temp Temp Tharm ! BDown' Tharm @ B'Fs @ - B'Fd @ / - TY ! \ cr ." harm: " temp . ." :" begin ty @ bdown' < If 0 i' ! 2 ccolor @ do Px' @ i' @ - clipx Lx ! Rport Lx @ Ty @ readPixel i+ 31 min rport swap setapen Rport Lx @ Ty @ WritePixel \ write this one.. Px' @ i' @ + clipx dup lx @ = if drop else Lx ! Rport Lx @ Ty @ ReadPixel i+ 31 min rport swap SetAPen Rport Lx @ Ty @ WritePixel \ write this one.. then 1 i' +! Loopix @ +loop then Temp Tharm +! \ convert tharm to Ty BDown' Tharm @ B'Fs @ - B'Fd @ / - TY ! \ ." (" Tharm @ . Ty @ . ." )" Ty @ Bdown < until loop Cx' @ BackX ! Cy' @ BackY ! then endof 7 of \ average mode 0 to Temp 3 -2 do Rport Cx' @ I + clipx Cy' @ ReadPixel temp + to Temp loop rport temp 5 / 1 max setapen Rport Cx' @ 2- clipx Cy' @ Cx' @ 2+ clipx cy' @ RectFill endof 8 of \ smear forward Rport Cx' @ Cy' @ ReadPixel to Temp 0 I' ! 2 Temp do Rport I SetApen Rport Cx' @ I' @ - dup bleft < if drop bleft then Cy' @ WritePixel 1 i' +! LoopIx @ +loop rport ccolor @ Setapen endof 9 of \ smear backward Rport Cx' @ Cy' @ ReadPixel to Temp 0 I' ! 2 Temp do Rport I SetApen Rport Cx' @ I' @ + dup bright > if drop bright then Cy' @ WritePixel 1 i' +! LoopIx @ +loop rport ccolor @ Setapen endof 10 of \ FLOOD ( all with the same as x-y become Apen ) rport cx' @ cy' @ readpixel to Temp \ search left.. Cx' @ Dup Lx ! Rx ! begin -1 Lx +! Rport Lx @ Cy' @ ReadPixel Temp = not LX @ Bleft < or until 1 Lx +! \ search right .. begin 1 rx +! Rport rx @ Cy' @ ReadPixel Temp = not rX @ Bright > or until -1 Rx +! \ redraw it Rport Lx @ cy' @ move Rport Rx @ Cy' @ Draw endof 11 of \ ramp this line up rport cx' @ cy' @ readpixel to Temp \ search left.. Cx' @ Dup Lx ! Rx ! begin -1 Lx +! Rport Lx @ Cy' @ ReadPixel dup Lcol ! Temp = not LX @ Bleft < dup if 2 lcol ! then or Lcol @ 2 < or until \ search right .. begin 1 rx +! Rport rx @ Cy' @ ReadPixel Dup Rcol ! Temp = not rX @ Bright > dup if 2 Rcol ! then or rcol @ 2 < or until \ ." Lx:" Lx ? ." Rx:" Rx ? ." Lcol:" Lcol ? ." Rcol:" rcol ? cr \ redraw .left. cx' @ 1+ Lx @ do rport Lcol @ 4* temp + 5 w/ dup Lcol ! Setapen Rport I Cy' @ WritePixel 1 +loop \ redraw right cx' @ rx @ 1+ do rport rcol @ 4* temp + 5 / dup rcol ! Setapen Rport I Cy' @ WritePixel -1 +loop Rport ccolor @ Setapen \ whew endof 12 of \ decrement 4 -3 do Rport Cx' @ I+ clipx Cy' @ ReadPixel Loopix @ + 1 max rport swap setapen Rport Cx' @ I+ clipx Cy' @ writePixel loop rport CColor @ setapen endof 13 of \ increment 4 -3 do Rport Cx' @ I+ clipx Cy' @ ReadPixel Loopix @ - 31 Min rport swap setapen Rport Cx' @ I+ clipx Cy' @ writePixel loop rport CColor @ setapen endof 14 of \ edible harmonie cx' @ BackX @ > cx' @ BackX @ 2+ < and Backx @ 0= or IF ( only writes contiguous ) cx' @ BackX ! Bdown' Cy' @ - B'fd @ * B'fs @ + 8/ to temp \ CUrrent phase# to temp Temp Tharm ! \ get the first corresponding y... BDown' Tharm @ B'Fs @ - B'Fd @ / - clipY TY ! bdown'' lx ! \ cr ." harm: " temp . ." :" rport 1 setapen begin ty @ i < If \ skip real low ones... rport cx' @ lx @ Move rport cx' @ ty @ 1+ Draw Ty @ 1- lx ! then \ next harmonic Temp Tharm +! \ convert tharm to Ty BDown' Tharm @ B'Fs @ - B'Fd @ / - TY ! \ ." (" Tharm @ . Ty @ . ." )" ty @ dup clipy ty ! bdown < until \ ." >" \ get the top.. rport cx' @ lx @ move rport cx' @ bdown Draw \ ." <" cr then endof 15 of \ eliminat low freqs 256 0 do I 170 20 n'text 128 0 do rport Bleft j + bdown i+ readpixel 2 ccolor @ range if \ wipe out if from 2 to ccolor drop Rport 1 setapen Rport bleft j + Bdown i+ Writepixel else drop then loop loop endof 16 of \ decrement ( not 0 ) 4 -3 do 4 -3 do Rport Cx' @ I+ clipx Cy' @ J + clipy ReadPixel dup 2 > if Loopix @ + 2 max rport swap setapen Rport Cx' @ I+ clipx Cy' @ j + Clipy writePixel else drop then loop loop rport CColor @ setapen endof 17 of \ increment ( not 0 ) 4 -3 do 4 -3 do Rport Cx' @ I+ clipx Cy' @ j + ClipY ReadPixel dup 1 > if Loopix @ - 31 Min rport swap setapen Rport Cx' @ I+ clipx Cy' @ J + Clipy writePixel else drop then loop loop rport CColor @ setapen endof 18 of \ set copy baseA... Curx' CBAseXA ! cury' CbaseYA ! endof 19 of \ set copy baseb... Curx' CBAseXB ! cury' CbaseYB ! endof 20 of \ actually copy 3 -2 do 3 -2 do rport rport cx' @ i+ clipx cy' @ j + clipy readpixel setapen \ now stomp it Rport cx' @ i+ clipx cbaseXa @ - CbaseXB @ + CLipx cy' @ j + clipy cbaseYa @ - CbaseYB @ + CLipY WritePixel loop loop endof 22 of \ Am modulate? Bdown' Cy' @ - B'fd @ * B'fs @ + locals| Temp | \ CUrrent phase# to temp Bright bleft do 14 temp I bleft - 2048 */ Xqsin -8 scale 15 + Rport swap setapen Rport I cy' @ WritePixel loop endof 23 of \ copy whole lines.. Bright Bleft DO Rport I Cbaseya @ ReadPixel Rport Swap Setapen Rport I Cy' @ WritePixel loop endof 24 of \ copy whole lines.. BDown' Bdown DO Rport CbaseXA @ I ReadPixel Rport Swap Setapen Rport CX' @ I WritePixel loop endof 25 of 1 flock ! endof 26 of 2 flock ! endof 27 of 4 flock ! endof 28 of 8 flock ! endof 29 of -10 HowLoud ! endof 30 of -11 HowLoud ! endof 31 of -12 HowLoud ! endof endcase Else \ up button CdrMode @ Case 2 of cx' @ clipx vx ! cy' @ clipy vy ! endof endcase then then \ Cy' was too high? eventpoll until ; { : DisplayIt ( x y Z -- ) \ hope that amt not> 128 4/ 1+ 31 min Rport swap SetAPen rport rot rot WritePixel ; } \ create @-8Scale -4 allot \ Code @-8scale hex 2057 w, \ a0 Get, 2010 w, \ A0 () d0 long Move, E080 W, \ D0 8 # Long Asr, 2E80 W, \ d0 Put, 361A w, 4EF6 W, 3018 W, \ next Decimal \ end-code \ : ProcBPF 0 0 0 0 Locals| T# S: f: W: | B'Ze @ B'Zd @ - F' @@ + to F: B'Zs @ F' @@ + to S: \ Do these little sub-loops, but ramp time before freq.. 1 Wn'x ! Bdown'' Dl'Y ! N'P @ to W: \ Skip my nonsense ... B'Fe @ B'Fs @ DO I 3523 * -15 scale 170 20 n'text \ Standard freq display... \ T'f @ I * 262143 and T'F ! \ scramble the phase somewhat.. t'f off \ Bleft Dl'X ! \ set up wn'p = { skip more nonsense 262144 WN'X @ * i / dup N'P @ 2/ < If 1 wn'X +! then Dup to W: 250 25 N'text \ freq is below time } \ Now go over the sample block at this frequency, LPF them \ F: S: Do \ freq = j..time = i \ \ we gots to go slow here... cars is passing \ T's Off T'c Off J I' ! \ Insert Assembler here ... W: I+ I do I c@ B> \ Get yer sample... \ T'f @-8scale 2dup XQSin t's +! XQCOS t'c +! I' @ T'F +! \ move the wave forward loop { T'F @ I' @ W: I+ I \ d0 d1 a1 a0 >CODE A0 Pop, a1 Pop, D1 Pop, D0 Pop, begin, A0 )+ D2 Byte Move, \ D2 = M(I) D2 Byte Ext, \ Extend somewhat \ save this fer a second - probly oughta save all the registers! d2 push, \ \ --- incr freq, d0 d1 long add, \ T'F = T'F + I' a0 a1 long cmpa, gt until, >Forth } \ Rport T's @ W: W/ -6 scale dup W* T'c @ W: W/ -6 scale dup W* + sqrt 4/ 1+ 31 min SetAPen Rport Dl'X @ Dl'Y @ WritePixel { DisplayIt } \ 1 Dl'X +! B'Zd @ +loop -1 Dl'Y +! \ \ BPFDone? GetEvent fCloseWindow = IF Leave then B'Fd @ +loop \ next frequency 3 Mode ! ; : BPFMode CurrentWindow @ BPFMode$ -1 SetWindowTitles getbpfFilename \ draw the box Rport 2 setApen Rport BLeft Bdown 1+ Bright 2- Bdown Bhei + RectFill \ draw the loopix box ProcBpf ; Hex Create ColtoByte \ somewhat stretched \ 0 1 2 3 4 5 6 7 00 c, 00 c, 04 c, 08 c, 0c c, 10 c, 14 c, 18 c, \ 8 9 10 11 12 13 14 15 1c c, 20 c, 24 c, 28 c, 2c c, 30 c, 34 c, 38 c, \ 16 17 18 19 20 21 22 23 3c c, 40 c, 44 c, 48 c, 4c c, 50 c, 55 c, 59 c, \ 24 25 26 27 28 29 30 31 5e c, 63 c, 68 c, 6d c, 72 c, 76 c, 7c c, 7f c, Decimal \ : SynthMode CurrentWindow @ SynthMode$ -1 SetWindowTitles 0 0 0 0 0 0 0 Locals| Value Ovalue Sx Sy F-> IFreq JFaze | Bleft to SX F' @@ F'Sz @ Erase F' @@ to F-> 0 Phase Bhei 4* erase \ Phases of each of the sins rport 2 SetDrMd Rport 15 setapen \ Bright Bleft DO \ for each column (time slice of b'zd samples) Rport i 1+ Bdown Move Rport I 1+ Bdown' Draw 0 Accum B'Zd @ 4* Erase \ zero out the special hi-res memory \ B'fs @ to Ifreq Bdown Bdown'' DO \ for each frequency ... Rport J I ReadPixel ColToByte + C@ ?dup If to Value \ zero out the Accumulator Array... \ sum up a sinwave (properly phased) at this amplitude i Phase to JFaze B'Zd @ 0 DO Value JFaze @ -8 scale XQsin I Accum +! Ifreq JFaze +! Loop then B'Fd @ Ifreq + to Ifreq -1 +loop \ now transfer the fourbyte values to the f-> array \ ." --- Accum --- " cr B'Zd @ 0 do I Accum @ \ so i made it -5! I'm clipping, aint I? \ -7 scale ( number of frequencies ) -5 scale HowLoud @ scale dup 127 > if drop 127 then dup -127 < if drop -127 then F-> C! F-> 1+ to F-> loop \ cr Rport i 1+ Bdown Move Rport I 1+ Bdown' Draw eventpoll if Mode @ 2 = not if leave then then \ stop me before I kill again.. Loop 3 Mode ! rport 1 setdrmd ; \ This is the Main switching loop, exiting in each case \ by hitting closegadget.. \ \ : ProcDrw Mode Off Begin \ split up into subgroups they will stay there till their mode changes? mode @ case 0 of TopMode endof 1 of doodleMode endof 2 of SynthMode endof 3 of PlayMode endof 4 of TopMode endof 6 of writemode endof 7 of BPFMode endof 8 of GetDrwParms endof 9 of InputMode endof 10 of outputmode endof \ 5 = quit endcase Mode @ 5 = until \ drop \ we'll figger out why later...(figgered out??) ; \ : Drw Decimal BigBegin if PutUpScreen ProcDrw ShutUpScreen \ and free core... else ." I couldn't get core... " cr then ?turnkey if bye else Depth IF ." funny depth:" depth . then abort then ; \ ." Drw is in " cr