goto init

dial:
strcmp s4 "        "
if success
return
endif
isfile s4
if success
return
endif
clear
box 00 00 02 79 07
strcpy s1 "TXDAL º "
strcat s1 s4
strcat s1 " º Dallas, TX          214 817 º "
strcat s1 s5
atsay 01 02 07 s1
locate 05 00
transmit "I^m"
pause 1
transmit "ATZ^m"
waitfor "OK"
transmit "^E^m"
waitfor "READY"
transmit "D"
transmit S4
transmit "^m"
rget s1
rget s1 80 40
rget s1 40 40
rget s1 40 40

mess:
find s1 "BUSY"
if found
strcpy s9 "M"
return
endif
find s1 "ANSWER TONE"
if found
set parity none
set databits 8
clear
log open s4
alarm 2
exit
endif
find s1 "RINGING"
if found
rget s1
find s1 "RINGING"
if not found
goto mess
else
log open s4
message "APCP: No answer - still ringing"
log close
transmit "^C^D^C"
endif
else
endif
return

top:
find s0 "A"
if found
strcpy s4 "392-1121"
strcpy s5 "Discus                     "
gosub dial
endif
find s0 "B"
if found
strcpy s4 "821-5312"
strcpy s5 "BlueBonnet                 "
gosub dial
endif
find s0 "C"
if found
strcpy s4 "881-0313"
strcpy s5 "RBase BBS                  "
gosub dial
endif
find s0 "D"
if found
strcpy s4 "638-8069"
strcpy s5 "Support Link               "
gosub dial
endif
find s0 "E"
if found
strcpy s4 "724-0033"
strcpy s5 "Cheyenne Social Club       "
gosub dial
endif
find s0 "F"
if found
strcpy s4 "265-4859"
strcpy s5 "Arlington FIDO             "
gosub dial
endif
find s0 "G"
if found
strcpy s4 "392-1121"
strcpy s5 "Big D BBS                  "
gosub dial
endif
find s0 "H"
if found
strcpy s4 "462-8054"
strcpy s5 "Soft-Touch                 "
gosub dial
endif
find s0 "I"
if found
strcpy s4 "492-8054"
strcpy s5 "Dodge City BBS             "
gosub dial
endif
find s0 "J"
if found
strcpy s4 "660-7447"
strcpy s5 "RBBS Grand Prairie         "
gosub dial
endif
find s0 "K"
if found
strcpy s4 "931-1834"
strcpy s5 "Dallas BBS                 "
gosub dial
endif
find s0 "L"
if found
strcpy s4 "528-7141"
strcpy s5 "Computer Solutions         "
gosub dial
endif
find s0 "M"
if found
strcpy s4 "241-5412"
strcpy s5 "860/17 Telecompaq          "
gosub dial
endif
find s0 "N"
if found
strcpy s4 "248-7757"
strcpy s5 "Software Exchange          "
gosub dial
endif
find s0 "O"
if found
strcpy s4 "279-6755"
strcpy s5 "Supercomputer              "
gosub dial
endif
find s0 "P"
if found
strcpy s4 "287-1332"
strcpy s5 "Dragon's Lair              "
gosub dial
endif
find s0 "Q"
if found
strcpy s4 "340-5850"
strcpy s5 "Datalink                   "
gosub dial
endif
find s0 "R"
if found
strcpy s4 "352-4147"
strcpy s5 "CBBS/Theta Labs            "
gosub dial
endif
find s0 "S"
if found
strcpy s4 "373-0193"
strcpy s5 "TUUG/Newsoft News Service  "
gosub dial
endif
find s0 "T"
if found
strcpy s4 "393-0750"
strcpy s5 "K Squared RBBS             "
gosub dial
endif
find s0 "U"
if found
strcpy s4 "424-6446"
strcpy s5 "DataTech                   "
gosub dial
endif
find s0 "V"
if found
strcpy s4 "475-4598"
strcpy s5 "Comm Link Rowlett          "
gosub dial
endif
find s0 "W"
if found
strcpy s4 "492-8090"
strcpy s5 "Double D                   "
gosub dial
endif
find s0 "X"
if found
strcpy s4 "495-5616"
strcpy s5 "SSBB Mike's Machine        "
gosub dial
endif
find s0 "Y"
if found
strcpy s4 "522-1963"
strcpy s5 "LawSIG                     "
gosub dial
endif
find s0 "Z"
if found
strcpy s4 "578-1308"
strcpy s5 "101 Schnee's Friendly      "
gosub dial
endif
find s0 "0"
if found
strcpy s4 "594-0390"
strcpy s5 "Unknown BBS                "
gosub dial
endif
find s0 "1"
if found
strcpy s4 "659-0387"
strcpy s5 "Epson >pw=Epsonstc<        "
gosub dial
endif
find s0 "2"
if found
strcpy s4 "669-9272"
strcpy s5 "35 Junior Forum            "
gosub dial
endif
find s0 "3"
if found
strcpy s4 "690-6464"
strcpy s5 "Fido #494                  "
gosub dial
endif
find s0 "4"
if found
strcpy s4 "820-2888"
strcpy s5 "BaylorNet                  "
gosub dial
endif
find s0 "5"
if found
strcpy s4 "824-7166"
strcpy s5 "Hacker's                   "
gosub dial
endif
find s0 "6"
if found
strcpy s4 "991-7934"
strcpy s5 "201 DalTex FIDOnet         "
gosub dial
endif
find s0 "7"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s0 "8"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s0 "9"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s0 "@"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s0 "#"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s0 "$"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s0 "%"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s0 "&"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s0 "*"
if found
strcpy s4 "        "
strcpy s5 "                           "
gosub dial
endif
find s9 "M"
if found
strcpy s9 " "
goto top
endif
clear
box 00 00 02 79 07
atsay 01 02 07 "APCP: All numbers connected / didn't answer ... terminating ..."
locate 05 00
alarm 2
exit

