1000 ' ********* Waveform generation program **********************
1100 '
1200 ' File structure is 'n' bytes, with byte #0,1 as-
1300 ' block size (MSB,LSB). All folowing bytes are data-
1400 ' with 0-255 all valid D/A outputs.
1500 '
1600 '****************** mainline ****************************
1700 '
1800 GOSUB 6600 'setup data
1900 GOSUB 34900 'open gsx and clear
2000 GOSUB 41700 'define screen strings
2100 PRINT clear$ : PRINT "                "+ulon$;
2200 PRINT "Program to generate waveform functions. 'GEN' v1.2."+normal$
2300 '
2400 GOSUB 7700 'draw grid
2500 ' ---- warm menu return ----
2600 amax=MAX(ptr,amax)
2700 GOSUB 24400 'show pointer
2800 '
2900 '
3000 GOSUB 5000 'menu
3100 GOSUB 35400 'cursor on
3110 row=28 : col=0 : GOSUB 43000 'posn curs
3111 PRINT "Enter option:";
3200 a$=UPPER$(INKEY$) : IF a$="" THEN 3200 'get user
3300 '
3400 IF a$="S" THEN GOSUB 12300 : GOTO 4600 'sine
3500 IF a$="R" THEN GOSUB 15500 : GOTO 4600 'random
3600 IF a$="D" THEN GOSUB 17400 : GOTO 4600 'DC level
3700 IF a$="P" THEN GOSUB  25000 : GOTO 2700 'plot / pointer
3800 IF a$="C" THEN GOSUB 20100 : GOTO 4600 'copy
3900 IF a$="W" THEN GOSUB 21400 : GOTO 4600 'write to file
4000 IF a$="L" THEN GOSUB 22600 : GOTO 4600 'load from file
4100 IF a$="Q" THEN GOSUB 13900 : GOTO 4600 'square wave
4200 IF a$="A" THEN GOSUB 19000 : GOTO 4600 'line function
4300 '
4400 'task complete, loop back
4500 '
4600 PRINT bell$ : GOTO 2500
4700 '
4800 '
4900 '
5000 '-------------------- menu --------------------------
5100 '
5200 GOSUB 28600 'era & posn
5300 PRINT "Sine wave...............S"
5400 PRINT "Square / Pulse..........Q"
5500 PRINT "Random..................R"
5600 PRINT "DC level................D"
5700 PRINT "Line function...........A"
5800 PRINT "Copy samples............C"
5900 row=irow : col=50 : GOSUB 43000
6000 PRINT "Plot / pointer..........P"
6100 GOSUB 6400 : PRINT "Write to file...........W"
6200 GOSUB 6400 : PRINT "Load from file..........L"
6300 RETURN
6400 row=row+1 : GOTO 43000
6500 '
6600 '----------------- setup data -----------------------
6700 '
6800 store=5000 : DIM wav%(store) 'setup array
6900 amax=0 : ptr=0 'array markers
7000 bmid=20464 : bsize=50*255 : bpos=bmid-bsize/2
7100 bleft=2000 : bright=30000 'array aspects
7200 twopi=2*3.14159
7300 midst=127.5 : ystep=2/255 'array factors 0-1 to 0-255
7400 irow=20 'i/p data posn
7500 RETURN
7600 '
7700 '-------------- draw plotting grid -----------------------
7800 '
7900 ' grid is plotted with annotation. Enter with 'lptr' and-
8000 ' 'rptr' set to array span.
8100 '
8200 row=4 : col=0 : GOSUB 43000 : FOR a=1 TO 16 : PRINT dline$ : NEXT
8300 lly=bpos : llx=bleft : trx=bright : try=lly+bsize
8400 GOSUB 35200 'draw box
8500 a=3 : GOSUB 35000 ' dotted line
8600 lly=bmid : try=lly : GOSUB 35100 'up middle
8700 llx=0 : a$="0" : GOSUB 35300 'annotate
8800 lly=bpos+bsize : a$="+1.0" : GOSUB 35300
8900 lly=bpos : a$="-1.0" : GOSUB 35300
9000 llx=bright+500 : lly=bpos : a$="0" : GOSUB 35300
9100 lly=bmid : a$="(128)" : GOSUB 35300
9200 lly=bpos+bsize : a$="(256)" : GOSUB 35300
9300 GOTO 9700 'margins
9400 '
9500 '----------------- annotate margins --------------------
9600 '
9700 llx=bleft-500 : lly=bpos-1500 : a$=STR$(lptr) : GOSUB 35300
9800 llx=bright : a$=STR$(rptr) : GOSUB 35300
9900 RETURN
10000 '
10100 '------------- plot array into grid ---------------------
10200 '
10300 ' Enter 'lptr' and 'rptr' set to array start / end.
10400 '
10500 GOSUB 11100 'init plot
10600 FOR a=lptr TO rptr
10700 GOSUB 11700 'plot point
10800 NEXT a
10900 RETURN
11000 '
11100 '--------------- init for plot ------------------------
11200 '
11300 a=1 : GOSUB 35000 'line type
11400 llx=bleft : lly=bmid ' 1st point
11500 plt=lptr : xfac=(bright-bleft)/(rptr-lptr) : RETURN 'x scale
11600 '
11700 ' ------------- plot this point ------------------------
11800 '
11900 trx=bleft+(plt-lptr)*xfac : try=bmid+((bsize/255)*(wav%(plt)-midst))
12000 GOSUB 35100 'draw line
12100 llx=trx : lly=try : plt=plt+1 : RETURN
12200 '
12300 ' ------------- sine wave generation ---------------------
12400 '
12500 type$="Sine" : want$="ABEFGH" : GOSUB 29200 'get data
12600 lptr=ptr : rptr=size*cycles+ptr-1 'array limits for plot
12700 GOSUB 7700 'draw grid
12800 GOSUB 11100 'init for plot
12900 nth=ptr-lptr 'sample
13000 w=SIN(twopi*((nth/(size))+phase/360)) 'basic waveform
13100 s=1 'default no attack / decay
13200 IF NOT adf=0 THEN a=EXP(-nth/(envtc*size))
13300 IF adf=-1 THEN s=a 'decay
13400 IF adf=1 THEN s=1-a 'attack
13500 b=bias+(peak*w*s)
13600 GOSUB 26700 'array,plot
13700 IF ptr>rptr THEN RETURN ELSE 12900
13800 '
13900 ' ------------- square wave generation ---------------------
14000 '
14100 type$="Square" : want$="AKH" : GOSUB 29200 'get data
14200 lptr=ptr : rptr=(fsamp+ssamp)*cycles+ptr-1 'array limits for plot
14300 GOSUB 7700 'draw grid
14400 GOSUB 11100 'init for plot
14500 nth=ptr-lptr 'nth sample
14600 IF 1+(nth MOD (fsamp+ssamp)) > fsamp THEN w=flevel ELSE w=slevel
14700 s=1 'default no attack / decay
14800 IF NOT adf=0 THEN a=EXP(-nth/(envtc*size))
14900 IF adf=-1 THEN s=a 'decay
15000 IF adf=1 THEN s=1-a 'attack
15100 b=bias+w*s
15200 GOSUB 26700 'array,plot
15300 IF ptr>rptr THEN  RETURN ELSE 14500
15400 '
15500 '---------------- random generate ------------
15600 '
15700 type$="Random" : want$="CEFI" : GOSUB 29200 'get data
15800 lptr=ptr : rptr=size+ptr-1 'array limits for plot
15900 GOSUB 7700 'draw grid
16000 GOSUB 11100 'init for plot
16100 nth=ptr-lptr 'sample
16200 w=2*(RND-0.5)
16300 s=1 'default no attack / decay
16400 IF NOT adf=0 THEN a=EXP(-nth/envtc)
16500 IF adf=-1 THEN s=a 'decay
16600 IF adf=1 THEN s=1-a 'attack
16700 b=bias+(peak*w*s)
16800 GOSUB 26700 'array,plot
16900 IF ptr>rptr THEN RETURN ELSE 16100
17000 '
17100 '
17200 '------------------ DC level -----------------------
17300 '
17400 type$="DC level" : want$="CEFI" : GOSUB 29200 'get data
17500 lptr=ptr : rptr=size+ptr-1 'array limits for plot
17600 GOSUB 7700 'draw grid
17700 GOSUB 11100 'init for plot
17800 nth=ptr-lptr 'sample
17900 w=1
18000 s=1 'default no attack / decay
18100 IF NOT adf=0 THEN a=EXP(-nth/envtc)
18200 IF adf=-1 THEN s=a 'decay
18300 IF adf=1 THEN s=1-a 'attack
18400 b=bias+(peak*w*s)
18500 GOSUB 26700 'array,plot
18600 IF ptr>rptr THEN RETURN ELSE 17800
18700 '
18800 '
18900 '
19000 '------------------ Line function -----------------------
19100 '
19200 type$="Line function" : want$="CL" : GOSUB 29200 'get data
19300 lptr=ptr : rptr=size+ptr-1 'array limits for plot
19305 IF ptr=0 THEN j=0 : GOTO 19320
19310 j=(wav%(ptr-1)-midst)*ystep 'pull startpoint value
19320 k=slevel 'endpoint value
19400 GOSUB 7700 'draw grid
19500 GOSUB 11100 'init for plot
19600 nth=ptr-lptr 'sample
19700 b=j+(((k-j)*(nth+1))/(rptr-lptr+1)) 'interpolate
19800 GOSUB 26700 'array,plot
19900 IF ptr>rptr THEN RETURN ELSE 19600
20000 '
20100 '--------------------- Copy samples ----------------------
20200 '
20300 type$="Copy samples" : want$="AJ" : GOSUB 29200 'get data
20400 lptr=ptr : rptr=cycles*(1+ends-start)+ptr-1 'array limits for plot
20500 GOSUB 7700 'draw grid
20600 GOSUB 11100 'init for plot
20700 FOR w=1 TO cycles
20800 FOR c=start TO ends
20900 b=(wav%(c)-midst)*ystep 'pull out existing val
21000 GOSUB 26700 'array,plot
21100 NEXT : NEXT : RETURN
21200 '
21300 '
21400 '---------------- Write array to file. --------------------
21500 '
21600 GOSUB 28600 'clear window
21700 b=amax+1 'max byte to write
21800 INPUT "Enter file name: ";filename$
21900 filename$=filename$+".WAV"
22000 OPEN "O",1,filename$
22100 PRINT #1;CHR$(INT(b/256))+CHR$(b MOD 256); 'block size
22200 FOR a=0 TO b-1
22300 PRINT #1;CHR$(wav%(a)); : NEXT
22400 CLOSE #1 : RETURN
22500 '
22600 '------------- Read file to array---------------------.
22700 '
22800 GOSUB 28600 'clear window
22900 INPUT "Enter file name: ";filename$
23000 ptr=0
23100 filename$=filename$+".WAV"
23200 OPEN "R",1,filename$
23300 GET 1 '1st record
23400  a=ASC(INPUT$ (1,#1)) : b=ASC(INPUT$(1,#1)) : size=256*a+b 'pull size
23500 lptr=0 : rptr=size-1
23600 GOSUB 7700 : GOSUB 11100 'init for plot
23700 c=3 : j=1 
23800 b=ASC(INPUT$ (1,#1))-bias
23900 wav%(ptr)=b : GOSUB 11700 : ptr=ptr+1
24000 c=c+1 : IF c=128 THEN c=1 : GET 1 'subseq recs
24100 j=j+1 : IF j<=size THEN  23800
24200 CLOSE #1  : RETURN 
24300 '
24400 ' --------------- show pointer ----------------------
24500 '
24600 row=3 : col=0 : GOSUB 43000 'curs
24700 PRINT "Current array pointer is: "+dline$; ptr ;", used: "; amax
24800 RETURN
24900 '
25000 '-------------- pointer operation --------------------
25100 '
25200 GOSUB 28600 'erase window
25300 PRINT "Draw entire array.................A"
25400 PRINT "Draw between specified margins....M"
25500 PRINT "Re-define pointer.................R"
25600 a$=UPPER$(INKEY$) : IF a$="" THEN 25600
25700 IF a$="A" THEN lptr=0 : rptr=amax-1 : GOTO 26200
25800 IF a$="M" THEN GOSUB 26400 : GOTO 26200
25900 IF a$="R" THEN GOSUB 26500 : RETURN 'redefine ptr
26000 RETURN
26100 '
26200 GOSUB 7700 : GOSUB 10100 : RETURN 'do plot
26300 '
26400 GOSUB 28600 : INPUT "Enter margins (L,R) : ";lptr,rptr : RETURN
26500 GOSUB 28600 : INPUT "Enter new pointer : ";ptr : RETURN
26600 '
26700 '--------- calculated point to array and grid --------
26800 '
26900 ' Enter b=-1 to +1 calculated
27000 ' - 'app' controls array load.
27100 '
27200 ON app GOSUB 27400,27500,27600,27700,27800
27300 ptr=ptr+1 : RETURN
27400 GOTO 28000 'overwrite
27500 a=(wav%(ptr)-midst)*ystep : b=b+a : GOTO 28000 'add to array
27600 a=(wav%(ptr)-midst)*ystep :  b=b*a : GOTO 28000 'mult with array
27700 a=(wav%(ptr)-midst)*ystep : b=a-b : GOTO 28000 'sub from array
27800 a=(wav%(ptr)-midst)*ystep : b=b/a : GOTO 28000 'div by array
27900 '
28000 ' enter 'b' -1 to +1 for upscale and clip to array
28100 b=INT(midst+b*255/2)
28200 IF b>255 THEN b=255 
28300 IF b<0 THEN b=0
28400 wav%(ptr)=b : GOTO 11700 ' plot
28500 '
28600 '------------ clear text window and posn curs ---------
28700 '
28800 row=irow : col=0 : GOSUB 43000
28900 FOR a=row TO 29 : PRINT dline$ : NEXT
29000 row=irow : GOTO 43000 'curs at start
29100 '
29200 ' ******************* data entry *********************
29300 '
29400 ' On entry, string 'want$' is set to chrs where:
29500 ' - A to Z inc call one input parameter as required-
29600 ' - in order.
29700 ' type$ contains name of waveform.
29800 '
29900 GOSUB 35400 'curs on
30000 GOSUB 28600 'erase window
30100 PRINT ulon$+"Entering data for:"+normal$+" "+type$ : PRINT
30200 '
30300 FOR a=1 TO LEN(want$)
30400 b$=MID$(want$,a,1) : b=ASC(b$)-64 'calc input variable
30500 IF b<7 THEN ON b GOSUB 31000,31100,31200,31300,31400,31500 : GOTO 30700
30600 IF b<13 THEN ON b-6 GOSUB 31600,31800,31800,32400,32700,33110 : GOTO 30700
30700 NEXT
30800 GOSUB 33200 : RETURN
30900 '
31000 INPUT "Number of cycles:.....................";cycles : RETURN
31100 INPUT "Number of samples per cycle:..........";size : RETURN
31200 INPUT "Total number of samples:..............";size : RETURN
31300 INPUT "Duty cycle (% high):..................";duty : RETURN
31400 INPUT "Bias level:...........................";bias : RETURN
31500 INPUT "Peak level:...........................";peak : RETURN
31600 INPUT "Phase angle at start (degrees)........";phase : RETURN
31700 '
31800 INPUT "Attack (1), decay (-1), or level (0): ";adf
31900 IF adf=0 THEN RETURN
32000 IF b$="I" THEN 32200
32100 INPUT "Envelope time constant in cycles:.....";envtc : RETURN
32200 INPUT "Envelope time constant in samples:....";envtc : RETURN
32300 '
32400 INPUT "Copy from sample number...............";start
32500 INPUT " - to sample number...................";ends : RETURN
32600 '
32700 INPUT "First level.........................";flevel
32800 INPUT " - for number of samples............";fsamp
32900 INPUT "Second level........................";slevel
33000 INPUT " - for number of samples............";ssamp : RETURN
33100 '
33110 INPUT "Enter line endpoint value.............";slevel : RETURN
33112 '
33200 row=irow : col=50 : GOSUB 43000 'posn curs
33300 PRINT ulon$+"Data application to array:"+normal$
33400 row=row+1
33500 GOSUB 34300 : PRINT "Overwrite into array..1"
33600 GOSUB 34300 : PRINT "Add to array..........2"
33700 GOSUB 34300 : PRINT "Multiply with array...3"
33800 GOSUB 34300 : PRINT "Subtract from array...4"
33900 GOSUB 34300 : PRINT "Divide by array.......5"
34000 GOSUB 34300 : GOSUB 34300 : INPUT app
34100 RETURN
34200 '
34300 row=row+1 : col=50 : GOTO 43000 'cursor
34400 '
34500 '******************** GSX ROUTINES *********************
34600 '
34700 '------------- GSX jump table ---------------
34800 '
34900 GOTO 35900 ' open GSX
35000 GOTO 36400 'a=line type
35100 GOTO 36700 'draw line
35200 GOTO 37100 'draw box
35300 GOTO 37600 'write text
35400 GOTO 36100 'cursor on at end
35500 '
35600 '--------------------------------------------
35700 '
35800 'init gsx, open workstation
35900 GOSUB 40600 : GOSUB 38500 : GOTO 39100
36000 '
36100 'enable cursor after GSX
36200 PRINT CHR$(27)+"e"; : RETURN
36300 '
36400 'set line type
36500 contrl%(1)=15 : intin%(1)=a : GOTO 40300 'one param 
36600 '
36700 'draw a line
36800 contrl%(1)=6 : contrl%(2)=2 : contrl%(6)=1
36900 GOTO 37300 'then as for box
37000 '
37100 'draw a box
37200 contrl%(1)=11 : contrl%(2)=2 : contrl%(6)=1
37300 ptsin%(1)=llx : ptsin%(2)=lly : ptsin%(3)=trx : ptsin%(4)=try 
37400 GOSUB 40000 : RETURN
37500 '
37600 'write text at specified position
37700 IF LEN(a$)=0 THEN STOP
37800 contrl%(1)=8 : contrl%(2)=1 : contrl%(4)=LEN(a$)
37900 ptsin%(1)=llx : ptsin%(2)=lly
38000 FOR x=1 TO LEN(a$)
38100 intin%(x)=ASC(MID$(a$,x,1)) 'put message characters into intin array
38200 NEXT
38300 GOSUB 40000 : RETURN
38400 '
38500 'Define arrays and address of "jump" to GSX
38600 gsx%=&H30
38700 DIM contrl%(6),ptsin%(64),ptsout%(12),intin%(64),intout%(45)
38800 RETURN
38900 '
39000 ' open workstation
39100 contrl%(1)=1 : contrl%(2)=0 : contrl%(4)=10
39200 RESTORE 39400 : FOR i=1 TO 10 : READ intin%(i) : NEXT
39300 GOTO 40000
39400 DATA 1,1,1,1,1,1,1,0,1,1
39500 '
39600 'close workstation
39700 contrl%(1)=2 : contrl%(2)=0 : contrl%(4)=0 : GOTO 40000
39800 '
39900 'Call of GSX
40000 CALL gsx%(gsx%,gsx%,contrl%(1),intin%(1),ptsin%(1),intout%(1),ptsout%(1))
40100 RETURN
40200 '
40300 'call of GSX with one INTIN parameter only
40400 contrl%(2)=0 : contrl%(4)=1 : GOTO 40000
40500 '
40600 'prepare GSX jump in m/c code
40700 gsx%=&H30
40800 POKE gsx%+0,&H50 'ld d,b	copy BC to DE
40900 POKE gsx%+1,&H59 'ld e,c
41000 POKE gsx%+2,&HE 'ld c,115	GSX function call
41100 POKE gsx%+3,115
41200 POKE gsx%+4,&HC3 'jp &H0005	jump to the BDOS
41300 POKE gsx%+5,&H5
41400 POKE gsx%+6,&H0
41500 RETURN
41600 '
41700 ' **************** Screen control  ************************
41800 '
41900 ' This section contains strings for easy  8256 screen handling.
42000 '
42100 escape$=CHR$(27)
42200 home$=escape$+"H"
42300 clear$=escape$+"E"+home$
42400 invideo$=escape$+"p"
42500 normal$=escape$+"q"+escape$+"u"
42600 ulon$=escape$+"r"
42700 dline$=escape$+"K" 'delete line
42800 RETURN
42900 '
43000 ' --------- set cursor to defined position. --------------
43100 '
43200 ' Enter with:	row set to required row,
43300 '		col set to required column.
43400 '
43500 PRINT escape$+"Y"+CHR$(32+row)+CHR$(32+col);
43600 RETURN
43700 '