5     ver$="0.8"
10    rem "Foenix Diagnostics":dim map(10,8):dim sid(12):dim mu(10)
20    ?$D001=0:definenotes():rem "init frequencies for sound tests"
30    sprites off :bitmap off :initscreen():qflag=0
40    loadpalette("default",0):loadpalette("vga13h",1)
50    readtile8():loadfont("gothic",1)
60    vsplugin():rem "Init vs1053b MIDI mode"
70    initcodec():rem "Init all lines in CODEC for SOund"
80    while qflag=0
90    showmenu()
100   if test=11 then screensizes()
110   if test=12 then drawscale():screensizes():bitmap clear 0:bitmap off 
120   if test=13
130   cls :charbox():printat(5,21,"Alternate Font"):?$D001=32
140   keywait():printat(5,21,"Original Font "):?$D001=0
150   keywait():printat(5,21,"Text Scroll Test"):keywait()
160   scrollx():keywait():printat(5,21,"Border Test      "):keywait()
170   bordertest():bordertest():bordertest():keywait()
180   printat(5,21,"Background Tests      "):keywait()
190   backgroundtest():pokel $D00D,$004080:keywait()
200   bitmap clear 0:bitmap off 
210   endif 
220   if test=14
230   cls :printat(5,21,"Sprite Show & Move Test"):keywait()
240   spritetest():keywait()
250   cls :bitmap clear 0:printat(5,21,"Sprite Priority")
260   spritepriority():keywait()
270   endif 
280   if test=15
290   dmatest()
300   endif 
310   if test=16
320   cls 
330   tiledemo():poke $D000,3:keywait()
340   endif 
350   if test=17 then mousetest()
360   if test=18 then luttest()
370   if test=21
380   cls 
390   poke $D6A1,00:printat(5,21,"PSG Sound Test - Mono")
400   keywait():playscalepsg()
410   poke $D6A1,12:rem "Enable stereo output sid+psg"
420   printat(5,21,"PSG Sound Test - Stereo")
430   keywait():playscalepsg()
440   endif 
450   if test=22 then sidtest()
460   if test=23 then playvgm("Letsgo.vgm")
470   if test=24 then samtest()
480   if test=25 then testvs1053()
700   if test=31 then rngmathtest()
720   rem "if test=32 then ClockTest()"
730   if test=33 then joytest()
740   if test=34 then testnes()
750   if test=35 then testsnes()
760   if test=4 then switchcodec()
940   if (test%10=0) then print test:qflag=1
950   test=-1:k=0
960   wend 
970   cls :print "Thank You for Using the Foenix Test Suite!"
999   end 
1000  proc printat(x,y,a$)
1005  col=(?$D001)&2:if col=0 then col=1
1010  local pos:pos=x+y*80\col:?1=2:rem "Set I/O to text memory"
1020  for c=0 to len(a$)-1:?(pos+c+$C000)=asc(mid$(a$,c+1,1)):next 
1030  ?1=0
1040  endproc 
1050  proc charbox()
1060  for c=0 to 7
1070  for d=0 to 31
1080  a$=a$+chr$(c*32+d)
1090  next 
1095  printat(5,c+2,a$):a$=""
1100  next 
1105  numrows():charcol()
1110  endproc 
1150  proc keywait()
1160  printat(5,24,"Press any key to continue")
1170  k=0:while k=0:k=inkey():wend 
1180  printat(0,24,spc(30))
1190  endproc 
1200  proc charcol()
1210  ?1=0:col=(?$D001)&2:if col=0 then col=1
1215  ?1=3
1220  for c=0 to 7
1230  for d=0 to 31
1240  ?($C000+(c+2)*80\col+d+5)=c*32+d
1250  next 
1260  next 
1270  ?1=0
1280  endproc 
5090  proc spritepriority()
5095  memcopy $30400,$400 poke $2:bitmap on :bitmap clear 0
5100  drawscale():rect color 255 solid from 100,100 to 200,200
5105  poke $D900,$19:pokel $D901,$30000
5110  poke $D908,$01:pokel $D909,$30400
5120  dim y(3):y(0)=150:y(1)=180:y(2)=80
5130  cls :print "Sprite 0 Foenix, back layer":print "Sprite 1 block, front layer"
5140  for y=0 to 2
5150  for x=50 to 220
5160  sprite 0 to x,y(y)
5170  sprite 1 to 280-x,y(y)
5180  for t=1 to 500:next 
5190  next 
5200  next 
5205  bitmap clear 0:bitmap off :sprites off 
5210  endproc 
5250  proc screensizes()
5260  ?$D001=0:cls :printat(5,21,"80x60 columns mode 60Hz")
5265  charbox():numrows():keywait()
5270  ?$D001=2:cls :printat(5,21,"40x60 columns mode 60Hz")
5275  charbox():numrows():keywait()
5280  ?$D001=4:cls :printat(5,21,"80x30 columns mode 60Hz")
5285  charbox():numrows():keywait()
5290  ?$D001=6:cls :printat(5,21,"40x30 columns mode 60Hz")
5295  charbox():numrows():keywait()
5296  printat(5,22,"Want to test 70Khz modes? (Y/N)")
5297  k$="":while k$="":k$=inkey$():wend 
5298  if (k$="y")^(k$="Y")
5300  ?$D001=1:cls :printat(5,21,"80x50 columns mode 70Hz")
5305  charbox():numrows():keywait()
5310  ?$D001=3:cls :printat(5,21,"40x50 columns mode 70Hz")
5315  charbox():numrows():keywait()
5320  ?$D001=5:cls :printat(5,21,"80x25 columns mode 70Hz")
5325  charbox():numrows():keywait()
5330  ?$D001=7:cls :printat(5,21,"40x25 columns mode 70Hz")
5335  charbox():numrows():keywait()
5337  endif 
5340  ?$D001=0
5350  endproc 
5500  proc numrows()
5510  for c=0 to 59:printat(0,c,str$(c)):next 
5520  endproc 
5550  proc drawscale()
5560  bitmap on :bitmap clear 0:c=0:pokel $D00D,$004080
5570  while c<320
5580  line color 2 from 0,0 to c,239
5590  line from 0,239 to c,0
5600  line from 319,0 to c,239
5610  line from 319,239 to c,0
5620  c=c+20
5630  wend 
5640  endproc 
5650  proc initscreen()
5660  cls :pokel $D00D,$004080:bitmap off :sprites off 
5990  endproc 
6000  proc scrollx()
6010  for c=0 to 7
6020  ?$D004=c*16
6030  for d=0 to 2000:next 
6040  next 
6050  for c=7 downto 0
6060  ?$D004=c*16
6070  for d=0 to 2000:next 
6080  next 
6090  endproc 
6100  proc bordertest()
6105  ?$D004=1
6110  for c=0 to 31
6120  ?$D008=c:?$D009=c
6130  for d=0 to 31:poke $D005,c*32+d:next 
6140  next 
6150  for c=31 downto 0
6160  ?$D008=c:?$D009=c
6170  for d=0 to 31:poke $D005,c*32+d:next 
6180  next 
6190  endproc 
6200  proc spritetest()
6210  cls 
6220  bload "bspr/foenixlogo.bspr",$30000
6230  drawscreen()
6240  sprites on 
6250  sprite 0 image 0 to 0,100:sprite 1 image 0 to 320,100
6255  poke $D900,9:poke $D908,9
6260  poke $D900,9:poke $D908,9
6270  e=0:count=0
6280  for c=00 to 160
6290  sprite 0 to c,100:sprite 1 to 320-c,100
6300  for d=1 to 180:next 
6310  if c>144
6320  line color 0 from 160-e,84 to 160-e,116
6325  line color 0 from 160+e,84 to 160+e,116
6330  e=e-1
6340  endif 
6350  next 
6360  a$="Foenix":printat(40-len(a$)\2-1,30,a$)
6370  a$="Retro Systems":printat(40-len(a$)\2-1,31,a$)
6380  for d=0 to 10000:next 
6390  cls :sprite 0 off :sprite 1 off 
6400  endproc 
6500  proc loadpalette(name$,lut)
6510  a$="palettes/"+name$+".pal"
6520  try bload a$,$7800 to err
6530  if err<>0 then print a$+" not found":end 
6540  ?1=1
6550  for c=0 to 1023:?($D000+lut*$400+c)=?($7800+c):next 
6560  ?1=0
6570  endproc 
6600  proc drawscreen()
6610  bitmap on :bitmap clear 0
6620  pokel $D00D,$000000
6630  for c=0 to 16
6640  line color 1 from 0,84+c*2 to 160,84+c*2
6650  line color 1 from 160,85+c*2 to 319,85+c*2
6660  next 
6670  endproc 
6700  proc backgroundtest()
6710  cls :charbox():printat(30,31,"Text mode"):bitmap off 
6720  for c=0 to 512
6730  pokel $D00D,random(255)*65536+random(255)*256+random(255)
6740  next 
6780  pokel $D00D,$004080:keywait()
6790  cls :bitmap clear 0:bitmap on :printat(30,31,"Graphics mode")
6795  drawscale()
6800  for c=0 to 512
6810  pokel $D00D,random(255)*65536+random(255)*256+random(255)
6820  next 
6830  endproc 
6900  proc tiledemo()
6910  cls :bitmap on :drawscale():?$D004=1:?$D009=16
6915  memcopy $24000,$2000 poke 0:?$D002=64
6920  tiles on :tiles dim 64,32 at $24000,$26000
6925  for c=0 to 31:for d=0 to 16
6930  tile at (c*2)+1,(d*2)+1 plot 1
6934  tile at c*2,d*2 plot 1
6940  next :next 
6945  for a=1 to 2:for c=0 to 5:for d=0 to 7
6950  while peekw($D01A)<490:wend 
6955  tile to d,d
6960  for e=0 to 500:next :next :next 
6965  ?$D002=4:next :rem "Set tile layer priority"
6970  tile16()
6975  for a=1 to 2:for c=1 to 5:for d=0 to 15
6980  while peekw($D01A)<485:wend 
6982  ?($D20C+8)=15-d:?($D20C+10)=d:tile to d,d
6985  for e=0 to 500:next :next :next 
6986  ?$D002=(5+4*16):?$D003=0:next 
6987  bitmap off :poke $D000,3:?$D009=0:?$D004=0
6990  endproc 
7010  proc definenotes()
7020  dim note#(12),psglb(12),psghb(12):rem "Octave 4 freq"
7030  note#(1)=261.63:note#(2)=277.18:note#(3)=293.66
7040  note#(4)=311.13:note#(5)=329.63:note#(6)=349.23
7050  note#(7)=369.99:note#(8)=392.00:note#(9)=415.30
7060  note#(10)=440.00:note#(11)=466.16:note#(12)=493.88
7070  for c=1 to 12
7080  freq=int(111552/note#(c))
7090  psglb(c)=freq&15:psghb(c)=(freq&1008)\16
7100  next 
7105  for c=1 to 8:read a:mu(c)=a:next 
7110  endproc 
7150  proc playscalepsg()
7160  for a=0 to 5
7170  printat(5,5,"Play PSG Voice "+str$(a))
7180  
7190  for d=1 to 12-a
7200  rem "Silence note"
7210  if a=0 then ?$D610=159:rem "144+15=159"
7220  if a=1 then ?$D600=159
7230  if a=2 then ?$D610=191:rem "176+15=191"
7240  if a=3 then ?$D600=191
7250  if a=4 then ?$D610=223:rem "208+15=223"
7260  if a=5 then ?$D600=223
7265  rem "Play Note in selected voice"
7270  if a=0 then ?$D610=148:?$D610=(128+psglb(d)):?$D610=psghb(d)
7280  if a=1 then ?$D610=180:?$D610=(160+psglb(d)):?$D610=psghb(d)
7290  if a=2 then ?$D610=212:?$D610=(192+psglb(d)):?$D610=psghb(d)
7300  if a=3 then ?$D600=148:?$D600=(128+psglb(d)):?$D600=psghb(d)
7310  if a=4 then ?$D600=180:?$D600=(160+psglb(d)):?$D600=psghb(d)
7320  if a=5 then ?$D600=212:?$D600=(192+psglb(d)):?$D600=psghb(d)
7340  for p=0 to 1000:next :rem "Pause for Note length "
7350  next 
7360  next 
7365  printat(5,5,"Press any key to silence"):keywait()
7367  printat(5,5,spc(30))
7370  ?$D610=159:rem "144+15=159"
7380  ?$D600=159
7390  ?$D610=191:rem "176+15=191"
7400  ?$D600=191
7410  ?$D610=223:rem "208+15=223"
7420  ?$D600=223
7430  endproc 
7500  proc setspr(num,mem,sz,show)
7510  rem "size: 0=32x32, 1=24x24, 2=16x16, 3=8x8"
7520  local shi:local smd:local slo:local sval:local sp
7530  shi=mem\65536:smd=((mem-(shi*65536))\256):slo=(mem&$FF)
7540  ?1=0:sp=$D900:sp=sp+(num*8)
7550  sz=sz&3:sval=sz*32+(show&1)
7560  ?sp=sval
7570  ?(sp+1)=slo:?(sp+2)=smd:?(sp+3)=shi
7580  endproc 
7590  proc showspr(num,show,sz)
7600  rem "show: 1=Show, 2=Hide"
7610  ?1=0:local sp
7620  sp=$D900:sp=sp+(num*8)
7630  sz=sz&3:sval=sz*32+(show&1)
7640  ?sp=sval
7650  endproc 
7660  proc movespr(num,x,y)
7670  ?1=0:local sp
7680  sp=$D900:sp=sp+(num*8)
7690  ?(sp+4)=x&$FF:?(sp+5)=int(x/256)
7700  ?(sp+6)=y&$FF:?(sp+7)=int(y/256)
7710  endproc 
7800  proc dmatest()
7805  cls :bload "bspr/foenixlogo.bspr",$30000
7810  bitmap on :bitmap clear 0:sprites on 
7811  printat(5,5,"DMA RECT - Copy Image to fill screen"):keywait()
7812  for c=0 to 8:for d=0 to 10:map(d,c)=0:next :next 
7815  image 0 to 0,0
7820  while count<80
7825  x=random(10):y=random(8)
7830  if map(x,y)=0
7835  rectdma(x,y)
7840  map(x,y)=1:count=count+1
7845  rem "for e=0 to 200:next"
7850  endif 
7855  wend 
7860  keywait():pokel $D00D,$004080
7865  sprites on 
7870  sprite 0 image 0 to 100,60
7875  setspr(1,$7800,0,1):movespr(1,150,76)
7880  printat(5,5,"DMA FILL - Fill Right sprite w/random color  ")
7885  keywait():memcopy $7800,1024 poke random(255)
7890  printat(5,5,"DMA COPY - Copy Left sprite to Right sprite  ")
7895  keywait():memcopy $30003,1024 to $7800
7900  keywait()
7905  sprites off :bitmap clear 0
7910  endproc 
8000  proc showmenu()
8010  cls :test=-1
8020  printat(25,1,"Foenix TestSuite V"+ver$)
8030  printat(25,2,"_____________________")
8040  printat(5,5,"1. Vicky Graphic Tests")
8050  printat(5,6,"2. Sound Chips Tests")
8060  printat(5,7,"3. Math/Joy/GamePads/LEDs Tests")
8065  printat(5,8,"4. Alternate Codec Config, Current:"+str$(codec))
8070  printat(5,20,"Press number for Selected Test, 0 to Quit")
8080  k=0:while ((k<48)^(k>52)):k=inkey():wend :k=k-48:test=k*10
8090  printat(25,1,"Foenix TestSuite V0.5")
8095  printat(25,2,"_____________________")
8100  if k=1
8110  printat(5,5,"1. Text Resolution Modes                  ")
8120  printat(5,6,"2. Graphic Resolution Modes               ")
8130  printat(5,7,"3. Fonts, Borders & Background color      ")
8140  printat(5,8,"4. Sprites & Sprite Priority              ")
8150  printat(5,9,"5. DMA Functions (RECT, FILL, COPY)       ")
8160  printat(5,10,"6. Tile Engine & Layers Test             ")
8190  printat(5,11,"7. Mouse Test                            ")
8195  printat(5,12,"8. LUT Palette Test                      ")
8200  printat(5,20,"Press number for Selected Test, 0 to Quit")
8220  k=0:while ((k<48)^(k>57)):k=inkey():wend :k=k-48:test=test+k
8225  k=0
8230  endif 
8240  if k=2
8250  printat(5,5,"1. PSG (SN76489) Tests")
8260  printat(5,6,"2. SID Chip Tests                         ")
8270  printat(5,7,"3. OPL3 Chip Tests                        ")
8280  printat(5,8,"4. SAM2695 Chip Tests                     ")
8290  printat(5,9,"5. VS1053b Chip Tests                     ")
8300  printat(5,20,"Press number for Selected Test, 0 to Quit")
8310  k=0:while ((k<48)^(k>55)):k=inkey():wend :k=k-48:test=test+k
8315  k=0
8320  endif 
8340  if k=3
8350  printat(5,5,"1. Math Coprocesor & Random Number Generator Tests ")
8360  printat(5,6,"2. Real Time Clock Tests                           ")
8370  printat(5,7,"3. Joystick Tests                                  ")
8380  printat(5,8,"4. NES Gamepad Tests                               ")
8390  printat(5,9,"5. SNES Gamepad Tests                              ")
8400  k=0:while ((k<48)^(k>55)):k=inkey():wend :k=k-48:test=test+k
8410  k=0
8420  endif 
8430  if k=4 then test=4:k=0
8440  endproc 
8500  proc readtile8()
8510  for c=0 to 63:read a:xpoke($26000+c,a):next 
8515  memcopy $26040,64 poke 0
8520  endproc 
8550  proc rectdma(x1,y1)
8560  da=$10000+(x1*32)+(y1*32*320)
8570  w=32:h=32:ss=320:sd=320
8580  memcopy $10000 rect 32,32 by ss to da
8590  for d=1 to 10:next 
8600  endproc 
8700  proc sidtest():rem "SID Demo"
8702  initcodec():poke $D6A1,00:rem "CODEC MONO MODE"
8705  cls :printat(5,5,"Play SID 1 & 2 voices"):keywait()
8710  f#=16.404601:rem "SID constant"
8720  for c=0 to 12
8730  a=int(note#(c)*f#):sid(c)=a:si=1
8740  next 
8750  s=$D400:rem "Left SID"
8760  pul=0:atk=1:dcy=15:sus=8:rel=4:fil=0:res=0
8770  wav=1:rem "i.e. waveform 16=tri, add 1 to Gate note!"
8780  poke s+24,15:rem "maximum volume"
8790  for e=0 to 2:printat(5,6,"Playing SID "+str$(si)+" Voice "+str$(e))
8795  wav=e+1+4*(si-1)
8800  poke s+5+(7*e),atk*16+dcy*16:rem "ATK=1, DEC=15"
8810  poke s+6+(7*e),sus*16+rel:rem "SUS=8, REL=4"
8820  pokew s+2+(7*e),pul
8840  for c=1 to 12-e:rem "play first 11 notes"
8850  poke s+(7*e),sid(c)&255:poke s+1+(7*e),sid(c)\255
8860  poke s+4+(7*e),wav*16+1:rem "use ctrl to sel wave & gate note"
8870  for d=0 to 750:next 
8880  if c<>(12-e) then poke s+4+(7*e),wav*16:rem "gate off note"
8890  for d=0 to 250:next 
8900  next :next :si=si+1
8910  if s=$D400 then s=$D500:goto 8780:rem "Right SID"
8920  printat(5,5,"Press any key to silence Sound"):keywait()
8930  for c=0 to 24:?($D400+c)=0:?($D500+c)=0:next 
8940  endproc 
9000  proc initcodec()
9010  ?$D620=$03:?$D621=$2A:?$D622=$01:rem "Thanks to MuOn!"
9015  codec=1
9020  endproc 
9050  proc initcodec2()
9055  poke $D620,$1F
9060  poke $D621,$2A
9065  poke $D622,$01
9070  delay():codec=2
9075  endproc 
9100  proc mathmul(ma,mb)
9110  pokew $DE00,ma:pokew $DE02,mb
9120  print peekd($DE10)
9130  endproc 
9150  proc mathdiv(de,nu)
9160  pokew $DE04,de:pokew $DE06,nu
9170  print peekw($DE14);" Remainder ";peekw($DE16)
9180  endproc 
9200  proc mathadd(sa,sb)
9210  poked $DE08,sa:poked $DE0C,sb
9220  print peekd($DE18)
9230  endproc 
9240  proc mathrnd(show)
9245  ?1=0
9250  poke $D6A6,1
9260  nrnd=peekw($D6A4):if show=1 then print nrnd
9270  poke $D6A6,0
9280  endproc 
9300  proc rngmathtest()
9305  cls :print 
9310  print "Operators 1,2 are generated using Foenix Random Number Generator"
9315  print :print "Integer Multiplication Test":print 
9320  print "OP1",,"OP2","BASIC RESULT","MATH COPROCESOR RESULT"
9330  for c=0 to 5
9335  rem "ISSUE: SUPERBASIC has trouble printing Big DWORD Values"
9340  repeat :mathrnd(0):ra=nrnd:mathrnd(0):rb=nrnd:until ra+rb<65536
9350  print ra,"*",rb;"=",ra*rb;"   ",:mathmul(ra,rb)
9360  next 
9370  print :print "Integer Division Test":print 
9380  print "OP1",,"OP2","BASIC RESULT","MATH COPROCESOR RESULT"
9390  for c=0 to 5
9400  repeat :mathrnd(0):ra=nrnd:mathrnd(0):rb=nrnd:until ra+rb<65536
9410  print ra,"/",rb;"=",ra/rb;"   ",:mathdiv(rb,ra)
9420  next 
9430  keywait()
9435  cls :print 
9440  print "Operators 1,2 are generated using Foenix Random Number Generator"
9450  print :print "32 Bit Addition Test":print 
9460  print "OP1",,"OP2","BASIC RESULT","MATH COPROCESOR RESULT"
9470  for c=0 to 5
9480  rem "ISSUE: SUPERBASIC has trouble printing Big DWORD Values"
9490  mathrnd(0):ra=nrnd:mathrnd(0):rb=nrnd
9500  print ra,"+",rb;"=",ra+rb;"   ",:mathadd(ra,rb)
9510  next 
9520  keywait()
9530  endproc 
9550  proc mousetest()
9560  cls :bitmap on :bitmap clear 0:pokew $D6E2,100:pokew $D6E4,100
9570  dx=0:dy=0:dz=1:lmb=0:mmb=0:rmb=0:col=1
9580  print "Paint with Left mouse button, clear with Right"
9590  print "Use scroll wheel to change color"
9600  print "Press space to end test"
9610  ?$D6E0=1:rem "Enable Visible mouse"
9620  while k<>32
9630  mdelta dx,dy,dz,lmb,mmb,rmb
9640  mouse x,y,z,lmb,rmb,mmb
9650  pokew $D6E2,peekw($D6E2)+dx:pokew $D6E4,peekw($D6E4)+dy
9660  if peekw($D6E2)>639 then pokew $D6E2,639
9670  if peekw($D6E4)>479 then pokew $D6E4,479
9680  col=(col+dz)&255:if col=0 then col=1
9690  if lmb=-1 then plot color col to peekw($D6E2)\2,peekw($D6E4)\2
9700  if rmb=-1 then bitmap clear 0
9710  k=inkey()
9720  wend 
9730  ?$D6E0=0:bitmap clear 0
9740  endproc 
9790  proc samtest()
9800  '	"BASIC doodle from Mu0n, written in Feb2025"
9810  '	"This is meant to play a scale in C major using the"
9815  '	"SAM2695 chip onboard a F256K2 or F256Jr2"
9820  '	"You may skip the machine ID detection part"
9897  '	"------------------------"
9898  '	"--------Globals---------"
9899  '	"------------------------"
9900  cls :green=0:'"approves sendind data to sam2695"
9910  '	"------------------------"
9915  '	"----------Main----------"
9920  '	"------------------------"
9930  printat(5,5,"Testing the SAM2695 onboard MIDI Chip")
9940  printat(5,10,"Playing the C major scale on MIDI channel 0")
9950  keywait()
10070 '	"------------------------"
10098 '	"-----Note Playing-------"
10099 '	"------------------------"
11000 for c=1 to 8
11010 a=mu(c):print a," ";
11020 noteon(a)
11030 delay()
11035 noteoff(a)
11050 next 
11060 keywait()
11070 endproc 
11100 '	"------------------------"
11105 '	"---hardware detection---"
11110 '	"------------------------"
11120 proc hwdetect()
11130 mid=peek($D6A7)
11140 mid=mid&$3F:'"keep only relevant bits"
11150 printat(5,7,"Machine ID detected: "+str$(mid))
11160 if mid=$02
11170 printat(5,7,"F256Jr2 detected"):green=1
11180 else 
11190 if mid=$11
11200 printat(5,7,"F256K2 detected"):green=1
11210 else 
11220 printat(5,7,"Sorry Incompatible machine detected")
11230 endif 
11240 endif 
11250 endproc 
11255 '	"------------------------"
11260 '	"--------delay-----------"
11265 '	"------------------------"
11270 proc delay()
11280 for i=0 to 2000:next 
11290 endproc 
11295 '	"------------------------"
11300 '	"------Note On-----------"
11305 '	"------------------------"
11310 proc noteon(n)
11320 poke $DDA1,$90:poke $DDA1,n:poke $DDA1,$3F:'"chn,note,speed"
11330 endproc 
11335 '	"------------------------"
11340 '	"------Note Off----------"
11345 '	"------------------------"
11350 proc noteoff(n)
11360 poke $DDA1,$80:poke $DDA1,n:poke $DDA1,$3F:'"chn,note,speed"
11370 endproc 
11390 proc testnes()
11392 ?1=0:poke $D000,3:cls :rem "Force Text mode"
11395 local d$:d$="|    ABsS"+chr$(251)+chr$(248)+chr$(249)+chr$(250)
11400 printat(5,5,"|------------|------------|------------|------------|")
11405 printat(5,6,"|    PAD 1   |    PAD2    |    PAD3    |    PAD4    |")
11410 printat(5,7,"|BUTTONS  DIR|BUTTONS  DIR|BUTTONS  DIR|BUTTONS  DIR|")
11415 printat(5,8,"|------------|------------|------------|------------|")
11420 printat(5,9,d$+d$+d$+d$+"|")
11425 printat(5,10,"|------------|------------|------------|------------|")
11430 k=0:while k<>32
11435 printat(5,20,"Test NES controls, press space to end Test")
11440 poke $D880,5:'"SNES Control"
11445 poke $D880,$81:'"Trigger SNES read"
11450 while nesrd<>$40:nesrd=peek($D880):nesrd=nesrd&$40:wend 
11455 p0=peekw($D884):p1=peekw($D886):p2=peekw($D888):p3=peekw($D88A)
11460 base2(p0):p0$=a$:base2(p1):p1$=a$:base2(p2):p2$=a$:base2(p3):p3$=a$
11465 colorat(6,9,p0$+chr$(146)+p1$+chr$(146)+p2$+chr$(146)+p3$)
11470 k=inkey()
11480 wend :cls 
11500 endproc 
11540 proc testsnes()
11542 ?1=0:poke $D000,3:cls :rem "Force Text mode"
11545 local d$:d$="|AXLRBYsS"+chr$(251)+chr$(248)+chr$(249)+chr$(250)
11550 printat(5,5,"|------------|------------|------------|------------|")
11555 printat(5,6,"|    PAD 1   |    PAD2    |    PAD3    |    PAD4    |")
11560 printat(5,7,"|BUTTONS  DIR|BUTTONS  DIR|BUTTONS  DIR|BUTTONS  DIR|")
11565 printat(5,8,"|------------|------------|------------|------------|")
11570 printat(5,9,d$+d$+d$+d$+"|")
11575 printat(5,10,"|------------|------------|------------|------------|")
11580 k=0:while k<>32
11585 printat(5,20,"Test SNES control, press space to end Test")
11590 poke $D880,5:'"SNES Control"
11595 poke $D880,$85:'"Trigger SNES read"
11600 while nesrd<>$40:nesrd=peek($D880):nesrd=nesrd&$40:wend 
11605 p0=peekw($D884):p1=peekw($D886):p2=peekw($D888):p3=peekw($D88A)
11610 base2(p0):p0$=a$:base2(p1):p1$=a$:base2(p2):p2$=a$:base2(p3):p3$=a$
11615 colorat(6,9,p0$+chr$(146)+p1$+chr$(146)+p2$+chr$(146)+p3$)
11620 k=inkey()
11630 wend :cls 
11660 endproc 
11700 proc base2(n)
11705 a$=""
11710 for c=0 to 11
11720 if n&1=1:d$=chr$(34):else :d$=chr$(38):endif 
11730 a$=d$+a$
11740 n=n\2
11750 next 
11760 endproc 
11800 proc colorat(x,y,a$)
11805 col=(?$D001)&2:if col=0 then col=1
11810 local pos:pos=x+y*80\col:?1=3:rem "Set I/O to text memory"
11820 for c=0 to len(a$)-1:?(pos+c+$C000)=asc(mid$(a$,c+1,1)):next 
11830 ?1=0
11840 endproc 
11900 proc joytest()
11902 cls :bload "bspr/foenixlogo.bspr",$30000
11903 bitmap on :bitmap clear 0:sprites on 
11905 cls :printat(5,21,"Press Space to End Test")
11910 printat(5,20,"Use Joysticks (DB9) to test")
11920 sprite 1 image 0 to 100,100:sprite 2 image 0 to 200,100
11930 posx1=100:posy1=100:posx2=200:posy2=100
11940 k=0:while k<>32
11950 processjoy()
11970 posx1=posx1+x1:posy1=posy1+y1
11980 if posx1<16 then posx1=16
11990 if posy1<16 then posy1=16
12000 if posx1>304 then posx1=304
12010 if posy1>224 then posy1=224
12020 posx2=posx2+x2:posy2=posy2+y2
12030 if posx2<16 then posx2=16
12040 if posy2<16 then posy2=16
12050 if posx2>304 then posx2=304
12060 if posy2>224 then posy2=224
12070 sprite 1 to posx1,posy1
12080 sprite 2 to posx2,posy2
12090 if b1<>0 then image 0 to posx1,posy1:b1=0
12100 if b2<>0 then image 0 to posx2-16,posy2-16:b2=0
12110 k=inkey()
12120 wend 
12130 sprites off :bitmap clear 0
12140 endproc 
12200 proc processjoy()
12210 local j:?1=0
12220 j=?($DC00):b1=0:x1=0:y1=0
12230 if j<>255
12240 if (j&1)=0 then y1=-1
12250 if (j&2)=0 then y1=1
12260 if (j&4)=0 then x1=-1
12270 if (j&8)=0 then x1=1
12280 if (j&16)=0 then b1=1
12290 else 
12300 x1=0:y1=0:b1=0
12310 endif 
12320 j=?($DC01):b2=0:x2=0:y2=0
12330 if j<>255
12340 if (j&1)=0 then y2=-1
12350 if (j&2)=0 then y2=1
12360 if (j&4)=0 then x2=-1
12370 if (j&8)=0 then x2=1
12380 if (j&16)=0 then b2=1
12390 else 
12400 x2=0:y2=0:b2=0
12410 endif 
12420 endproc 
12500 proc luttest()
12510 cls :printat(30,3,"Color LUT Tests")
12520 ?1=1:for k=0 to 255:rem "Create two more palettes"
12540 poke $D400+k*4,k
12550 poke $D401+k*4,k
12560 poke $D402+k*4,k
12580 poke $D800+k*4,0
12590 poke $D801+k*4,k
12600 poke $D802+k*4,0
12630 next 
12650 ?1=0:bitmap on :bitmap clear 0
12660 for y=0 to 15
12670 for x=0 to 15
12700 rect solid color (x+16*y) from 80+x*10,20+y*10 to (80+x*10+10),(20+y*10+10)
12710 next 
12720 next 
12725 printat(21,47,"Press any key to change LUT palette")
12730 printat(25,48,"Press Space to Quit Test")
12745 k=0:while k<>32
12750 k=0:while k=0:k=inkey():wend :if k=32 then goto 12840
12760 poke $D100,3
12780 k=0:while k=0:k=inkey():wend :if k=32 then goto 12840
12790 poke $D100,5
12800 k=0:while k=0:k=inkey():wend :if k=32 then goto 12840
12810 poke $D100,7
12820 k=0:while k=0:k=inkey():wend :if k=32 then goto 12840
12830 poke $D100,1
12840 wend 
12845 ?1=0:bitmap clear 0
12850 endproc 
12900 proc tile16()
12910 rem "set tileset1 graphics address"
12915 poke $D000,63:?$D003=5:rem "activate layer 2 as tile2"
12920 pokel $D284,$40000:rem "poke $D284,$40000"
12930 poke $D20C,1:rem "Enable tile layer 2 as 16x16"
12940 pokel $D20D,$50000:rem "Set tilemap2 address"
12950 poke $D210,25:rem "Tile X size 2"
12960 poke $D212,21:rem "Tile Y size 1"
12970 memcopy $40000,256 poke random(256)+1:rem "Fill tile with white"
12980 memcopy $40100,256 poke 0:rem "Fill 2nd Tile transparent"
12990 memcopy $50000,2048 poke 0
12995 c=0:while c<840
13000 xpoke($50000+c,0):xpoke($50001+c,1)
13010 xpoke($50002+c,1):xpoke($50003+c,1)
13030 c=c+4
13040 wend 
13050 rem "activate bitmap & 2 tile layers"
13060 poke $D002,0+4*16:rem "activate bitmap & tile layer 1"
13070 endproc 
13100 proc playvgm(vgm$)
13105 cls :printat(5,20,"Playing Lemmings Sample using OPL3")
13110 samples=0:sndmem=$7A00:peekvalue=alloc(1)
13120 bload vgm$,$7A00
13125 i=0:endplay=0:while endplay=0
13126 cmd=peek(sndmem+i)
13130 if cmd=$5A
13140 i=i+1:addr=peek(sndmem+i)
13150 i=i+1:dat=peek(sndmem+i)
13160 poke $D580,addr
13170 poke $D581,dat
13180 goto 13410
13190 endif 
13200 if cmd=$66
13210 print "Done playing"
13220 endplay=1
13230 endif 
13240 waitdone=timer()
13250 if cmd=$61
13260 i=i+1:lsb=peek(sndmem+i)
13270 i=i+1:msb=peek(sndmem+i)
13280 delay=256*msb+lsb
13290 endif 
13300 if cmd=$62
13310 delay=735
13320 endif 
13330 if cmd=$63
13340 delay=882
13350 endif 
13360 if cmd>=$70 and cmd<=$7F:delay=cmd-$70:endif 
13370 samples=samples+delay
13380 waitdone=waitdone+delay\630
13390 repeat :until timer()>=waitdone
13400 samples=samples-samples\630*630
13410 i=i+1:wend 
13420 keywait():cls 
13430 endproc 
13500 proc testvs1053()
13510 cls :printat(5,5,"Testing the VS1053b onboard Chip")
13520 printat(5,10,"Playing the C major scale on MIDI channel 0")
13530 keywait()
13540 boostvsclock()
13550 for i=1 to 8
13560 a=mu(i):print a," ";
13570 noteonvs(a)
13580 delay()
13590 noteoffvs(a)
13600 next 
13610 keywait()
13620 endproc 
13700 proc vsplugin()
13710 for j=1 to 3
13720 read ady,n
13730 for k=1 to n
13740 read valhi,vallo
13750 writetosci(ady,valhi,vallo)
13760 next 
13770 next 
13780 endproc 
13800 proc noteonvs(n)
13810 poke $DDB1,$90:poke $DDB1,n:poke $DDB1,$4F:'"chn,note,speed"
13820 endproc 
13850 proc noteoffvs(n)
13860 poke $DDB1,$80:poke $DDB1,n:poke $DDB1,$5F:'"chn,note,speed"
13870 endproc 
13900 proc writetosci(a,hv,lv)
13910 poke $D701,a
13920 poke $D702,lv
13930 poke $D703,hv
13940 poke $D700,1
13950 poke $D700,0
13960 endproc 
14000 proc boostvsclock()
14010 poke $D701,3
14020 poke $D702,$00
14025 poke $D703,$A0
14040 poke $D700,1
14050 poke $D700,0
14060 delay()
14070 endproc 
14100 proc switchcodec()
14110 if codec=1
14120 initcodec2()
14130 else 
14140 initcodec()
14150 endif 
14160 endproc 
20000 proc xpoke(addr,value)
20010 local block:block=addr\8192:local prevblock
20020 local offset:offset=addr%8192
20030 ?0=179:prevblock=?$E:?$E=block:?1=4
20040 ?($C000+offset)=value
20050 ?1=0:?$E=prevblock
20060 endproc 
20100 proc loadfont(a$,slot)
20110 try bload "fonts/"+a$+".font",$7800 to ec
20115 if ec=0
20120 ?1=1
20130 for c=0 to 2047
20140 ?($C000+($800*slot)+c)=?($7800+c)
20150 next 
20160 ?1=0
20170 else cls :print "Font fonts/"+a$+".font not found!"
20180 endif 
20190 endproc 
29999 rem "MUSIC DATA"
30000 data $30,$32,$34,$35,$37,$39,$3B,$3C
30002 rem "TILE DATA"
30005 data 00,00,00,00,00,00,00,00
30010 data 00,07,07,07,07,07,00,00
30020 data 00,07,05,05,02,00,00,00
30030 data 00,07,05,05,05,00,00,00
30040 data 00,07,02,05,05,05,00,00
30050 data 00,07,00,03,05,05,05,00
30060 data 00,00,00,00,03,05,05,03
30070 data 00,00,00,00,00,03,03,03
30080 rem "VS1053b data for realtime midi plugin mode enabling"
30090 data $07,$01,$80,$50,$06,$14,$00,$30,$07,$15,$B0,$80
30100 data $34,$00,$00,$07,$92,$55,$3D,$00,$00,$24,$00,$30,$02,$95,$68,$90
30110 data $34,$00,$00,$30,$04,$95,$3D,$00,$00,$24,$29,$08,$4D,$40,$00,$30
30120 data $02,$00,$0A,$01,$00,$50