init:
strcpy s9 " "
log close
clear
box 00 00 22 38 07
box 00 41 22 79 07
atsay 01 02 07 "A Discus ................. 392-1121"
atsay 02 02 07 "B BlueBonnet ............. 821-5312"
atsay 03 02 07 "C RBase BBS .............. 88-10313"
atsay 04 02 07 "D Support Link ........... 638-8069"
atsay 05 02 07 "E Cheyenne Social Club ... 724-0033"
atsay 06 02 07 "F Arlington Fido ......... 265-4859"
atsay 07 02 07 "G Big D .................. 392-1121"
atsay 08 02 07 "H Soft-Touch ............. 462-8054"
atsay 09 02 07 "I Dodge City ............. 492-8054"
atsay 10 02 07 "J RBBS Grand Prairie ..... 660-7447"
atsay 11 02 07 "K Dallas BBS ............. 931-1834"
atsay 12 02 07 "L Computer Solutions ..... 528-7141"
atsay 13 02 07 "M 860/17 Telecompaq ...... 241-5412"
atsay 14 02 07 "N Software Exchange ...... 248-7757"
atsay 15 02 07 "O Supercomputer .......... 270-6755"
atsay 16 02 07 "P Dragon's Lair .......... 287-1332"
atsay 17 02 07 "Q Datalink ............... 340-5850"
atsay 18 02 07 "R CBBS/Theta Labs ........ 352-4147"
atsay 19 02 07 "S TUUG/Newsoft News Svc .. 373-0193"
atsay 20 02 07 "T K Squared RBBS ......... 393-0750"
atsay 21 02 07 "U DataTech ............... 424-6446"
atsay 01 43 07 "V Comm Link Rowlett ...... 475-4598"
atsay 02 43 07 "W Double D ............... 492-8090"
atsay 03 43 07 "X SSBB Mike's Machine .... 495-5616"
atsay 04 43 07 "Y LawSIG ................. 522-1963"
atsay 05 43 07 "Z 101 Schnee's Friendly .. 578-1308"
atsay 06 43 07 "0 Unknown BBS ............ 594-0390"
atsay 07 43 07 "1 Epson <pw=Epsonstc> .... 659-0387"
atsay 08 43 07 "2 35 Junior Forum ........ 669-9272"
atsay 09 43 07 "3 Fido #494 .............. 690-6464"
atsay 10 43 07 "4 BaylorNet .............. 820-2888"
atsay 11 43 07 "5 Hacker's ............... 824-7166"
atsay 12 43 07 "6 201 DalTex FIDOnet ..... 991-7934"
atsay 13 43 07 "7 ........................ ... ...."
atsay 14 43 07 "8 ........................ ... ...."
atsay 15 43 07 "9 ........................ ... ...."
atsay 16 43 07 "@ ........................ ... ...."
atsay 17 43 07 "# ........................ ... ...."
atsay 18 43 07 "$ ........................ ... ...."
atsay 19 43 07 "% ........................ ... ...."
atsay 20 43 07 "& ........................ ... ...."
atsay 21 43 07 "* ........................ ... ...."
locate 23 00
get s0
goto top
return