10 REMark QL I2C Analogue input/output demo
20 REMark By Simon N Goodwin, November 93
30 :
100 REPLAY "flp1_Dwayne"
110 REPLAY "Flp1_Fanfare"
120 REPLAY "flp1_Dalek"
130 REPLAY "flp1_ThisPlanet"
140 REPLAY "flp1_Marvelous_QL"
150 REPLAY "flp1_Weird"
155 JOYSTICK
160 :
170 DEFine PROCedure JOYSTICK
175 CLS
177 PRINT " Move the block with an analogue joystick"
180 x=100 : y=100 : OVER -1
190 BLOCK 10,10,x,y,2
200 REPeat scan
210   k$=READ_adc$(1)
220   IF k$="" : BEEP 1000,10:NEXT scan
230   BLOCK 10,10,x,y,2 : ox=x : oy=y
240   x=CODE(k$(1)) : y=CODE(k$(2))
250   PRINT #0,x,y
260   IF x<100 : x=ox
270   IF y<100 : y=oy
280   BLOCK 10,10,x,y,2
290 END REPeat scan
300 END DEFine JOYSTICK
310 :
320 DEFine PROCedure REPLAY(n$)
325 REMark replays samples up to about 32K long
327 REMark from disk onto DAC channel 1
330 LOCal k$,t
340 OPEN_IN #3,n$
350 k$=INPUT$(#3,FLEN(#3))
360 CLOSE #3
370 t=WRITE_adc%(1,k$)
380 END DEFine
390 :
400 DEFine PROCedure CONVERT_IFF
405 REMark Early source for CONVERTER_TASK
410 REMark Converts AMIGA signed byte IFF samples
420 REMark to I2C unsigned format; uses Turbo TK
430 OPEN_IN #3,ram1_Marvelous
440 HUNK name$,size
450 IF INPUT$(#3,4)="8SVX"
460 REPeat scan
470   HUNK name$,size
480   IF name$="BODY"
490     CONVERT size : EXIT scan
500   ELSE
510     REMark Skip this hunk
520     SET_POSITION #3,POSITION(#3)+size+(size MOD 2)
530     IF EOF(#3)
540       PRINT #0;"No sample body found." : EXIT scan
550     END IF
560   END IF
570 END REPeat scan
580 ELSE
590   PRINT #0;"Sample is not in IFF 8SVX format."
600 END IF
610 CLOSE #3
620 END DEFine CONVERT_IFF
630 :
640 REFERENCE k$,k
650 DEFine PROCedure HUNK(k$,k)
660 k$=INPUT$(#3,4)
670 PRINT "Hunk name = ";k$
680 k=0 : FOR i%=1 TO 4:k=k*256+CODE(INKEY$(#3,-1))
690 PRINT "Hunk size = ";k
700 END DEFine HUNK
710 :
720 DEFine PROCedure CONVERT(bytes)
730 LOCal i%,k%
740 k$=""
750 FOR i%=1 TO bytes
760   k%=CODE(INKEY$(#3,-1))
770   IF k%>127 : k%=k%-128 : ELSE k%=k%+128
780   k$=k$ & CHR$(k%)
790 END FOR i%
800 END DEFine CONVERT
810 :
820 REMark samples on ports 0..3 as a string, or null string on error
830 REMark $$external
840 DEFine FuNction READ_adc$(address):LOCal addr%,a$
850  addr%=test_adc_addr%(address):IF addr%<0:RETurn ''
860  a$=I2C_IO(CHR$(160)&CHR$(4)&CHR$(1)&CHR$(178)&CHR$(3)&CHR$(156)&CHR$(255),5,addr%,1)
870  REMark 160 is send START+device, write from control (length 1 is preset), no STOP
880  REMark first 4 is the ADC control to select mode of operation
890 REMark 1 will be the first acknowledged byte count
900  REMark 178 is send START+device, read 1 acknowleged byte to register - ie lose duff old sample.
910  REMark 3 will be the acknowledged read byte count
920  REMark 156 is read 3 acknowledged bytes to buffer, read one more byte to buffer without acknowledge, send STOP
930  REMark 255 is standard finish
940  RETurn a$:END DEFine
950 :
960 REMark non-zero error code on error
970 REMark $$external
980 DEFine FuNction WRITE_adc%(address,x$):LOCal addr%
990  addr%=test_adc_addr%(address):IF addr%<0:RETurn addr%
1000  RETurn CODE(I2C_IO(CHR$(160)&CHR$(68)&x$&CHR$(255),0,addr%,x$(0)+1))
1010  REMark 160 is send START+device, write from control buffer (length LEN(x$)+1 is preset)
1020  REMark 68 is the ADC control byte
1030  REMark x$ is the string itself
1040  REMark 255 is the standard finish
1050  END DEFine
1060 :
1070 DEFine FuNction test_adc_addr%(a):RETurn test_addr%(a,72):END DEFine
1080 :
1090 DEFine FuNction test_addr%(a,m%):LOCal a%:IF isnum%(a)
1100   IF NOT inrange%(0,a,127):RETurn -4:REMark out of range
1110   IF INT(a)=a
1120    a%=a&&-8:SELect a%=0,m%:RETurn m%||a:REMark OK
1130    RETurn -7:REMark not found
1140    END IF :END IF :RETurn -15:END DEFine
1150 REMark ret non-zero if parameter is not valid floating point
1160 DEFine FuNction isnum%(p):LOCal a$,b$,e$,lp,i%:a$=p:REMark only unset will cause a problem
1170  IF a$(0)>1:IF a$(1)INSTR'+-':a$=a$(2TO):REMark accept sign+sommat
1180  e$='0':i%='e'INSTR a$:SELect i%=2TO a$(0)-2:e$=a$(i%+1TO):a$=a$(1TO i%-1):IF e$(0)>1:IF e$(1)INSTR'+-':e$=e$(2TO):REMark accept sensible, optionally signed exponent
1190  b$='0':IF a$(0)>1:i%='.'INSTR a$:SELect i%=1:b$=a$(2TO):a$='0':=a$(0):a$=a$(1TO a$(0)-1):=1TO a$(0):b$=a$(i%+1TO):a$=a$(1TO i%-1):REMark accept mantissa with sensible, optional decimal point
1200  a$=a$&b$&e$:REMark recombine parts
1210  FOR i%=1TO a$(0):IF (CODE(a$(i%))-48)DIV 10:RETurn 0:REMark reject any non-digits left
1220  RETurn e$<550AND a$(0):END DEFine :REMark not being too pedantic about huge exponents
1230 :
1240 DEFine FuNction inrange%(scan,v,h):RETurn scan<=v AND v<=h:END DEFine
