Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / HAMRADIO / MCODE.ZIP / CPO.BAS next >

Wrap

BASIC Source File | 1986-10-28 | 16.3 KB | 407 lines

10 CLS:KEY OFF 20 FALSE=0:TRUE=NOT FALSE 30 DEFINT I-L 40 ' 50 '********** DEFINE ARRAYS ********** 60 ' 70 DIM B$(100) 'B$ = LIST OF CHARACTERS TO BE GENERATED 80 DIM C$(100) 'C$ = MORSE LOOKUP TABLE INDEX 90 DIM D$(100) 'D$ = MORSE LOOKUP TABLE OUTPUT 100 DIM M$(10) 'M$ = GROUP PASSED TO THE CODE GENERATOR 110 DIM IMAGE$(5) 'IMAGE$ = LAST 5 GROUPS SENT 120 ' 130 '********** DEFINE MORSE CONVERSION TABLE ********** 140 ' FIND THE CHARACTER YOU WANT IN C$ AND LOOK UP THE 150 ' CORRESPONDING DITTY DAHS AT THE SAME POSITION IN D$ 160 ' 170 C$ = " -4VUAT :7BSIE ? ZD , WM .! K * $FRN " 180 C$ = C$ + CHR$ (34) + "/ ;#C " 190 D$ = " -....- ---... ..--.. --..-- .-.-.- .-... ...-. .-..-. -.-.-. " 200 C$ = C$ + " '9 G ( Q 3 2JO 1 0 Y X P L " 210 D$ = D$ + " .----. -.--.- ...-- ..--- .---- ----- -.-- -..- .--. .-.. " 220 C$ = C$ + " @% = 5H 6 8 " 230 D$ = D$ + " -...-.- -...- ..... -.... ---.. " 240 ' 250 '********** DEFINE VARIABLES ********** 260 ' 270 'BD NUMBER OF CHARS IN B$ 280 'D1 CODE GEN DIT TIME 290 'D2 CODE GEN 1/3 CHARACTER SPACE TIME 300 'F1 SIDETONE PITCH, INITIALIZE TO 750 Hz 310 'LMIN MINIMUM NUMBER OF CHARACTERS IN A GROUP 320 'LMAX MAXIMUM NUMBER OF CHARACTERS IN A GROUP 330 'LPC NUMBER OF GROUPS SENT TO THE PRINTER SINCE LAST C.R. 340 'LPF PRINTER ON/OFF FLAG 350 'L1 LENGTH OF M$ 360 'NEWTIME CURRENT MINUTES FROM CLOCK 370 'OLDTIME PREVIOUS MINUTES FROM CLOCK 380 'PASS NUMBER OF MINUTES TO SEND BEFORE GOING TO NEXT SPEED 390 'P1 POSITION OF CURRENT CHARACTER IN C$ 400 'S1 CHARACTER RATE - DEFINES DIT/DAH LENGTH 410 'S2 SPEED - DEFINES SPACING BETWEEN CHARACTERS 420 'S3 END SPEED - SPEED INCREASES TO THIS VALUE AND HOLDS 430 'TIMER MINUTES COUNTER 440 ' 450 ' 460 '********** DEFINE INTERRUPT KEYS ********** 470 ' 480 ON KEY(1) GOSUB 1730 'F1 DECREASES RATE 490 ON KEY(2) GOSUB 1870 'F2 INCREASES RATE 500 ON KEY(11) GOSUB 1650 'UP INCREASES PITCH 510 ON KEY(14) GOSUB 1570 'DOWN DECREASES PITCH 520 ON KEY(13) GOSUB 2290 'RIGHT INCREASES SPEED 530 ON KEY(12) GOSUB 2180 'LEFT DECREASES SPEED 540 ' 550 '********** JUMP TO MAIN ********** 560 ' 570 GOTO 2620 580 ' 590 ' ********************************* 600 ' ********** SUBROUTINES ********** 610 ' ********************************* 620 ' 630 '********** EI: ENABLES INTERRUPT KEYS ********** 640 ' 650 KEY(1) ON 660 KEY(2) ON 670 KEY(11) ON 680 KEY(12) ON 690 KEY(13) ON 700 KEY(14) ON 710 RETURN 720 ' 730 '*********** DI: DISABLES INTERRUPT KEYS ********** 740 ' 750 KEY(1) OFF 760 KEY(2) OFF 770 KEY(11) OFF 780 KEY(12) OFF 790 KEY(13) OFF 800 KEY(14) OFF 810 RETURN 820 ' 830 '***** CHARS: BUILDS BUFFER OF CHARACTERS TO BE SENT 840 ' 850 CLS 860 IF BD<>0 THEN 920 870 PRINT"Type in a list of characters to send in UPPER CASE ONLY please" 880 PRINT" To send all characters, type ALL" 890 PRINT" Use ; for comma" 900 PRINT" Use = for double dash (dah di di di dah) 910 PRINT: GOTO 1090 920 PRINT "The following characters are available for code practice:":PRINT 930 FOR I.CHARS = 0 TO BD-1 940 PRINT B$(I.CHARS)+" "; 950 NEXT I.CHARS 960 PRINT 970 PRINT:PRINT:PRINT 980 PRINT "Please enter: 990 PRINT" Y to accept these characters 1000 PRINT" A to add more to the list 1010 PRINT" E to erase the list and start over 1020 PRINT:PRINT 1030 K$=INKEY$ 1040 IF (K$="Y" OR K$="y") THEN CLS:RETURN 'EXIT FROM ROUTINE 1050 IF (K$="A" OR K$="a") GOTO 870 1060 IF (K$="E" OR K$="e") THEN BD=0:GOTO 830 'CLEARS BUFFER AND RESTARTS 1070 IF K$="" GOTO 1030 1080 GOTO 970 'INVALID RESPONSE 1090 'ADD CHARACTERS TO BUFFER 1100 INPUT;K$ 1110 IF (K$="ALL" OR K$="all") GOTO 1200 1120 IF K$="" GOTO 830 'START OVER IF NONE ENTERED 1130 FOR J.CHARS = 1 TO LEN(K$) 'APPEND STRING TO B$ 1140 CTMP$=MID$(K$,J.CHARS,1) 'ONE CHARACTER AT A TIME 1150 IF CTMP$=";" THEN CTMP$=CHR$(44)'CONVERT SEMICOLON TO COMMA 1160 B$(BD)=CTMP$ 1170 BD=BD+1 'POINT TO NEXT ENTRY IN B$ 1180 NEXT J.CHARS 1190 GOTO 830 'RE-DISPLAY CHARACTERS 1200 'LOAD B$ WITH ALL VALID CHARACTERS 1210 FOR L.CHARS = 65 TO 90 1220 B$(BD) = CHR$(L.CHARS) 1230 BD=BD+1 1240 NEXT L.CHARS 1250 FOR L.CHARS = 46 TO 57 1260 B$(BD) = CHR$(L.CHARS) 1270 BD=BD+1 1280 NEXT L.CHARS 1290 B$(BD)=CHR$(44):BD=BD+1 'LOADS COMMA 1300 B$(BD)="?":BD=BD+1 1310 B$(BD)="=":BD=BD+1 'LOADS DOUBLE DASH 1320 GOTO 830 'REDISPLAY AND ALLOW MORE 1330 ' 1340 '***** CODEGEN: MORSE GENERATOR, CHARACTERS PASSED IN M$ 1350 ' 1360 L1 = LEN (M$) : IF L1 = 0 GOTO 1530 'NULL INPUT IF 0 1370 FOR I1 = 1 TO L1 1380 W$ = MID$ (M$ , I1 , 1) : IF W$ = " " GOTO 1510 'WORD SPACE REQ'D 1390 P1 = INSTR (1 , C$ , W$) 1400 IF P1 = 0 GOTO 1510 : REM SEND WORD SPACE FOR UNKNOWN CHARACTERS 1410 SOUND 32000,3*D2 : REM output character space 1420 W$ = MID$ (D$ , P1 , 1) 1430 IF W$ = " " GOTO 1520 : REM jump if end of character 1440 IF W$ <> "." GOTO 1460 1450 SOUND F1,D1 : GOTO 1480 : REM output dot 1460 IF W$ <> "-" GOTO 1500 1470 SOUND F1,3*D1 : REM output dash 1480 P1 = P1 + 1 1490 IF MID$ (D$ , P1 , 1) = " " GOTO 1520 1500 SOUND 32000,D1 : GOTO 1420 1510 SOUND 32000,4*D2 : REM word space 1520 NEXT I1 1530 RETURN 1540 ' 1550 ' 1560 ' 1570 '***** PITCHDOWN: INTERRUPT ROUTINE FOR THE CURSOR DOWN KEY. DECREASES 1580 ' BY 10 Hz FOR EACH DEPRESSION. UPDATES STATUS LINE. 1590 ' 1600 IF F1<=40 THEN RETURN '40 Hz IS LOWER LIMIT 1610 F1=F1-10 'PITCH DOWN BY 10 Hz 1620 GOSUB 2430 'CALL STATUS 1630 RETURN 1640 ' 1650 '***** PITCH UP: INTERRUPT ROUTINE FOR THE CURSOR UP KEY. INCREASES 1660 ' PITCH BY 10 Hz FOR EACH DEPRESSION. UPDATES STATUS. 1670 ' 1680 IF F1>2000 THEN RETURN '2000 Hz IS UPPER LIMIT 1690 F1=F1+10 'PITCH UP 1700 GOSUB 2430 'CALL STATUS 1710 RETURN 1720 ' 1730 '***** RATE DOWN: INTERRUPT ROUTINE FOR THE F1 KEY. DECREASES THE RATE 1740 ' BY 1 WPM FOR EACH DEPRESSION. IF THE RATE IS SET LESS 1750 ' THAN THE CURRENT SPEED, SPEED WILL BE DECREASED ALSO. 1760 ' 1770 'VARIABLES USED: S1 = RATE; S2 = SPEED; S3 = ENDING SPEED 1780 ' 1790 IF S1<2 THEN RETURN '2 WPM IS LOWER LIMIT 1800 S1=S1-1 'DECREASE RATE BY 1 WPM 1810 IF S1<S3 THEN S3=S1 'DECREASE END SPEED IF > RATE 1820 IF S1<S2 THEN S2=S1 'DECREASE SPEED IF > RATE 1830 GOSUB 2430 'CALL STATUS 1840 GOSUB 2560 'CALL TWEAK 1850 RETURN 1860 ' 1870 '***** RATE UP: INTERRUPT ROUTINE FOR THE F2 KEY. INCREASES THE RATE 1880 ' BY 1 WPM FOR EACH DEPRESSION. 1890 ' 1900 'VARIABLES USED: S1 = RATE 1910 ' 1920 IF S1>99 THEN RETURN '99 WPM IS UPPER LIMIT 1930 S1=S1+1 'INCREASE RATE BY 1 WPM 1940 GOSUB 2430 'CALL STATUS 1950 GOSUB 2560 'CALL TWEAK 1960 RETURN 1970 ' 1980 ' 1990 '***** SCROLL: DISPLAYS LAST 5 GROUPS SENT 2000 ' 2010 FOR N = 1 TO 4 'SCROLL IN MEMORY 2020 IMAGE$(N) = IMAGE$(N+1) 2030 NEXT N 2040 IMAGE$(5)=M$ 'LOAD GROUP JUST SENT 2050 FOR N = 1 TO 5 'DISPLAY ON CRT 2060 LOCATE N,60 2070 PRINT IMAGE$(N)+" " 'SPACE OVER ANYTHING ALREADY THERE 2080 NEXT N 2090 RETURN 2100 ' 2110 '***** SEED: SEEDS THE RANDOM NUMBER GENERATOR BASED ON TIME & DATE. 2120 ' 2130 SEED=10000*VAL(RIGHT$(TIME$,2))+1000*VAL(MID$(TIME$,4,2))+100*VAL(LEFT$(TIME$,2))+10*VAL(LEFT$(DATE$,2))+VAL(MID$(DATE$,4,2)) 2140 SEED=INT((SEED*.100592)-32767) 2150 RANDOMIZE SEED 2160 RETURN 2170 ' 2180 '***** SPEED DOWN: INTERRUPT ROUTINE FOR THE CURSOR LEFT KEY. DECREASES 2190 ' SPPED BY 1 WPM. 2200 ' 2210 'VARIABLES: S2 = SPEED 2220 ' 2230 IF S2<=2 THEN RETURN 'LOWER LIMIT IS 2 WPM 2240 S2=S2-1 'DECREASE SPEED BY 1 WPM 2250 GOSUB 2560 'CALL TWEAK 2260 GOSUB 2430 'CALL STATUS 2270 RETURN 2280 ' 2290 '***** SPEED UP: INTERRUPT ROUTINE FOR THE CURSOR RIGHT KEY. INCREASES 2300 ' BY 1 WPM FOR EACH DEPRESSION. IF SPEED IS GREATER 2310 ' THAN THE CURRENT RATE, RATE WILL BE INCREASED ALSO. 2320 ' 2330 'VARIABLES USED: S1 = RATE; S2 = SPEED; S3 = ENDING SPEED 2340 ' 2350 IF S2>59 THEN RETURN '60 WPM IS UPPER LIMIT 2360 S2=S2+1 'INCREASE SPEED BY 1 WPM 2370 IF S2>S3 THEN S3=S2 'INCREASE END SPEED IF < SPEED 2380 IF S2>S1 THEN S1=S2 'INCREASE RATE IF < SPEED 2390 GOSUB 2560 'CALL TWEAK 2400 GOSUB 2430 'CALL STATUS 2410 RETURN 2420 ' 2430 '***** STATUS: UPDATES STATUS LINE 2440 ' 2450 X=POS(0):Y=CSRLIN 'SAVE CURRENT CURSOR LOCATION 2460 LOCATE 25,1:PRINT "PITCH" F1; 2470 LOCATE 25,15:PRINT"RATE" S1; 2480 LOCATE 25,26:PRINT"SPEED" S2; 2490 LOCATE 25,37:PRINT "END SPEED" S3; 2500 LOCATE 25,59:PRINT " ";:LOCATE 25,52:PRINT "TIMER" PASS; 2510 IF LPF=TRUE THEN LOCATE 25,65:PRINT "PRINTER ON "; 2520 IF LPF =FALSE THEN LOCATE 25,65:PRINT "PRINTER OFF"; 2530 LOCATE Y,X 'RESTORE CURSOR 2540 RETURN 2550 ' 2560 '***** TWEAK: CALCULATES DIT AND DAH TIMES BASED ON RATE AND SPEED 2570 ' 2580 'VARIABLES: D1 = DIT TIME; D2 = 1/3 SPACE TIME; S1 = RATE; S2 = SPEED 2590 D1 = 1.2*18.2/S1 : D2 = (50*1.2*18.2/S2 - 31*D1) / 19 2600 RETURN 2610 ' 2620 '******************************************************************** 2630 '** ** 2640 '** START OF MAIN PROGRAM ** 2650 '** ** 2660 '******************************************************************** 2670 ' 2680 CLS 2690 ' 2700 LOCATE 10,20 2710 PRINT"Code Practice Oscillator Version 1.0 2720 PRINT:LOCATE,25 2730 PRINT"by Tom Carrington N5FGN and Bill Lutts WB5LSR 2740 FOR DELAY=1 TO 2000:NEXT DELAY 2750 ' 2760 FOR N = 1 TO 5 'CLEAR THE DISPLAY BUFFER 2770 IMAGE$(N)="" 2780 NEXT N 2790 ' 2800 GOSUB 2110 'CALL SEED, GENERATES RANDOM NUMBER 2810 ' 2820 GOSUB 730 'CALL DI, DISABLE INTERRUPTS 2830 ' 2840 GOSUB 830 'CALL CHARS - BUILDS BUFFER OF 2850 'AVAILABLE CHARACTERS 2860 ' 2870 'SET STARTING VALUES FOR PRINTER, PITCH, RATE, SPEED, ENDING SPEED, 2880 'TIME TO SPEND AT EACH SPEED, AND TYPE OF GROUPS TO SEND. 2890 ' 2900 PRINT "Print while sending? Y/N, (Return = NO)" 2910 PK$=INKEY$:IF PK$="" GOTO 2910 2920 IF (PK$="y" OR PK$="Y") THEN LPF=TRUE ELSE LPF=FALSE 2930 CLS 2940 GOSUB 2430 'CALL STATUS 2950 ' 2960 INPUT "Sidetone pitch? (Return = 750 Hz) ",F1 2970 IF F1 = 0 THEN F1=750 2980 IF (F1<40 OR F1>2000) THEN PRINT"PITCH MUST BE BETWEEN 40 AND 2000 Hz":GOTO 2960 2990 CLS 3000 GOSUB 2430 'CALL STATUS 3010 ' 3020 PRINT "The character rate is the speed that each character will be sent." 3030 PRINT "The spacing between characters is set by the speed and is the" 3040 PRINT "actual words per minute to be sent":PRINT:PRINT 3050 INPUT "Character rate? (Return = 20 WPM) ",S1 3060 IF S1=0 THEN S1=20 3070 IF (S1<2 OR S1>60) THEN PRINT "Character rate must be between 2 and 60 WPM":GOTO 3050 3080 CLS 3090 GOSUB 2430 'CALL STATUS 3100 ' 3110 PRINT "The starting speed is the actual speed that code will be sent" 3120 PRINT:PRINT 3130 INPUT "Starting speed? (Return = 5 WPM) ",S2 3140 IF S2=0 THEN S2=5 3150 IF (S2<2 OR S2>60) THEN PRINT "Speed must be between 2 and 60 WPM":GOTO 3130 3160 IF S2>S1 THEN S1=S2 'MAKE RATE=SPEED IF SPEED>RATE 3170 CLS 3180 GOSUB 2430 'CALL STATUS 3190 ' 3200 PRINT "The ending speed is the highest speed that will be sent. Once it" 3210 PRINT "is reached, the speed will hold at this":PRINT:PRINT 3220 INPUT "Ending speed (Return = 20 WPM) ",S3 3230 IF S3=0 THEN S3=20 3240 IF (S3<2 OR S3>60) THEN PRINT "Ending speed must be between 2 and 60 WPM":GOTO 3220 3250 IF S3<S2 THEN S3=S2 'ENDSPEED MUST BE AT LEAST = START SPEED 3260 CLS 3270 GOSUB 2430 'CALL STATUS 3280 GOSUB 2560 'CALL TWEAK 3290 ' 3300 PRINT "Now set the number of minutes to send before increasing the speed" 3310 PRINT:PRINT 3320 INPUT "Time in minutes? (Return = 5 Minutes) ",PASS 3330 IF PASS=0 THEN PASS=5 3340 IF (PASS<1 OR PASS>9999) THEN PRINT"Timer must be between 1 and 9999 Minutes":GOTO 3320 3350 CLS 3360 GOSUB 2430 'CALL STATUS 3370 ' 3380 PRINT"You have a choice of fixed length or variable length groups":PRINT:PRINT 3390 INPUT"Fixed or Variable F/V (Return = 5 Character fixed length) ",K$ 3400 IF K$="F" GOTO 3450 3410 IF K$="V" GOTO 3520 3420 IF K$="" THEN LMIN=5:LMAX=5:GOTO 3610 3430 PRINT "Please type F, V OR Return":GOTO 3390 3440 ' 3450 'FOR FIXED LENGTH GROUPS 3460 ' 3470 INPUT"Number of characters in fixed length groups (Return = 5) ";LMIN 3480 IF LMIN=0 THEN LMIN=5 3490 IF LMIN>9 THEN PRINT"The length must be less than 10":GOTO 3470 3500 LMAX=LMIN: GOTO 3610 3510 ' 3520 'FOR VARIABLE LENGTH GROUPS 3530 ' 3540 INPUT"Minimum length of groups (Return = 1) ";LMIN 3550 IF LMIN=0 THEN LMIN=1 3560 IF LMIN>9 THEN PRINT "Minimum length must be less than 10":GOTO 3540 3570 INPUT"Maximum length of groups (Return = 9) ";LMAX 3580 IF LMAX=0 THEN LMAX=9 3590 IF LMAX>9 THEN PRINT"Maximum length must be less than 10":GOTO 3570 3600 IF LMIN>LMAX THEN SWAP LMIN,LMAX 'IF BACKWARDS, SWAP THEM 3610 CLS 3620 GOSUB 2430 'CALL STATUS 3630 ' 3640 ' DISPLAY MENU OF OPTIONS ON CRT 3650 ' 3660 PRINT"Hit space bar to stop":PRINT:PRINT 3670 PRINT"F2 Increases Rate 3680 PRINT"F1 Decreases Rate":PRINT:PRINT 3690 PRINT CHR$(26) + " Increases Speed 3700 PRINT CHR$(27) + " Decreases Speed":PRINT:PRINT 3710 PRINT CHR$(24) + " Increases Pitch" 3720 PRINT CHR$(25) + " Decreases Pitch 3730 ' 3740 ' START SENDING CODE 3750 ' 3760 FOR N = 1 TO 5:LOCATE N,30:PRINT " ";:NEXT 3770 IF LPF=TRUE THEN LPRINT:LPRINT:LPRINT S1,S2:FOR DELAY=1 TO 2000:NEXT 3780 GOSUB 630 'ENABLE INTERRUPT KEYS 3790 WHILE TIMER <= PASS 3800 FOR J=0 TO (LMIN+INT(RND*(LMAX-LMIN)))-1 3810 M$=M$+B$(INT(RND*(BD))) 3820 NEXT J 3830 M$=M$+" " 3840 GOSUB 1340 'CALL CODEGEN 3850 GOSUB 1990 'CALL SCROLL 3860 IF LPF=TRUE THEN LPRINT M$;:LPC=LPC+1 3870 IF(LPF=TRUE AND LPC=12) THEN LPRINT:LPC=0:FOR DELAY=1 TO 2000:NEXT ' PAUSE AFTER PRINTING TO ALLOW OPERATOR TO RECOVER FROM SURPRISE! 3880 M$="" 3890 K$=INKEY$ 3900 IF K$<>" " GOTO 3960 3910 LOCATE 22,1:INPUT"Restart, Continue, or System";K$ 3920 IF (K$="R" OR K$="r") THEN IF LPF=TRUE THEN LPRINT:GOTO 2620 ELSE GOTO 2620 3930 IF (K$="S" OR K$="s") THEN CLS:SYSTEM 3940 IF (K$="C" OR K$="c") THEN LOCATE CSRLIN-1,1:PRINT STRING$(50,32):GOTO 3960 3950 GOTO 3910 3960 NEWTIME=VAL(MID$(TIME$,4,2)) 3970 IF NEWTIME=OLDTIME THEN 3980 ELSE OLDTIME=NEWTIME:TIMER=TIMER+1 3980 WEND 'SEND CODE TILL TIME EXPIRES 3990 TIMER=1 4000 S2=S2+1 4010 IF S2>=S3 THEN S2=S3 4020 IF S2>=S1 THEN S1=S2 4030 GOSUB 2560 'CALL TWEAK 4040 GOSUB 2430 'CALL STATUS 4050 IF LPF=TRUE THEN LPRINT:LPRINT S1, S2:LPC=0:FOR DELAY= 1 TO 2000:NEXT ' PAUSE FOR OPERATOR RECOVERY FROM PRINTING 4060 GOTO 3780