Searchlight Source Code

At right is the BASIC source code to the main module of Searchlight BBS as it appeared on the last day of its official operation in 1987. This code accepts connections and handles the main menu, mail, and message boards. The complete application consists of several similar modules for Files, Games, and User functions, plus a series of assembly-language routines and some utility programs. (Scroll down to see some examples of the assembler code).

If you think this code looks needlessly complicated, it is. The lack of comments and even white space is due to memory constraints -- BASIC on the TRS-80 is stored in memory and interpreted, and there is only 48k of memory available. The twisted logic flow (GOTOs and IF-THENs) is partially due to the constraints of BASIC and partially due to an aversion to even renumbering the working code, usually because I had memorized the line numbers where important subroutines started.

The various PEEKs and POKEs are where the BASIC program is communicating with either the operating system or a custom piece of machine language. Of course this depended on the machine code always being loaded at exactly the right place in memory or else the entire application would fail. I enforced this by using only one particular version of the operating system (LDOS 5.1) and loading the machine language routines to a fixed location during bootup. Today there is almost no way I could run this thing on even a slightly different version of LDOS, let alone another kind of computer, without rewriting a lot of it. Of course, the DOS and Windows versions of Searchlight BBS that were marketed after 1987 were completely new applications, related to this code only in shared functionality and name.

The IN and OUT statements refer to CPU ports -- usually where you see these statements is where the program is trying to affect the serial port. Raw data communication with the serial port is done with an assembler routine for speed, but the BASIC code manipulates ports directly to read modem status flags and issue disconnects. Today you could never do such a thing in a high-level language, nor would you want to.

