10REM   DNS-LINK 1.3 5/2/86
20REM              converted mini-board program from TAB BOOKS
30LOMEM :29000
40REM              ADAM subroutines by GORDON MEYER & Alan Neeley
50 fetch=28000: cin=28061: cntrl=28007: numbout=28013: dump=28062: chrout=28075
60 ustat=28048: cdstat=28037: carrier=28047:POKE 16149, 255:POKE 16150, 255
70DIM n$(400), p$(400)
75 d$=CHR$(4)
80IF PEEK(27957)=1 THEN  p=PEEK(27950): dw=PEEK(27952):GOTO 138
90FOR i=28000 TO 28075
95HTAB 1:? d$; "NOMON c,i,o"
100READ j
110POKE i, j
120NEXT i
125FOR i=27900 TO 27999:POKE i, 0:NEXT i
126GOSUB 8700
130GOSUB 2150
131REM             ***RECOGNIZE SYSOP
132INPUT " What is the name of the SYSOP? "; sy$
133IF sy$="" THEN  sy$="SYSOP not in... "
135FOR i=1 TO LEN(sy$)
136POKE 27920+i, ASC(MID$(sy$, i, 1)):NEXT i
137POKE 27920+i, 13: sy$=""
138FOR i=1 TO 20: x=PEEK(27920+i):IF x=13 THEN 140
139 sy$=sy$+CHR$(x):NEXT i
140HOME:?:? "*******The ADAM-Board 1.2******"
142IF pt=1 THEN 150
145GOSUB 3000
146 pz=0
150?:?:? "Waiting for caller..."
160?:?:? "Press <Fire Button> to answer"
165IF PEEK(64885)=149 THEN GOTO 7000
170IF PDL(9)=1 THEN 180
175GOTO 165
180POKE 64885, 0
185FOR x=1 TO 8000:NEXT x
190GOSUB 2240
200FOR i=1 TO 5000:NEXT i
205GOSUB 1980
208 o$="":?:?:?:GOSUB 2050: o$="":GOSUB 2050: o$="":GOSUB 2050
210 o$="Welcome to SLC ADAM-LINK":GOSUB 2050: o$="":?:GOSUB 2050
211 o$="The #1 SLC based ADAM-BBS":GOSUB 2050: o$="":?:GOSUB 2050
212 o$="Supported by Alan Neeley":GOSUB 2050: o$="":?:GOSUB 2050
213 o$="Created by DNS Software":GOSUB 2050: o$="":?:GOSUB 2050
230 o$="":?:GOSUB 2050: o$="     ADAM LIVES!!":GOSUB 2050:GOTO 350
240POKE cin, 0: a$=""
250CALL ustat:IF PEEK(cin)=0 THEN GOSUB 1980:CALL ustat:IF PEEK(cin)=0 THEN 250
255GOSUB 5000
260 y=PEEK(cin):IF y=13 THEN ?:RETURN
265IF y=163 THEN  y=8
270IF y=8 AND LEN(a$)=1 THEN POKE cin, 0:GOTO 250
280IF y<8 OR y>128 THEN POKE cin, 0:GOTO 250
290IF y=8 THEN  a$=LEFT$(a$, (LEN(a$)-1)):POKE chrout, y:CALL dump:GOTO 320
300 a$=a$+CHR$(y):POKE chrout, y:CALL dump
320? CHR$(y); 
325IF LEN(a$)=ln THEN RETURN
330GOSUB 1980
340POKE cin, 0:GOTO 250
350 o$="":?:GOSUB 2050: o$="Enter your ID number":GOSUB 2050: o$="":GOSUB 2050
360 o$="Enter 'N' for New User":GOSUB 2050: o$="":GOSUB 2050
370 o$="==>":GOSUB 2050: ln=5:GOSUB 240:IF a$="" OR a$="n" OR a$="N" THEN 460
380IF VAL(a$)<1000 OR VAL(a$)>3000 THEN  o$="ERROR":GOSUB 2050: o$="":GOSUB 2050:GOTO 350
390 id=VAL(a$)-1000:?
400 o$="":GOSUB 2050: o$="Enter Password":GOSUB 2050: ln=15:GOSUB 3500
405 o$="":?:GOSUB 2050
410IF a$="" THEN 350
420IF a$="" OR a$<>p$(id) THEN  o$="Incorrect!!! Access Denied":GOSUB 2050:GOTO 350
425 o$="":GOSUB 2050
430 o$="Welcome back "+n$(id):GOSUB 2050: o$="":GOSUB 2050
440 o$="":?:GOSUB 2050: o$="You have been cleared to access ":GOSUB 2050
441 o$="":GOSUB 2050
442 o$="   The SLC ADAM-LINK BBS ":GOSUB 2050
444 o$="":?:GOSUB 2050: o$="Your SYSOP is... "+sy$:GOSUB 2050
445 o$="":?:GOSUB 2050
450GOTO 650
460 o$="Logged on as new caller. Standby":GOSUB 2050
465 o$="":?:GOSUB 2050
470 tc=tc+1: p$(tc)="": n$(tc)="": id=tc
480 o$="Enter your WHOLE name :":GOSUB 2050: o$="":?:GOSUB 2050
485 ln=20:GOSUB 240
490IF a$="" THEN  a$="NONAME"
500 n$(id)=a$
510 o$="":GOSUB 2050: o$="Enter a Password. (15 letters "
511GOSUB 2050
515 o$="":?:GOSUB 2050: o$="or less)==>>":GOSUB 2050: ln=15:GOSUB 240
520 o$="":?:GOSUB 2050:IF a$="" THEN  a$="PASSWORD"
530 p$(id)=a$
540 o$="":?:GOSUB 2050: o$="Logged in as "+n$(id):GOSUB 2050
545 o$="":?:GOSUB 2050: o$="Password :"+p$(id):GOSUB 2050
550 o$="":?:GOSUB 2050: o$="Correct? ":GOSUB 2050: ln=1:GOSUB 240
560IF a$="N" OR a$="n" THEN ?:GOTO 480
570IF a$<>"y" AND a$<>"Y" THEN GOTO 540
575GOSUB 3200
580 o$="":GOSUB 2050: o$="Accepted. Your *SECRET* logon":GOSUB 2050
590 o$="":?:GOSUB 2050: o$="number is... "+STR$(id+1000):GOSUB 2050
595 o$="":?:GOSUB 2050
600 o$="Write this number down and ":GOSUB 2050
605 o$="":?:GOSUB 2050: o$="use it whenever you Logon here ":GOSUB 2050
610 o$="":?:GOSUB 2050: o$="Press <RETURN> to see":GOSUB 2050
611 o$="":?:GOSUB 2050: o$="a list of Options":GOSUB 2050
650 o$="":?:GOSUB 2050: o$="One moment please... ":GOSUB 2050
660FOR i=1 TO LEN(n$(id))
670POKE 27899+i, ASC(MID$(n$(id), i, 1)):NEXT i
680POKE 27899+i, 13
690FOR i=1 TO LEN(STR$(id))
700POKE 27944+i, ASC(MID$(STR$(id), i, 1)):NEXT i
710POKE 27944+i, 13
715HTAB 1:? d$; "CATALOG,D"; p
720HTAB 1:? d$; "BRUN BBSCB"
1980REM              ***Carrier Check***
2010CALL cdstat
2020IF PEEK(carrier)=255 THEN POKE carrier, 0:RETURN
2030?:?:? "CARRIER LOST!":POKE numbout, 37:CALL cntrl:GOTO 150
2040RETURN
2050REM             ***OUT TO CALLER***
2080IF o$="" THEN POKE chrout, 13:CALL dump:? o$:RETURN
2090GOSUB 1980
2100FOR k=1 TO LEN(o$)
2110 q=ASC(MID$(o$, k))
2120POKE chrout, q:CALL dump:? CHR$(q); 
2130NEXT k
2140RETURN
2150REM  **Set UART(8,n,2)**
2160POKE numbout, 128:CALL cntrl:REM                                                                         NULL
2170POKE numbout, 64:CALL cntrl:REM                                                                         INTERNAL RESET
2180POKE numbout, 79:CALL cntrl:REM                                                                         8,n,2
2190FOR i=1 TO 10:NEXT i:REM                                                                         delay to let UART catch up
2200POKE numbout, 55:CALL cntrl
2210POKE carrier, 0
2220POKE numbout, 37:CALL cntrl:REM                                                                         hang it up
2230RETURN
2240REM  ***Pick up Phone***
2270POKE numbout, 7:CALL cntrl:REM                                                                     set answer mode
2280POKE numbout, 39:CALL cntrl:RETURN:REM                                                                     sieze line
2290DATA                                                                         219,94,50,102,109,201
2300DATA                                                                         0,58,109,109,211,95,201
2310DATA                                                                         0,58,109,109,211,94,201
2320DATA                                                                         0,219,95,50,102,109,201
2330DATA                                                                         0,219,95,183,203,79,192
2340DATA                                                                         195,124,109,219,95,203
2350DATA                                                                         127,200,62,255,50,143,109,255
2360DATA                                                                         219,95,183,203,79,200,219
2370DATA                                                                         94,50,157,109,201,0,0
2380DATA                                                                         219,95,203,87,202,158,109
2390DATA                                                                         58,171,109,211,94,201,0
3000REM  ***Read Password from Disk***
3010HTAB 1:? d$; "OPEN PASSWORD,D"; dw
3015HTAB 1:? d$; "READ PASSWORD"
3020FOR i=1 TO 2000:INPUT n$(i):IF n$(i)="EOF" THEN  tc=i-1:GOTO 3030
3025INPUT p$(i):NEXT i
3030HTAB 1:? d$; "CLOSE PASSWORD,D"; dw
3035 pt=1
3050RETURN
3200REM  ***Write Password to disk***
3210HTAB 1:? d$; "DELETE PASSWORD,D"; dw
3211HTAB 1:? d$; "OPEN PASSWORD"
3215HTAB 1:? d$; "WRITE PASSWORD"
3220GOSUB 3300
3221FOR i=1 TO tc
3225? n$(i):? p$(i)
3230IF tc=1 THEN ? "EOF":GOTO 3240
3235NEXT i:? "EOF"
3240HTAB 1:? d$; "CLOSE PASSWORD"
3245 pt=0
3250RETURN
3300FOR i=1 TO tc
3305IF n$(i)="*****" AND pz=0 THEN  n$(i)=n$(id): p$(i)=p$(id): pz=1: id=i: tc=tc-1:RETURN
3310NEXT i
3320RETURN
3500REM          ***UNSEEN PASSWORD***
3505POKE cin, o: a$=""
3510CALL ustat:IF PEEK(cin)=0 THEN GOSUB 1980:CALL ustat:IF PEEK(cin)=0 THEN 3510
3520 y=PEEK(cin):IF y=13 THEN RETURN
3530IF y=163 THEN  y=8
3535IF y=8 AND LEN(a$)<1 THEN POKE cin, 0:GOTO 3510
3540IF y<8 OR y>128 THEN POKE cin, 0:GOTO 3510
3545IF y=8 THEN  a$=LEFT$(a$, (LEN(a$)-1)):GOTO 3555
3550 a$=a$+CHR$(y)
3555IF LEN(a$)>ln THEN RETURN
3560POKE cin, 0:GOTO 3510
5000REM  ***Key Set for BBS Mode***
5005IF PEEK(64885)=131 THEN  o$="GREETINGS!!! From your SYSOP... "+sy$:GOSUB 2050
5010IF PEEK(64885)=130 THEN POKE 27956, 0
5020IF PEEK(64885)=129 THEN POKE 27956, 1
5025IF PEEK(64885)=132 THEN  o$="Choose OPTION C from ":GOSUB 2050
5030IF PEEK(64885)=132 THEN  o$="":?:GOSUB 2050: o$="MAIN OPTION list to CHAT ":GOSUB 2050
5035IF PEEK(64885)=132 THEN  o$="":?:GOSUB 2050: o$="with SYSOP... ":GOSUB 2050
5040IF PEEK(64885)=133 THEN HTAB 1:? d$; "MON C,I,O":?:?:? "-+-> MONITOR ON":?
5045IF PEEK(64885)=141 THEN HTAB 1:? d$; "NOMON C,I,O":?:?:? "-+-> MONITOR OFF":?
5499POKE 64885, 0:RETURN
7000REM  ***End Routine***
7010POKE 27957, 0
7015HOME:?:? "Would you like to"
7016INPUT "run BBSAID program?"; a$
7020IF a$="Y" OR a$="y" THEN GOTO 7050
7025IF a$="N" OR a$="n" THEN END
7026GOTO 7015
7050HTAB 1:? d$; "RUN BBSAID,D"; p
8700REM                                                    ***SET DRIVES***
8701HOME
8702INPUT "Which drive is main programs on?"; p
8703POKE 27950, p
8705? "Which drive do you want "
8710INPUT "Uploading to go?"; dr
8711POKE 27953, dr
8715?:? "Which file do you want "
8720INPUT "Downloading to come from? "; dd
8721POKE 27954, dd
8725?:? "Which drive is "
8730INPUT "PASSWORD file on? "; dw
8731POKE 27952, dw
8735?:? "Which drive is "
8740INPUT "MESSAGE file on? "; dm
8741POKE 27951, dm
8745?:? "Which drive is "
8750INPUT "BULLETIN file on? "; db
8751POKE 27955, db
8755POKE 27957, 1
8760RETURN
