home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Nibble Magazine
/
nib28b.dsk
/
TONE.DIALER.bas
< prev
next >
Wrap
BASIC Source File
|
2023-02-26
|
2KB
|
69 lines
10 REM **********************
20 REM * TONE.DIALER *
30 REM * BY ALAN H. STEIN *
40 REM * COPYRIGHT (C) 1986 *
50 REM * BY MICROSPARC, INC *
60 REM * CONCORD, MA 01742 *
70 REM **********************
80 HOME :SLOT = 2: REM CHANGE THIS TO YOUR MODEM SLOT
90 A$ = "TOUCH TONE DIALER": GOSUB 460
100 A$ = "BY": GOSUB 460
110 A$ = "ALAN H STEIN": GOSUB 460: PRINT
120 A$ = "COPYRIGHT 1986 BY MICROSPARC, INC.": GOSUB 460
130 PRINT : PRINT
140 A$ = "THE FIRST NUMBER WILL BE PULSE DIALED": GOSUB 460
150 A$ = "ALL OTHERS WILL BE TONE DIALED": GOSUB 460
160 VTAB 22:
170 A$ = "PRESS <RETURN> TO ACCEPT, <ESC> TO EXIT": GOSUB 460
180 POKE 35,21
190 D$ = CHR$(4)
200 J$ = CHR$(10)
210 Q$ = CHR$(17)
220 V$ = "D1234567890*#ABC"
230 Z$ = CHR$(26)
240 CR3 = -16253 +SLOT *16: REM CONTROL REGISTER 3
250 DL = 30
260 PRINT D$"PR#"SLOT: REM TURN ON MODEM
270 POKE CR3,32: REM TURN ON SPEAKER
280 VV = 17:QQ$ = "ENTER NUMBER TO PULSE DIAL: ":QB$ = "": GOSUB 520
290 PRINT Q$;QB$;J$: REM PULSE DIAL
300 PRINT
310 VV = 17:QQ$ = "ENTER NUMBER TO TONE DIAL: ": GOSUB 520: REM GET NUMBER INPUT
320 REM TONE DIAL A NUMBER
330 FOR X = 1 TO LEN(QB$)
340 D1$ = MID$ (QB$,X,1): GOSUB 370: REM DIAL X'TH DIGIT
350 NEXT
360 GOTO 310
370 REM TONE DIAL SUBROUTINE
380 D = -1
390 FOR J = 1 TO 16
400 IF D1$ = MID$ (V$,J,1) THEN D = J -1
410 NEXT
420 IF D <0 THEN 450
430 POKE CR3,D +48: FOR K = -40 TO DL: NEXT
440 POKE CR3,D +32: FOR K = 1 TO DL: NEXT
450 RETURN
460 REM CENTER DISPLAY
470 TB = 20 - INT( LEN(A$)/2): IF TB <1 THEN TB = 1
480 PRINT TAB( TB)A$
490 RETURN
500 POKE CR3,0: PRINT Z$: REM TURN OFF SPEAKER AND HANG UP
510 END
520 REM INPUT SUBROUTINE
530 HH = LEN(QQ$): HTAB 1: VTAB VV
540 PRINT QQ$;
550 HTAB HH: CALL -958: PRINT QB$;: HTAB HH
560 GET QA$: PRINT QA$;: IF QA$ = CHR$(27) THEN TEXT : HOME : GOTO 500: REM QUIT
570 IF ASC(QA$) <32 AND QA$ < > CHR$(13) THEN PRINT CHR$(7);: GOTO 530
580 IF QA$ = CHR$(13) THEN RETURN
590 QB$ = QA$: CALL -868
600 GET QA$: PRINT QA$;
610 IF QA$ = CHR$(13) THEN GOTO 660
620 IF QA$ = CHR$(8) THEN GOSUB 670: GOTO 600
630 IF QA$ = CHR$(27) THEN HOME : END
640 IF ASC(QA$) <32 THEN VTAB VV: GOTO 600
650 QB$ = QB$ +QA$: GOTO 600
660 RETURN
670 IF QB$ = "" THEN CALL -1036: RETURN
680 IF LEN(QB$) >1 THEN QB$ = LEFT$(QB$, LEN(QB$) -1): PRINT " ";: CALL -1008: RETURN
690 QB$ = "": PRINT " ";: CALL -1008: RETURN