5 REM  SEARCHLIGHT BBS--VERSION 3.3   UPDATE: 05/18/87
8 ONERRORGOTO322:GOSUB316
12 OUT95,1:CLEAR3100
50 DEFINTA-Z
55 OPEN"R",1,"MSG:1",42
56 OPEN"R",2,"MAP:0",192:OPEN"R",3,"INDEX:1"
57 OPEN"R",4,"USER",85:OPEN"R",5,"CURRENT",255
58 GOSUB5000:GOTO290
59 GOSUB5000:R=X:UL=0:IC=VAL(IC$):GOTO1210
60 Z=(R-1)/8:Z1=R-Z*8-1:Z=Z+1:A0=1
62 IFZ>192THENZ=Z-192:A0=A0+1:GOTO62ELSERETURN
290 IFX=0THENZ=254:GOSUB435:GOTO371
292 UR=X:GET4,X:UL=ASC(AC$):CC=ASC(CC$):IFUL=9GOSUB317
296 IC=VAL(IC$):IFIC=0PRINTCHR$(14);
297 B=PEEK(LC):IFB<1ORB>12THENB=1
298 D8=VAL(MID$(TIME$,10)):D9=1:GOSUB4180:PRINT:K=0:GOTO2000
310 V=VARPTR(BB$):V1=PEEK(V+1)+PEEK(V+2)*256-65536
312 IFUL<5POKEV1+1,224-20*UL
315 DEFUSR0=V1:U=USR0(0):RETURN
316 POKE&H41AD,0:POKE&H41AE,0:GOSUB4012:RETURN
317 POKE&H41AD,86:POKE&H41AE,94:GOSUB4014:RETURN
318 POKE&HF3EE,206:POKE&HF4FF,&H7C:RETURN
319 POKE&HF3EE,212:POKE&HF4FF,201:RETURN
320 RETURN
321 RETURN
322 IFERR=104THENRUN
324 IFERR=106THEN347
325 PRINT:PRINT"UNRECOVERABLE SYSTEM ERROR HAS OCCURED"
330 IF(ERR/2+1)<>58THEN335
333 CLOSE:PRINT"DISK ERROR";ERR;ERL
334 IFFNCS=0THEN334ELSE1487
335 CMD"P",I:IFI=48LPRINT"- ERROR #";ERR/2+1;" AT LINE";ERL;TIME$;" ^";UR;"]"
345 PRINT"please wait:":PRINT:CLOSE:RUN
347 RESUME348
348 RETURN
350 REM
352 BK=0:O$=INKEY$:IFO$=""THENRETURNELSEO=USR3(ASC(O$))
354 IFFNCDTHEN1480
355 IFO=32ORO=3THENBK=1:POKED2,PEEK(D1):RETURN
360 IFO<>19RETURN
362 POKED0,201
365 O$=INKEY$:IFO$=""THEN368ELSEO=USR3(ASC(O$))
366 IFO=32ORO=3THENBK=1:POKED0,42:GOTO355:ELSE369
368 IFFNCD=0THEN365ELSEPOKED0,42:GOTO1480
369 POKED0,42:RETURN
371 PRINTCHR$(14);:POKEUP,0:POKEBD,0:IFFNCSTHENOUT233,&H77:GOTO387ELSEIFFNCD=0THEN389
372 OUT233,&H77:LSETDS$="wait":D8=VAL(MID$(TIME$,10)):D9=1:F=1:GOSUB319
373 H=&H77:L=&H55:OUT233,H:PRINT"aA";:CLS:R=0:OPEN"I",6,"LOGIN/TXT"
374 IFFNCSTHENLSETDS$="local":IC=0:LSETIC$=CHR$(IC+48):PUT5,1:PRINT:PRINT:OUT233,&HFF:POKEBD,1:GOTO389
376 IF(INP(232)AND32)=0THENLSETDS$="carrier":IC=1:GOTO380
377 R=R+1:IFR=350THENGOSUB3900:R=0
378 A$=INKEY$:GOTO374
380 LSETIC$=CHR$(IC+48):PUT5,1:I$="":R=1
381 A$=INKEY$:IFA$=""THEN385
382 IFASC(A$)>128THENA$=CHR$(ASC(A$)-128)
383 IFASC(A$)>31THENI$=I$+A$:IFLEN(I$)=255THEN386
384 R=R+1:IFINSTR(I$,"1200")<>0THEN386ELSEIFR<100THEN381
385 R=R+1:IFR<50THEN381
386 IFINSTR(I$,"1200")<>0THEN387ELSE388
387 POKEBD,1:PRINT:PRINT"::: 1200 BAUD CONNECTION :::":GOTO389
388 POKED3,129:POKED1,1:POKED2,1:OUT233,L:GOSUB318:PRINT:PRINT"::: 300 BAUD CONNECTION :::"
389 PRINT:GOSUB428:GOSUB4180:GOTO1000
392 GOSUB400:IFX<LMORUL>2RETURN
398 PRINT:PRINT"Time Limit Reached!!":GOTO2666
400 Y=VAL(MID$(TIME$,10))*60+VAL(MID$(TIME$,13)):X=VAL(TT$)*60+VAL(MID$(TT$,4)):IFX>YTHENX=X-1440
401 X=Y-X:RETURN
407 J$=LEFT$(TIME$,8)
410 Y2=365*(VAL(MID$(J$,7,2))-84)+D(VAL(J$)-1)+VAL(MID$(J$,4))
416 Y2=CINT((Y2/7-CINT(Y2/7))*7+.5)
418 DY$=MID$("SunMonTueWedThuFriSat",Y2*3+1,3):RETURN
428 X=1:IFINKEY$<>""THEN428
430 PRINT:PRINT"Linefeeds (Y/N)? ";:EH=700:GOSUB580
432 IFA$="Y"THENZ=254:GOTO435
434 IFA$="N"THENZ=201ELSEX=X+1:IFX<6THEN430ELSE445
435 T=(PEEK(17109)+PEEK(17110)*256)-65536
440 POKET+5,Z:RETURN
445 IFPEEK(BD)=0OUT233,&H77:POKEBD,1:GOSUB319:GOTO448
447 GOSUB318:POKED3,129:POKED1,1:POKED2,1:OUT233,&H55:POKEBD,0
448 GOTO428
480 GET5,1:UR=CVI(CU$):UL=ASC(AC$):CC=ASC(CC$):GOTO1560
495 GOTO1000
500 REM
510 IFFNCDTHEN1480
511 POKE &HF2B3,0
512 V=VARPTR(E$):POKE&HF2B1,PEEK(V+1):POKE&HF2B2,PEEK(V+2)
515 POKE&HF2AD,CP:POKE&HF2AE,EH:POKE&HF2AF,WR:POKE&HF2B0,ML
525 IFUSR4(0)THEN
526 IFLF=0PRINT
527 IFFNCDTHEN1480
530 E=PEEK(&HF2B3):IFWR=0THENA$=LEFT$(E$,E):GOTO540
531 U=PEEK(&HF2AF):IFE=0ANDU>1THENA$=LEFT$(E$,ML):E=ML-1:FF=1:GOTO540
532 IFE>0THENIFMID$(E$,E,1)=" "THENE=E-1
535 A$=LEFT$(E$,E):FF=U-1
540 CP=0:EH=0:WR=0:LF=0:ML=76:RETURN
579 X$="YN"
580 REM
581 POKE&HF5C7,1:IFFNCDTHEN1480ELSEIFBR=0PRINT"^";
582 A$=INKEY$:IFA$<>""THEN584
583 EH=EH+(EH>0):IFFNCDOREH=1THEN1480ELSE582
584 A1=ASC(A$):A=USR3(ASC(A$)):A$=CHR$(A)
585 I=INSTR(X$,A$):IFI=0ANDX$<>""THEN582
586 IFA>31ANDA<127PRINTA$;ELSEIFA<>13THEN582
587 PRINTLEFT$("]",ABS(BR-1));:IFLF=0PRINT
588 POKE-2617,0:LF=0:EH=0:BR=0:X$="":RETURN
600 REM
602 U=0:NX=FP:IFFP<>NPTHENPUT2,NP:NP=FP:GET2,NP:U=1
605 A0=USR2(VARPTR(BM$)):IFA0=0THEN630
610 J=USR7(ASC(MID$(BM$,A0)))
620 NF=(NP-1)*1536+(A0-1)*8+J+1:RETURN
630 FP=FP+1:IFFP>6THENFP=1
632 IFFP=NXTHENF=0:RETURN
635 IFU=0PUT2,NP
637 GET2,FP:NP=FP:U=1:GOTO605
640 REM
642 GOSUB60
645 IFA0<>NPTHENPUT2,NP:NP=A0:GET2,NP
646 Z2=VP+Z-1:POKEZ2,(PEEK(Z2)ORB(Z1))
649 RETURN
650 REM
652 GOSUB60
654 IFNP<>A0THENNP=A0:GET2,NP:IFNP<FPTHENFP=NP
655 Z2=VP+Z-1:POKEZ2,(PEEK(Z2)AND(255-B(Z1)))
659 PUT2,NP:RETURN
660 REM
665 GOSUB600:R1=NF:X2=0:IFR1=0RETURN
670 B$="":FORIK=1TON:B$=B$+M$(IK)+CR$:M$(IK)=""
672 IFLEN(B$)>40THENGOSUB680:GOTO672
674 NEXT:IFB$=""THEN676
675 GOSUB680:IFB$<>""THEN675
676 R2=R:GET1,R2:LSETPT$=MKI$(0):PUT1,R2
679 PUT2,NP:RETURN
680 LSETM$=B$
682 R=NF:GOSUB640:GOSUB600
688 LSETPT$=MKI$(NF)
690 PUT1,R:X2=NOTX2:IFX2PRINT".";
692 B$=MID$(B$,41):RETURN
700 REM
710 MX=26:N=0:OK=0:FF=0:F$=""
715 PRINT"Enter text; type a period (.) when done.":PRINT
717 L=N+1:GOSUB797
720 WR=1:IFFF=0THENLF=1:GOSUB500:GOTO725
722 PRINTF$;:LSETE$=F$:POKE&HF2B3,LEN(F$):LF=1:GOSUB512
725 IFA$="."THENPRINT:GOTO750
728 IFFF>0THENF$=MID$(E$,E+2,FF):PRINTSTRING$(FF,8);STRING$(FF,32):ELSEPRINT
730 N=N+1:M$(N)=A$
735 IFN=MX-1PRINT"two lines left"
740 IFN<=MXTHEN717
750 FF=0:PRINT:PRINT"Cont  Edit  List  Abort  Save -? ";:X$="CELAS":IFUL=9THENX$=X$+"F"
752 GOSUB580:IFI=6THEN785
760 ONIGOTO762,768,780,794,796
762 IFN<=MXTHEN717ELSE750
765 L=0:PRINT"Line: ";:ML=2:GOSUB500:IFA$=""RETURN
766 V=VAL(A$):IFV<1ORV>NTHEN765
767 L=V:I0=1:GOSUB797:PRINTM$(L):PRINT:RETURN
768 PRINT"Change  Retype  Insert  Delete ? ";:X$="CRID"+CR$:GOSUB580:IFI=5THEN750
769 PRINT:ONIGOTO770,773,798,775
770 GOSUB765:IFL=0GOTO750ELSEPRINT"String to edit: ";:GOSUB500:B$=A$:IFB$=""THEN750
771 I=INSTR(M$(L),B$):IFI<>0THENML=LEN(B$)+(ML-LEN(M$(L))):PRINT"Replacement   : ";:GOSUB500:ELSEPRINT"Not found":B$="":GOTO750
772 M$(L)=LEFT$(M$(L),I-1)+A$+MID$(M$(L),LEN(B$)+I):B$="":GOTO750
773 GOSUB765:IFL=0GOTO750ELSEGOSUB797:GOSUB500:IFA$<>""THENM$(L)=A$
774 GOTO750
775 PRINT"DELETE From Line: ";:ML=2:GOSUB500:IFA$=""THEN750
776 B$=A$:PRINT"       To Line  : ";:ML=2:GOSUB500:IFA$=""THENA$=B$
777 V1=VAL(B$):V2=VAL(A$):IF(V1<1)OR(V1>N)OR(V2<1)OR(V2>N)OR(V2<V1)PRINT"Line Range Error":GOTO750
778 M=(V2-V1)+1:IFN>V2THENFORI=V2+1TON:M$(I-M)=M$(I):NEXT
779 N=N-M:PRINT M;"Line(s) Deleted":GOTO750
780 IFN=0THEN750ELSEPRINT"From Line: ";:ML=2:GOSUB500:V=VAL(A$):IFV<1ORV>NTHENV=1
781 FORI=VTON:L=I:GOSUB797
782 PRINTM$(I)
783 GOSUB350:IFBKTHENI=N
784 NEXT:GOTO750
785 PRINT"Filename: ";:CP=1:GOSUB500:IFA$=""THEN750
786 ONERRORGOTO789:OPEN"I",6,A$
787 IFEOF(6)THENCLOSE6:GOTO750
788 N=N+1:LINEINPUT#6,M$(N):GOTO787
789 PRINT"Bad Filename":ONERRORGOTO322:RESUME750
794 PRINT"Abort, really (Y/N)? ";:GOSUB579:IFI=2THEN750
795 OK=0:RETURN
796 OK=1:RETURN
797 IFL>9PRINTUSING"## ";L;:RETURN:ELSEPRINTUSING"0# ";L;:RETURN
798 IFN>=MXTHEN750ELSEPRINT"INSERT At Line: ";:ML=2:GOSUB500:L=VAL(A$)
799 IFL<1ORL>NTHEN750
800 FORI=NTOLSTEP-1:M$(I+1)=M$(I):NEXT:N=N+1
801 GOSUB797:GOSUB500:M$(L)=A$:GOTO750
805 U=0:X1=PEEK(BD):AA=B:I=1:GOSUB350:IFBKTHEN830
806 GET1,R:R=CVI(PT$):IFLEFT$(M$,1)="$"THENF$=MID$(M$,2,FNSP(M$)-1)+"/TXT":GOSUB950:GOTO835
807 IFX1=0THEN814
808 IFR=0THEN812
810 FORR=RTO0STEP0:U=U+1:M$(U)=M$:GET1,R:R=CVI(PT$):NEXT
812 Q=USR1(VARPTR(M$)):U=U+1:M$(U)=LEFT$(M$,Q):GOTO830
814 IFR=0THEN820ELSEFORR=RTO0STEP0:PRINTM$;
817 GOSUB350:IFBKTHENR=0:GOTO819
818 GET1,R:R=CVI(PT$)
819 NEXT:IFBKTHEN835
820 PRINTLEFT$(M$,FNSP(M$))
830 IFX1GOSUB845
831 IF FL PRINT#6,CR$
835 B=AA:FL=0:CLOSE6:RETURN
845 IFU=0RETURN
846 FORI=1TOU:PRINTM$(I);:IF FL PRINT#6,M$(I);
847 GOSUB350:IFBKTHENI=U
848 M$(I)="":NEXT:PRINT:RETURN
880 REM
882 GOSUB3895
884 IFFNQI(X1)=X2GOSUB3870
886 MID$(U$,(X1-1)*2+1,2)=MKI$(R):X1=FNQI(X1):GOSUB3897:RETURN
892 GET1,R:R1=CVI(PT$):GOSUB650
893 IFFNCSOR(UR=0ANDFNCD=0)THENRETURN
894 IFR1=0RETURNELSER=R1:GOTO892
900 REM
905 K!=0:J=1:H=LEN(A$):IFH=0THENLSETRR$=ZR$:RETURN
907 IFLEFT$(A$,4)="THE "ANDH>4THENJ=5
910 S=INSTR(J,A$," ")-1:IFS>=0ANDPWTHENS=S+1:GOTO915
912 IFS<0THENS=H
915 FORJ=JTOS:K!=K!+ASC(MID$(A$,J,1))/10:NEXT
920 LSETRR$=K1$
930 H=RND(839):PW=0:RETURN
940 REM
945 T$="":FORJ=0TO2
948 T$=T$+CHR$(VAL(MID$(TIME$,J*3+1,2))):NEXT:RETURN
950 REM
955 OPEN"I",6,F$
960 IFEOF(6)CLOSE6:RETURN
962 LINEINPUT#6,A$:FORI=1TOLEN(A$)STEP15
964 PRINTMID$(A$,I,15);:GOSUB350:IFBKCLOSE6:I=255
970 NEXT:PRINT:GOTO960
1000 REM
1010 GOSUB960:TR=1
1150 PRINT"Enter your name, or type NEW"
1155 PRINT">";:CP=1:ML=20:GOSUB500:C$=A$:IFA$=""THEN1150
1158 IFC$="NEW"THEN1300
1164 A$=C$:GOSUB900
1165 FORU=1TO839:GET4,H:I=FNCR:IFLN$=DL$THEN1167
1166 IFLEFT$(NA$,I-1)=C$ANDLN$<>ZR$THENR=H:GOTO1185
1167 IFLN$<>ZR$THENH=FNINC(H):NEXT
1168 GOTO1190
1185 IFPW$=ZR$THEN1210
1186 PRINT"Password? ";:CP=1:EH=1:GOSUB500:PW=1:GOSUB900
1188 IFRR$=PW$THEN1210
1189 PRINT:PRINT"Password incorrect!":GOTO1200
1190 PRINT:PRINT"Name not on file"
1200 PRINT:TR=TR+1:IFTR<4THEN1150
1208 GOTO1485
1210 REM
1211 GET5,1:IFR<>CVI(QU$)ORASC(AC$)>2ORR=196THEN1215
1212 F$="LOG2/TXT":GOSUB950:GOTO1480
1215 J=FNCR:GOSUB4180:PRINT
1220 PRINT"Searchlight BBS Welcomes ";LEFT$(NA$,J-1);:GOSUB350
1225 GOSUB407:PRINT" On ";DY$;" ";LEFT$(TIME$,8):GOSUB350
1227 D=CVI(SP$)+1:IFD>1THENX=USR9(VARPTR(LL$)):PRINT" You last called on ";J$:GOSUB350
1232 GET5,1
1233 LSETTT$=MID$(TIME$,10)
1235 PRINT" You are caller #";:C=CVI(CN$):PRINTSTR$(C);:GOSUB350
1236 IFASC(AC$)=9THEND=0:GOTO1241
1238 C=C+1:LSETCN$=MKI$(C)
1240 PRINT", with";D;"calls total":LSETSP$=MKI$(D):GOSUB350
1241 LSETCU$=MKI$(R):LSETIC$=CHR$(IC+48):PUT5,1
1242 GOSUB940:LSETLL$=T$:PUT4,R
1245 REM
1250 UR=R:UL=ASC(AC$):CC=ASC(CC$):POKEUP,UL:IFUL=9GOSUB317
1255 GOSUB4050
1258 IFUL>7PRINT:PRINT"Visible Login (Y/N)? ";:GOSUB579:IFI=2THEN1290
1259 PRINT"Logging Name...";
1260 OPEN"R",6,"LOG:1",252:FIELD 6,2 AS SX$,250 AS CL$
1265 GET6,1:CX$=CL$:I=CVI(SX$)+1:IFI>50THENI=1
1268 T$=CHR$(VAL(MID$(TIME$,10)))+CHR$(VAL(MID$(TIME$,13)))+CHR$(PEEK(BD))
1270 MID$(CX$,(I-1)*5+1,5)=MKI$(UR)+T$:LSETCL$=CX$
1275 LSETSX$=MKI$(I):PUT6,1:CLOSE6
1280 IFUR=196THENLSETBL$=STRING$(24,0):LSETSP$=MKI$(0):PUT4,UR
1285 PRINT:PUT4,R
1290 X=CVI(QU$):GET4,X:F=FNCR:PRINT
1292 PRINT"Last caller was "LEFT$(NA$,F-1);
1293 IFLEFT$(QQ$,1)=CR$PRINT",":PRINT"who logged off improperly.":GOTO1298:ELSEPRINT", who says:"
1294 F=FNSP(QQ$):PRINTQT$;LEFT$(QQ$,F);QT$
1298 IFUL<8GET5,1:LSETQU$=CU$:LSETQQ$=CR$:PUT5,1
1299 GOTO1500
1300 REM
1305 GOSUB4180:PRINT:N=0:F$="NEW/TXT":GOSUB950
1316 PRINT"Select -> ";:X$="RGC"+CR$:GOSUB580
1320 IFI=4PRINT:GOTO1150
1330 ONIGOTO1350,1335,1340
1335 R=196:GET4,R:GOTO1210
1340 GOSUB2500:PRINT:GOTO1305
1350 PRINT:PRINT"Please wait...";:RUN"NEW",R,58
1480 REM
1482 GET5,1:LSETCU$=ZZ$:PUT5,1
1485 POKEUP,0:IFUL<>9THEN1490
1486 IFIC=1AND(INP(232)AND32)<>0THEN1490
1487 PRINT"Reset? ";:GOSUB580:GOSUB317:IFA$="N"THENCLOSE:ONERRORGOTO0:CMD"B","ON":END
1490 REM
1491 CLOSE
1492 IFPEEK(D1)<>PEEK(D2)THEN1492
1493 OUT233,0:OUT234,118
1494 IFFNCD=0ANDIC=1THEN1493
1495 CLOSE:POKED3,129:OUT233,&H77:RUN
1500 REM BBS!
1515 GOSUB4100:PRINT"CTRL-S Pause  CTRL-Q Continue  SPACEBAR Quits":GOSUB2581:GOSUB4180:PRINT
1518 GET4,UR:IFUR=196THEN1522
1520 Y=ASC(CT$):IFY=0GOSUB3972
1522 X=CVI(FM$):IFX=0GOSUB4170:GOTO1550:ELSEPRINT"Checking Your Mailbox...";:U=0:N=0
1523 GET1,X:U=U+1:IFASC(RE$)=0THENN=N+1
1524 X=CVI(ID$):IFX<>0THEN1523
1525 PRINT:PRINT"You Have";U;"Message(s);";N;:IFN=1PRINT"is";:ELSEPRINT"are";
1527 PRINT" New":PRINT:PRINT"Read Mail Now (Y/N)? ";:X$="YN*":GOSUB580:IFI=2THENPRINT:GOTO1550
1528 P=-(I=3):GOSUB1810:GOTO1557
1550 REM
1555 PRINT"Enter "QT$"?"QT$" for menu."
1557 PRINT:B=1:K=0:GOTO2000
1560 REM
1561 IFLEFT$(A$,1)=" "THENA$=MID$(A$,2):GOTO1561
1562 IFA$=""ORA$="."ORA$="-"THENI=22:K=0:GOTO1590
1563 IFVAL(A$)<>0THENK=0:I=22:GOTO1590
1564 IFLEN(A$)<3ANDA$>="A"ANDA$<"M"THENK=0:I=9:GOTO1590
1566 IFLEN(A$)<3ANDA$<>"?"THEN1583
1567 I=1:K=INSTR(A$," "):IFK=0THENK=LEN(A$)+1
1570 J=INSTR(CM$,LEFT$(A$,K-1)):IFJ=0THEN1580
1575 I=(J-1)/6+1:IF(I-1)*6+1=JTHEN1590
1580 IFLEFT$(A$,3)="SET"GOSUB2460:RETURN
1581 IFA$="YBBS"ANDUL>2GOSUB2800:CLOSE:RUN"YBBS"
1582 IFLEFT$(A$,3)="SYS"ANDUL>7GOSUB3304:RETURN
1583 IFK<1THENK=LEN(A$)+1
1585 IFLEN(A$)>2GOSUB1648:IFV>0THENA$=CHR$(64+V):K=0:I=9:GOTO1590
1586 PRINT"Bad command ^";LEFT$(A$,K-1);"] - Type '?' for list":RETURN
1590 IFCCGOSUB4180:IFA$<>""PRINT"> ";MID$(CM$,(I-1)*6+1,6);" ";MID$(A$,K+1):IFI=22PRINT
1600 ONIGOSUB1730,2581,2500,2400,1650,2816,2750,2814,1640,3000,2580,2300,1760,3255,1800,1750,2200,2660,2810,2250,1722,2085,2150,1688,1685,2818,3960
1610 RETURN
1640 REM
1641 V=0:IFK<LEN(A$)THENA$=MID$(A$,K+1)ELSE2494
1642 IFLEN(A$)<3THENV=ASC(A$)-64ELSEGOSUB1648
1643 IFV<1ORV>12PRINT"No such board":RETURN
1644 IFB=VTHENB0=0:PRINT:RETURNELSEGET3,V:ST=ASC(ST$):SY=CVI(SY$):IFST>0THENB=V:GOTO1647
1645 IFUL=9ORUR=SYTHENB=V:GOTO1647
1646 PRINT"Board Temporarily CLOSED":GET3,B:ST=ASC(ST$):SY=CVI(SY$)
1647 PRINT:K=INSTR(A$,"*"):RETURN
1648 V=0:RESTORE1765:FORI=1TO12:READU$:LSETE$=U$:U=USR6(VARPTR(E$)):IFINSTR(E$,A$)THENV=I:I=12
1649 NEXT:RETURN
1650 IFUL=0THENW=1:ELSEW=337
1655 IFUL<8THENCT=CC:CC=0:GOSUB1896:CC=CT:RETURN
1660 UX=UR:UR=1:GOSUB1800:UR=UX:RETURN
1685 PRINT:PRINT"Current Time : ";MID$(TIME$,10):PRINT"Logged on at : ";TT$
1686 GOSUB400:PRINTUSING"Elapsed Time : ### mins.";X: IF UL<3 PRINTUSING"Time Left    : ### mins.";LM-X
1687 GOSUB407:PRINT"Today's Date : ";DY$;" ";LEFT$(TIME$,9):RETURN
1688 PRINT:PRINT"Your Name  : ";:GET4,UR:I=FNCR:PRINTLEFT$(NA$,I-1)
1689 PRINT"Status     : ";:IFUL=9PRINT"Sysop"ELSEIFUL>0PRINT"Validated"ELSEPRINT"New User"
1690 GET4,UR:GET5,1:PRINT"Caller No. : ";:PRINTUSING"#,####";CVI(CN$)
1692 PRINT"No. Calls  : ";CVI(SP$):RETURN
1722 PRINT:PRINT"A Few Recent Quotations:":GOSUB1728
1723 FORI=1TO4:GET6,RND(L)
1724 PRINT
1725 PRINTLEFT$(Q3$,USR1(VARPTR(Q3$))):PRINT" -- ";LEFT$(Q4$,USR1(VARPTR(Q4$)))
1726 GOSUB350:IF BK THEN I=6
1727 NEXT:IFI>5CLOSE6:RETURNELSEPRINT:PRINT"Want More (Y/N)? ";:GOSUB579:IFI=2THENCLOSE6:RETURNELSEGOSUB4175:GOTO1723
1728 OPEN"R",6,"QUOTES",80:FIELD6,60ASQ3$,20ASQ4$:L=LOF(6):RANDOM:RETURN
1730 REM
1731 PRINT:PRINT"-> Commands:":GOSUB1732:IFBKTHEN1744ELSE1743
1732 F=(LEN(CM$)-6)/6:Q=F/4:IFQ*4<>FTHENQ=Q+1
1734 PRINT" ";:FORI=1TOQ:FORJ=0TO3
1736 PRINTMID$(CM$,(J*Q+1)*6+(I-1)*6+1,6);
1738 GOSUB352:IFBKTHENRETURN
1740 IFJ<3PRINT"    ";:ELSEPRINTCR$;:IFI<QPRINT" ";
1742 NEXT:NEXT:RETURN
1743 PRINT:PRINT"-> Type MENU or HELP for more info"
1744 RETURN
1750 REM
1751 PRINT:F$="MENU/TXT":GOSUB950:RETURN
1760 REM
1761 PRINT:PRINTTAB(4)"Board"TAB(27)"Messages";:K=INSTR(A$,"*"):IFKPRINTELSEPRINT"   Sub-Sysop"
1762 JX=B:U=0:IFBL=0GOSUB3900
1765 DATASearchlight,Current Events,Dreamscape
1770 DATAMusic,Programming,Computers,College Prep
1775 DATASports Board,Joke Book,Dear Chippy,BBS Reviews,Policy/Suggestion,EOR
1776 GET4,UR:B$=BL$:N=1:RESTORE1765:NM=2
1778 READA$:IFA$="EOR"THEN1797
1779 X=M(N,2):I=CVI(MID$(B$,(N-1)*2+1,2)):IFKTHENIFI>=XTHEN1793
1780 PRINT" ";CHR$(64+N);"- ";A$;" ";STRING$(23-LEN(A$),".");" ";
1782 GOSUB352:IFBKTHEN1798
1785 Y=M(N,1):PRINTUSING"^###]";Y;:U=U+Y
1787 IFI<XPRINT"*";:ELSEPRINT" ";
1790 IFKORM(N,3)=0THENPRINT:GOTO1793
1791 GET4,M(N,3):J=FNCR:PRINT"   ";LEFT$(NA$,J-1)
1793 GOSUB352:IFBKTHEN1798
1794 N=N+1:GOTO1778
1797 IFK=0PRINT"* indicates new messages    ";:PRINTUSING"^####] total";U
1798 B=JX:RETURN
1800 REM
1802 P=0:IL=0:A$=MID$(A$,K+1):IFA$="R"THEN1810ELSEIFA$="L"THEN1990ELSEIFA$="N"THEN1809
1803 IFA$<>""THEN1900
1804 PRINT:PRINT"Mail: ^L]ist ^R]ead ^N]ew ^S]end: ";:X$="LRNS"+CR$:GOSUB580
1806 ONIGOTO1990,1810,1809,1900:RETURN
1809 P=1
1810 GET4,UR:X=CVI(FM$):LZ=0:RP=0
1815 IFX=0GOTO4170
1820 RE=-1:GET1,X:Y=CVI(ID$):IFPTHENIFASC(RE$)THENI=2:GOTO1846
1821 GOSUB4175
1822 PRINT:GOSUB1825:S$=LEFT$(SJ$,USR1(VARPTR(SJ$))):GOTO1842
1825 W=CVI(WH$):IFW=0PRINT"From ANONYMOUS";:GOTO1830
1826 GET4,W:I=FNCR:IFLN$=DL$ORLN$=ZR$PRINT"<deleted user>";:W=-1:GOTO1830
1828 IF(USR9(VARPTR(MD$)))OR1GOSUB410:PRINT"From "LEFT$(NA$,I-1);
1830 PRINT" on "DY$" "J$
1840 PRINT"Subj: "LEFT$(SJ$,USR1(VARPTR(SJ$)));:RETURN
1842 IFASC(RE$)>0PRINT" ^Read";STR$(ASC(RE$))"]";:ELSEPRINT" ^New]";
1843 IFUL<8PRINTELSEVV=ASC(AC$):IFVV=0PRINT" ^I]"ELSEPRINT
1845 IFILTHENI=1ELSEPRINT"Read now (Y/N/Q)? ";:X$="YNQ":GOSUB580
1846 IFI=2THENLZ=X:GOTO1892
1847 IFI=3THENRETURN
1850 PRINT:R=CVI(PT$):R3=R
1852 GOSUB805
1853 PRINT:I2=I
1854 IFRE=-1THENGET1,X:RE=ASC(RE$)+1:LSETRE$=CHR$(RE):PUT1,X
1855 PRINT"<L>ist <R>eply <CR>: ";:X$="LRF"+CR$
1856 GOSUB580:RP=(I=2)
1858 IF(I=3ANDUL=9)PRINT"Filename: ";:GOSUB500:OPEN"E",6,A$:FL=1:I=1
1859 IFI=1THENR=R3:I=I2:PRINT:GOTO1852
1860 IFUL>2THEN1862
1861 IFRE>2THEN1865
1862 PRINT"Delete this message? ";:GOSUB579:II=I
1863 IFVV=0ANDUL>7ANDW>0PRINT"Validate? ";:GOSUB579:IFI=1GET4,W:LSETAC$=CHR$(1):PUT4,W
1864 I=II:IFI=2THENLZ=X:GOTO1890
1865 IFLZ<>0THEN1880
1870 GET4,UR:LSETFM$=MKI$(Y):IFY=0THENLSETLM$=FM$
1875 PUT4,UR:R=X:GOSUB880:IFY=0THEN1894
1876 LZ=0:X=Y:IFRPGOSUB1896
1877 IFILRETURNELSE1815
1880 GET1,LZ:LSETID$=MKI$(Y):PUT1,LZ
1885 R=X:GOSUB880
1886 IFY<>0THEN1890
1887 IFLZ=0THENGET4,UR:LSETFM$=LM$:PUT4,UR:GOTO1890
1888 GET4,UR:LSETLM$=MKI$(LZ):PUT4,UR
1890 IFRPGOSUB1896
1892 IFY<>0THENX=Y:IFILRETURNELSE1815
1894 IFRPTHENGOSUB1896
1895 IFILRETURNELSEPRINT:PRINT"End of Mail":RP=0:RETURN
1896 IFW>0GOSUB4175:PRINT:H=W:PRINT"     To: ";:GET4,H:I=FNCR:PRINTLEFT$(NA$,I-1):ELSEPRINT"Can't reply, user has been deleted":RP=0:RETURN
1897 T1=Y:T2=X:T3=LZ:GOSUB1945
1898 Y=T1:X=T2:LZ=T3:RP=0:RETURN
1900 REM
1901 IFUL=0PRINT:PRINTRG$:PRINT"Use FEED command to contact Sysop.":RETURN
1902 PRINT:IFA$="S"PRINT"Send To: ";:CP=1:GOSUB500:IFA$=""RETURN
1915 K$=A$:GOSUB900:X1=H:F=1
1917 FORU=1TO839:GET4,H
1920 IFLN$=DL$THENH=FNINC(H):NEXT
1921 IFLN$=ZR$THEN1942
1922 I=FNCR:IFLEFT$(NA$,I-1)=K$THEN1945
1923 IFF=1THEN1927ELSEJ=INSTR(K$," "):IFJ=0THENJ=IELSEJ=J+1
1924 IFINSTR(NA$,LEFT$(K$,J))<>0THEN1930
1927 H=FNINC(H):NEXT
1930 PRINT"Send to ";LEFT$(NA$,I-1);" (Y/N)? ";:GOSUB579
1935 IFI=1THEN1945ELSEH=FNINC(H):NEXT
1942 IFF=2PRINT"Invalid user name":RETURN:ELSEF=2:H=X1:NEXT
1945 LF=RP:PRINT"Subject: ";:ML=32:GOSUB500:IFRP=0THENS$=A$:GOTO1948
1946 IFA$=""THENS$=S$+" (R)":PRINTS$:ELSES$=A$:PRINT
1948 GOSUB600:KR=NF:IFKR=0PRINT"Disk Space Full!":RETURN
1950 HH=H:PRINT:GOSUB700:IFOK=0ORN=0THEN1988
1955 PRINT"Saving Message";
1960 LSETWH$=MKI$(UR):LSETID$=MKI$(0):LSETRE$=CHR$(0):GOSUB940
1962 LSETMD$=T$:LSETSJ$=S$:PUT1,KR:R=KR:GOSUB640:PUT2,NP
1965 GOSUB660:GET1,KR:LSETPT$=MKI$(R1):PUT1,KR
1970 GET4,HH:X=CVI(FM$):IFX<>0THEN1980
1972 LSETFM$=MKI$(KR):LSETLM$=FM$:PUT4,HH:GOTO1986
1980 X=CVI(LM$):GET1,X:LSETID$=MKI$(KR):PUT1,X
1985 LSETLM$=MKI$(KR):PUT4,HH
1986 PRINT
1988 RETURN
1990 GET4,UR:X=CVI(FM$):GOSUB1992:IFC=0ORBKRETURNELSE1997
1992 C=0:IFX=0RETURNELSEPRINT:PRINT"    From";TAB(26);"Subj"
1994 FORX=XTO0STEP0:GET1,X:C=C+1:M$(C)=MKI$(X):X=CVI(ID$):W=CVI(WH$):GET4,W:IFASC(RE$)PRINT" ";ELSEPRINT"*";
1995 PRINTUSING"##. ";C;:GOSUB4150:GOSUB352:X=X-X*BK:NEXT:RETURN
1997 PRINT:PRINT"Read: <1-";MID$(STR$(C),2);"> <CR> ? ";:CP=1:ML=2:GOSUB500:V=VAL(A$):IFV=0RETURNELSEIFV<1ORV>CTHEN1997
1998 X=CVI(M$(V)):IFV=1THENLZ=0ELSELZ=CVI(M$(V-1))
1999 IL=1:GOSUB4175:GOSUB1820:GOSUB4175:IL=0:GOTO1990
2000 REM
2010 RESTORE1765:FORI=1TOB:READB1$:NEXT
2015 GET3,B:N1=CVI(NN$):X1=CVI(NX$):GET4,UR
2020 Y1=CVI(MID$(BL$,(B-1)*2+1,2)):MM=0:MP$=IX$
2022 ST=ASC(ST$):SY=CVI(SY$)
2025 PRINT"Active Sub: ";B1$:POKELC,B
2026 IFSY<>0GET4,SY:I=FNCR:PRINT"Sub-Sysop : ";LEFT$(NA$,I-1)
2028 PRINTN1;"Messages";
2030 IFX1>Y1PRINT"; some NEW":ELSEPRINT"."
2032 IFX1>Y1ANDKTHENB0=B:A$="":GOSUB2200
2040 PRINT
2041 GOSUB392:PRINTCHR$(64+B)"-^";:CP=1:B0=B:LF=1:GOSUB500
2042 IFA$=""THENPRINTCHR$(8);" ";:ELSEPRINT"]"
2043 IFFNCSGOSUB2550:GOTO2040
2044 IFLEFT$(A$,1)="/"THEN2041
2050 GOSUB1560
2055 IFB=B0THEN2040ELSE2000
2085 REM
2086 P=0:IFMID$(A$,K+1,1)="."THENMM=MM-(MM=0):GOTO2100
2087 IFMID$(A$,K+1,1)="-"ANDVAL(MID$(A$,K+1))=0THENMM=(MM-1)-N1*(MM<2)-(MM=0):GOTO2100
2088 GOSUB2090:IFV=0ANDA$<>""THENMM=MM-1:GOTO2494
2089 IFABS(V)>N1THEN2493ELSE2100
2090 IFMID$(A$,K+1,1)="."THENV=MMELSEV=VAL(MID$(A$,K+1))
2092 IFV=0ORV>N1THENMM=MM+1:GOTO2096
2095 MM=ABS(V)
2096 IFV<0THENMM=N1:P=ABS(V):RETURN
2097 I=INSTR(A$,"-"):IFI=0THENI=INSTR(A$,"+")
2098 IFI>0THENP=VAL(MID$(A$,I+1)):IFP=0THENP=N1
2099 RETURN
2100 IFMM>N1THENPRINT"No More Messages":MM=N1:RETURN
2102 IFINSTR(A$,",F")ANDIC=0ANDUL=9PRINT"Filename: ";:GOSUB500:OPEN"E",6,A$:FL=1
2105 R=CVI(MID$(MP$,(MM-1)*2+1,2)):GET1,R
2107 PRINT"Msg";MM;:GOSUB1825:PRINT
2126 II$=ID$:V1=CVI(ID$)
2130 R=CVI(PT$):GOSUB805:IFBKTHENP=0
2131 IFMM=N1THENGET3,B:II$=NX$:GOTO2132ELSEIFV1<=Y1THEN2135
2132 GET4,UR:U$=BL$:MID$(U$,(B-1)*2+1,2)=II$:LSETBL$=U$:PUT4,UR:Y1=V1:M(B,2)=V1
2135 IFP=0ORP=MMRETURN
2140 MM=MM+SGN(P-MM):IFMM<1ORMM>N1RETURNELSEPRINT:GOTO2100
2150 REM
2152 IFN1=0RETURN
2153 P=0:GOSUB2090:IFV=0ORV>N1ORMM>N1THENMM=N1:D=-1:U=1:ELSEIFP>0THENU=P:D=SGN(P-MM):ELSEU=N1:D=1
2154 K$="":K=INSTR(A$,QT$):IFK=0THEN2157
2155 I=INSTR(K+1,A$,QT$):I=I-((LEN(A$)+1)*(I=0)):K$=MID$(A$,K+1,I-K-1):A$=LEFT$(A$,K-1)
2157 IFD=-1ANDMM=1THENMM=N1
2158 PRINT:PRINTB1$;TAB(24);N1"Messages"
2159 F=INSTR(A$,"D"):Z=INSTR(A$,"*")
2160 AA=B:FORI=MMTOUSTEPD:R=CVI(MID$(MP$,(I-1)*2+1,2))
2162 GET1,R:IFK$=""THEN2165
2164 A$=LEFT$(SJ$,USR1(VARPTR(SJ$))):V=USR6(VARPTR(A$)):IFINSTR(A$,K$)=0THEN2172
2165 IFZTHENIFCVI(WH$)<>URTHEN2172
2166 IFCVI(WH$)=URTHENPRINT"*";:GOTO2168
2167 IFCVI(WH$)=SYPRINT"+";:ELSEPRINT" ";
2168 PRINTUSING"###. ";I;:IF F PRINTUSING" ### #### ";CVI(ID$);R;
2170 GOSUB4155
2172 GOSUB350:IFBKTHENI=U
2175 NEXT
2190 B=AA:RETURN
2200 C=N1:PRINT
2202 X1=1:X2=N1:K$=""
2204 C=(X1+X2)/2:IFX1>X2THEN2220
2205 R=CVI(MID$(MP$,(C-1)*2+1,2)):GET1,R:X=CVI(ID$)
2210 IFY1<XTHENX2=C-1:GOTO2204
2212 IFY1>XTHENX1=C+1:GOTO2204
2215 X1=C+1
2220 IFX1>N1THENPRINT"No New Messages":RETURN
2222 PRINT"New Messages:"
2225 MM=X1:U=N1:D=1:GOSUB2159:MM=X1-1:RETURN
2250 REM
2252 AA=B:AK=B:IFUL=0THENPRINTRG$:RETURN
2255 IFN1=124GOTO2259
2257 IFST>1THEN2260
2258 IFUL=9ORUR=SYTHEN2260
2259 PRINT"Cannot Post Message":RETURN
2260 PRINT:PRINT"Enter Title of your Posting:"
2265 PRINT">";:ML=32:GOSUB500:IFA$=""THENRETURN
2266 AN=0:S$=A$:IFST<3THEN2270
2267 PRINT"Post Anonymously (Y/N)? ";:GOSUB579
2268 IFI=1THENAN=1
2270 PRINT:GOSUB700:IFOK=0ORN=0THENB=AA:GOTO2298
2275 GOSUB600:IFNF=0PRINT"No Disk Space!":B=AA:RETURN
2276 PRINT"Saving #";MID$(STR$(N1+1),2);:B=AA:GET3,B
2280 X1=CVI(NX$)+1:LSETID$=MKI$(X1):LSETNX$=ID$
2285 LSETSJ$=S$:LSETWH$=MKI$(UR-UR*AN):GOSUB940
2290 LSETMD$=T$:PUT1,NF:R=NF:GOSUB640:RR=R:PUT2,NP
2295 GOSUB660:GET1,RR:LSETPT$=MKI$(R1):PUT1,RR
2296 B=AK:N1=N1+1:MID$(MP$,(N1-1)*2+1,2)=MKI$(RR):LSETIX$=MP$:LSETNN$=MKI$(N1):PUT3,B:M(B,1)=N1:PRINT
2298 RETURN
2300 REM
2305 IFUL=0PRINTRG$:RETURN
2310 GOSUB2492:IFV=0RETURN
2315 F1=INSTR(A$,"+"):IFF1=0THENF1=INSTR(A$,"-")
2325 X=CVI(MID$(MP$,(V-1)*2+1,2)):GET1,X
2330 IFUL>7ORUR=SYTHEN2350
2335 F1=0:IFUR=CVI(WH$)THEN2350
2340 PRINT"Permission Denied!":RETURN
2350 PRINT:PRINT"Msg";V;:GOSUB1825:PRINT:PRINT
2355 PRINT"Delete (Y/N/Q)? ";:LF=1:X$="YNQ":GOSUB580:IFI=2THENPRINT:V=V+1:GOTO2380:ELSEIFI=3PRINT:GOTO2390
2360 PRINT"  ";:R=X:GOSUB880
2365 MP$=LEFT$(MP$,(V-1)*2)+MID$(MP$,2*V+1)+ZZ$
2370 LSETIX$=MP$:N1=N1-1:IFMM>N1THENMM=N1
2375 LSETNN$=MKI$(N1):PUT3,B:M(B,1)=N1
2376 PRINT"-- deleted --":MM=V-1
2380 IFF1=0ORV>N1THEN2390
2385 X=CVI(MID$(MP$,(V-1)*2+1,2)):GET1,X:GOTO2330
2390 RETURN
2400 REM
2405 PRINT:GOSUB2492:IFV=0RETURN
2415 VX=V:X=CVI(MID$(MP$,(V-1)*2+1,2)):GET1,X:XX=X
2420 IFUL>7ORUR=SYTHEN2425
2422 IFUR=CVI(WH$)THEN2425
2423 GOTO2340
2425 AA=B:PRINT"Reading...";:N=1:M$(N)="":X=CVI(PT$):UU=X:GET1,X:J=1:X=CVI(PT$)
2430 I=INSTR(J,M$,CR$):IFI=0THENI=41
2432 M$(N)=M$(N)+MID$(M$,J,I-J):J=I+1
2434 IFI<41THENN=N+1:M$(N)="":GOTO2430
2436 IFX=0THEN2440
2438 GET1,X:X=CVI(PT$):J=1:GOTO2430
2440 N=N-1:OK=0:MX=30:GOSUB750:B=AA
2445 IFOK=0RETURN
2450 PRINT"Saving Changes";:R=UU:GOSUB880
2455 GOSUB660:GET1,XX:LSETPT$=MKI$(R1):PUT1,XX:PRINT:RETURN
2460 IFUL<8RETURN
2465 PRINT"CO-SYSOP: CURRENT -";SY;
2470 IFSY=0THENPRINTELSEGET4,SY:I=FNCR:PRINTLEFT$(NA$,I-1)
2475 PRINT"CHANGE TO: ";:GOSUB500:IFA$<>""THENSY=VAL(A$)
2480 PRINT"STATUS: ";
2485 PRINT"CURRENT-";ST;"   CHANGE TO: ";:GOSUB500:IFA$<>""THENST=VAL(A$)
2490 GET3,B:LSETSY$=MKI$(SY):LSETST$=CHR$(ST):PUT3,B:RETURN
2492 V=VAL(MID$(A$,K+1)):IFV=0THENIFINSTR(K+1,A$,".")THENV=MM
2493 IFV>0ANDV<=N1RETURNELSEIFV<>0PRINT"Invalid number - must be 1 to";N1:V=0:RETURN
2494 PRINT"Parameter(s) required - see HELP ";MID$(CM$,J,6)
2496 RETURN
2500 REM
2505 PRINT"Paging Sysop...";:T$=TIME$:N=0:LSETDC$="C":GOTO2520
2510 IFFNCSTHEN2550
2515 IFT$=TIME$THEN2510
2520 N=N+1:PRINT".";:IFN<(8+UL)THENGOSUB310:IFUL>1GOSUB310
2525 IFN<15THENT$=TIME$:GOTO2510
2530 PRINT:PRINT"Sorry, the Sysop is unavailable.":RETURN
2550 PRINT:PRINT"^sysop on line]":POKE-2617,0:K=1
2555 FORIT=1TO2
2556 I3$=INKEY$:IFI3$=""THEN2556
2557 PRINTCHR$(USR3(ASC(I3$)));:NEXT
2560 FORI0=1TO32765:I3$=INKEY$:IFI3$=""THEN2565ELSEIFI3$=CHR$(12)THEN2572
2561 IFI3$=CHR$(6)THENONKGOSUB2576,2578:GOTO2565
2564 PRINTCHR$(USR3(ASC(I3$)));:IFK=2PRINT#6,CHR$(USR3(ASC(I3$)));
2565 IFFNCS=0THENNEXT:GOTO2560
2570 PRINT:PRINT"^sysop off line]":GOSUB2578:LSETDC$=""
2571 IFFNCSTHEN2571ELSERETURN
2572 PRINT:PRINT"*";:EH=1:CP=1:GOSUB500:PW=1:GOSUB900:GET5,1:IFRR$=PP$GOSUB3305
2574 GOTO2565
2576 OPEN"E",6,"CHAT/LOG:1":GET4,UR:J=FNCR:PRINT#6,CR$;TIME$;" - ";LEFT$(NA$,J-1):K=2:LSETDC$="F":RETURN
2578 CLOSE6:K=1:LSETDC$="C":RETURN
2580 F$="INFO/TXT":GOSUB950:RETURN
2581 PRINT:PRINT"Searchlight Bulletins:":GET5,1:X=CVI(UB$):IFX=0THEN2586
2582 PRINT:C=0:F1=0:I=0:FORX=XTO0STEP0:GET1,X:C=C+1:M$(C)=MKI$(X):X=CVI(ID$):GOSUB4152:IFASC(RE$)=0THENF1=C
2583 O=0:GOSUB352:IFBKTHENX=0ELSEIFO>48ANDO<57THENI=O-44
2584 IFI<=C+4ANDI<>0THENX=0
2585 NEXT:IFBKRETURNELSEIFI>0ANDI<=C+4THEN2592ELSEIFI>0RETURN
2586 PRINT:PRINT"Read ^1-";MID$(STR$(C),2);"], ^P]ost, ^K]ill, ^Q]uit: ";:X$="PKQ"+CR$+LEFT$(NO$,C):IFUL>7THENX$=X$+"S"
2588 GOSUB580:IFI=3ORI=4RETURN
2590 IFA$="S"THENGOSUB4070:GOSUB4180:GOTO2581
2591 IFI<3THENONIGOSUB4040,4030:PRINT:GOSUB4175:GOTO2581
2592 GOSUB4025:GOTO2581
2605 PRINT:IFUL=0PRINT"Can't change password":PRINT:RETURN
2610 N=0:GET4,UR:IFUL>7ORPW$=ZR$THEN2630
2615 PRINT"Enter OLD password:";:EH=1:CP=1:GOSUB500
2620 PW=1:GOSUB900:IFRR$=PW$THEN2630
2625 N=N+1:IFN<>3PRINT"incorrect, try again":PRINT:GOTO2615
2626 GOTO1480
2630 PRINT"Enter new password:";:EH=1:CP=1:GOSUB500
2635 PW=1:GOSUB900:P$=RR$
2640 PRINT"Re-enter password :";:EH=1:CP=1:GOSUB500
2645 PW=1:GOSUB900:IFRR$=P$THEN2650
2648 PRINT"Attempts differ- password unchanged!":RETURN
2650 LSETPW$=RR$:PUT4,UR:PRINT"Password changed.":RETURN
2660 PRINT"Ready to Log Off (Y/N)? ";:GOSUB579
2662 IFI=2RETURN
2665 PRINT:CLOSE1,2,3
2666 GET4,UR:J=FNCR:GET5,1:PRINT"Please leave us a quote:":PRINT">";:ML=60:GOSUB500:IFLEN(A$)=0THENIFUL>7THEN2672ELSEIFFNCSTHEN2550ELSE2666
2669 LSETQQ$=A$:LSETQU$=MKI$(UR):PUT5,1
2670 GOSUB1728:LSETQ3$=A$:LSETQ4$=LEFT$(NA$,J-1):PUT6,RND(L):CLOSE6
2672 PRINT:GOSUB407:PRINT"Logoff at ";DY$;" ";TIME$:GOSUB400:PRINT"Elapsed Time =";X;"Minutes":PRINT
2675 I=1:IFLEFT$(NA$,4)="THE "THENI=5
2677 PRINT"Thanks for calling The Searchlight."
2678 PRINT"Live long and prosper, ";MID$(NA$,I,J-I);".":PRINT
2679 PRINT"(c) 1986 Searchlight Software, by Frank LaRosa":PRINT
2680 GOTO1480
2710 REM
2750 Y=1:IFK<LEN(A$)THEN A$=MID$(A$,K+1):K=1:P=0:GOTO2765
2756 K=0:PRINT"Users on file:";CVI(NI$):PRINT
2758 PRINT"Enter name to look for:"
2760 PRINT">";:CP=1:GOSUB500:P=0:IFA$=""THENRETURN
2765 GOSUB900
2770 FORU=1TO839:GET4,H:IFLN$=ZR$THEN2782
2772 IFLN$=DL$THEN2780
2774 IFLEFT$(NA$,LEN(A$))<>A$THEN2780
2776 I=FNCR:PRINT
2777 PRINTLEFT$(NA$,I-1);"; from ";LO$:GOSUB3980:IFASC(AC$)>0PRINT"Validated ";:ELSEPRINT"Non-Validated ";
2778 PRINTC$;" user":X=USR9(VARPTR(LL$)):PRINT"Last logon ";J$;";";CVI(SP$);"calls";:P=P+1
2779 IFUL>7PRINTUSING"  ^###/##]";H,Y:ELSEPRINT
2780 GOSUB350:IFBK=0THENY=Y+1:H=FNINC(H):NEXT
2782 IFP=0PRINT"Name not found"
2783 IF K THEN RETURN ELSEPRINT:PRINT"Enter name:":GOTO2760
2800 REM
2805 PRINT"Loading...";:RETURN
2810 GOSUB2800:RUN"POLLS",R,20
2814 IFUL<1PRINTRG$:RETURN:ELSEGOSUB2800:RUN"GAMES",R,15
2816 GOSUB2800:RUN"FILES"
2818 IFUL<1PRINTRG$:RETURN:ELSEGOSUB2800:RUN"USER",R,5
3000 REM
3001 PRINT:A$=MID$(A$,K+1):IFLEN(A$)>=3THEN3020
3002 PRINT"The following help is available:":PRINT
3003 PRINT"^1] Help with individual commands":PRINT"^2] General procedures & tips":PRINT"^3] Validation/New User information":PRINT"^4] Help with the text editor"
3005 PRINT:PRINT"Enter Selection: ";:X$=CR$+"1234":GOSUB580:IFI=1THENRETURN
3006 GOSUB4175:PRINT:ONI-1GOTO3012,3042,3046,3044
3012 PRINT"Type the command you'd like help with,":PRINT"or '?' for a command list: ";:CP=1:GOSUB500:IFA$=""RETURN
3013 IFLEFT$(A$,1)="?"PRINT:GOSUB1732:PRINT:GOTO3012
3014 PRINT
3020 I=INSTR(CM$,A$):IFI>1THEN3030
3025 GOTO1585
3030 J=INSTR(I,CM$," "):IFJ>I+5THENJ=I+6
3035 F$=MID$(CM$,I,J-I)+"/HLP"
3040 GOSUB950:RETURN
3042 F$="GENERAL/HLP":GOSUB950:RETURN
3044 F$="EDITOR/HLP":GOSUB950:RETURN
3046 F$="NEWUSER/TXT":GOSUB950:RETURN
3255 PRINT:PRINT"Call Log of last 50 callers:"
3260 OPEN"R",6,"LOG:1",252:FIELD 6,2 AS SX$,250 AS CL$
3263 PRINT:PRINT"  Time  Caller";TAB(30);"Location"
3265 GET6,1:F=CVI(SX$):Z=F
3270 H=CVI(MID$(CL$,(F-1)*5+1,2))
3272 GET4,H:U$=MID$(CL$,(F-1)*5+3,3):T$=""
3273 FORJ=1TO2:T=ASC(MID$(U$,J,1)):IFT<10THENT$=T$+"0"+MID$(STR$(T),2):NEXT:ELSET$=T$+MID$(STR$(T),2):NEXT
3274 PRINTMID$("LH",ASC(RIGHT$(U$,1))+1,1);" ";
3275 PRINTLEFT$(T$,2);":";MID$(T$,3);" ";:J=FNCR
3280 PRINTLEFT$(NA$,J-1);" ";STRING$(21-J,46);" ";LEFT$(LO$,FNSP(LO$))
3285 F=F-1:IFF<1THENF=50
3287 GOSUB350:IFBKTHEN3295
3290 IFF<>ZTHEN3270
3295 CLOSE6:RETURN
3304 IFUL<8RETURN
3305 UG=UL:IFUL<8THENUL=9
3310 PRINT"SYS>";:CP=1:GOSUB500:K=LEN(A$)
3315 IFA$=""THEN3310
3320 IFA$="Q"THENA$="":UL=UG:RETURN
3325 I=INSTR("?RFUAPKXMTE",A$):IFI=0PRINT"???":GOTO3310
3330 ONIGOSUB3350,3552,3610,2750,3655,3700,3865,3845,3850,3852,3750
3340 GOTO3310
3350 PRINT:PRINT "Access, Read, Free, User, Pass,"
3352 PRINT "Kill, Mem, Time, eXit, Extended"
3355 PRINT:RETURN
3370 RETURN
3500 RETURN
3552 GOSUB4110:IFV=0RETURN
3556 UX=UR:UR=V:A$="":GOSUB1800:UR=UX:RETURN
3610 K=0:PRINT"Mapping";LL;"Records"
3615 FORI=1TOINT(LL/1536)+1
3620 GET2,I:K=K+USR8(VARPTR(BM$)):NEXT
3645 PRINTK;"used  ";LL-K;"free  ";INT(((LL-K)/LL)*100);"%"
3648 GET2,NP:RETURN
3655 GOSUB4110:IFV=0RETURN
3665 V1=V:GET4,V:PRINT"Level: ";ASC(AC$)
3670 PRINT"Change to: ";:GOSUB500:F=VAL(A$)
3672 IFUL<>9AND(F>5ORASC(AC$)>7)THEN2340
3675 LSETAC$=CHR$(F):PUT4,V1:IFF>UGTHENUG=F
3680 RETURN
3700 GOSUB4110:IFV=0RETURN
3710 IFUL<>9ANDASC(AC$)>7THEN2340
3720 UX=UR:UR=V:GOSUB3960:UR=UX:RETURN
3750 GOSUB2800:RUN"SYSOP",R,58
3845 IFUL<>9THEN2340ELSEONERRORGOTO0:GOSUB317
3846 STOP
3847 ONERRORGOTO322:PRINTCHR$(14);:GOSUB316
3848 RETURN
3850 PRINT"MEM";MEM;"FRE";FRE(""):RETURN
3852 GET5,1:LSETTT$=MID$(TIME$,10):PUT5,1:RETURN
3865 GOSUB3870:IFF=0ORR1<>0RETURNELSE3865
3870 GOSUB3895:F=X1-X2:IFF=0RETURN
3872 R=CVI(MID$(U$,(X2-1)*2+1,2)):GOSUB892
3873 IFR1<>0THENMID$(U$,(X2-1)*2+1,2)=MKI$(R1):GOSUB3897:RETURN
3874 X2=FNQI(X2):GOSUB3897:RETURN
3895 GET5,1:X1=CVI(Q1$):X2=CVI(Q2$):U$=DQ$:RETURN
3897 LSETQ1$=MKI$(X1):LSETQ2$=MKI$(X2):LSETDQ$=U$:PUT5,1:RETURN
3900 IFBL=0THENFORI=1TO12:GET3,I:M(I,1)=CVI(NN$):M(I,2)=CVI(NX$):M(I,3)=CVI(SY$):NEXT:BL=1:RETURN
3905 IFF<>0GOSUB3870
3906 RETURN
3915 DATATRS-80,APPLE II,MACINTOSH,IBM/MSDOS,COMMODORE,ATARI,CP/M,ADAM,TI99/4A,OTHER,COCO,AMIGA,ATARI ST,EOR
3920 PRINT"Enter your system type:"
3925 RESTORE3915
3928 FORX=1TO99:READA$
3930 IFA$="EOR"THENX=99:GOTO3945
3935 PRINTUSING"##. ";X;:PRINTA$;
3940 IFX/3=INT(X/3)THENPRINTELSEPRINTSTRING$(12-LEN(A$),32);
3945 NEXT:PRINT
3950 PRINT:PRINT"Type (1-13)? ";:ML=2:GOSUB500:V=VAL(A$):IFV>13ORV<1THEN3950
3955 LSETCT$=CHR$(V):RETURN
3960 IFUL<1PRINTRG$:RETURNELSEPRINT:PRINT"^P] Password Change":PRINT"^F] Linefeeds on/off":PRINT"^A] Auto Screenclear":PRINT"^T] Change System Type":PRINT"^L] Change Location  ...? ";:X$="PFTLA"+CR$:GOSUB580
3970 ONIGOTO2605,430,3972,3974,3976:RETURN
3972 PRINT:GET4,UR:GOSUB3915:PUT4,UR:RETURN
3974 PRINT:GET4,UR:PRINT"Current   : ";LO$:PRINT"Change to : ";:ML=15:GOSUB500:IFA$<>""THENLSETLO$=A$:PUT4,UR:RETURN:ELSERETURN
3976 PRINT:GET4,UR:PRINT"Enable Auto Screenclear (Y/N)? ";:GOSUB579:IFI=2THENI=0
3977 CC=I:LSETCC$=CHR$(I):PUT4,UR:RETURN
3980 C=ASC(CT$):IFC=0THENC$="":RETURN
3982 RESTORE3915
3985 FORX1=1TOC:READC$:IFC$<>"EOR"THEN NEXT
3986 RETURN
4012 RESTORE4020:GOTO4016
4014 RESTORE4022
4016 X=&H402D:FORI=0TO5:READY:POKEX+I,Y:NEXT:RETURN
4020 DATA195,0,0,195,0,0
4022 DATA62,147,239,62,163,239
4025 GOSUB4180:PRINT:GET1,CVI(M$(I-4)):R=CVI(PT$):PRINT"Bulletin #";:PRINTUSING"# ";I-4;:GOSUB1825:PRINT:PRINT:GOSUB805:GOSUB4100:RETURN
4030 PRINT:PRINT"Bulletin to Delete? ";:X$=CR$+LEFT$(NO$,C):LF=1:GOSUB580:IFI=1THENPRINT:RETURNELSEPRINT"  ";:GOSUB4032:GOTO4038
4032 B2=-1:R=CVI(M$(I-1)):GET1,R:IFUL>7ORUR=CVI(WH$)THEN4033ELSE2340
4033 B2=CVI(M$(I-2))
4034 X=CVI(ID$):IFB2=0THENGET5,1:LSETUB$=MKI$(X):PUT5,1ELSEGET1,B2:LSETID$=MKI$(X):PUT1,B2
4036 GOSUB880:RETURN
4038 IFB2>=0PRINT"** Bulletin Killed **":RETURNELSERETURN
4040 IF(F1=0ANDC=8)ORUL=0PRINTRG$:RETURN
4041 B1=CVI(M$(1))+CVI(M$(1))*(C=0):IFF1>0THENIFC=8THENB2=CVI(M$(F1-1)):F1=CVI(M$(F1)):ELSEF1=0
4042 GOSUB4175:PRINT:PRINT"Enter Title of your Bulletin:":PRINT">";:ML=32:GOSUB500:IFA$=""THENPRINT:RETURNELSES$=A$:GOSUB600:KR=NF:PRINT:GOSUB700
4043 IFOK<>1ORN=0PRINT:RETURNELSEPRINT"Saving";
4044 LSETWH$=MKI$(UR):GOSUB940:LSETMD$=T$:LSETSJ$=S$:LSETRE$=CHR$(0):LSETID$=MKI$(B1):PUT1,KR:R=KR:GOSUB640:PUT2,NP
4046 GOSUB660:GET1,KR:LSETPT$=MKI$(R1):PUT1,KR
4047 IFF1>0THENR=F1:GET1,R:GOSUB4034
4048 GET5,1:LSETUB$=MKI$(KR):PUT5,1
4049 PRINT:RETURN
4050 GOSUB3980:J=FNCR:LSETDS$=LEFT$(NA$,J-1)+STR$(UR)+"| "+C$:RETURN
4070 PRINT:PRINT"Bulletin? ";:X$=CR$+LEFT$(NO$,C):GOSUB580:IFI=1THENRETURN
4072 R=CVI(M$(I-1)):GET1,R:PRINT"Status: ";:IFASC(RE$)PRINT"Protected";:ELSEPRINT"Unprotected";
4074 PRINT". Change (Y/N)? ";:GOSUB579:IFI=2RETURN
4076 LSETRE$=CHR$(ABS(ASC(RE$)=0)):PUT1,R:RETURN
4100 PRINT:PRINT"Press ^RETURN] :";:X$=CR$:BR=1:GOSUB580:GOSUB4180:PRINT:RETURN
4110 ML=3:PRINT"User ID: ";:GOSUB500:V=VAL(A$):IFV<1ORV>839THENV=0:RETURN
4115 GET 4,V:IFLN$=DL$ORLN$=ZR$THENV=0
4120 IFV=0PRINT"Invalid ID"
4122 PRINT"User: ";LEFT$(NA$,FNCR-1)
4125 RETURN
4150 I=FNCR:PRINTLEFT$(NA$,I-1);" ";STRING$(21-I,46);" ";LEFT$(SJ$,FNSP(SJ$)):RETURN
4152 IFI>0RETURNELSEPRINTUSING"## - ";C;
4155 V=ASC(MID$(MD$,2)):PRINTUSING"##/";ASC(MD$);:IFV<10PRINTUSING"0#  ";V;:ELSEPRINTUSING"##  ";V;
4160 PRINTLEFT$(SJ$,USR1(VARPTR(SJ$))):RETURN
4170 PRINT"No Mail Waiting.":RETURN
4175 IFCCGOSUB4180:RETURNELSERETURN
4180 IFIC=0CLS
4182 PRINTCHR$(12);:RETURN
5000 DEFINTA-Z:DIMA0,A$,I,J,N,O$,O,BK,Z,Z1,Z2,Z$,R,T$,U,X1,M$(60),B(7),M(12,3),D(12):E$=STRING$(80,32):M$(0)=MKI$(0)
5005 ONERRORGOTO322
5010 FIELD1,2ASID$,2ASWH$,3ASMD$,32ASSJ$,1ASRE$,2ASPT$:LL=LOF(1)
5015 FIELD1,40ASM$,2ASPT$
5020 FIELD2,192ASBM$:NP=1:GET2,NP:FP=1
5025 FIELD 3,2ASNN$,248ASIX$,2ASSY$,1ASST$,1ASWW$,2ASNX$
5030 FIELD 4,3AS PW$,3AS LN$,20AS NA$,15AS LO$,3AS LL$,1AS AC$,2AS FM$,2AS LM$,24AS BL$,2AS QR$,1AS CC$,3AS QS$,3AS PL$,1AS CT$,2AS SP$
5035 FIELD 5,2AS CN$,2AS CU$,8ASTT$,2ASNI$,1ASIC$,2ASQU$,60ASQQ$,20AST1$,20AST2$,2ASQ1$,2ASQ2$,100ASDQ$,2ASUB$,3ASPP$
5037 GET5,1:X=CVI(CU$):IFX=0CLS:PRINT@128,;
5038 LM=30:IFVAL(TT$)<6THENLM=60
5040 POKE16916,2:RR$="   ":V=VARPTR(RR$):POKEV+1,170:POKEV+2,64
5045 K!=0:K1$="":K!=VARPTR(K!)+65537:V=INT(K!/256):U=K!-256*V
5050 I=VARPTR(K1$):POKEI,3:POKEI+1,U:POKEI+2,V
5055 CR$=CHR$(13):ZZ$=MKI$(0):FF$=CHR$(255):QT$=CHR$(34):ZR$=STRING$(3,0):DL$="***"
5060 DEFFNCD=SGN((INP(232)AND32))*IC:IC=1
5065 DEFFNCS=(PEEK(14400)AND2)
5070 DEFFNCR=INSTR(NA$,CR$)-21*(INSTR(NA$,CR$)=0)
5075 DEFFNVP=PEEK(VARPTR(BM$)+1)+PEEK(VARPTR(BM$)+2)*256:VP=FNVP
5080 DEFFNQI(X)=X+1+50*(X=50):DEFFNINC(X)=X+1+839*(X=839)
5085 DEFFNC(I)=I-32*(CPANDI>96ANDI<123):DEFFNS$(I$)=CHR$(ASC(I$)-128)
5090 DATA33,224,0,0,76,69,62,1,211,255,16,254,69,62,2,211,255,16,254,13,32,239,251,201
5100 RESTORE5090:BB$="":FORI=1TO24:READB:BB$=BB$+CHR$(B):NEXT
5110 FORJ=0TO7:B(J)=2^J:NEXT
5115 DS$="":V=VARPTR(DS$):POKEV,35:POKEV+1,0:POKEV+2,60
5120 DC$="":V=VARPTR(DC$):POKEV,1:POKEV+1,38:POKEV+2,60
5125 LW$="":V=VARPTR(LW$):POKEV,64:POKEV+1,64:POKEV+2,60
5130 IFX=0FORI=15424TO15486STEP2:POKEI,45:POKEI+1,32:NEXT' :CMD"R"
5135 RG$="Validated Access Required."
5140 DEFUSR1=&HF580:DEFUSR2=&HF5A2:DEFUSR3=&HF5C8:DEFUSR4=&HF2B5:DEFUSR6=&HF291:DEFUSR7=&HF1F3:DEFUSR8=&HF1B6:DEFUSR9=&HF171
5145 DEFFNSP(A$)=USR1(VARPTR(A$)):DEFFNFF(A$)=USR2(VARPTR(A$))
5150 D0=&HF44C:D1=&HF479:D2=&HF47A:D3=&HF47C:UP=&HF50E:BD=UP-1:LC=&HF170
5155 CM$="?     BULL  CHAT  EDIT  FEED  FILES FIND  GAMES GOTO  HELP  INFO  KILL  LIST  LOG   MAIL  MENU  NEW   OFF   POLLS POST  QUOTESREAD  SCAN  STAT  TIME  USER  UTIL  "
5160 ML=76:POKE&HF2B0,ML:DIMIC,X1,Y1,J1,X2,Y2:NM=1
5170 Y2=0:RESTORE5175:FORI=1TO12:READJ:Y2=Y2+J:D(I)=Y2:NEXT
5175 DATA31,28,31,30,31,30,31,31,30,31,30,31
5199 NO$="12345678":J$=STRING$(8,0):RANDOM:RETURN
These are some of the z80 assembly language routines I wrote to do low-level operations or to do things faster than could be accomplished in BASIC. The Zilog z80 was an advanced (for its time) 8-bit CPU that used the same basic instruction set as the 8080, the grandfather of today's Pentium chips, but offered additional registers and opcodes that could be used to write smaller and faster programs. Like all 8-bit processors, its biggest handicap was its inability to directly address more than 64k of memory. Thus, machines like the TRS-80 always had 64k or less main memory available (in the Model III, we had 48k RAM with 16k of ROM occupying the remaining address space).

