5REM                ***Data Library program***
6REM                ***created by Alan Neeley 74756,1104 SLC,Utah***
7REM                ***Version 1.1***
30LOMEM :29000
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:REM                            remove Coleco Pok
80DIM fr$(50), fw$(50)
85 d$=CHR$(4)
87 p=PEEK(27950): dd=PEEK(27954): dr=PEEK(27953)
88FOR i=1 TO 20: y=PEEK(27920+i)
89IF y=13 THEN 100
90 sy$=sy$+CHR$(y):NEXT i
100GOTO 8000
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 ? a$:POKE chrout, 13:CALL dump: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 cin, 0:GOTO 250
300 a$=a$+CHR$(y):POKE chrout, y:CALL dump
310IF a$="/EXIT" OR a$="/exit" THEN RETURN
320IF LEN(a$)=ln THEN RETURN
330GOSUB 1980
340POKE cin, 0:GOTO 250
650 o$="":?:GOSUB 2050: o$="Press E to return to MAIN MENU":GOSUB 2050
660 o$="":GOSUB 2050: o$="or Press T to hang up ==>":GOSUB 2050
670 ln=2:GOSUB 240
675 o$="":GOSUB 2050
680IF a$="E" OR a$="e" THEN 700
690IF a$="T" OR a$="t" THEN 1880
695GOTO 650
700 o$="":?:GOSUB 2050: o$="One moment please... ":GOSUB 2050
705IF tw=1 THEN GOSUB 8900
710HTAB 1:? d$; "RUN BBSCB,D"; p
1869REM                            ********************
1870REM                            * Hang up          *
1880REM                            ********************
1890 o$="":GOSUB 2050: o$="Are you sure you want to ":GOSUB 2050
1891 o$="":GOSUB 2050
1900 o$="Hang-up? ":GOSUB 2050: ln=1:GOSUB 240
1905IF a$="" THEN 8000
1910IF a$="n" OR a$="N" THEN 650
1920IF a$<>"y" AND a$<>"Y" THEN 1900
1930?
1940 o$="Thanks for calling "+n$(id):GOSUB 2050
1941 o$="":GOSUB 2050
1950 o$="Call again soon!":GOSUB 2050
1960IF tw=1 THEN GOSUB 8900
1965POKE numbout, 37:CALL cntrl
1970HTAB 1:? d$; "RUN BBS,D"; p
1980REM      ***CARRIER CHECK***
2010CALL cdstat
2020IF PEEK(carrier)=255 THEN POKE carrier, 0:RETURN
2030?:?:? "CARRIER LOST!":GOTO 1960
2040RETURN
2050REM                            ********************
2060REM                            * Out to Caller    *
2070REM                            ********************
2080IF o$="" THEN POKE chrout, 13:CALL dump:? o$:RETURN
2090GOSUB 1980:REM                            check for carrier
2100FOR k=1 TO LEN(o$)
2110 q=ASC(MID$(o$, k))
2120POKE chrout, q:CALL dump:? CHR$(q); 
2130NEXT k
2140RETURN
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":?:?:? "-+-> MON"
5045IF PEEK(64885)=141 THEN HTAB 1:? d$; "NOMON C,I,O":?:?:? "-+-> NOMON"
5499POKE 64885, 0:RETURN
8000REM                                         ***DATA LIBRARY***
8009 o$="":?:GOSUB 2050
8010 o$="Data Library :":GOSUB 2050
8019 o$="":?:GOSUB 2050
8020 o$="D.L. Options (U,D,V,E)==>":GOSUB 2050: ln=2:GOSUB 240
8025IF a$="U" OR a$="u" THEN 8100
8030IF a$="D" OR a$="d" THEN 8300
8035IF a$="V" OR a$="v" THEN 8500
8040IF a$="E" OR a$="e" THEN 650
8044 o$="":?:GOSUB 2050
8045 o$="Data Library Commands:":GOSUB 2050
8049 o$="":?:GOSUB 2050
8050 o$="U - Upload File to BBS":GOSUB 2050
8054 o$="":?:GOSUB 2050
8055 o$="D - Download File from BBS":GOSUB 2050
8059 o$="":?:GOSUB 2050
8060 o$="V - View Directory of Files":GOSUB 2050
8064 o$="":?:GOSUB 2050
8065 o$="E - Exit Data Library":GOSUB 2050
8070 o$="":?:GOSUB 2050:GOTO 8020
8100REM                                         ***UPLOAD FILE***
8109 o$="":?:GOSUB 2050
8110 o$="Enter Filename to Upload":GOSUB 2050
8119 o$="":?:GOSUB 2050
8120 o$="No more than 10 characters":GOSUB 2050
8122 o$="":?:GOSUB 2050: o$="==>":GOSUB 2050: ln=10:GOSUB 240
8125IF a$="" THEN 8045
8126FOR i=1 TO LEN(a$):IF MID$(a$, i, 1)=CHR$(32) THEN  o$="":GOSUB 2050: o$="No Spaces":GOSUB 2050
8127NEXT i
8128 fi$=a$
8129 o$="":?:GOSUB 2050
8130 o$="Filename :"+fi$:GOSUB 2050
8134 o$="":?:GOSUB 2050
8135 o$="Correct? ":GOSUB 2050: ln=1:GOSUB 240
8140IF a$="N" OR a$="n" THEN 8100
8150IF a$="Y" OR a$="y" THEN 8155
8152GOTO 8135
8155IF tu=1 THEN GOTO 8600
8157GOSUB 8800:GOTO 8600
8159HTAB 1:? d$; "OPEN "; fi$; ",D"; dr: o$="":?:GOSUB 2050
8160 o$="Use Capture Protocol Only! ":GOSUB 2050
8169 o$="":?:GOSUB 2050
8170 o$="Enter '/EXIT' when ":GOSUB 2050
8179 o$="":?:GOSUB 2050
8180 o$="Transfer is finished...":GOSUB 2050
8181 o$="":?:GOSUB 2050
8185 o$="One moment please... ":GOSUB 2050: o$="":?:GOSUB 2050
8190HTAB 1:? d$; "WRITE "; fi$
8200 o$="START TRANSFER":GOSUB 2050: o$="":GOSUB 2050
8245FOR i=1 TO 5000: ln=200:GOSUB 240
8250IF a$="/EXIT" OR a$="/exit" THEN 8270
8260 a$="":NEXT i
8270? "EOF"
8280HTAB 1:? d$; "CLOSE "; fi$; ",D"; dr
8289 o$="":?:GOSUB 2050
8290 o$="File Transfer complete...":GOSUB 2050:GOTO 8000
8300REM                                        ***DOWNLOAD FILE***
8309 o$="":?:GOSUB 2050
8310 o$="Enter Filename to Download":GOSUB 2050
8319 o$="":GOSUB 2050
8320 o$="from BBS ==>":GOSUB 2050: ln=10:GOSUB 240
8325IF a$="" THEN 8045
8330 fi$=a$
8334 o$="":GOSUB 2050
8335 o$="Filename:"+fi$:GOSUB 2050
8339 o$="":GOSUB 2050
8340 o$="Correct? ":GOSUB 2050: ln=1:GOSUB 240
8341 o$="":GOSUB 2050
8345IF a$="N" OR a$="n" THEN 8300
8350IF a$="Y" OR a$="y" THEN 8353
8351GOTO 8339
8353 o$="":?:GOSUB 2050: o$="One moment please...":GOSUB 2050
8355IF td=1 THEN 8360
8357GOSUB 8700
8360REM               ***READ DIRECTORY TO CHECK FOR FILE***
8370FOR i=1 TO hf
8375IF fi$=fr$(i) THEN 8400
8385NEXT i
8390 o$="":?:GOSUB 2050
8395 o$="That file does not exist...":GOSUB 2050:GOTO 8300
8400REM                ***OPEN FILE TO SEND OUT***
8401 o$="":?:GOSUB 2050
8410 o$="Press 'R' when ready to":GOSUB 2050
8414 o$="":?:GOSUB 2050
8415 o$="Recieve file...":GOSUB 2050: o$="":?:GOSUB 2050
8420 ln=1:GOSUB 240
8425 o$="":GOSUB 2050
8430IF a$="" THEN 8045
8435IF a$="R" OR a$="r" THEN 8440
8436GOTO 8420
8440HTAB 1:? d$; "OPEN "; fi$; ",D"; dd
8445HTAB 1:? d$; "READ "; fi$
8447GET x$:IF ASC(x$)=13 OR ASC(x$)=3 THEN 8455
8450 o$=o$+x$:GOTO 8447
8455IF o$="EOF" THEN 8465
8456IF o$="START TRANSFER" THEN  o$="":GOTO 8447
8457GOSUB 2050:?: o$="":GOSUB 2050:GOTO 8447
8465HTAB 1:? d$; "CLOSE "; fi$; ",D"; dd
8470 o$="":?:GOSUB 2050: o$="Transfer Complete...":GOSUB 2050
8474 o$="":?:GOSUB 2050
8475 o$="Press <RETURN> to continue...":GOSUB 2050
8480 ln=1:GOSUB 240: o$="":GOSUB 2050:IF a$="" THEN 8000
8490GOTO 8475
8500REM                                        ***READ DIRECTORY FILE***
8505 o$="":?:GOSUB 2050: o$="One moment please...":GOSUB 2050
8510IF td=1 THEN 8540
8515GOSUB 8700
8540FOR i=1 TO hf
8550 o$="":?:GOSUB 2050: o$=fr$(i):GOSUB 2050
8555IF hf=0 THEN  o$="":GOSUB 2050: o$="No Files...":GOSUB 2050:GOTO 8599
8560NEXT i
8599GOTO 8000
8600REM                                         ***CHECKS TO SEE IF FILE EXISTS IF NOT WRITE FILENAME***
8605 o$="":?:GOSUB 2050: o$="One moment please... ":GOSUB 2050
8606 o$="":?:GOSUB 2050
8610FOR i=1 TO rf
8630IF fw$(i)=fi$ THEN 8640
8635NEXT i:GOTO 8650
8640REM               ***NAME EXISTS USE ANOTHER***
8641 o$="":?:GOSUB 2050
8642 o$="Filename already exists...":GOSUB 2050
8643 o$="":?:GOSUB 2050
8645 o$="Please use another name... ":GOSUB 2050:GOTO 8100
8650REM              ***ENTER FILE NAME TO DIRECTORY***
8660 rf=rf+1: fw$(rf)=fi$
8670 tw=1
8680GOTO 8159
8700REM                ***READ DIRECTORY FROM FILE***
8710HTAB 1:? d$; "OPEN DIRECTORY,D"; dd
8720HTAB 1:? d$; "READ DIRECTORY"
8730FOR i=1 TO 50
8740INPUT r$
8745IF r$="EOF" THEN  hf=i-1:GOTO 8760
8750 fr$(i)=r$:NEXT i
8760HTAB 1:? d$; "CLOSE DIRECTORY,D"; dd
8770 td=1:RETURN
8800REM                ***READ UPLOADING DIRECTORY***
8810HTAB 1:? d$; "OPEN DIRECTORY,D"; dr
8820HTAB 1:? d$; "READ DIRECTORY"
8830FOR i=1 TO 50
8840INPUT r$
8850IF r$="EOF" THEN  rf=i-1:GOTO 8870
8860 fw$(i)=r$:NEXT i
8870HTAB 1:? d$; "CLOSE DIRECTORY,D"; dr
8880 tu=1:RETURN
8900REM              ***WRITE FILE NAME TO DIRECTORY FILE***
8910HTAB 1:? d$; "DELETE DIRECTORY,D"; dr
8920HTAB 1:? d$; "OPEN DIRECTORY"
8930HTAB 1:? d$; "WRITE DIRECTORY"
8940FOR i=1 TO rf
8945IF rf=0 THEN 8960
8950? fw$(i):NEXT i
8960? "EOF"
8970HTAB 1:? d$; "CLOSE DIRECTORY"
8980 tw=0:RETURN