The first piece of code is the line input routine, a function that does nothing more than read a line of typing and store it in a buffer. Notice how it explicitly handles every detail, from word wrapping and password masking to even backspacing. Today we would never write code like this by hand in any language, but back then it was necessary to get the desired behavior and performance. (Early versions had the same logic written in BASIC but it ran so slowly that callers couldn't even upload prepared text at 1200 baud).

Next is a "sysop chat" function, written in assembly language primarily so it could remain memory-resident at all times regardless of which BASIC module was running. It was also necessary to use assembly in order to detect special keystrokes and differentiate them from characters typed at the remote terminal. This code would allow me to interrupt any session in progress and type directly with the user who was connected. The code actually addresses the TRS-80 keyboard hardware directly, making it about the least portable thing one could imagine writing.

Programmers who have never worked in assembly language assume it's complicated, but in reality it's just extremely tedious, each line of assembler performing a tiny bit of work and many dozens or hundreds of lines required to get anything useful done. This is why it was rare even in the 80s for entire applications to be written in pure assembler. Typically you'd write pieces like these in assembly language and the rest in a higher level language like BASIC or C.

;	INPUT ROUTINE
;
	ORG	0F2ADH
; SYSTEM VARIABLES
CP	DEFB	0
EH	DEFB	0
WR	DEFB	0
ML	DEFB	59
; STORAGE
BUFF	DEFW	0
EE	DEFB	0
IC	DEFB	1
; SYSTEM EQUATES
GET	EQU	0013H
PUT	EQU	001BH
DO	EQU	401DH
KI	EQU	4015H
;
BEGIN	IN	A,(232)
	AND	32
	LD	(IC),A	; CD STATUS ON ENTRY
	LD	HL,(BUFF)
	DEC	HL
	LD	A,(EE)
	LD	E,A
	LD	D,0
	ADD	HL,DE
;
GETKY	LD	DE,KI
	CALL	GET	;GET CHAR
	JR	Z,CDCHK	;NO BYTE AVAIL.
;
	AND	127	;STRIP HI BIT
	CP	127
	JR	NZ,CONT0
	LD	A,8	;DEL TO BKSP
CONT0	LD	B,A
	LD	A,(CP)
	CP	0
	JR	Z,CONT1	;LOWERCASE
;
	LD	A,B
	CP	'a'
	JP	M,CONT1
	CP	'{'
	JP	P,CONT1
CAP	AND	223
	LD	B,A	;MAKE UC
;
CONT1	LD	A,B
	CP	32
	JP	P,INP	;ENTER INTO BUFFER
;
	CP	8
	JR	Z,BKSP
	CP	13
	JP	Z,RET
	CP	5
	JR	NZ,CDCHK
	LD	A,(EH)
	XOR	1	;TOGGLE ECHO
	LD	(EH),A
	JR	CDCHK
;
BKSP	LD	A,(EE)
	CP	0
	JR	Z,CDCHK
	DEC	A
	LD	(EE),A
	DEC	HL
	LD	DE,DO
	LD	A,8
	CALL	PUT
	LD	A,32
	CALL	PUT
	LD	A,8
	CALL	PUT	;BACKSPACE & ERASE
	JR	CDCHK
;
INP	LD	B,A
	LD	A,(EE)
	LD	C,A
	LD	A,(ML)
	CP	C
	JR	NZ,INP2
	LD	A,(WR)
	CP	0
	JR	Z,CDCHK
	CALL	ADD
	JP	WRAP
INP2	CALL	ADD
	CALL	ECHO
;
CDCHK	LD	A,(IC)
	LD	B,A
	IN	A,(232)
	AND	32
	CP	B
	JP	Z,GETKY
;
ADD	LD	A,(EE)
	INC	A
	LD	(EE),A
	INC	HL
	LD	A,B
	LD	(HL),A
	RET
;
ECHO	LD	A,(EH)
	CP	1
	JR	Z,EH2
	LD	DE,DO
	LD	A,B
	CALL	PUT
	RET
EH2	LD	DE,DO
	LD	A,'.'
	CALL	PUT
	RET
;
RET	RET
WRAP	LD	A,(HL)
	CP	32
	JR	Z,WR2
	DEC	HL
	LD	A,(WR)
	INC	A
	LD	(WR),A
	LD	A,(EE)
	DEC	A
	LD	(EE),A
	CP	0
	JR	Z,WR2
	LD	A,(WR)
	CP	20
	JR	NZ,WRAP
	LD	A,0
	LD	(EE),A
;
WR2	RET
	END



ORG	8000H
GET	EQU	0013H
PUT	EQU	001BH
KI	EQU	4015H
DO	EQU	401DH
KEY1	EQU	3840H
SHFT	EQU	3880H
DSPLY	EQU	4467H
ADTSK	EQU	403DH
HIGH	EQU	4411H
;
BEGIN	LD	HL,TASK
	LD	(TCB),HL
	LD	DE,TCB
	LD	A,0
	CALL	ADTSK
	LD	HL,TCB
	DEC	HL
	LD	(HIGH),HL
	RET
;
; CHAT TASK
; HIGH MEM MUST BE F234H
	ORG	0F235H
; ENTER CHAT BY PRESSING BOTH SHIFT KEYS
TCB	DEFS	2
TASK	LD	A,(SHFT)
	CP	3
	RET	NZ
;
	LD	HL,ONM
	CALL	DSPLY	;DISPLAY MSG
; DEBOUNCE
DEB	LD	A,(SHFT)
	CP	3
	JR	Z,DEB
READ	LD	DE,KI
	CALL	GET
	JR	Z,CHECK	;NO BYTE AVAIL.
	AND	127
	LD	DE,DO
	CALL	PUT	;OUTPUT BYTE
; EXIT CHAT BY PRESSING CLEAR KEY
CHECK	LD	A,(KEY1)
	AND	2
	JR	Z,READ
; GO BACK
DEB2	LD	A,(KEY1)
	AND	2
	JR	NZ,DEB2
	LD	HL,OFFM
	CALL	DSPLY
	RET
;
ONM	DEFM	'[sysop on line]'
	DEFB	13
OFFM	DEFM	'[sysop off line]'
	DEFB	13
	END	BEGIN

franklarosa.com   ...   frank's vinyl museum   ...   webversi   ...   photo albums   ...   blog   ...   trs-80   ...   noble applications   ...   frank@franklarosa.com
Search this site: