IMD 1.16: 8/06/2007 19:28:33                    FLITPLANBASJONLIFE BAS LOANPMTSBASb MYSTERY BAS SPECIFICBASSPHERE BAS)BACCARATBASTKID BASBBINGO BAS FIGHTER BAS !BLACKBOXBAS"#BLKJCK BAS8$%&'POWERS BAS (MATH BAS )MATH DOC *TESTMAKRBAS6+,-.10 REM THIS PROGRAM WAS TAKEN FROM PAGE 39 OF SCCS INTERFACE 20 REM MAGAZINE, VOL. 1, ISSUE 12, JULY 1977 30 REM IT WAS WRITTEN BY BOB RIPLEY 40 REM 50 CL$=CHR$(26):REM SCREEN CLEAR CHAR. 60 PRINT CL$ 70 PRINT "PLANNING A FLIGHT CAN BE FUN" 80 PRINT "I WILL DO IT FOR YOU, IF YOU JUST ANSWER MY QUESTIONS." 90 PRINT "PRESS THE RETURN KEY AFTER EACH RESPONSE." 100 PRINT "WE WILL DO A LEG AT A TIME, PAUSING SO THAT YOU CAN" 110 PRINT"FILL IN THE FLIGHT PLAN FORM AS WE GO." 120 PRINT"IF YOU NOTICE THABIO-FF ASC"/01BIORYTH ASC23BIO BAS$456ELEGY ENG7PRIMES BAS8OSCAR BAS&9:;FORMHAM1ASM<=HAMLINK4ASM2>?@ABCDEFGHIHAMLOG BASJKHAMHELP BAS$LMNCODE BAS OINDEX DOCLPQRSTUVWXYZ[\T YOU MADE A MISTAKE AFTER THE RETURN" 130 PRINT "HOLD DOWN CNTL AND TYPE C, THEN TYPE RUN TO START OVER" 140 PRINT:PRINT:LINEINPUT"PRESS RETURN TO CONTINUE >";Z$ 150 PRINT CL$ 160 INPUT"HOW MANY GALLONS OF USABLE FUEL";F1 170 INPUT"WHAT IS THE FUEL RATE IN GPH";F 180 INPUT"WHAT IS THE TRUE AIR SPEED IN KNOTS";T 190 INPUT"THE WIND IS FROM WHAT (TRUE) DIRECTION (DEGREES)";D 200 INPUT"WHAT IS THE WIND SPEED IN KNOTS";S 210 INPUT"WHAT IS THE MAGNETIC VARIATION (EAST=+,WEST=-DEGREES)";V 220 INPUT"WHAT    IS THE COURSE FOR THIS LEG (DEGREES)";C 230 INPUT"HOW LONG IS THIS LEG IN NM";M 240 R=57.2958 250 D=D-V 260 A=SIN(D-C) 270 IF S=0THEN B=0 280 IF S=0THENGOTO300 290 B=S/T 300 B1=ATN(B/SQR(-B*B+1)) 310 H=C+(B1*R*A) 320 IF H<0THEN 370 330 PRINT 340 H=INT(H*10+.5)/10 350 PRINT "HEADING IS";H;"DEGREES" 360 GOTO 390 370 H=H+360 380 GOTO 330 390 G=T*COS((H-C)/R)-S*COS((D-C)/R) 400 G=INT(G*10+.5)/10 410 PRINT"GROUND SPEED IS";G;"KNOTS" 420 IF G>0 GOTO 440 430 PRINT"YOU CAN NOT GET THERE THIS WEED, WIND, OR VAR CHANGES THIS LEG";C$ 620 IF LEFT$(C$,1)="Y" THEN GOTO 170 630 GOTO 220 640 PRINT 650 PRINT"RUNNING OUT OF FUEL IN FLIGHT" 660 PRINT"CAN BE HAZARDOUS TO YOUR HEALTH" 670 FOR I=1 TO 500:NEXT I 680 RUN "DIR" 690 END RUNNING OUT OF AND";T4;"MINUTES" 530 F2=F*(T1/60) 540 F2=INT(F2*10+.5)/10 550 PRINT"FUEL USED ON THIS LEG IS";F2;"GALLONS" 560 F1=F1-F2 570 F3=F3+F2 580 PRINT"TOTAL FUEL USED IS ";F3;"GALLONS; LEAVING";F1;"GALLONS" 590 IFF1<=0THEN640 600 PRINT 610 INPUT "ANY SP10 PRINTCHR$(26):DEFINT A-Z:CLEAR 1000:DIM S(29,29),M$(72) 20 Y=0:A=0:S=0:INPUT "DO YOU WANT INSTRUCTIONS";J$: IF LEFT$(J$,1)="N" THEN 290 30 PRINTCHR$(26);"THIS IS JOHN CONWAY'S GAME OF LIFE." 40 PRINT 50 PRINT"THE GAME INVOLVES CELLULAR GENERATION GROWTH. EACH CELL IS" 60 PRINT"ONE PRINTED CHARACTER. A CELL IS SURROUNDED BY EIGHT OTHER" 70 PRINT"CELLS, IN THREE DIRECTIONS: DIAGONALLY, HORIZONTALLY, AND" 80 PRINT"VERTICALLY. IN EACH GENERATION CELLS DIE AND GROW" 90 PRINT"SIMULTANEOUSLY." 100RINTED." 190 PRINT 200 PRINT"ENTER YOUR PATTERN - A LINE AT A TIME - A '*' WHERE" 210 PRINT"YOU WANT A LIVE CELL AND A ' ' (SPACE) FOR AN EMPTY ONE." 220 PRINT"MAXIMUM BOARD SIZE IS 28 BY 28." 230 PRINT 240 PRINT"WHEN YOU'RE FINISHED, TYPE IN THE WORD 'DONE'" 250 PRINT"AS YOUR LAST LINE." 260 PRINT 270 PRINT"NOTE: IF THE LIMITS ARE REACHED, IT WILL TERMINATE." 280 PRINT:PRINT:INPUT "TO CONTINUE , TYPE ANY CHARACTER";A$ 290 PRINTCHR$(26) 300 INPUT"WHICH GENERATION SHALL THE PRINTING START WITH";TAY" 440 T1=60*M/G 450 T1=INT(T1*10+.5)/10 460 PRINT"THE TIME FOR THIS LEG IS";T1;"MINUTES" 470 T2=T2+T1 480 IFT2<60 THEN PRINT"TOTAL TIME IS";T2;"MINUTES" 490 IF T2<60 THEN 530 500 T3=INT(T2/60) 510 T4=T2-T3*60 520 PRINT"TOTAL TIME IS ";T3;"HOURS AND";T4;"MINUTES" 530 F2=F*(T1/60) 540 F2=INT(F2*10+.5)/10 550 PRINT"FUEL USED ON THIS LEG IS";F2;"GALLONS" 560 F1=F1-F2 570 F3=F3+F2 580 PRINT"TOTAL FUEL USED IS ";F3;"GALLONS; LEAVING";F1;"GALLONS" 590 IFF1<=0THEN640 600 PRINT 610 INPUT "ANY SP PRINT 110 PRINT"A CELL DIES FROM OVERPOPULATION IF IT IS SURROUNDED BY MORE" 120 PRINT"THAN THREE LIVING CELLS. IT WILL ALSO DIE OF ISOLATION IF IT" 130 PRINT"HAS LESS THAN TWO CELLS SURROUNDING IT. NEW CELLS CAN BE" 140 PRINT"FORMED IN EMPTY POSITIONS ONLY; IF AND ONLY IF IT HAS THREE" 150 PRINT"CELLS AROUND IT.":PRINT:PRINT 160 INPUT "TO CONTINUE, TYPE ANY CHARACTER";A$:PRINT CHR$(26) 170 PRINT"YOU WILL BE ASKED TO ENTER THE FIRST, LAST, AND THE INTERVAL" 180 PRINT"BETWEEN THE GENERATIONS TO BE P 310 INPUT"AND THE LAST GENERATION";R1 320 INPUT"ALSO, HOW MANY SHALL I SKIP";O 330 O=O+1 340 PRINT "ENTER PATTERN:" 350 FOR M=1 TO 28 360 LINEINPUT M$ 370 IF M$="DONE" THEN 480 380 IF LEN(M$)<29 THEN 400 390 PRINT"NO MORE THAN 28 CELLS PER LINE":GOTO 360 400 FOR R=1 TO LEN(M$) 410 IF MID$(M$,R,1)=" " THEN 460 420 IF MID$(M$,R,1)<>"*" THEN 490 430 S(M,R)=1 440 A=A+1 450 IF R>S THEN S=R 460 NEXT R 470 NEXT M 480 GOTO 520 490 PRINT"'";MID$(M$,R,1);"' IS NEITHER A ' ' NOR A '*'"; 500 PRINT"   --TYPE THE LINE AGAIN":A=A-(R-1) 510 GOTO 360 520 DIM X(29,29) 530 IF Y<=0 THEN 550 540 GOTO 20 550 ERASE X 560 DIM X(29,29) 570 V=0:G=0 580 Y=M-1:N1=M-1 590 PRINTCHR$(26);"GENERATION = 0 POPULATION =";A 600 GOSUB 1020 610 G=G+1 620 A=0:V=0 630 FOR M=1 TO N1 640 FOR R=1 TO S 650 J=0 660 IF M>28 OR R>28 THEN 1370 670 IF X(M,R+1)<=0 OR R=S THEN 690 680 J=J+1 690 IF X(M+1,R+1)<=0 OR M=N1 OR R=S THEN 710 700 J=J+1 710 IF X(M+1,R)<=0 OR M=N1 THEN 730 720 J=J+1 730 IF M=N1 OR R=1 THEN 760 HR$(26);"GEN=";G;TAB(2*R-1);"POP=";A 980 GOTO 1000 990 V=9 1000 GOSUB 1020 1010 GOTO 610 1020 J=50:A=50 1030 C=0:D=0 1040 FOR M=1 TO N1 1050 FOR R=1 TO S 1060 IF S(M,R)<=0 THEN 1130 1070 IF MC THEN C=M 1100 IF R>D THEN D=R 1110 IF V=9 THEN 1130 1120 PRINT TAB(2*R-2)"*"; 1130 NEXT R 1140 IF V=9 THEN 1160 1150 PRINT 1160 NEXT M 1170 IF G=R1 THEN 1350 1180 C=C-J+3 1190 D=D-A+3 1200 X(1,5)=3 1210 ERASE X 1220 DIM X(29,29) 1230 FOR M=1 TO N1 1rem - program LPT.BAS rem - Loan Payment Tabulation rem - Copyright 1982 by Peter C. Hawxhurst rem - revised 06/13/1982 rem - variable tabulation ************************ rem a = amount of loan rem a$ = amount of loan rem d$ = loan description rem e1$ = description too long error rem e2 = no data in loan file index rem i = total interest to be payed rem i1 = monthly payment of interest rem i2 = interest payed per year rem i% = for/next loop counter rem l = line m q$ = carriage return rem q1$ = existing file question rem q2$ = save data question rem q3$ = end or continue option rem q4$ = output device question rem q5$ = data check question rem q6$ = correct input or exit rem q7$ = continue with monthly breakdown rem r = numeric interest rate rem r1 = annual interest rate rem r$ = interest rate on loan rem s1 = end switch rem s2 = first pass switch rem t = total money outlay rem t1 = principal total rem t2 =  - tone on gosub 1500 : rem - date 110 gosub 500 : rem - cursor print tab(10);" "; input "Existing loan on file (y/n) >";q1$ let q1$=ucase$(q1$) if q1$<>"Y" and q1$<>"N" then 110 if q1$="N" then 130 120 gosub 500 : rem - cursor print tab(12);" "; input "Filename or I for index >";n$ let n$=ucase$(n$) if n$="I" then gosub 600 : rem - index if n$="I" and e2=1 then 110 if n$="I" then 120 let e2=0 if len(n$)>14 then gosub 700 : rem - spec error if e2=1 then 120 if left$(n$,2)<>"B:" then gosub  740 IF X(M+1,R-1)<=0 THEN 760 750 J=J+1 760 IF R=1 THEN 790 770 IF X(M,R-1)<=0 THEN 790 780 J=J+1 790 IF M=1 OR R=1 THEN 820 800 IF X(M-1,R-1)<=0 THEN 820 810 J=J+1 820 IF M=1 THEN 850 830 IF X(M-1,R)<=0 THEN 850 840 J=J+1 850 IF M=1 OR R=S THEN 880 860 IF X(M-1,R+1)<=0 THEN 880 870 J=J+1 880 IF J=3 THEN 900 890 IF J<>2 OR X(M,R)<=0 THEN 920 900 S(M,R)=1 910 A=A+1 920 NEXT R 930 NEXT M 940 IF A=0 THEN 1340 950 IF G=R1 THEN 970 960 IF (GINT((G-T)/O) THEN 990 970 PRINTC240 FOR R=1 TO S 1250 IF S(M,R)<=0 THEN 1270 1260 X(M-J+2,R-A+2)=1 1270 NEXT R 1280 NEXT M 1290 ERASE S 1300 DIM S(29,29) 1310 N1=C 1320 S=D 1330 RETURN 1340 PRINT "NO MORE LIFE IN GENERATION";G 1350 PRINT "*** END OF RUN ***" 1360 GOTO 1380 1370 PRINT "CELL HAS REACHED LIMITS OF PROGRAM. PROGRAM MUST TERMINATE." 1380 PRINT 1390 INPUT "ANOTHER RUN";J$ 1400 Y=0:A=0:S=0 1410 ERASE S 1420 DIM S(29,29) 1430 IF LEFT$(J$,1)="Y" THEN CLEAR:GOTO 290 1440 RUN "DIR" 1450 END ;J$ 1400 Y=0:A=0:Scounter rem l1 = line counter for file index rem m$ = month loan payments begin rem m1$ = month data rem n = month counter rem n$ = input filename rem n1$ = filename rem n2$ = file description rem p = monthly payment rem p1 = monthly payment of principle rem p2 = principal payment total rem p(1)= payment factor 1 rem p(2)= payment factor 2 rem p$ = date check conversion rem p1$ = date check month rem p2$ = date check day rem p3$ = date check year reinterest total rem t3 = total of each payment rem w = numeric check for decimal point rem x = numeric check variable rem y = period of loan rem y$ = period of loan rem z = numeric check equivalent rem - program structure ************************** gosub 100 : rem - housekeeping 10 if s1=1 then 90 gosub 200 : rem - process goto 10 90 gosub 300 : rem - end of job chain "SSPM" 100 rem - housekeeping subroutine **************** dim d$(26) dim p(2) let s2=1 gosub 400 : rem700 if e2=1 then 120 if right$(n$,4)<>".DAT" then gosub 700 if e2=1 then 120 let e2=0 gosub 800 : rem - file check if e2=1 then 110 open n$ as 1 read #1;d$,a,r,y,m$ close 1 let r$=str$(r*100) let y$=str$(y) goto 140 130 gosub 900 : rem - interrogate 140 gosub 500 : rem - cursor print tab(8);" "; input "Enter (S)creen or (P)rinter output >";q4$ let q4$=ucase$(q4$) if q4$<>"S" and q4$<>"P" then 140 if q4$="S" then 150 lprinter 150 gosub 1000 : rem - tone off return 200 rem - process sub   routine ********************* if s2=0 then 210 let s2=0 gosub 1300 : rem - calculate gosub 1100 : rem - report 1 goto 290 210 gosub 1200 : rem - report 2 290 return 300 rem - end of job subroutine ****************** if q1$="Y" then 360 310 gosub 400 : rem - tone on gosub 500 : rem - cursor print tab(6);" "; input "Do you wish to save loan data (y/n) >";q2$ gosub 1000 : rem - tone off let q2$=ucase$(q2$) if q2$<>"Y" and q2$<>"N" then 310 if q2$="N" then 360 gosub 400 : rem - tone on 320 go40 350 print #1;n$,d$ close 1 create n$ as 1 print #1;d$,a,r,y,m$ close 1 360 gosub 400 : rem - tone on gosub 500 : rem - cursor print tab(7);" "; input "Press - RETURN - to return to menu >";line q$ gosub 1000 : rem - tone off return 400 rem - tone on subroutine ********************* print chr$(27)+")"; return 500 rem - cursor subroutine ********************** print chr$(27)+"="+chr$(51)+chr$(32); print chr$(27)+"T"; print chr$(27)+"="+chr$(52)+chr$(32); print chr$(27)+"T"; print chr$(2e2=1 goto 650 630 read #1;n1$,n2$ print print n1$,n2$ if end #1 then 640 let l1=l1+2 if l1<18 then 630 gosub 400 : rem - tone on gosub 500 : rem - cursor print tab(10);" "; input "Press - RETURN - to continue >";line q$ goto 610 640 gosub 400 : rem - tone on 650 close 1 return 700 rem - spec error subroutine ****************** if q1$="N" then gosub 400 : rem - tone on gosub 500 : rem - cursor print tab(5);"Error - specify as B:filename:.DAT!!!" print tab(4);" "; input "Press - RETURN - er description of loan >";d$ d$=ucase$(d$) if len(d$)<27 then 920 gosub 500 : rem - cursor print tab(12);"Error - description too long!!!" print tab(11);" "; input "Press - return - to retry >";line q$ goto 910 920 let e2=0 gosub 500 : rem - cursor print tab(14);" "; input "Enter amount of loan >";a$ let x$=a$ gosub 1600 : rem - numeric check if e1=1 then 920 let a=val(a$) if a<=999999 then 930 gosub 500 : rem - cursor print tab(12);"Error - amount too large!!!" print tab(11);" "; input m$ gosub 1800 : rem - date check if e1=1 then 950 return 1000 rem - tone off subroutine ******************** print chr$(27)+"("; return 1100 rem - report 1 subroutine ******************** if q4$="S" then print chr$(26) print "MONTHLY LOAN PAYMENT CALCULATION" print print d$ print print print print tab(6);"LOAN";tab(15);"LOAN"; print tab(23);"INTEREST";tab(35);"MONTHLY"; print tab(46);"ANNUAL" print tab(5);"AMOUNT";tab(14);"PERIOD"; print tab(25);"RATE";tab(35);"PAYMENT"; print tab(47);"Rsub 500 : rem - cursor print tab(12);" "; input "Enter filename for data >";n$ let n$=ucase$(n$) let e2=0 if len(n$)>14 then gosub 700 : rem - spec error if e2=1 then 320 if left$(n$,2)<>"B" then gosub 700 if e2=1 then 320 if right$(n$,4)<>".DAT" then gosub 700 if e2=1 then 320 let e2=0 gosub 800 : rem - file check if e2=0 then gosub 1400 : rem - file exists if e2=0 then 320 gosub 1000 : rem - tone off open "B:LPF.DAT" as 1 if end #1 then 350 340 read #1;n1$,n2$ if end #1 then 350 goto 37)+"="+chr$(53)+chr$(32); print chr$(27)+"T"; print chr$(27)+"="+chr$(51)+chr$(32); return 600 rem - index subroutine *********************** 610 let l1=0 print chr$(26) gosub 1000 : rem - tone off print "LOAN PAYMENT FILE INDEX" print print "FILENAME","DESCRIPTION" print let l1=l1+4 open "B:LPF.DAT" as 1 if end#1 then 620 goto 630 620 gosub 400 : rem - tone on gosub 500 : rem - cursor print tab(12);"Error - no file!!!" print tab(11);" "; input "Press - RETURN - to retry >";line q$ let to retry >";line q$ let e2=1 if q1$="N" then gosub 1000 : rem - tone off return 800 rem - filecheck subroutine ******************* open "B:LPF.DAT" as 1 810 if end #1 then 820 read #1;n1$,n2$ if n$=n1$ then 830 goto 810 820 gosub 500 : rem - cursor print tab(12);"Error - file not on line!!!" print tab(11);" "; input "Press - RETURN - to retry >";line q$ let e2=1 830 close 1 return 900 rem - interrogate subroutine ***************** 910 gosub 500 : rem - cursor print tab(1);" "; input "Ent"Press - RETURN - to retry >";line q$ goto 920 930 let e1=0 gosub 500 : rem - cursor print tab(9);" "; input "Enter interest rate as II% >";r$ let x$=r$ gosub 1700 : rem - percent check if e1=1 then 930 let r=val(r$)/100 940 let e1=0 gosub 500 : rem - cursor print tab(9);" "; input "Enter period of loan in years >";y$ let x$=y$ gosub 1600 : rem - numeric check if e1=1 then 940 let y=val(y$) 950 let e1=0 gosub 500 : rem - cursor input "Enter date payments begin (MM/DD/YYYY) >";m$ let p$=ATE" print print tab(1);" "; : print using "$$#####.##";a; print tab(15-len(y$));y;"YRS"; print tab(28-len(r$));100*r;"%"; print tab(32);" "; : print using "$$####.##";p; print tab(42);" "; : print using "#####.##";r1; print "%" let l=l+10 if q4$="S" then 1110 console 1110 if q1$="Y" then 1150 gosub 400 : rem - tone on 1120 gosub 500 : rem - cursor print tab(7);" "; input "Is above input data correct (y/n) >";q5$ let q5$=ucase$(q5$) if q5$<>"Y" and q5$<>"N" then 1120 if q5$="Y" then 1140    1130 gosub 500 : rem - cursor print tab(8);" "; input "Enter C to correct of X to exit >";q6$ let q6$=ucase$(q6$) if q6$<>"C" and q6$<>"X" then 1130 if q6$="C" then gosub 900 : rem - interrogate if q6$="C" then 1100 gosub 1000 : rem - tone off let s1=1 goto 1180 1140 gosub 1000 : rem - tone off 1150 gosub 400 : rem - tone on 1160 gosub 500 : rem - cursor print tab(8);" "; input "Display monthly breakdown (y/n) >";q7$ let q7$=ucase$(q7$) if q7$<>"Y" and q7$<>"N" then 1160 if q7$="Y" then 117#";i%; if i%-1<>c then 1210 print "*"; 1210 print tab(11);" "; : print using "######.##";p1; print tab(21);" "; : print using "######.##";i1; print tab(32);" "; : print using "######.##";a-t1; if i%=y*12 then 1220 if n<12 then print if n<12 then 1230 1220 print tab(42);" "; : print using "######.##";i2 let n=0 let i2=0 1230 let n=n+1 let l=l+1 if q4$="P" then 1250 if l<18 then 1260 1240 gosub 500 : rem - cursor print tab(8);" "; input "Enter C to continue or E to exit >";q3$ let q3$=ucase let m3$=right$(m$,4) let n=val(m1$) let t1$=left$(t$,2) let t3$=right$(t$,4) let p(1)=(a*(r/12)*(1+r/12)^(12*Y)) let p(2)=((1+r/12)^(12*y)-1) let p=p(1)/p(2) let i=t-a let r1=(((1+r/12)^12)-1)*100 return 1400 rem - file exists subroutine **************** gosub 400 : rem - tone on gosub 500 : rem - cursor print tab(12);"Error - file exists!!!" print tab(11);" "; input "Press - RETURN - to retry >";q$ gosub 1000 : rem tone off return 1500 rem - date subroutine *********************** 1510 !" print tab(11);" "; input "Press - RETURN - to retry >";line q$ 1620 return 1700 rem - percent check subroutine ************** let e1=0 let x=0 let x=match("%",r$,1) if x=0 then 1710 let r$=left$(r$,len(r$)-1) 1710 let x$=r$ gosub 1600 : rem - numeric check return 1800 rem - date check subroutine ***************** let e1=0 if len(p$)>10 then 1810 let x=0 for i%=1 to 10 let x=x+match("#",p$,i%) next i% if x<>57 then 1810 let p1$=left$(p$,2) let p2$=mid$(p$,4,2) let p3$=right$(p$,4) URN - to retry >";line q$ let e1=1 1820 return 1900 rem - headings subroutine ******************* print tab(4);"MONTH";tab(13);"PRINCIPAL"; print tab(24);"INTEREST";tab(35);"BALANCE"; print tab(46);"INT/YR" print let l=l+2 return hen 1810 if val(p1$)=2 and val(p2$)>29 then 1810 if val(p3$)/4=int(val(p3$)/4) then 1820 if val(p1$)=2 and val(p2$)>28 then 1810 goto 1820 1810 gosub 500 : rem - cursor print tab (12);"Error - improper date!!!" print tab(11);" "; input "Press - RET0 let s1=1 1170 gosub 1000 : rem - tone off 1180 if q4$="S" then 1190 lprinter 1190 return 1200 rem - report 2 subroutine ******************* if q4$="S" then print chr$(26) if q4$="S" then let l=0 print tab(3);"PAYMENT SCHEDULE IS AS FOLLOWS:" print let l=l+2 gosub 1900 : rem - heading let c=(val(t3$)-val(m3$))*12-val(m1$)+val(t1$) for i%=1 to 12*y let p1=p-((a-p2)*r/12) let p2=p2+p1 let i1=p-p1 let t1=t1+p1 let t2=t2+i1 let t3=t3+p1+i1 let i2=i2+i1 print tab(4);" "; : print using "##$(q3$) if q3$<>"C" and q3$<>"E" then 1240 if q3$="E" then let i%=12*y if q3$="E" then 1260 let l=0 print chr$(26) gosub 1900 goto 1260 1250 if l<60 then 1260 for j%=1 to 66-l print next j% print print let l=2 1260 next i% if q3$="E" then 1270 print print tab(11);" "; : print using "######.##";t1; print tab(21);" "; : print using "######.##";t2; print tab(31);" "; : print using "#######.##";t3 1270 let s1=1 return 1300 rem - calculate subroutine ****************** let m1$=left$(m$,2) let e1=0 gosub 500 : rem - cursor print tab(8);" "; input "Enter today's date (MM/DD/YYYY) >";t$ let p$=t$ gosub 1800 : rem - date check if e1=1 then 1510 return 1600 rem - numeric check subroutine ************** let e1=0 let x=0 let w=0 let z=0 let w=w+match(".",x$,1) for i%=1 to len(x$) let z=z+i% next i% if w=0 then 1610 let z=z+1 1610 for i%=1 to len(x$) let x=x+match("#",x$,i%) next i% if x=z then 1620 let e1=1 gosub 500 : rem - cursor print tab(12);"Error - non numeric input!!if val(p1$)<1 then 1810 if val(p1$)>12 then 1810 if val(p2$)<1 then 1810 if val(p3$)<1 then 1810 if val(p1$)=9 and val(p2$)>30 then 1810 if val(p1$)=4 and val(p2$)>30 then 1810 if val(p1$)=6 and val(p2$)>30 then 1810 if val(p1$)=11 and val(p2$)>30 then 1810 if val(p1$)=2 and val(p2$)>29 then 1810 if val(p3$)/4=int(val(p3$)/4) then 1820 if val(p1$)=2 and val(p2$)>28 then 1810 goto 1820 1810 gosub 500 : rem - cursor print tab (12);"Error - improper date!!!" print tab(11);" "; input "Press - RET   110 REM **** A KILOBAUD MYSTERY PROGRAM ***** 120 REM FROM THE APRIL, 1978, ISSUE. 130 REM BY TOM RUGG AND PHIL FELDMAN 150 DIM A(42) 160 FOR J=3 TO 28 170 A(J)=J+62 180 NEXT J 190 FOR J=1 TO 10 200 A(J+29)=J+47 210 NEXT J 220 FOR J=1 TO 2 230 A(J)=J+31 240 NEXT J 250 REM NOW IT GETS MORE MYSTERIOUS 260 A(A(1)-3)=A(A(2))-7 270 T=0 280 FOR J=1 TO 9 290 T=T+J 300 NEXT J 310 A(T-5)=T+1 320 A(A(T-T+1)+T/5)=T+INT(T/3)+3 330 T=T-A(2) 340 J=T/4 350 A(T*J+2*J)=J*T+(T/J)-1 410 GOSUB 500 500 16,6,1,39,34,30,-4,40,-1 950 DATA 1,3,9,3,11,16,2,0,16,17,25,1,20,7,15,17,24,7,1 960 DATA 39,32,30,29,1,39,35,30,29,1,3,16,6,1,39,36,30,-1 970 DATA 20,11,6,6,14,7,-4,40,1,25,10,3,22,42,21,1,3,1,22,10,20 980 DATA -2,7,1,22,17,7,6,1,21,14,17,22,10,41,0,-4,40,6,7,14,7 990 DATA 22,7,1,39,37,30,29,1,39,38,30,29,1,3,16,6,1,-2,39,30,-1 1000 DATA -3,1,10,3,2,1,10,3,2,1,10,3,2,1,10,3,2,1,0,11,42,15,1 1010 DATA 3,1,5,17,15,18,23,22,7,20,29,1,16,17,22,1,3,1,28,-2 1020 DATA 17,14,17,9,11,21,22,2,0,4,27,7,-1 123bdobn2@386,"The purpose of this program is to calculate the".cx2@450,"specific heat of metals from your laboratory data."Qc2:2"Press any key to continue"_c IU""J140"c:2"Type in your experimental values for the following items:"(c 2`c* "1> What is the mass of your metal (in grams):";MMoc4MMVU0J170(d> "2> What is your calorimeter's mass (in grams):";MCbdH2"3> What is your total mass for the calorimeter and"dR " the water (in grams):";Md\MTUMCJ250Rdf2"Your calorimeter's mass is greater than the tonal temperature is always less than the metal's temperature!!" g 260^g2"What is your calculated value for the specific heat of"tg "your metal:";CV)g$ "Accepted value for specific heat of metal:";AV/g.;g8MWUMNMCPgB2"Calculations:"xgL2"8> Mass of water";<46);MW;"grams"hVTCUTFNTW5h`2"9> Temperature change of calorimeter and"\hj2" water";<46);TC;"deg. Celsius"ihtCWUMWOTC$h~2"10> Calories gained by the water";<46);CW;"calories"4hCCUMCOSCOTCqh2"11> Calories gained by calorimeter";<46);CC;"cGOSUB 700 510 READ T 520 IF T<>0 THEN 550 530 GOSUB 700 550 IF T<0 THEN 580 560 GOSUB 800 570 GOTO 510 580 IF T=-1 THEN 1230 590 J=ABS(T) 600 READ T 610 FOR K=1 TO J 620 GOSUB 800 630 NEXT K 640 GOTO 510 700 T=A(24)-A(29) 710 PRINT 720 FOR J=1 TO 5/2 730 GOSUB 900 740 NEXT J 750 PRINT 760 RETURN 800 PRINT CHR$(A(T)); 810 RETURN 900 PRINT CHR$(T); 910 RETURN 920 DATA -5,1,3,18,20,11,14,1,8,-2,17,14 930 DATA 2,0,22,20,27,1,6,7,14,7,22,11,16,9,1,14,11,16,7,21 940 DATA 1,39,33,30,1,3,30 PRINT 1240 END 0 DATA 3,1,5,17,15,18,23,22,7,20,29,1,16,17,22,1,3,1,28,-2 1020 DATA 17,14,17,9,11,21,22,2,0,4,27,7,-1 12,39,36,30,-1 970 DATA 20,11,6,6,14,7,-4,40,1,25,10,3,22,42,21,1,3,1,22,10,20 980 DATA -2,7,1,22,17,7,6,1,21,14,17,22,10,41,0,-4,40,6,7,14,7 990 DATA 22,7,1,39,37,30,29,1,39,38,30,29,1,3,16,6,1,-2,39,30,-1 1000 DATA -3,1,10,3,2,1,10,3,2,1,10,3,2,1,10,3,2,1,0,11,42,15,1 1010 DATA 3,1,5,17,15,18,23,22,7,20,29,1,16,17,22,1,3,1,28,-2 1020 DATA 17,14,17,9,11,21,22,2,0,4,27,7,-1 12tal mass!"[dp 190e "4> What is the specific heat of your calorimeter:";SCOe2"5> What is the initial temperature of your metal"re " (in degrees Celsius):";TM/e2"6> What is the initial temperature of the calorimeter"\e" " and water (in degrees Celsius):";TWf,2"7> What is the final temperature of metal, water, and"Hf6 " calorimeter (in degrees Celsius):";TFXf@TFVUTWJ350hfJTFTUTMJ380qfT 400Gf^2"Final temperature of water is always greater than the initial temperature!!!"Pfr 280g|2"Fialories"~hCGUCWMCC2i&2"12> Total calories gained";<46);CG;"calories"?i0MTUTMNTFyi:2"13> Temperature change of metal";<46);MT;"calories" iDCMUCGP(MMOMT)FiN2"14> Specific heat of metal--exper.";<46);CM;"cal/gc"iX2"15> Specific heat of metal--acc.";<46);AV;"cal/gc"jbPEUY((CMNAV)O100PAV)=jl2"16> Percent error";<46);PE;"%"vjv2"Note: your calculated value for specific heat was" j2<7);CV;"cal/gc"j 29j2"Press any key for an evaluation";GjIU""J670Mj2`j<2"Evaluation:"fjF2jPMEUY((CMNCV)O100P   AV)kZMEV10J780Dkd2"Your calculations are much different than mine"Nkn1070skx2"You'd better check your math!"|k 860 k MEV5J8307k2"Your answers are fairly close to mine"Ak 1070vk*2"Be more careful in rounding off your numbers!"k4 860*l>2"Your answers are very close to mine"4lH1070VlR2"Your math must be correct!"\l\2klfPEV20J920lp2"Your experimental error is very high!""lz1110_l2"You may have made some mistakes in your measurements."il 1000wlPEV5J970&m"2"Your experimental e130 LETL=0 150 PRINT 160 PRINT" S P H E R I C A L T R I A N G L E S O L U T I O N" 170 PRINT 180 PRINT 185 GOTO2035 200 LETP=3.14159265# 210 C=180/P 250 LETL=L+1 260 PRINT"CASE NUMBER";L 270 PRINT 280 PRINT 290 PRINT"POSITION 1:" 300 PRINT 310 PRINTABS(D0);"DEG ";M0;"MIN "; 320 IFD0<0THEN350 330 PRINT"NORTH "; 340 GOTO360 350 PRINT"SOUTH "; 360 PRINT"LATITUDE" 370 PRINTABS(T0);"DEG ";N0;"MIN "; 380 IFT0<0THEN410 390 PRINT"WEST "; 400 GOTO420 410 PRINT"EAST "; 420 PRINT"LONGI=0THEN720 700 LETD1=(ABS(D1)+M1+90)/C 710 GOTO730 720 LETD1=(90-(D1+M1))/C 730 IFT0>=0THEN760 740 LETT0=-(ABS(T0)+N0)/C 750 GOTO770 760 LETT0=(T0+N0)/C 770 IFT1>=0THEN800 780 LETT1=-(ABS(T1)+N1)/C 790 GOTO810 800 LETT1=(T1+N1)/C 810 LETT=ABS(T1-T0) 820 LETF=FNC(D0)*FNC(D1)+FNS(D0)*FNS(D1)*FNC(T) 830 LETF1=SQR(ABS(1-F*F)) 831 LETK4=ABS(F1/F) 832 IFK4<-1THEN838 833 IFK4>1THEN836 834 LETZ=FNA(K4) 835 GOTO850 836 LETZ=FNT(K4) 837 GOTO850 838 LETZ=FNN(K4) 850 IFF>=0THEN870 860 LETZ=P-Z 80 IF(T1-T0)>=0THEN990 980 LETB1=2*P-B1 990 PRINT"LOCAL HOUR ANGLE (AT NORTH POLE):" 1000 PRINT 1010 PRINTINT(10*T*C+.5)/10;"DEG" 1020 PRINTINT(T*C);"DEG "; 1030 PRINTINT(600*(T*C-INT(T*C))+.5)/10;"MIN" 1040 LETH7=T*C/15 1050 LETM7=(H7-INT(H7))*60 1060 LETS7=(M7-INT(M7))*60 1070 PRINTINT(H7);"HRS ";INT(M7);"MIN ";INT(10*S7+.5)/10;"SEC" 1080 PRINT 1090 PRINT 1100 PRINT"ZENITH (GREAT CIRCLE) DISTANCES:" 1110 PRINT 1120 PRINTINT(10*Z*C+.5)/10;"DEG" 1130 PRINTINT(Z*C);"DEG "; 1140 PRINTINT(6rror is not too bad."0m,1110nm62"However, you can be more precise in your measurements."xm@ 1000$mJ2"Your ecperimental error is very low!".mT1110Tm^2"You must be a good scientist!!"Zmh2nr2"Press any key to start another trial"n|IU""J1020n 140In.2"(Your results differ from mine by ";]n8MEV2J2"only ";jnB2ME;"%)"pnLnV2"(Your experimental error was ";*n`PEV5J2"only ";7nj2PE;"%)"=nt! =C?1*r~M-&~" eM,kaMj( ~,(M-& w##M&"r~(XIM-&~#J97Mp+!Y=~" M,Md1Mr(;M-&!\=MB1M48 Md1!5<!3=0THEN680 660 LETD0=(ABS(D0)+M0+90)/C 670 GOTO690 680 LETD0=(90-(D0+M0))/C 690 IFD1>70 LETG=(FNC(D1)-F*FNC(D0))/(F1*FNS(D0)) 871 LETK4=ABS(SQR(ABS(1-G*G))/G) 872 IFK4<-1THEN878 873 IFK4>1THEN876 874 LETB0=FNA(K4) 875 GOTO890 876 LETB0=FNT(K4) 877 GOTO890 878 LETB0=FNN(K4) 890 IFG>=0THEN910 900 LETB0=P-B0 910 IF(T0-T1)>=0THEN930 920 LETB0=2*P-B0 930 LETH=(FNC(D0)-F*FNC(D1))/(F1*FNS(D1)) 931 LETK4=ABS(SQR(ABS(1-H*H))/H) 932 IFK4<-1THEN938 933 IFK4>1THEN936 934 LETB1=FNA(K4) 935 GOTO950 936 LETB1=FNT(K4) 937 GOTO950 938 LETB1=FNN(K4) 950 IFH>=0THEN970 960 LETB1=P-B1 9700*(Z*C-INT(Z*C))+.5)/10;"MIN" 1150 PRINTINT(600*Z*C+.5)/10;"NAUTICAL MILES" 1160 PRINTINT(600*Z*C*6080.2/5280+.5)/10;"STATUTE MILES" 1170 PRINT 1180 PRINT 1190 PRINT"TRUE BEARINGS (GREAT CIRCLE COURSES):" 1200 PRINT 1210 PRINT" POSITION 2 FROM POSITION 1:" 1220 PRINTINT(10*B0*C+.5)/10;"DEG" 1230 PRINTINT(B0*C);"DEG ";INT(600*(B0*C-INT(B0*C))+.5)/10;"MIN" 1240 PRINT 1250 PRINT" POSITION 1 FROM POSITION 2:" 1260 PRINTINT(10*B1*C+.5)/10;"DEG" 1270 PRINTINT(B1*C);"DEG ";INT(600*(B1*C-INT(B1*C))+   .5)/10;"MIN" 1280 PRINT 1290 PRINT 1300 PRINT"ALTITUDE (REMOTE CELESTIAL POSITION ABOVE LOCAL HORIZON):" 1310 PRINT 1330 LETA7=90-Z*C 1340 LETA8=ABS(A7) 1350 IFA7<0THEN1380 1360 PRINTINT(10*A7+.5)/10; 1370 GOTO1390 1380 PRINT-1*INT(10*A8+.5)/10; 1390 PRINT"DEG" 1400 IFA7<0THEN1440 1410 PRINTINT(A7);"DEG "; 1420 PRINTINT(600*(A7-INT(A7))+.5)/10;"MIN" 1430 GOTO1460 1440 PRINT-1*INT(A8);"DEG "; 1450 PRINTINT(600*(A8-INT(A8))+.5)/10;"MIN" 1460 PRINT 1470 PRINT 1480 IF(1+H0)*(1+J0)=1THEN173B9=B9-360 1710 GOTO1680 1720 PRINTINT(10*B0*C+.5)/10;"DEGREES TRUE" 1730 PRINT:PRINT 1790 PRINT"ANOTHER PROBLEM "; 1800 INPUT A$ 1806 PRINT 1810 IF LEFT$(A$,1)="Y" THEN 2130 1820 GOTO 3000 2030 REM THESE SERIES REPLACE TRIG FUNCTIONS. GET ORIG. AND 2031 REM PUT THE FUNCTIONS BACK --- GOOD GRIEF !!! 2035 DEF FNV(X)=X^5/120 2040 DEF FNW(X)=X^6/720 2050 DEF FNX(X)=X^7/5040 2060 DEF FNY(X)=X^8/40320! 2070 DEF FNZ(X)=X^9/362880! 2080 DEF FNS(X)=X-X^3/6+FNV(X)-FNX(X)+FNZ(X) 2090 DEF FNC(X)=1-X^2D ITUDE OF POSITION 2 (DEG,MIN) "; 2220 INPUTT1,N1 2230 LETH0=0 2240 LETJ0=0 2250 PRINT 2260 PRINT 2270 GOTO200 3000 EN=-3.14159/2-1/X+1/(3*X^2)-1/(5*X^5) 2130 PRINT 2150 PRINT"LATITUDE OF POSITION 1 (DEG,MIN) "; 2160 INPUTD0,M0 2170 PRINT"LONGITUDE OF POSITION 1 (DEG,MIN) "; 2180 INPUTT0,N0 2190 PRINT"LATITUDE OF POSITION 2 (DEG,MIN) "; 2200 INPUTD1,M1 2210 PRINT"LONGITUDE OF POSITION 2 (DEG,MIN) "; 2220 INPUTT1,N1 2230 LETH0=0 2240 LETJ0=0 2250 PRINT 2260 PRINT 2270 GOTO200 3000 ENRb :{BACCARAT VER 1.0 04/13/79yb:{COPYRIGHT (C) 1979, TANDY CORP.c IN$,W$,WL,WL%,WD,WS,FL: 210Nc(IN$U"":W1$UI:WDU0:BU0:WSUWD:WL%UWD:FLUWDJFLU1sc22D(Y(FL),w(136));D(Y(FL),w(24));Gc<2w(14);:W%U1=25:W1$UI:W1$VT""J70::2w(15);:W%U1=25:W1$UI:W1$VT""J70:: 60ncFW1$VTw(13)J90:2D(Y(FL)NWL%," ");dP2w(15);:W%U25::.dZ2w(14);:W1$Uw(24)J2D(WL%,w(24));: 40qddW1$VTw(8)J140:WL%U0J60:2w(24);:FLT0J120:e(16418)U44J130+dne(16418)U46JWDU0: 120:e(16418)U43Se(16418)U45JWSU0CdxIN$Ux(IN$,s(IN$)N1)`RRAYS";gfNU0=9:N1U1=5:N2U1=8: RD:S(N,N1)US(N,N1)Mw(RD):N2,N1,N:S1UD(10,32):S2Uw(143)Mw(143):NU1=14: RD:ST(N)Uw(RD)::NU1=11: RD:SRUSRMw(RD)::SPU"$$###,###.##+".hpNU1=13: SX(N)::SUw(157)Mw(174):NU1=4:S3US3MS::SHUw(191)Mw(140)Mw(140)Mw(191):SGUw(179)Mw(140)Mw(179):SW(1)USGM" WON "MSG:SW(2)USW(1):NU1=17: RD:SW(3)USW(3)Mw(RD):PhSB(1)UD(11,32):SB(2)USB(1):SB(3)UD(17,32):S4Uw(179)MD(2,140)Mw(179):NU1=12: PB(N)::NU1=12:DB(N)U" ":A(N)U0::S7US2:NU1=8: RD:S7US7Mw(32)Mw(RD)Mw(32)MS2:miNU1=13:DE(0 1490 PRINT"OBSERVED ALTITUDE:" 1500 PRINT 1510 PRINTH0;"DEG ";J0;"MIN" 1520 LETH1=H0+J0/60 1530 PRINTINT(100*H1+.5)/100;"DEG" 1540 PRINT 1550 PRINT 1560 PRINT"LINE OF POSITION:" 1570 PRINT 1580 LETI4=60*(H1-A7) 1590 PRINTINT(10*ABS(I4)+.5)/10;"MILES "; 1600 IFI4>0THEN1630 1610 PRINT"AWAY "; 1620 GOTO1640 1630 PRINT"TOWARDS "; 1640 PRINT"ON LINE BEARING "; 1650 IFI4>0THEN1720 1660 LETB9=B0*C+180 1670 IFB9>360THEN1700 1680 PRINTINT(10*B9+.5)/10;"DEGREES TRUE "; 1690 GOTO1730 1700 LET/2+X^4/24-FNW(X)+FNY(X) 2100 DEF FNA(X)=X-X^3/3+X^5/5-X^7/7 2110 DEF FNT(X)=3.14159/2-1/X+1/(3*X^2)-1/(5*X^5) 2120 DEF FNN(X)=-3.14159/2-1/X+1/(3*X^2)-1/(5*X^5) 2130 PRINT 2150 PRINT"LATITUDE OF POSITION 1 (DEG,MIN) "; 2160 INPUTD0,M0 2170 PRINT"LONGITUDE OF POSITION 1 (DEG,MIN) "; 2180 INPUTT0,N0 2190 PRINT"LATITUDE OF POSITION 2 (DEG,MIN) "; 2200 INPUTD1,M1 2210 PRINT"LONGITUDE OF POSITION 2 (DEG,MIN) "; 2220 INPUTT1,N1 2230 LETH0=0 2240 LETJ0=0 2250 PRINT 2260 PRINT 2270 GOTO200 3000 ENdWL%UWL%N1:116418,136: 60e Y(FL)UWL%J60:FLT0JW1$TU" "RW1$VU"Z"J190,eW1$U"."RWDU0JWDU1: 190Ne W1$U","J2W1$;:WL%UWL%M1: 200ze*(W1$U"-"SW1$U"+")RWSU0RWL%U0JWSU1: 190e4W1$V"0"SW1$T"9"J602e>2W1$;:IN$UIN$MW1$:WL%UWL%M1FeHY(FL)U1J80:60`fR:81500::BND,FNZ:EU30:S,D: A(12),A1(12),PB(12),DB(12),DN(12),SN(12),ST(14),S(9,5),S!(416),DE(52),SX(13),M(52):PA(1)U243:PA(2)U755:PA(3)U491:SFU"C"_f\:2w(23):2@4,"* B A C C A R A T *":2@448,"YOUR TRS-80 WILL BE BUSY FOR ONE";:2"MINUTE SETTING UP GRAPHIC AN)USX(N)M" CLUBS"::NU1=13:DE(NM13)USX(N)M" HEARTS"::NU1=13:DE(NM26)USX(N)M" SPADES"::NU1=13:DE(NM39)USX(N)M" D'MNDS"::NU1=8: SE(N):!iAAUZ(AA$)::2<11)"* B A C C A R A T *"xiFLUN2:2@75,"HOW MANY PLAYERS (1 TO 12) ";:40:PXUu(IN$):PXV1SPXT12J280:NU1=PX=j"FLU8:2:2<11)"ENTER NAME OF PLAYER NUMBER ";N;" ";:40:SN(N)UIN$Mj,:AAUZ(AA$)[j6940: 670ej@ 910tjJGUGM1:SIUI0jTCOUCOM1:x(DE(S!(CO)),1)U"A"JC(2)U1:C(2)Uu(DE(S!(CO)))xj^PU0:NU1=5:2@578MP,S(C(2),N);:PUPM64::2@898,DE(S!(C   O));:NU1=300:4khCOUCOM1:x(DE(S!(CO)),1)U"A"JC(1)U1:C(1)Uu(DE(S!(CO)))krPU0:NU1=5:2@66MP,S3;:PUPM64::2@386,w(140);" BACK ";w(140);:SM(1)UDE(S!(CO)):NU1=300:Mk|COUCOM1:x(DE(S!(CO)),1)U"A"JC(4)U1:C(4)Uu(DE(S!(CO)))lPU0:NU1=5:2@591MP,S(C(4),N);:PUPM64::2@911,DE(S!(CO));:NU1=300:QlCOUCOM1:x(DE(S!(CO)),1)U"A"JC(3)U1:C(3)Uu(DE(S!(CO))).lPU0:NU1=5:2@79MP,S3;:PUPM64::2@399,w(140);" BACK ";w(140);:SM(3)UDE(S!(CO)):NU1=300:Nl$BAUC(1)MC(3):BAT9JBAUBAN10nl.PLUC(2)MC(4):PLT9JPLUPLN10m8:SIU""J490:SIUw(13)J530:SIVT"H"J4902otPLV6JPU0:530no~COUCOM1:x(DE(S!(CO)),1)U"A"JC(6)U1:C(6)Uu(DE(S!(CO)))AoNU1=5:2@604MP,S(C(6),N);:PUPM64::2@924,DE(S!(CO));:PLUPLMC(6):PLT9JPLUPLN10ZoBAU7J2@222,S4;: 630pBAU6RC(6)U6SBAU6RC(6)U7J600:BAU6J2@222,S4;: 630yp&BAU5RC(6)UN1J600:BAU5RC(6)U4J590:BAU5RC(6)U5SBAU5RC(6)U6SBAU5RC(6)U7J600:BAU5J2@222,S4;: 630[p0BAU4RC(6)UN1J600:BAU4RC(6)U0SBAU4RC(6)U1SBAU4RC(6)U8SBAU4RC(6)U9J2@222,S4;: 630:BAU4J600 q:BAU3RC(6)U8J2@222,S4;: 630:B);:NU1=75::SIU""J660)sSIUI=s(C(6)UN1JC(6)U0Ds2:2@11,S7:2D(64,140):2@961,w(140);" H = HOUSE TOTALS ";w(140);" R = REPLACE ";w(140);" N = NEW PL. ";w(140);" C = CANCEL ";w(140);Ys<CKUN1JCKU0: 760'tFGU0J760:BATPLJW1UW1M1:W$U"B":PLTBAJW2UW2M1:W$U"P":W$U"":PUSHUPUSHM1tPW$U""J760:W$U"B"J740:W$U"P"JNU1=PX:DB(N)UW$JA1(N)UA1(N)MA(N):E(2)UE(2)MA(N):A1(N)UA1(N)NA(N):E(3)UE(3)MA(N)*tZ: 760.udNU1=PX:DB(N)UW$JA1(N)UA1(N)M(A(N)N(A(N)O.05)):E(1)UE(1)MA(N)N(A(N)O.05):E(5)UE(5)M(A(N)O.05):A1JDMU"":MAU0: 790:IN$U"D"J1010:IN$U"N"J1050Bw*IN$U"I"J1170:IN$U"R"J1070:IN$U"H"J1130:IN$U"B"Ru(DM)T0J830:IN$U"P"Ru(DM)T0J840:v(IN$)T57Sv(IN$)V48JDMU"": 7909x4u(DMMIN$)V1Su(DMMIN$)T12JDMU"": 790:DMUDMMIN$:2@128,S2;" PLAYER ";DM;w(30);:KCUN1:NUu(DM):NTPXJDMU"": 790: 800^x>DMU"":DN(N)UDB(N):DB(N)U"B": 850xHDMU"":DN(N)UDB(N):DB(N)U"P": 850?xRFLUN4:40:IN$U""J860:IN$U"0"JDMU"":MAU0: 790:DMUIN$y\DCU"":MAUu(DM):DMU"":MAT2000SMAV20JMAU0:DB(N)UDN(N):DCU"C": 870:A(N)UMA:2@143,A(N);:DMU40);w(188)<26)w(188);D(10,140);w(188);:PU0:NU1=14:2@127MP,ST(N);:PUPM64::M{,COU0:PPU0::2@11,S7:2D(64,191):2:2<9)S2;" WE WILL NOW SHUFFLE EIGHT DECKS OF CARDS ";S2;v{62@448,D(64,131);D(128,32);D(64,176);>|@P1U0:PU0:N1U1=8:2@512,D(128,32);:2@985,S2;" DECK #";N1;S2;:NU1=52j|JMU^(52):M(M)UN1J970:S!(NMP)UM:M(M)UN1M|T2@512MP1,DE(S!(NMP));:2@512MP1N8,D(8,32);:2@504,D(8,131);:P1UP1M8:P1U128JP1U0:2@631,D(9,143);!}^N:PUPM52:N2U1=52:M(N2)U0:N2:2@768MPP,w(140);" FINISHED #";N1;:PPUPPM16:N1:E}h2@128BAT7J2@371,w(143);" NATURAL ";w(143);: 630ImBPU0:NU1=5:2@618MP,S(PL,N);:PUPM64::PLU9J2@1005,w(143);" LA GRANDE ";w(143);: 630:PLU8J2@1005,w(140);" LA PETITE ";w(140);: 630:PLT52@1005,S2;" MUST STAND ";S2;BnLPLV5J2@1005,S2;" MUST HIT ";S2;:PLU5RSFU"C"J2@1005,S2;" MUST HIT ";S2;:PLU5J2@1005,S2;" HIT OPTIONAL ";S2;: 490 nVSIU"":SIUI:2@500,SG;:NU1=200::2@500,D(3,32);:NU1=75::SIU""J470:n`2@1005,SB(3);:PLVT5J500I:PLU5RSFU"C"J500ojSIU"":SIUI:2@734,SH;:NU1=200::2@734,D(4,32);:NU1=75:AU3RC(6)U9J590qD 600ZqNSFU"C"J600:2@424,D(9,93);" HIT OPTIONAL ";:VU^(100):VT50J630qXCOUCOM1:x(DE(S!(CO)),1)U"A"JC(5)U1:C(5)Uu(DE(S!(CO)))4qbBAUBAMC(5):BAT9JBAUBAN10{qlPU0:NU1=5:2@92MP,S(C(5),N);:PUPM64::2@412,DE(S!(CO));:NU1=300:ervPU0:NU1=5:2@66MP,S(C(1),N);:PUPM64::2@386,SM(1);:PU0:NU1=5:2@79MP,S(C(3),N);:PUPM64::2@399,SM(3);3rPU0:NU1=5:2@106MP,S(BA,N);:PUPM64::PU0:NU1=5:2@618MP,S(PL,N);:PUPM64:Sr BAUPLJQU3:BATPLJQU1:QU2 sSIU"":SIUI:2@PA(Q),SW(Q);:NU1=200::2@PA(Q),SB(Q(N)UA1(N)NA(N):E(4)UE(4)MA(N)4unvuxPU0:NU1=12:2@192MP,S2;:2?"##";N;:2w(32);SN(N);<15)w(133);" ON ";DB(N);" FOR $";A(N)<48)w(138)<62)S2;:PUPM64::2@242,"GAME #";G;:2@306,"BANKER";W1;:2@370,"C 1 =";C(1);:2@434,"C 2 =";C(3);4v2@498,"C 3 =";C(5);:NU1=PX:2@PB(N)M35,"";:2?SP;A1(N);:Gv 2@562,"PLAYER";W2;:2@626,"C 1 =";C(2);:2@690,"C 2 =";C(4);:2@754,"C 3 =";C(6);:2@818,"PUSH =";PUSH;:2@882,"WINNER ";W$;:2@946,"NEXT G";GM1;tvC(5)U0:C(6)UN1:DMU"":2@128,w(30);S2;" ";Ew FLU1:40:IN$U""J880:IN$U"C"""%yf2@PB(N)M27,A(N);" ";:2@PB(N)M20,DB(N);:2@128,w(30);S2;:KCU0:DCU"C"J2@164,S2;w(94);" VERIFY BET ON PLAYER";N;:2@128,S2;: 800:800:ypKCUN1JKCU0: 790KyzCOT410J940Yy910: 330jz:2w(188);D(10,140);w(188)<13)w(188);D(10,140);w(188)<26)w(188);D(10,140);w(188):NU1=14:2w(191);S1;w(191)<13)w(191);S1;w(191)<26)w(191);S1;qz2w(191)::2D(12,131)<13)D(12,131)<26)D(12,131);:2@448,D(12,131)<13)D(12,131)<26)D(12,131);:2@167,S2;:2@295,S2;:2@679,S2;:2@807,S2;p{"2@512,w(188);D(10,140);w(188)<13)w(188);D(10,1,SB(3);:DMU"":SIU"":MAU0:+}r:2@11,S7:2"ENTER DECK YOU WOULD LIKE TO REVIEW ( 1-8 )";:2@977,R2;" PRESS ENTER TO RETURN ";S2;B~|SIU"":SIUI:2@977," ";:2@1004," ";:NU1=75::2@977,S2;:2@1004,S2;:NU1=150::SIU""J1020:SIUw(13)JCKUN1: 670:v(SI)T56Sv(SI)V49J1020:XXUu(SI)E~2@117,"DECK #";XX;:XXU1JXXU0:XXU2JXXU52:XXU3JXXU104:XXU4JXXU156:XXU5JXXU208:XXU6JXXU260:XXU7JXXU312:XXU8JXXU364:2@128,"";:2w(31):2@128,"";:NU1=52:2?"##";N;:2w(94);w(32);DE(S!(XXMN)),::2@979," PRESS ENTER TO RETU   RN ";: 1020PXU12J790::2@11,S7:2D(64,191):2:2"ENTER NAME OF NEW PLAYER ";:FLU8:40:PXUPXM1:SN(PX)UIN$Q$CKUN1:SN(PX)U""JSN(PX)U"PLAYER"Mt(PX): 670:670<.X5$U""::2@11,S7;:NU1=PX:2@PB(N),S2;:2?"##";N;:2w(32);SN(N);::2@978,S2;" PRESS ( E ) TO ESCAPE ";S2;,8FLU2:2@128,S2;" ENTER PLAYER NUMBER TO BE REPLACED ";:40:IN$U"E"JCKUN1: 670:X5Uu(IN$):X5TPXSX5V1J1080YB2@296,S2;" REMOVED ";S2;:2@960,D(55,32);oL2@360,S2;X5;SN(X5);:2@424,S2;" BALANCE ";S2;:2@488,S2;:2?SP;A1(X5);:2@552,S2;" SETTLE WITH"ST=";:2?SP;E(0);:2@833,"GAMES PLAYED TO DATE ";G;@~2@869,"CARDS LEFT IN SHOE -> ";416NCO;:2@978,S2;" PRESS ENTER TO RETURN ";S2;ISIU"":SIUI:NU1=8:2@PB(N)," ";:2@PB(N)M62," ";:N1U1=20:N1:2@PB(N),S2;:2@PB(N)M62,S2;:N:SIU""J1160:SIUw(13)JCKUN1: 670::1160 :2@11,S7;:2@256,S2;" BANKERS HAND = B / PLAYERS HAND = P .":2:2S2;" MINIMUM BET $ 20.00 / MAXIMUM $ 2,000.00.":2:2S2;" EXAMPLE: PLAYER # 2 BETS ON THE BANKER FOR $ 50.".2S2;" ENTER -> / 2B50 / THATS ALL THERE IS TO32,32,175,191,189,188,188,188,188,190,170,143,143,143,143,175,191,189,32,32,32,32,32 : 160,191,191,32,32,32,143,143,175,191,183,32,32,32,32,32,32,191,191,189,188,188,188,188,190,191,159,191,191,32,32,32,32,191,191,191,191,144,32,32,32,191,191,139,143,143,143,143,143,191,191,32,32,32,32,32,32,191,191,32,32,32,32,32,160,191,159 D 190,191,159,143,143,143,143,175,191,191,144,32,32,32,32,32,139,143,143,143,143,175,191,189,32,32,32,32,32,32,191,191,189,188,188,188,188,190,191,159,190,191,159,143,143,143,143,191,32,32,32,32,32,130,191,191X b 189,188,188,188,188,190,191,159,66,65,78,75,69,82,32,32,80,76,65,89,69,82,82,65,68,73,79,32,83,72,65,67,75,A,2,3,4,5,6,7,8,9,T,J,Q,K,140,32,80,32,140,32,85,32,140,32,83,32,140,32,72,32,140,192,256,320,384,448,512,576,640,704,768,832,896 l 66,65,67,67,65,82,65,84,PD'OUT/BANKER WINS,PD'OUT/PLAYER WINS,R'CPTS/BANKER LOSS,R'CPTS/PLAYER LOSS,5% COLMISSION,W/L TO BANKER,W/L TO PLAYER,HOUSE PROFITo adjust your video screen$There is nothing wrong with your computer$We contro BANKER";:2@PB(X5)M2,SB(3);:DB(X5)U" ":A(X5)U0:A1(X5)U0ZV2@128,w(30);:2@850,S2;" ENTER NAME OF NEW PLAYER ";:FLU8:40:SN(X5)UIN$:IN$U""JSN(X5)U"PLAYER"Mt(X5)`2@PB(X5)M2,X5;SN(X5);:NU1=2000::CKUN1:X5U0: 1070Kj:E(6)UE(3)NE(1):E(7)UE(4)NE(2):E(8)UE(6)ME(7):E(9)UE(1)ME(2):E(10)UE(3)ME(4):E(0)UE(6)ME(7):2@11,S7:2D(64,191);:NU1=8:2@PB(N),S2;" ";D(24,95);w(94);:2?SP;E(N);:2D(20,95);" ";S2;:nt2D(64,140);:NU1=8:2@PB(N)M3,SE(N);::2@PB(2)M45,"ST=";:2?SP;E(9);:2@PB(4)M45,"ST=";:2?SP;E(10);:2@PB(7)M44, IT.":2:2S2;" PRESS TO RETURN (ENTER FOR HIT OPTION) ";: SI:CKUN1:SIU"O"JSFU"O": 670:SFU"C": 670*&190,191,159,143,143,175,191,189,191,191,32,32,32,32,191,191,191,191,32,32,32,32,191,191,191,191,32,32,32,32,191,191,175,191,189,188,188,190,191,159,32,32,138,191,191,32,32,32,32,32,32,191,191,32,32,32,32,32,32,191,191,32,32,32,32,32,32,191,191,320 32,32,32,32,188,191,191,188,32,32,159,143,143,143,143,175,191,189,32,32,32,32,32,160,191,191,190,191,159,143,143,143,143,135,191,191,32,32,32,32,,175,191,191,144,32,32,32,32,32,191,191,159,143,143,175,191j N 189,191,191,32,32,32,32,191,191,175,191,189,188,188,190,191,149,159,143,143,143,143,175,191,189,32,32,32,32,32,32,191,191,32,32,32,32,32,32,191,191,32,32,32,32,32,32,191,191,32,32,32,32,32,160,191,159,190,191,159,143,143,175,191e X 189,191,191,144,32,32,160,191,191,187,191,159,143,143,175,191,183,191,191,32,32,32,32,191,191,175,191,189,188,188,190,191,159,190,191,159,143,143,175,191,189,191,191,32,32,32,32,191,191,175,191,189,188,188,190,191   REM KID.BAS -- JUST ECHOES KEYBOARD ENTRY TO CONSOLE, BUT IN LARGE FORM. REM DESIGNED TO AMUSE A YOUNG CHILD. BORING FOR ADULTS. REM REM WRITTEN IN SBASIC BY MIKE KRUGER OCT 1983 REM VAR R,C,RE,CE,I,W,J =INTEGER VAR K,E,Q =CHAR DIM STRING:10; P(6) REM E AND Q ARE ESCAPE AND EQUALS E=1BH Q=3DH REM REM THE CHECK.WIDTH PROCEDURE CHECKS THAT THERE IS ENOUGH ROOM TO REM PRINT THE NEXT CHARACTER ON THE SCREEN GIVEN CURRENT CURSOR REM ASSIGNMENTS. SCREEN RUNS FROM 0,0 (UPPER LEFTING EQUATION ALLOWS FOR 2 BLANK COLUMNS BETWEEN. C=C+W+2 END PROCEDURE REM PROCEDURE OUTCHAR REM OUTPUTS THE CHARACTER TO THE SCREEN PRINT E;Q;CHR$(RE+0+32);CHR$(CE+32);P(0); E;Q;CHR$(RE+1+32);CHR$(CE+32);P(1); E;Q;CHR$(RE+2+32);CHR$(CE+32);P(2); E;Q;CHR$(RE+3+32);CHR$(CE+32);P(3); E;Q;CHR$(RE+4+32);CHR$(CE+32);P(4);  IF (K>60H) AND (K<7BH) THEN K=K-20H REM CASE K OF ' ' : BEGIN W=5 CHECK.WIDTH PRINT E;Q;CHR$(R+32);CHR$(C+32); END SPACE 0DH : BEGIN W=0 CHECK.WIDTH PRINT E;Q;CHR$(R+32);CHR$(C+32); END CR 09H : BEGIN PRINT CHR$(26); FOR I=1 TO 24 PRINT""; PRINT"" NEXT I END TAB '\' : BEGIN PRINT CHR$(26);CHR$(07); R=0 C=0 END '[' : PRINT CHR$(07); ']' : PRINT CHR$(07);  A 'B' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " REM OUTCHAR END B 'C' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END C 'D' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END G 'H' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)="" P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END H 'I' : BEGIN W=3 CHECK.WIDTH P(0)="" P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)="" OUTCHAR REM END I 'J' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " ) T0 23,79. REM LETTERS ARE NOT ALL THE SAME WIDTH. REM PROCEDURE CHECK.WIDTH VAR BLK=STRING:20 VAR IP = INTEGER REM IF (C+W) > 79 OR (K=0DH) THEN BEGIN BLK=" " C=0 R=R+8 IF R > 16 THEN R=0 PRINT E;Q;CHR$(R+32);CHR$(C+32); FOR I = 1 TO 7 PRINT BLK;BLK;BLK;BLK; NEXT I PRINT E;Q;CHR$(R+32);CHR$(C+32); END IF REM HOUSEKEEPING: RE, CE WILL BE COORDINATES FOR THIS ENTRY; REM R, C FOR NEXT ENTRY RE=R CE=C REM THE "2" IN THE FOLLOW E;Q;CHR$(RE+5+32);CHR$(CE+32);P(5); E;Q;CHR$(RE+6+32);CHR$(CE+32);P(6); E;Q;CHR$(R+32);CHR$(C+32); END PROCEDURE REM PROCEDURE CLEAR.P VAR RR=INTEGER FOR RR=0 TO 6 P(RR)="" NEXT RR END PROCEDURE REM ----------------------------------------------------------------- PRINT CHR$(26);"Press Any Key" REM MAIN LOOP OF PROGRAM. NOTE: MUST HIT RESET TO GET OUT 0LOOP INPUT3 K REM CHANGE TO UPPER CASE ';' : PRINT CHR$(07); ':' : PRINT CHR$(07); '`' : PRINT CHR$(07); '=' : PRINT CHR$(07); '-' : PRINT CHR$(07); '' : PRINT CHR$(07); '!' : PRINT CHR$(07); '@' : PRINT CHR$(07); '#' : PRINT CHR$(07); '$' : PRINT CHR$(07); '%' : PRINT CHR$(07); '^' : PRINT CHR$(07); '&' : PRINT CHR$(07); '\' : PRINT CHR$(07); 'A' : BEGIN W=6 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)="" P(5)=" " P(6)=" " OUTCHAR REM END P(6)=" " OUTCHAR REM END D 'E' : BEGIN W=5 CHECK.WIDTH P(0)="" P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)="" OUTCHAR REM END E 'F' : BEGIN W=5 CHECK.WIDTH P(0)="" P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END F 'G' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)="  P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END J 'K' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END K 'L' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)="" OUTCHAR REM END L 'M' : BEGIN W=6 CHECK.WIDTH    P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END M 'N' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END N 'O' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END O 'P' : BOUTCHAR REM END S 'T' : BEGIN W=5 CHECK.WIDTH P(0)="" P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END T 'U' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END U 'V' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5 " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END X 'Y' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END Y 'Z' : BEGIN W=5 CHECK.WIDTH P(0)="" P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)="" OUTCHAR REM END Z '?' : BEGIN W=5 CHECK.WIDTAT BEGIN FOR J=1 TO I PRINT ""; NEXT J PRINT I=I-1 END UNTIL I=0 END ESCAPE END GO TO 0LOOP  ',' : BEGIN W=2 CHECK.WIDTH CLEAR.P P(3)="" P(4)="" P(5)=" " P(6)=" " OUTCHAR END COMMA 1BH : BEGIN I=1 REPEAT BEGIN FOR J=1 TO I PRINT ""; NEXT J PRINT I=I+1 END UNTIL I=79 REPEEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END P 'Q' : BEGIN W=6 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END Q 'S' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " )=" " P(6)=" " OUTCHAR REM END V 'R' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END R 'W' : BEGIN W=8 CHECK.WIDTH P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END W 'X' : BEGIN W=5 CHECK.WIDTH P(0)=" " P(1)=" H P(0)=" " P(1)=" " P(2)=" " P(3)=" " P(4)=" " P(5)=" " P(6)=" " OUTCHAR REM END QUESTIONMARK '.' : BEGIN W=2 CHECK.WIDTH CLEAR.P P(5)="" P(6)="" OUTCHAR END PERIOD ',' : BEGIN W=2 CHECK.WIDTH CLEAR.P P(3)="" P(4)="" P(5)=" " P(6)=" " OUTCHAR END COMMA 1BH : BEGIN I=1 REPEAT BEGIN FOR J=1 TO I PRINT ""; NEXT J PRINT I=I+1 END UNTIL I=79 REPE   10 PRINT CHR$(26):REM SCREEN CLEAR 20 PRINT"YOU ARE NOW GOING TO PLAY A COMPUTERIZED VERSION OF BINGO--" 30 PRINT 40 CLEAR 50 IF PEEK(3)<>3 THEN X1=14 ELSE X1=2:REM Define STATUS port 60 PRINT:PRINT:PRINT 70 F=1 80 V=0 90 DIM B(10,10),L(75) 100 FOR I=1 TO 5:READ A$(I):NEXT I 110 DATA B,I,N,G,O 120 FOR K1=1 TO 75 130 LET L(K1)=0 140 NEXT K1 150 LINEINPUT "PRESS RETURN TO PRINT CARDS >";A$ 160 IF X1=14 THEN POKE 3,3:REM TURN ON HARD COPY 170 PRINT:PRINT" "," HERE'S "; 180 IF F>1 THEN 210 -----------------------------------------------"; 460 PRINT"-----------" 470 PRINT" (TEAR OFF AFTER MACHINE AUTOMATICALLY ADVANCES PAPER)" 480 FOR K9=1 TO 9 490 PRINT 500 NEXT K9 510 IF X1=14 THEN POKE 3,1:REM TURN OFF HARD COPY 520 FOR Z=1 TO 3000:NEXT Z 530 IF F=6 THEN 560 540 F=6 550 GOTO 120 560 PRINT 570 PRINT"NOW WE'RE ALL SET TO PLAY THE GAME. USE A PENCIL TO MARK OFF" 580 PRINT"THE NUMBERS ON YOUR CARD AS THEY ARE CALLED." 590 PRINT" (PLEASE PLAY MY CARD AS WELL AS YOUR OWN)" 60 810 800 PRINT"THE NEXT ONE IS:", 810 PRINT A$(INT((U-1)/15)+1);U 820 FOR Y=1 TO 10 830 FOR X=1 TO 10 840 IF B(X,Y)=U THEN 960 850 NEXT X 860 NEXT Y 870 F=1 880 GOSUB 980 890 F=6 900 GOSUB 980 910 IF V=0 THEN 940 920 IF W=1 THEN 1600 930 GOTO 1670 940 IF W=0 THEN 740 950 GOTO 1730 960 LET B(X,Y)=0 970 GOTO 850 980 G=F+4 990 FOR Y=F TO G 1000 FOR X=F TO G 1010 IF B(X,Y)<>0 THEN 1130 1020 IF X0 THEN 1590 1480 X=X-1 1490 Y=Y+1 1500 IF Y0 THEN 250 280 LET B(X,Y)=R 290 LET L(R)=1 300 NEXT X 310 M=M+15 320 NEXT Y 330 PRINT 340 PRINT"--B--","--I--","--N--","--G--","--O--" 350 FOR X=F TO G 360 PRINT:PRINT 370 FOR Y=F TO G 380 IF B(X,Y)=B(F+2,F+2) THEN 410 390 PRINT B(X,Y), 400 GOTO 420 410 PRINT"FREE", 420 NEXT Y 430 NEXT X 440 PRINT:PRINT 450 PRINT"------------0 PRINT"***DON'T GET SMART. I'LL BE PLAYING BOTH YOUR CARD AND MINE." 610 PRINT"IMPORTANT: DON'T FORGET TO MARK OFF THE FREE SPACE!" 620 PRINT 630 INPUT"ARE YOU READY";R$ 640 IF LEFT$(R$,1)<>"N" THEN 680 650 PRINT 660 PRINT"**********!HURRY UP!**********" 670 GOTO 620 680 FOR K1=1 TO 75 690 LET L(K1)=0 700 NEXT K1 710 PRINT 720 LET B(3,3)=0 730 LET B(8,8)=0 740 LET U=INT(75*RND(2)+1) 750 IF L(U)<>0 THEN 740 760 LET L(U)=1 770 IF RND(3)>.5 THEN 800 780 PRINT"THE NUMBER COMES UP:", 790 GOTO060 W=1 1070 RETURN 1080 PRINT 1090 PRINT"I'VE GOT A B I N G O * * * * *" 1100 V=1 1110 GOTO 1140 1120 NEXT X 1130 NEXT Y 1140 G=F+4 1150 FOR X=F TO G 1160 FOR Y=F TO G 1170 IF B(X,Y)<>0 THEN 1290 1180 IF Y0 THEN 1440 1330 X=X+1PRINT 1610 PRINT" ********** IT'S A TIE **********" 1620 PRINT 1630 INPUT"DO YOU WANT TO PLAY AGAIN";E$ 1640 PRINT 1650 IF LEFT$(E$,1)="Y" THEN 30 1660 GOTO 1760 1670 PRINT 1680 FOR S=1 TO 6 1690 PRINT"I WIN. "; 1700 NEXT S 1710 PRINT 1720 GOTO 1620 1730 PRINT 1740 PRINT" YOU WIN..... YOU WIN..... YOU WIN....." 1750 GOTO 1620 1760 FOR I=1 TO 500:NEXT I 1770 RUN "DIR" 1780 END T 1740 PRINT" YOU WIN..... YOU WIN..... YOU WIN....." 1750 GOTO 1620 1760 FOR I=1 TO 500:NEXT I 1770 RUN "DND F TO FIRE" 170 FOR N=0 TO 1500: NEXT N 180 INPUT "TYPE N FOR NOVICE PILOT, E FOR EXPERIENCED, A FOR ACE";V$ 185 RANDOMIZE 190 IF V$="E" THEN V8=200 200 IF V$="N" THEN V8=350 210 IF V$ = "A" THEN V8=100 220 PRINT CHR$(26) 230 Y5=10:X5=10:GOSUB 670 240 PRINT "GOOD LUCK ON YOUR MISSION --- ON INTO BATTLE!!!" 250 FOR N=0 TO 1000:NEXT N 270 D2=1:D1=1:PRINT CHR$(26) 280 GOSUB 1140 290 Y5=6:X5=0:GOSUB 670:GOSUB 500 300 Y5=INT(10*RND+7) 310 X5=INT(20*RND+21) 320 GOSUB 670 330 GOSUB 640 340 GOSU   B 690 350 GOSUB 1080 355 ST=INP(3) 360 IF(ST AND 2)=0 THEN 350 365 IN=INP(2) 370 D=(IN AND 127) 380 GOSUB 670 390 IF D=76 THEN X5=X5+1 400 IF D=82 THEN X5=X5-1 410 IF D=85 THEN Y5=Y5+1 420 IF D=68 THEN Y5=Y5-1 430 IF D=70 THEN 710 440 IF D=3 THEN 500 450 GOSUB 1050 460 GOSUB 670 470 GOSUB 640 480 GOTO 340 500 PRINT " ----------------------" 510 PRINT " |" 520 PRINT " |" 530 PRINT "  |" 620 PRINT " ---------------------" 630 RETURN 640 PRINT "I-0-I" 650 P=Y5:Q=X5 660 RETURN 670 PRINT CHR$(27)+"="+CHR$(32+Y5)+CHR$(32+X5); 680 RETURN 690 PRINT CHR$(27)+"="+CHR$(32)+CHR$(32) 700 RETURN 710 IF Y5=12 THEN 740 720 GOSUB 880 730 GOTO 320 740 IF X5=34 THEN 770 750 GOSUB 880 760 GOTO 320 770 Y5=12:X5=33:GOSUB 670:PRINT " POW " 780 FOR N=0 TO 100:PRINT CHR$(7);:NEXT N 790 FOR N=0 TO 100:NEXT N 800 GOSUB 670:PRINT BLANK$+CHR$(0) 810% PERFORMANCE" 970 IF 5/5+D2*100 >75 THEN V8=V8-50 980 IF 5/5+D2*100 <51 THEN V8=V8+50 990 PRINT "DO YOU WANT ANOTHER MISSION?" 995 ST=INP(3) 1000 IF(ST AND 2) =0 THEN 995 1010 X=(INP(2) AND 127) 1020 IF X<>89 THEN STOP 1030 GOTO 270 1040 Y5=0:X5=0:GOSUB 670 1050 PRINT CHR$(27)+"="+CHR$(32+P)+CHR$(32+Q); 1060 PRINT BLANK$+CHR$(0) 1070 RETURN 1080 T=T+1 1090 IF T>V8 THEN 1110 1100 RETURN 1110 IF X5>36 THEN 1116 1011 IF Y5<12 THEN 1116 1112 X5=X5-1:Y5=Y5+1:GOSUB 1050: GOSUB 670:GOSUB 640: GO1 REM ***** BLACK BOX ***** 2 REM A computerized version of the popular board game. 10 REM 11 REM by Bruce Ratoff, with credit to Kris Tuttle of Computer Mart 12 REM for the Apple II version on which the logic is based. 13 REM IMPORTANT: This program makes heavy use of ADM-3A cursor controls. 14 REM You must change the value of AT$ to the cursor address sequence 15 REM for your own terminal. You should also change all occurrences of 16 REM CLS$ to the "clear screen" code for your terminal. 17 REM F N<3 OR N>6 THEN 150 160 FOR J=0 TO 9: FOR I=0 TO 9: B(I,J)=0: NEXT I,J 170 FOR I=1 TO N 180 X=FNR(1): Y=FNR(1): IF B(X,Y)<>0 THEN 180 190 B(X,Y)=1: NEXT I 200 S=0: C=0 210 PRINT AT$;CHR$(54);" IN AT";WI$; :INPUT R: IF R<1 THEN 480 215 IF R>32 THEN 230 220 ON INT((R-1)/8+1) GOTO 240,250,260,270 230 PRINT RX$;"ERROR ": GOTO 210 240 X=0: Y=R: U=1: V=0: GOTO 280 250 X=R-8: Y=9: U=0: V=-1: GOTO 280 260 X=9: Y=25-R: U=-1: V=0: GOTO 280 270 X=33-R: Y=0: U=0: V=1 280 XN=X: YN=Y: X1=X+U: Y1=Y+V  |" 540 PRINT " | |" 550 PRINT " | | | |" 560 PRINT " |----------| |----------|" 570 PRINT " | | | |" 580 PRINT " | |" 590 PRINT " |" 600 PRINT " |" 610 PRINT "  FOR N=0 TO 100:NEXT N 820 Y5=22:X5=0:GOSUB 670 830 PRINT "M A Y T H E F O R C E B E W I T H Y O U !!!!!" 840 Y5=1:X5=50:GOSUB 670 850 PRINT "ENEMY DESTROYED=";D1 860 D1=D1+1 865 IF D1=6 THEN 920 870 GOTO 300 880 P=Y5:Q=X5:Y5=2:X5=50:GOSUB 670 890 PRINT "NUMBER MISSED =";D2:D2=D2+1 900 Y5=P:X5=Q:GOSUB 670 910 RETURN 920 Y5=22:X5=10:GOSUB 670 930 D2=D2-1 940 Y5=20:X5=0:GOSUB 670 950 PRINT "THE HOME BASE HAS BEEN SAVED-CONGRADULATIONS" 960 PRINT "YOUR MISSION RECORD: ";5/(5+D2)*100;"SUB 690: GOTO 1120 1114 GOTO 1120 1116 X5=X5+1:Y5=Y5-1:GOSUB 1050:GOSUB 670:GOSUB 640:GOSUB 690:GOTO 1120 1120 IF Y5>18 THEN PRINT CHR$(26):PRINT "YOURE SHOT DOWN!!!":GOTO 500 1122 IF Y5<5 THEN PRINT CHR$(26):PRINT "YOUR SHOT DOWN!!!":GOTO 500 1130 T=0:RETURN 1140 IF V8<=100 THEN Q$="RATING=ACE PILOT":GOTO 1170 1150 IF V8>= 350 THEN Q$="RATING=NOVICE PILOT":GOTO 1170 1160 Q$="RATING=EXPERIENCED PILOT" 1170 Y5=2:X5=25:GOSUB 670 1180 PRINT Q$ 1190 RETURN  18 REM 19 REM 20 AT$=CHR$(27)+"=": RX$=AT$+CHR$(54)+CHR$(92): WI$=SPACE$(10)+STRING$(10,8) 21 CLS$=CHR$(26) 30 RANDOMIZE 90 MK$="!#$%&'():*-=[{]}^~\|@`;+/?.>,<_"+CHR$(34) 100 PRINT CLS$;TAB(33);"BLACKBOX" 130 PRINT : PRINT : PRINT : PRINT : PRINT 131 PRINT TAB(25);"32 31 30 29 28 27 26 25" 132 FOR I=1 TO 8: PRINT TAB(22);I;" . . . . . . . . ";25-I: NEXT I 133 PRINT TAB(25);" 9 10 11 12 13 14 15 16" 140 DEF FNR(Z)=INT(8*RND(1)+1) 150 PRINT AT$;CHR$(52);CHR$(62);"# OF ATOMS";WI$;:INPUT N:I290 IF U=0 THEN X2=X1-1: X3=X1+1: Y2=Y1: Y3=Y1: GOTO 310 300 Y2=Y1-1: Y3=Y1+1: X2=X1: X3=X1 310 ON 8*B(X1,Y1)+B(X2,Y2)+2*B(X3,Y3)+1 GOTO 330,340,350,340 320 PRINT RX$;"HIT ": S=S+1: Z=R: M$="H": GOSUB 630: GOTO 210 330 X=X1: Y=Y1: GOTO 380 340 Z=1: GOTO 360 350 Z=-1 360 IF U=0 THEN U=Z: V=0: GOTO 380 370 U=0: V=Z 380 ON INT((X+15)/8) GOTO 420,400,430 390 STOP 400 ON INT((Y+15)/8) GOTO 440,280,450 410 STOP 420 Z=Y: GOTO 460 430 Z=25-Y: GOTO 460 440 Z=33-X: GOTO 460 450 Z=8+X 460 IF Z=R    THEN PRINT RX$;"REFLECTED": S=S+1: M$="R": GOSUB 630: GOTO 210 465 PRINT RX$;SPACE$(15);RX$; 470 PRINT "OUT AT";Z: S=S+2: GOSUB 630: GOTO 210 480 PRINT AT$;CHR$(52);CHR$(52);"WHERE DO YOU THINK THE ATOMS ARE?" 490 C=0 500 FOR Q=1 TO N 510 PRINT AT$;CHR$(54);" ATOM #";Q;"(ROW,COLUMN)";WI$; 520 INPUT J,I 525 M$="?": GOSUB 750 530 IF B(I,J)=0 THEN S=S+5: GOTO 540 535 C=C+1 540 NEXT Q 550 FOR J=1 TO 8: FOR I=1 TO 8 560 IF B(I,J)=1 THEN M$="*": GOSUB 750 570 NEXT I,J 590 PRINT AT$;CHR$(53);" YOU ((Z-1)/8+1) GOTO 710,720,730,740 710 PRINT AT$;CHR$(38+Z);CHR$(52);M$: RETURN 720 PRINT AT$;CHR$(48);CHR$(30+3*Z);M$: RETURN 730 PRINT AT$;CHR$(63-Z);CHR$(84);M$: RETURN 740 PRINT AT$;CHR$(37);CHR$(153-3*Z);M$: RETURN 750 PRINT AT$;CHR$(38+J);CHR$(54+3*I);M$: RETURN 999 END R$(84);M$: RETURN 740 PRINT AT$;CHR$(37);CHR$(153-3*Z);M$: RETURN 750 PRINT AT$;CHR$(38+J);CHR$(54+690 670 PRINT AT$;CHR$(63-R);CHR$(84);M$: GOTO 690 680 PRINT AT$;CHR$(37);CHR$(153-3*R);M$ 690 IF R=Z THEN RETURN 700 ON INT2 PRINT TAB(18);"BLACK JACK" 6 PRINT:PRINT:PRINT 20 DIM P(15,12),Q(15),C(52),D(52),T(8),S(7),B(15) 30 DIM R(15) 40 REM 50 REM 60 REM 70 REM 80 REM 90 GOTO 1500 100 REM 110 IF C<51 THEN 230 120 PRINT "RESHUFFLING" 130 FOR D=D TO 1 STEP -1 140 C=C-1 150 C(C)=D(D) 160 NEXT D 170 FOR C1=52 TO C STEP -1 180 C2=INT(RND(1)*(C1-C+1))+C 190 C3=C(C2) 200 C(C2)=C(C1) 210 C(C1)=C3 220 NEXT C1 230 X=C(C) 240 C=C+1 250 RETURN 300 REM 310 REM 320 REM 330 REM 340 REM 350 REM 360 Q=0 370 FOR=3 850 ON H GOTO 950,930 860 GOSUB 100 870 B(I)=B(I)*2 880 PRINT "Received a"; 890 GOSUB 700 900 GOSUB 1100 910 IF Q>0 THEN GOSUB 1300 920 RETURN 930 GOSUB 1320 940 RETURN 950 GOSUB 100 960 PRINT "Received a"; 970 GOSUB 700 980 GOSUB 1100 990 IF Q<0 THEN 940 1000 PRINT "Hit"; 1010 GOTO 830 1100 REM 1110 R(I)=R(I)+1 1120 P(I,R(I))=X 1130 Q=Q(I) 1140 GOSUB 500 1150 Q(I)=Q 1160 IF Q>=0 THEN 1190 1170 PRINT "...BUSTED!" 1180 GOSUB 1200 1190 RETURN 1200 REM 1210 IF R(I)<>0 THEN 1230 TO 13 1550 FOR J=4*I-3 TO 4*I 1560 D(J)=I 1570 NEXT J 1580 NEXT I 1590 D=52 1600 C=53 1610 PRINT "Do you want instructions"; 1620 INPUT H$ 1630 IF LEFT$(H$,1)="N" THEN 1760 1640 PRINT "This is the game of 21. As many as 7 players" 1642 PRINT "may play the game. On each deal, bets will" 1650 PRINT "be asked for, and the players bets should" 1652 PRINT "be typed in. The cards will then be delt," 1670 PRINT "and each player in turn plays his hand." 1672 PRINT "The first response should be eitGUESSED ";C;" OUT OF ";N;" ATOMS CORRECTLY" 600 PRINT "YOUR SCORE FOR THIS ROUND WAS ";S;" POINTS. " 610 INPUT "CARE TO TRY AGAIN";A$ 620 IF LEFT$(A$,1)="Y" OR LEFT$(A$,1)="y" THEN 90 ELSE 999 630 IF Z<>R THEN M$=LEFT$(MK$,1):MK$=MID$(MK$,2) 640 ON INT((R-1)/8+1) GOTO 650,660,670,680 650 PRINT AT$;CHR$(38+R);CHR$(52);M$: GOTO 690 660 PRINT AT$;CHR$(48);CHR$(30+3*R);M$: GOTO 690 670 PRINT AT$;CHR$(63-R);CHR$(84);M$: GOTO 690 680 PRINT AT$;CHR$(37);CHR$(153-3*R);M$ 690 IF R=Z THEN RETURN 700 ON INT Q2=1 TO R(I) 380 X=P(I,Q2) 390 GOSUB 500 400 NEXT Q2 410 Q(I)=Q 420 RETURN 500 REM 510 X1=X: IF X1>10 THEN X1=10: REM 520 Q1=Q+X1 530 IF Q>11 THEN 590 540 IF X>1 THEN 570 550 Q=Q+11 560 RETURN 570 Q=Q1-11*(Q1>=11) 580 RETURN 590 Q=Q1-(Q<=21 AND Q1>21) 600 IF Q<33 THEN 620 610 Q=-1 620 RETURN 700 REM 710 REM 720 PRINT MID$(D$,3*X-2,3); 730 PRINT " "; 740 RETURN 750 REM 760 PRINT " ";MID$(D$,3*X-1,2); 770 PRINT " "; 780 RETURN 800 REM 810 REM 820 H1=5 830 GOSUB 1410 840 H1 1220 RETURN 1230 D=D+1 1240 D(D)=P(I,R(I)) 1250 R(I)=R(I)-1 1260 GOTO 1210 1300 REM 1310 PRINT 1320 AA=Q(I):GOSUB 3400 1325 PRINT "Total is";AA 1330 RETURN 1400 REM 1410 REM 1420 INPUT H$: H$=LEFT$(H$,1) 1430 FOR H=1 TO H1 STEP 2 1440 IF H$=MID$(I$,H,1) THEN 1480 1450 NEXT H 1460 PRINT "Type ";MID$(I$,1,H1-1);" or ";MID$(I$,H1 ,2);" Please"; 1470 GOTO 1420 1480 H=(H+1)/2 1490 RETURN 1500 REM 1510 REM 1520 D$="n A 2 3 4 5 6 7n 8 9 10 J Q K" 1530 I$="H,S,D,/," 1540 FOR I=1 her 'D'," 1680 PRINT "indicating that the player is doubling down," 1682 PRINT "'S' indicating that he is standing, 'H'," 1690 PRINT "indicating he wants another card, or '/'," 1700 PRINT "indicating he wants to split his cards." 1710 PRINT "After the initial response, all further " 1720 PRINT "responses should be 'S' or 'H', unless the " 1722 PRINT "cards were split, in which case doubling " 1730 PRINT "for blackjack, the initial response should" 1740 PRINT "be 'S'." 1759 PRINT 1760 PRINT "Numbe    r of Players"; 1770 INPUT N 1780 IF N<1 OR N>7 OR N>INT(N) THEN 1760 1790 FOR I=1 TO 8: T(I)=0: NEXT I 1800 D1=N+1 1810 IF 2*D1+C>52 THEN GOSUB 120 1820 IF C=2 THEN C=C-1 1830 FOR I=1 TO N: Z(I)=0: NEXT I 1840 FOR I=1 TO 15: B(I)=0:NEXT I 1850 FOR I=1 TO 15: Q(I)=0: NEXT I 1860 FOR I=1 TO 7: S(I)=0: NEXT I 1870 FOR I=1 TO 15: R(I)=0: NEXT I 1879 PRINT 1880 PRINT "Bets" 1890 FOR I=1 TO N: PRINT "#";I;: INPUT Z(I): NEXT I 1900 FOR I=1 TO N 1910 IF Z(I)<=0 OR Z(I)>500 THEN 1880 1920 B(I)=Z(I) NEXT I 2180 FOR I=1 TO N 2190 IF Z(I)<0 OR Z(I)>B(I)/2 THEN 2160 2200 NEXT I 2210 FOR I=1 TO N 2220 S(I)=Z(I)*(3*(-(P(DI,2)>=10))-1) 2230 NEXT I 2240 REM 2250 L1=1: L2=1 2252 IF P(D1,1)=1 AND P(D1,2)>9 THEN L1=0: L2=0 2253 IF P(D1,2)=1 AND P(D1,1)>9 THEN L1=0: L2=0 2254 IF L1<>0 OR L2<>0 THEN 2320 2260 PRINT "Dealer has a";MID$(D$,3*P(D1,2)-2,3);" IN THE HOLE "; 2270 PRINT "for Blackjack" 2280 FOR I=1 TO D1 2290 GOSUB 300 2300 NEXT I 2310 GOTO 3140 2320 REM 2330 IF P(D1,1)>1 AND P(D1,1)<1 THEN L1=10 2612 L2=P(I,2): IF P(I,2)>10 THEN L2=10 2614 IF L1=L2 THEN 2640 2620 PRINT "Splitting not allowed." 2630 GOTO 2370 2640 REM 2650 I1=I+D1 2660 R(I1)=2 2670 P(I1,1)=P(I,2) 2680 B(I+D1)=B(I) 2690 GOSUB 100 2700 PRINT "First hand receives a"; 2710 GOSUB 700 2720 P(I,2)=X 2730 GOSUB 300 2740 PRINT 2750 GOSUB 100 2760 PRINT "Second hand receives a"; 2770 I=I1 2780 GOSUB 700 2790 P(I,2)=X 2800 GOSUB 300 2810 PRINT 2820 I=I1-D1 2830 IF P(I,1)=1 THEN 2900 2840 REM 2850 PRINT "Ha750 3080 GOSUB 1100 3090 AA=Q: GOSUB 3400 3095 IF Q>0 AND AA<17 THEN 3060 3100 Q(I)=Q-(Q<0)/2 3110 IF Q<0 THEN 3140 3120 AA=Q: GOSUB 3400 3125 PRINT "---Total is";AA 3130 PRINT 3140 REM 3150 REM 3160 Z$="loses draws wins " 3170 FOR I=1 TO N 3180 AA=Q(I): GOSUB 3400 3182 AB=Q(I+D1): GOSUB 3410 3184 AC=Q(D1): GOSUB 3420 3186 S(I)=S(I)+B(I)*SGN(AA-AC)+B(I+D1)*SGN(AB-AC) 3188 B(I+D1)=0 3200 PRINT "Player";I; 3210 PRINT MID$(Z$,SGN(S(I))*6+7,6);" "; 3220 IF S(I)<>0 THEN 3250 3230 PRINT "  1930 NEXT I 1940 PRINT "Player"; 1950 FOR I=1 TO N 1960 PRINT I;" "; 1970 NEXT I 1980 PRINT "Dealer" 1990 FOR J=1 TO 2 2000 PRINT TAB(5); 2010 FOR I=1 TO D1 2020 GOSUB 100 2030 P(I,J)=X 2040 IF J=1 OR I<=N THEN GOSUB 750 2050 NEXT I 2060 PRINT 2070 NEXT J 2080 FOR I=1 TO D1 2090 R(I)=2 2100 NEXT I 2110 REM 2120 IF P(D1,1)>1 THEN 2240 2130 PRINT "Any insurance"; 2140 INPUT H$ 2150 IF LEFT$(H$,1)<>"Y" THEN 2240 2160 PRINT "Insurance bets" 2170 FOR I=1 TO N: PRINT "#";I;: INPUT Z(I):0 THEN 2350 2340 PRINT "No dealer Blackjack" 2350 REM 2360 FOR I=1 TO N 2370 PRINT "Player";I; 2380 H1=7 2390 GOSUB 1410 2400 ON H GOTO 2550,2410,2510,2600 2410 REM 2420 GOSUB 300 2430 IF Q(I)<>21 THEN 2490 2440 PRINT "Blackjack!" 2450 S(I)=S(I)+1.5*B(I) 2460 B(I)=0 2470 GOSUB 1200 2480 GOTO 2900 2490 GOSUB 1320 2500 GOTO 2900 2510 REM 2520 GOSUB 300 2530 GOSUB 860 2540 GOTO 2900 2550 REM 2560 GOSUB 300 2570 H1=3 2580 GOSUB 950 2590 GOTO 2900 2600 REM 2610 L1=P(I,1): IF P(I,1)>10nd";1-(I>D1); 2860 GOSUB 800 2870 I=I+D1 2880 IF I=I1 THEN 2850 2890 I=I1-D1 2900 NEXT I 2910 GOSUB 300 2920 REM 2930 FOR I=1 TO N 2940 IF R(I)>0 OR R(I+D1)>0 THEN 3005 2950 NEXT I 2960 PRINT "Dealer had a"; 2970 X=P(D1,2) 2980 GOSUB 700 2990 PRINT " Concealed." 3000 GOTO 3140 3005 PRINT 3010 PRINT "Dealer has a";MID$(D$,3*P(D1,2)-2,3);" concealed "; 3020 I=D1 3030 AA=Q(I):GOSUB 3400 3035 PRINT "For a total of";AA 3040 IF AA>16 THEN 3130 3050 PRINT "Draws"; 3060 GOSUB 100 3070 GOSUB  "; 3240 GOTO 3260 3250 PRINT ABS(S(I)); 3260 T(I)=T(I)+S(I) 3270 PRINT "Total=";T(I) 3280 GOSUB 1200 3290 T(D1)=T(D1)-S(I) 3300 I=I+D1 3310 GOSUB 1200 3320 I=I-D1 3330 NEXT I 3340 PRINT "Dealer's Total=";T(D1) 3350 GOSUB 1200 3351 PRINT 3352 PRINT "Do you want to continue"; 3354 INPUT W$ 3356 IF LEFT$(W$,1)="N" THEN 3430 3360 GOTO 1810 3400 AA=AA+11*(AA>=22): RETURN 3410 AB=AB+11*(AB>=22): RETURN 3420 AC=AC+11*(AC>=22): RETURN 3430 END 430 3360 GOTO 1810 3400 AA=AA+11*(AA>=22): RE   10 CLEAR 500 20 PRINT 30 INPUT "HOW MANY CHARACTERS PER LINE";C:IF C<15 THEN 30 ELSE WIDTH C 40 INPUT "NUMBER OF DIGITS";L 50 IF L>255 OR L<1 OR L<>INT(L) THEN 40 60 DIM X(L) 70 U=1:E=U:Z=0:F=Z:T=10 80 X$="" 90 INPUT "ENTER N";N 100 IF N9999 THEN 90 110 IF N=Z THEN END 120 IF N=U THEN F=U 130 IF INT(N)<>N THEN 90 140 IF F=Z THEN PRINT "POWERS OF";N 150 IF F=U THEN PRINT "FACTORIALS" 160 X(J)=N 170 J=Z 180 IF X(J)=Z THEN 290 330 IF LEN(X$)=Z THEN 290 330 IF LEN(X$), , or :";ZZ$ 180 IFLEFT$(ZZ$,1)="R"THEN560 190 IFLEFT$(ZZ$,1)="W"THEN220 200 IFLEFT$(ZZ$,1)="E"THEN1720 210 PRINT"Try a listed option":PRINT@64,"";:GOTO170 220 GOSUB1540:N=LOF(1):CLOSE 230 PRINT"You have";N;" records stored on disk" 240 GOSUB1570 250 N=N+1 260 CLS:PRINT"Item #:";N 270 IFTF$="C"THEN340 280 IF(TF$="M")OR(TF$="A")OR(TF$="F")THEN460 310 PRINT:PRINT"Another item (Y or N):?":GGOSUB1560 520 LSETT$=B$:LSETAN$=A$ 530 PUT1,N 540 CLOSE 550 GOTO310 560 ' 570 CLS:PRINT"Please enter the type of read wanted" 580 INPUT", , or :";TR$ 590 IFLEFT$(TR$,2)="DU"THEN630 600 IFLEFT$(TR$,2)="LD"THEN850 610 IFLEFT$(TR$,2)="LP"THEN1070 620 PRINT"Please choose a listed option":PRINT@64,"";:GOTO580 630 CLS:PRINTF$ 640 GOSUB1540:N=LOF(1):CLOSE 650 IFTF$="C"THEN750 660 FORI=1TON 670 PRINTI;") "; 680 GOSUB1540:GOSUB1560:GET1,I:CLOSE 690 GOSUB1580 700 PRINT"ANS: ";AN$ 710 IFI/5=INT(I/ 930 GOSUB1610 940 LPRINTTAB(55)"Answer: ";AN$ 950 IFI/30=INT(I/30)THENLPRINTCHR$(12):LPRINTF$:LPRINT" " 960 NEXTI 970 GOSUB2680 980 FORI=1TON 990 LPRINTI;") "; 1000 GOSUB1540:GOSUB1550:GET1,I:CLOSE 1010 D=CVI(CN$) 1020 GOSUB1610 1030 LPRINT"Answer--";L$,"Chapter #--";D:LPRINT" " 1040 IFI/8=INT(I/8)THENLPRINTCHR$(12):LPRINTF$ 1050 NEXTI 1060 GOTO2680 1070 ' 1080 CLS:INPUT"How many test items do you need:";NN 1090 FORI=1TONN 1100 PRINT"Input record #:";I; 1110 INPUTA(I) 1120 NEXTI 1130 GOSUB1640 1140 CLS:PRI70 FORI=1TONN 1290 LPRINTI;") "; 1300 GOSUB1540:GOSUB1550:GET1,A(I):CLOSE 1310 GOSUB1610 1320 IFLEFT$(AS$,1)<>"Y"LPRINTTAB(50)I;") ( )" 1330 IFI/8=INT(I/8)LPRINTCHR$(12):GOTO1350 1340 LPRINT" " 1350 NEXTI 1360 GOSUB2680 1370 ' 1380 IFLEFT$(AS$,1)<>"Y"THEN1420 1390 LPRINT"On the answer sheet place the proper answer for each" 1400 LPRINTTAB(8)"question in the proper blank." 1410 GOTO1440 1420 LPRINT"Place in the parentheses the proper answer for" 1430 LPRINTTAB(8)"each question." 1440 LPRINT" " 1450 FORI=1OSUB2070 320 IFYN$="Y"THEN250 330 GOSUB2680 340 ' 350 LINEINPUT"TEXT:";B$ 360 INPUT"Letter of correct answer:";C$ 370 INPUT"Chapter number (if not applicable, type 0):";D 380 PRINT:PRINT"Is item okay for storage (Y or N):":GOSUB2070 390 IFYN$="N"THEN260 400 GOSUB1540:GOSUB1550 410 LSETT$=B$ 420 LSETL$=C$:LSETCN$=MKI$(D) 430 PUT1,N 440 CLOSE 450 GOTO310 460 ' 470 LINEINPUT"TEXT:";B$ 480 INPUT"Correct answer:";A$ 490 PRINT:PRINT"Is item okay for storage (Y or N):":GOSUB2070 500 IFYN$="N"THEN260 510 GOSUB1540:5)THENINPUT"Press ENTER";Z$:CLS 720 NEXTI 730 PRINT:INPUT"End of File--Press ENTER to continue";Z$ 740 GOSUB2680 750 FORI=1TON 760 PRINTI;") "; 770 GOSUB1540:GOSUB1550:GET1,I:CLOSE 780 GOSUB1580 800 PRINT"Answer--";L$,"Chapter #";D 810 IFI/2=INT(I/2)THENINPUT"Press ENTER";Z$:CLS 820 NEXTI 830 PRINT:INPUT"End of File--Press ENTER to continue";Z$ 840 GOSUB2680 850 ' 860 GOSUB1640 870 LPRINTF$ 880 GOSUB1540:N=LOF(1):CLOSE 890 IFTF$="C"THEN980 900 FORI=1TON 910 LPRINTI;") "; 920 GOSUB1540:GOSUB1560:GET1,I:CLOSENT"Is this part of a larger test (Y or N):":GOSUB2070 1150 IFYN$="Y"INPUT"What is the part number:";D8 1160 INPUT"Is there a separate answer sheet (Y or N):";AS$ 1170 IFYN$="Y"THENLPRINT"PART";D8;") "; 1180 IFTF$="C"THEN1200 1190 GOTO1370 1200 ' 1210 IFLEFT$(A$,1)<>"Y"THEN1250 1220 LPRINT"On the answer sheet circle the letter of the" 1230 LPRINTTAB(8)"coorect answer for each." 1240 GOTO1270 1250 LPRINT"Insert in the parentheses the letter of the" 1255 LPRINTTAB(8)"correct answer for each." 1260 LPRINT" " 12TONN 1460 LPRINTI;") "; 1470 GOSUB1540:GOSUB1560:GET1,A(I):CLOSE 1480 GOSUB1610 1490 IFLEFT$(AS$,1)<>"Y"THENLPRINTTAB(60)I;") ( )":GOTO1510 1500 LPRINT" " 1510 PK=PEEK(16425):IFPK>60THENLPRINTCHR$(12) 1520 NEXTI 1530 GOTO2680 1540 OPEN"R",1,F$:RETURN 1550 FIELD1,2AS CN$,1ASL$,253AST$:RETURN 1560 FIELD1,200AST$,20ASAN$:RETURN 1570 FORWT=1TO1200:NEXTWT:RETURN 1580 LS=INSTR(T$," ") 1590 IFLS<>0THENM$=LEFT$(T$,LS)ELSEM$=T$ 1600 PRINTM$:RETURN 1610 LS=INSTR(T$," ") 1620 IFLS<>0THENM$=LEFT$(T$,LS)ELSEM$=T$    1630 LPRINTM$:RETURN 1640 ' 1650 CLS:PRINT"Press any key when printer is ready" 1660 IFINKEY$=""THEN1660 1680 POKE16425,1 1690 CLS:PRINT"Position paper at top of page" 1700 INPUT"Press ENTER when ready";ZM$ 1710 RETURN 1720 ' 1730 INPUT"Item number:";V:M$="" 1740 IFTF$="C"THEN1760 1750 GOSUB1540:GOSUB1560:GET1,V:CLOSE:GOTO2170 1760 GOSUB1540:GOSUB1550:GET1,V 1770 D=CVI(CN$):CLOSE 1780 PRINTT$ 1790 PRINT"Ans--";L$,"Chapt #--";D 1800 PRINT"Is item okay (Y or N):":GOSUB2070 1810 IFYN$="Y"THEN2490 1820 PRINT"In" or :";FR$ 1970 IFLEFT$(FR$,1)="F"THEN2120 1980 LINEINPUT"Text:";B$ 1990 PRINT:PRINT"Okay for storage (Y or N):":GOSUB2070 2000 IFYN$="Y"THEN2040 2010 PRINT"Another try (Y or N):":GOSUB2070 2020 IFYN$="Y"THEN1980 2030 GOTO2490 2040 GOSUB1540:GOSUB1550 2050 LSETT$=B$:PUT1,V:CLOSE 2060 GOTO2490 2070 ' 2080 YN$=INKEY$:IFYN$=""THEN2080 2090 IF(YN$<>"Y")AND(YN$<>"N")THEN2080 2100 RETURN 2110 ' 2120 LS=INSTR(T$," "):GOSUB2320 2130 GOSUB1540:GOSUB1550 2140 LSETT$=M$:PUT1,V 2150 CLOSE 2160 GOTO2490IFI$=" "THEN2440 2390 IFI$="C"GOSUB2530:GOTO2440 2400 IFI$="@"THEN2440 2410 IFI$="I"THENGOSUB2600:GOTO2440 2420 IFI$="D"THENGOSUB2570:GOTO2470 2430 IFI$=";"THEN2480 2440 M$=M$+A$ 2450 PRINTA$; 2460 IF(I$="X")AND(II=LS-1)THENGOSUB2600 2470 NEXTII 2480 RETURN 2490 CLOSE:PRINT:PRINT"Do you want to edit any more (Y or N):":GOSUB2070:M$="":I$="" 2500 IFYN$="N"THEN2690 2510 M$="":I$="":CLS:GOTO1720 2530 ' 2540 A$=INKEY$ 2550 IFA$=""THEN2540 2560 RETURN 2570 ' 2580 A$="" 2590 RETURN 2600 ' 2610 Q$=INKEY$ 2620 IFQ$ 10 'COPYRIGHT [C] 1977 BY W.A.BURTON. ALL RIGHTS RESERVED 20 DIM A(12), M$(12) 30 DATA 1,31,59,90,120,151,181,212,243,273,304,334 40 FOR I=1 TO 12: READ A(I): NEXT 50 PI=3.14159:P1=1:P2=0:QP=0 60 INPUT" INSTRUCTIONS (Y OR N)";Z$ 70 IF Z$="Y"THEN GOSUB 660 80 INPUT"FOR HOW MANY DAYS DO YOU WANT THIS CHART";DL 90 INPUT"STARTING DATE OF YOUR ANALYSIS ";M,D,Y 100 INPUT"WHAT IS THE DAY OF YOUR BIRTH ";MB,DB,YB 110 INPUT"WHAT IS YOUR NAME "; A$ 120 DEF FNI(X)=INT(25*SIN(2*PI*X/33)+.5) 130 DEF FNdicate the type of edit wanted" 1830 INPUT", , or :";E$ 1840 IFLEFT$(E$,1)="T"THEN1960 1850 IFLEFT$(E$,1)="I"THENPRINT"Do others first":PRINT 1860 PRINT"Indicate or make the correction" 1870 PRINT"Ans--";L$;:INPUT" OK";OK$ 1880 IFOK$<>"OK"LSETL$=OK$ 1890 PRINT"Chapt #--";D;:INPUT" OK";OK$ 1900 IFOK$<>"OK"THEND=VAL(OK$):LSETCN$=MKI$(D) 1910 GOSUB1540 1920 IFTF$="C"THENGOSUB1550ELSEGOSUB1560 1930 PUT1,V:CLOSE 1940 IFLEFT$(E$,1)<>"I"THEN2490 1950 ' 1960 PRINT"Text correction:":INPUT 2170 ' 2180 PRINTT$ 2190 PRINTAN$ 2200 INPUT"Is answer okay:";YN$ 2210 IFLEFT$(YN$,1)="Y"THEN2240 2220 INPUT"New answer:";A$ 2230 GOSUB1540:GOSUB1560:LSETAN$=A$:PUT1,V:CLOSE 2240 PRINT"Is text okay (Y or N):":GOSUB2070 2250 IFYN$="Y"THEN2300 2260 LS=INSTR(T$," "):GOSUB2320 2270 GOSUB1540:GOSUB1560 2280 LSETT$=M$:PUT1,V 2290 CLOSE 2300 GOTO2490 2310 LS=INSTR(T$," ") 2320 FORII=1TOLS 2330 A$=MID$(T$,II,1) 2340 IF(I$="@")OR(I$="X")THEN2440 2350 IFII=1THENPRINT"*"; 2360 I$=INKEY$ 2370 IFI$=""THEN2360 2380 =""THEN2610 2630 IFQ$="@"THEN2670 2640 PRINTQ$; 2650 M$=M$+Q$ 2660 GOTO2610 2670 RETURN 2680 ' 2690 CLS:PRINT"Do you wish further work on this file (Y or N):":GOSUB2070 2700 IFYN$="Y"THEN160 2710 RUN"MENU:0"  STURN-TO\\'F Oh 4O ]OhoN 2490 CLOSE:PRINT:PRINT"Do you want to edit any more (Y or N):":GOSUB2070:M$="":I$="" 2500 IFYN$="N"THEN2690 2510 M$="":I$="":CLS:GOTO1720 2530 ' 2540 A$=INKEY$ 2550 IFA$=""THEN2540 2560 RETURN 2570 ' 2580 A$="" 2590 RETURN 2600 ' 2610 Q$=INKEY$ 2620 IFQ$E(X)=INT(25*SIN(2*PI*X/28)+.5) 140 DEF FNP(X)=INT(25*SIN(2*PI*X/23)+.5) 150 T=INT(D+365.25*Y+A(M)+.01*M-.03) 160 TB=INT(DB+365.25*YB+A(MB)+.01*MB-.03) 170 X=T-TB 180 RB=TB-1-INT((TB-1)/7)*7 190 DATA MON,TUE,WED,THU,FRI,SAT,SUN 200 FOR I=0 TO 6:READ D$(I):NEXT 210 DATA JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC 220 FOR I=1 TO 12:READ M$(I):NEXT 230 GOSUB 1090 240 R=T-1-INT((T-1)/7)*7 250 LE=21+LEN(DAY$(R))+LEN(M$(M))+LEN(STR$(D))+LEN(RIGHT$(STR$(V),2)) 260 PRINT "STARTING DATE: ";D$(R)", "    ;M$(M)STR$(D);", 19"; 270 PRINT RIGHT$(STR$(Y),2), 280 PRINT "BIRTH DATE: "D$(RB)", "M$(MB)STR$(DB)", 19"; 290 PRINT RIGHT$(STR$(YB),2) 300 GOSUB 1110 310 PRINT D$(R)D;M$(M);TAB(10)":"; 320 C$=":" 330 F(0)=42:F$(0)=C$ 340 F(1)=42+FNI(X):F$(1)="I" 350 F(2)=42+FNE(X):F$(2)="E" 360 F(3)=42+FNP(X):F$(3)="P" 370 FOR I=0 TO 2 380 FOR J=I+1 TO 3 390 IF F(I)1 THEN 710 ELSE RETURN 1110 GOSUB 860 1120 PRINT TAB(20)"DOWN",TAB(38)"CRITICAL",TAB(61)"UP" 1130 GOSUB 860 1140 RETURN P>1 THEN 710 ELSE RETURN 1110 GOSUB 860 1120 PRINT TAB(20)"DOWN",TAB(38)"CRITICAL",TAB(61)"UP" 1130 GOSUB 860 MMAND 'PRINT CHR$(12)' IN LINE 890 MUST BE" 1060 PRINT"CHANGED (USUALLY TO 'PRINT' STATEMENTS IN FOR-NEXT LOOP).":PRINT 1070 PRINT"TO RUN PROGRAM, TYPE 'GOTO 80'.......":PRINT:PRINT 1080 END 1090 PRINT "BIORHYTHM ANALYSIS FOR ";A$;:PRINT TAB(60)"PAGE XT J:NEXT I 450 FOR I=0 TO 3 460 IF F(I)=42 AND F$(I)<>":"THEN GOSUB 820 470 NEXT 480 FOR I=0 TO 3 490 PRINTTAB(F(I));F$(I); 500 NEXT 510 PRINT:X=X+1 520 IF P2>52 THEN 880 530 P2=P2+1 540 IF Z=DL THEN 640 550 R=R+1:IF R=7 THEN R=0 560 D=D+1:IF M=4 OR M=6 OR M=9 OR M=11 THEN L=30:GOTO 600 570 IF M=2 AND Y/4=INT(Y/4) THEN L=29:GOTO 600 580 IF M=2 THEN L=28:GOTO 600 590 L=31 600 IF D>L THEN D=D-L:M=M+1:GOTO 620 610 PRINTD$(R);D;TAB(10)":";:Z=Z+1:GOTO 330 620 IF M=13 THEN M=1:Z=Z+1:GOTO 310 6 YOUR CRITICAL DAYS." 760 PRINT 770 PRINT" I=INTELLECTUAL 33 DAY CYCLE" 780 PRINT" E=EMOTIONAL 28 DAY CYCLE" 790 PRINT" P=PHYSICAL 23 DAY CYCLE" 800 PRINT 810 GOTO 650 820 FOR WB=0 TO 3 830 IF F$(WB)=":"THEN F$(WB)="" 840 NEXT 850 RETURN 860 FOR I=1 TO 72:PRINT "-";:NEXT 870 PRINT:RETURN 880 P1=P1+1:P2=0 890 PRINTCHR$(12) 900 FOR LI=1 TO 100:WL=WL+1:NEXT 910 GOSUB 1090 920 GOSUB 1110 930 IF QP>1 THEN 710 ELSE 540 940 PRINT"THIS PROGRAM IS PRESENTLY CONFIGURED T 1020 PRINT"TO RE-CONFIGURE THIS PROGRAM FOR PRINTERS OR TELETYPES WITH NO" 1030 PRINT"TOP OF FORM OPTION, OR CRT'S: LINES 520 - 530 WILL HAVE TO BE" 1040 PRINT"MODIFIED; ALSO THE ROUTINE AT 880 WILL HAVE TO BE CHANGED. IN" 1050 PRINT"PARTICULAR THE COMMAND 'PRINT CHR$(12)' IN LINE 890 MUST BE" 1060 PRINT"CHANGED (USUALLY TO 'PRINT' STATEMENTS IN FOR-NEXT LOOP).":PRINT 1070 PRINT"TO RUN PROGRAM, TYPE 'GOTO 80'.......":PRINT:PRINT 1080 END 1090 PRINT "BIORHYTHM ANALYSIS FOR ";A$;:PRINT TAB(60)"PAGE     1 R1=(360/33)/57.2958 2 R2=(360/28)/57.2958 3 R3=(360/23)/57.2958 50 DATA0,31,59,90,120,151,181,212,243,273,304,334,365 60 DIML$(50) 75 RESTORE 100 PRINT"ENTER BIRTHDATE,CURRENT DATE (YYMMDD)" 125 P1=0 150 J6=1 200 INPUTD1,D2 205 D9=D2 206 PRINT"ENTER DURATION" 207 INPUTJ5 210 PRINT"ENTER NAME OF SUBJECT" 220 INPUT A$ 230 GOSUB12000 300 IFD1>D2THENPRINT"INVALID DATES":GOTO200 400 X1=D1 500 GOSUB1000 550 Y1=X2:M1=X3:D1=X4 600 X1=D2 625 GOSUB1000 650 Y2=X2:M2=X3:D2=X4 800 GOTO4000 106100 D2=(D4-(INT(D4/28)*28)) 6200 D3=(D4-(INT(D4/23)*23)) 6300 FORL3=1TO50 6350 FORI=1TO50 6360 L$(I)=" " 6370 NEXTI 6400 X=SIN(R1*D1) 6500 Y=SIN(R2*D2) 6600 Z=SIN(R3*D3) 6700 L$(X*20+25)="*" 6800 L$(Y*20+25)="+" 6900 L$(Z*20+25)="." 6950 PRINT": "; 7000 FORI=1TO50 7050 L$(25)=":" 7100 PRINTL$(I); 7200 NEXTI 7205 PRINT": "; 7207 GOSUB10000:PRINTD5;" : "; 7210 IFD1=0THENC=1:PRINT"* "; 7215 IFD1=16THENC=1:PRINT"* "; 7220 IFD2=0THENC=1:PRINT"+ "; 7225 IFD2=14THENC=1:PRINT"+ "; 7230 J3GOTO11000 10400 NEXTI 10500 Y2=Y2+1 10510 L2=(Y2/4)-(INT(Y2/4)) 10520 IFL2=0THENL2=1:GOTO10600 10530 L2=0 10600 J2=J2-365 10700 GOTO10000 11000 M2=I-1 11100 D6=J2-J4 11150 IFJ2=60THEND6=D6+L2 11200 D5=Y2*10000+(M2*100)+D6 11300 RETURN 12000 FORI=1TO75 12100 PRINT"-"; 12200 NEXTI 12250 PRINT 12300 PRINT": COMPUTERIZED STUDY OF BIORYTHMIC CURVES"; 12400 GOSUB13600 12500 PRINT": SUBJECT, ";A$; 12600 GOSUB13600 12700 PRINT": DATE OF STUDY - ";D9;" - DURATION";J5;" DAYS"; 12800 GOSUB13600NERVES, MOOD, CREATIVE ABILITY"; 14900 GOSUB13600 15000 PRINT": . = PHYSICAL STRENGTH, FORURANCE, CONFIDENCE"; 15100 GOSUB13600 15150 FORI=1TO75:PRINT"-";:NEXTI:PRINT 15200 PRINTTAB(31);"PAGE ";P1 15400 RETURN ORURANCE, CONFIDENCE"; 15100 GOSUB136I 13530 PRINT 13540 RETURN 13600 J=75-POS(X) 13700 FORI=1TOJ-1 13800 PRINT" "; 13900 PRINT":" 14100 RETURN 14500 FORI=1TO75:PRINT"-";:NEXTI:PRINT 14600 PRINT": * = INTELLECTUAL ABILITY, AMBITION"; 14700 GOSUB13600 14800 PRINT": + = SENSIBILITY, 1 LET R1=(360/33)/57.2958 2 LET R2=(360/28)/57.2958 3 LET R3=(360/23)/57.2958 4 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT 10 PRINT "******************** BIO-RHYTHM ********************" 15 PRINT:PRINT 20 PRINT "TO GENERATE A BIO-RHYTHM:" 25 PRINT 30 PRINT " - TYPE IN THE SUBJECT'S BIRTHDAY AND THE CURRENT DATE" 35 PRINT " (SEPARATED BY A COMMA OR )" 40 PRINT " - ENTER THE NUMBER OF DAYS YOU WANT TO COVER" 45 PRINT " - ENTER THE NAME OF THE SUBJECT" 47 PRINT:PRINT:PRINT:PRIN00 X2=INT(X1/10000) 1100 X3=INT(X1/100)-(X2*100) 1200 X4=X1-((X3*100)+(X2*10000)) 1300 RETURN 4000 D4=(INT((Y2-1)*365.25)-INT((Y1-1)*365.25)) 4100 FOR I=1TOM1 4200 READJ1 4300 NEXTI 4400 RESTORE 4500 FORI=1TOM2 4600 READJ2 4700 NEXTI 4800 J1=J1+D1 4900 J2=J2+D2 5000 L1=(Y1/4)-(INT(Y1/4)) 5100 IFL1=0THENL1=1:GOTO5300 5200 L1=0 5300 L2=(Y2/4)-(INT(Y2/4)) 5400 IFL2=0THENL2=1:GOTO5600 5500 L2=0 5600 IFM1>2THENJ1=J1+L1 5700 IFM2>2THENJ2=J2+L2 5800 D4=D4+J2-J1 6000 D1=(D4-(INT(D4/33)*33)) IFD3=0THENC=1:PRINT". "; 7235 IFD3=12THENC=1:PRINT". "; 7240 IFC=1THENC=0 7250 PRINT 7300 D1=D1+1 7400 D2=D2+1 7500 D3=D3+1 7600 IFD1=33THEND1=0 7700 IFD2=28THEND2=0 7800 IFD3=23THEND3=0 7900 J2=J2+1 7920 J6=J6+1 7950 IFJ559THENJ3=J3+L2 10300 IFJ2<= 12810 FORI=1TO75:PRINT"-";:NEXTI:PRINT 13200 FORI=1TO75:PRINT"-";:NEXTI 13210 PRINT 13250 PRINT": LOW : HIGH :"; 13260 PRINT" DATE :CRITICAL"; 13400 PRINT":" 13500 FORI=1TO75 13510 PRINT"-"; 13520 NEXTI 13530 PRINT 13540 RETURN 13600 J=75-POS(X) 13700 FORI=1TOJ-1 13800 PRINT" "; 13900 PRINT":" 14100 RETURN 14500 FORI=1TO75:PRINT"-";:NEXTI:PRINT 14600 PRINT": * = INTELLECTUAL ABILITY, AMBITION"; 14700 GOSUB13600 14800 PRINT": + = SENSIBILITY, T 50 DATA 0,31,59,90,120,151,181,212,243,273,304,334 51 DATA 365 60 DIM L$(50) 70 GOTO 90 75 PRINT "DO YOU WANT ANOTHER BIO-RHYTHM" 80 INPUT "(Type 1 for YES)";A 85 IF A<>1 THEN END 87 PRINT:PRINT:PRINT 90 RESTORE 100 PRINT"ENTER BIRTHDAY,CURRENT DATE (YYMMDD)" 125 LET P1=0 150 LET J6=1 200 INPUT D1,D2 205 LET D9=D2 206 PRINT"ENTER DURATION " 207 INPUT J5 210 PRINT"ENTER NAME OF SUBJECT " 220 INPUT A$ 230 GOSUB 12000 300 IF D1>D2 THEN PRINT" INVALID DATES " 400 LET X1=D1 500 GOSUB 1000     550 LET Y1=X2:LET M1=X3:LET D1=X4 600 LET X1=D2 625 GOSUB 1000 650 LET Y2=X2:LET M2=X3:LET D2=X4 800 GOSUB 4000 1000 LET X2=INT(X1/10000) 1100 LET X3=INT(X1/100)-(X2*100) 1200 LET X4=X1-((X3*100)+(X2*10000)) 1300 RETURN 4000 LET D4=(INT((Y2-1)*365.25)-INT((Y1-1)*365.25)) 4100 FOR I=1 TO M1 4200 READ J1 4300 NEXT I 4400 RESTORE 4500 FOR I =1 TO M2 4600 READ J2 4700 NEXT I 4800 LET J1=J1+D1 4900 LET J2=J2+D2 5000 LET L1=(Y1/4)-(INT(Y1/4)) 5100 IF L1=0 THEN LET L1=1:GOTO 5300 5200 LET L1 "; 7000 FOR I=1 TO 50 7050 LET L$(25)="I" 7100 PRINT L$(I); 7200 NEXT I 7205 PRINT": "; 7207 GOSUB 10000:PRINT D5;" : "; 7210 IF D1=0 THEN LET C=1:PRINT"M "; 7215 IF D1=16 THEN LET C=1:PRINT"M "; 7220 IF D2=0 THEN LET C=1:PRINT"E "; 7225 IF D2=14 THEN LET C=1:PRINT"E "; 7230 IF D3=0 THEN LET C=1:PRINT"P "; 7235 IF D3=12 THEN LET C=1:PRINT"P "; 7240 IF C=1 THEN LET C=0 7250 PRINT 7300 LET D1=D1+1 7400 LET D2=D2+1 7500 LET D3=D3+1 7600 IF D1=33 THEN LET D1=0 7700 IF D2=28 THEN LET D2=0  10600 LET J2=J2-365 10700 GOTO 10000 11000 LET M2=I-1 11100 LET D6=J2-J4 11150 IF J2=60 THEN LET D6=D6+L2 11200 LET D5=Y2*10000+(M2*100)+D6 11300 RETURN 12000 FOR I=1 TO 70 12100 PRINT"-"; 12200 NEXT I 12250 PRINT 12300 PRINT": COMPUTERIZED STUDY OF BIORHYTHMIC CURVES BY ELMER "; 12400 GOSUB 13600 12500 PRINT": SUBJECT, ";A$; 12600 GOSUB 13600 12700 PRINT ": DATE OF STUDY- ";D9;"- DURATION ";J5;"DAYS "; 12800 GOSUB 13600 12810 FOR I=1 TO 70:PRINT"-";:NEXT I:PRINT 12820 PRINT": P=LITY, EFFICIENCY, "; 14610 PRINT"AND HIGH ENDURANCE"; 14700 GOSUB 13600 14800 PRINT": LOW DAYS OF REDUCED EFFICIENCY, RECUPERATION, "; 14810 PRINT"TIRE EASILY"; 14900 GOSUB 13600 15000 PRINT": CRITICAL DAYS TO AVOID SITUATIONS THAT MIGHT "; 15010 PRINT"LEAD TO TROUBLE"; 15100 GOSUB 13600 15150 FOR I=1 TO 70:PRINT"-";:NEXT I:PRINT 15200 PRINT TAB(31);"PAGE ";P1 15400 RETURN D TO TROUBLE"; 15100 GOSUB 13600 15150 FOR I=1 TO 70:PRINT"-";:NEXT I:PRINT 15200 PRINT TAB(31);"=0 5300 LET L2=(Y2/4)-(INT(Y2/4)) 5400 IF L2=0 THEN LET L2=1:GOTO 5600 5500 LET L2=0 5600 IF M1>2 THEN LET J1=J1+L1 5700 IF M2>2 THEN LET J2=J2+L2 5800 LET D4=D4+J2-J1 6000 LET D1=(D4-(INT(D4/33)*33)) 6100 LET D2=(D4-(INT(D4/28)*28)) 6200 LET D3=(D4-(INT(D4/23)*23)) 6300 FOR L3=1 TO 50 6350 FOR I= 1 TO 50 6360 LET L$(I)=" " 6370 NEXT I 6400 LET X=SIN(R1*D1) 6500 LET Y=SIN(R2*D2) 6600 LET Z=SIN(R3*D3) 6700 LET L$(X*20+25)="M" 6800 LET L$(Y*20+25)="E" 6900 LET L$(Z*20+25)="P" 6950 PRINT": 7800 IF D3=23 THEN LET D3=0 7900 LET J2=J2+1 7920 LET J6=J6+1 7950 IF J559 THEN LET J3=J3+L2 10300 IF J2<=J3 GOTO 11000 10400 NEXT I 10500 LET Y2=Y2+1 10510 LET L2=(Y2/4)-(INT(Y2/4)) 10520 IF L2=0 THEN LET L2=1:GOTO 10600 10530 LET L2=0PHYSICAL E=EMOTIONAL M=MENTAL "; 12830 PRINT TAB(70)":" 13200 FOR I=1 TO 70:PRINT"-";:NEXT I 13210 PRINT 13250 PRINT": LOW : HIGH :"; 13260 PRINT" DATE :CRITICAL"; 13400 PRINT":" 13500 FOR I=1 TO 70 13510 PRINT"-"; 13520 NEXT I 13530 PRINT 13540 RETURN 13600 LET J=70-POS(X) 13700 FOR I=1 TO J-1 13800 PRINT" "; 13900 NEXT I 14000 PRINT":" 14100 RETURN 14500 FOR I=1 TO 70:PRINT"-";:NEXT I:PRINT 14600 PRINT": HIGH DAYS OF FULL VITA   .OP .PO 39 Elegy to an Engineer's Sweetheart Verily, I say to you, marry not an engineer; For an engineer is a strange creature possessed of many evils; Yea, he speaketh eternally in parables, which he calls formulae; He wieldeth a calibrated stick which he calls a slide rule, and his Bible is a handbook; He thinketh only on stresses and strains and without end on thermodynamics; H showet onl seriou aspec an seemet no t kno ho t smile;es there shineth a faraway look, but neither that of love or longing-rather a vain attempt to recall the formula. The one letter he yearns to receive is an "A". When his damsel writeth of love and signeth with "X"'s, he taketh not these symbols for kisses but of unknown quantities. Even as a small boy he pulleth girls' hair to test it's elasticity; As a man he discovereth different devices, for he would count the vibrations of her heart- strings and reck10 REM PROGRAM WRITTEN BY: JIM PETERSEN 20 REM DATE : DECEMBER 9, 1978 30 REM PROGRAM GENERATES PRIMES FROM X TO Y WITHOUT LARGE DIMENSIONS, AND A LOT FASTER, TOO... 40 REM 50 PRINT CHR$(26):REM SCREEN CLEAR CHARACTER 60 INPUT "PLEASE INPUT THE LOWER AND UPPER LIMITS";L,U 70 S=0 80 PRINT:PRINT"THE PRIME NUMBERS BETWEEN";L;"AND";U;"ARE:":PRINT:PRINT 90 FOR I=L TO U 100 FOR J=1 TO SQR(I) 110 IF I=1 THEN 170 120 IF I/J=INT(I/J) THEN S=S+1 130 IF S>1 THEN 160 140 NEXT J 150 I1 DIM D(30):REM PROGRAM TO DETERMINE WHICH ORBITS ARE USABLE AND 2 REM PROVIDE ANTENNA INFORMATION 5 REM PARAMETERS 6 DEFINT N,M,U,T,Z 7 REM RESTORE TO ORIGINAL BY 'GOTO100' AT END OF 73 10 DIM H(3), I(3), P(3) 20 H(1)=901 21 I(1)=102 22 P(1)=114.942 23 H(2)=543 24 I(2)=99 25 P(2)=103.204 26 H(3)=1060 27 I(3)=82.56 28 P(3)=120.393 29 S=77.178:REM QTH LONG, CLE WAS 81.55 30 A=40.192:REM QTH LAT, CLE WAS 41.47 31 R=3957 50 PRINT "WHICH SATELLITE? ENTER 1 FOR OSCAR 7" 51 PRINT "  Neither does he know a waterfall except by its power, nor a sunset except that he must turn on the lights, nor a damsel except by her live weight. He carries always his books with him and enter- taineth his sweetheart by the steam tables. Verily, though his damsel expecteth chocolates when he calls, she openeth the package to find ore samples. Yea, he holdeth his damsel's hand but to measure the friction thereof. His kisses are to test viscosity, and in his eyon the strength of her materials Lo I say to you, marry not an engineer; The accountant may consider you surplus stock; The musician may think you to be a discord; The journalist will ponder your errors in style; But oh, far worse is the engineer- for he will plot the intensity of your love as a function of time on 3-cycle semi-logarithmic paper. Reprinted from Dis'n'Data a NU Engineer Publication F S=1 THEN PRINT I, 160 S=0 170 NEXT I 180 INPUT "DO YOU WANT TO RUN THIS PROGRAM AGAIN";A$ 190 IF LEFT$(A$,1)="Y" THEN 50 200 END  PRINT I, 160 S=0 170 NEXT I 180 INPUT "DO YOU WANT TO RUN THIS PROGRAM AGAIN";A$ 190 IF LEFT$(A$,1)="Y" THEN 50 LEASE INPUT THE LOWER AND UPPER LIMITS";L,U 70 S=0 80 PRINT:PRINT"THE PRIME NUMBERS BETWEEN";L;"AND";U;"ARE:":PRINT:PRINT 90 FOR I=L TO U 100 FOR J=1 TO SQR(I) 110 IF I=1 THEN 170 120 IF I/J=INT(I/J) THEN S=S+1 130 IF S>1 THEN 160 140 NEXT J 150 I ENTER 2 FOR OSCAR 8" 52 PRINT " ENTER 3 FOR RS" 53 INPUT N 60 PRINT "ENTER TIME YOU DESIRE (EST,EDT,UTC)" 61 INPUT Q$ 70 PRINT "ENTER REFERENCE ORBIT NUMBER, TIME (HR,MIN)" 71 PRINT "AND CROSSING LONGITUDE" 72 INPUT O1,U1,M1,R1 73 H=0:X6=0 75 INPUT "ENTER CURRENT HOUR--SAME TIME ZONE AS REQUESTED (99 FOR REF ORB)";HR:IF HR=99 THEN 100 76 IF Q$="EST" THEN HR=HR+5 ELSE IF Q$="EDT" THEN HR=HR+4 ELSE IF HR>24 THEN HR=HR-24 77 IF U1=>HR-1 THEN 100 ELSE U1=U1+INT(P(N)/60):M1=M1+P(N)    -60:IF N=3 THEN M1=M1-60 78 IF M1>60 THEN U1=U1+1:M1=M1-60:GOTO78 79 O1=O1+1:R1=R1+P(N)*360/(24*60):IF R1>360 THEN R1=R1-360 80 GOTO77 100 REM COMPUTATION FOR REF AND NEXT 13 ORBITS TO SEE AVAILABILITY 110 K=R/(R+H(N)) 111 D1 =(-ATN(K/SQR(-K*K+1))+1.5708)*57.2958 120 FOR Z=1 TO 13 125 FOR T=1 TO 60 STEP 5 126 O=O1+Z-1 130 A1=.0174533 132 K=(SIN(I(N)*A1))*(SIN(A1*360*T/P(N))) 133 B=(ATN(K/SQR(-K*K+1)))*57.2958 134 K=COS(A1*360*T/P(N))/COS(A1*B) 135 C=(-ATN(K/SQR(-K*K+1))+1.5708)*57U=U-4 251 IFU=>0 THEN 260 252 U=U+24 260 PRINT "FOR ORBIT NUMBER";O;"AT";U;M;" ";Q$;" SATELLITE USABLE" 265 PRINT "DO YOU WANT ANTENNA BEARINGS?(Y/n) 266 INPUT X$ 270 IF X$="Y" THEN INPUT"DO YOU WISH LINEPRINT(Y/N)";X$:GOTO300 271 PRINT "DO YOU WANT FURTHER ORBITS?(Y/N) 272 INPUT X$ 273 H=0 274 IF X$="N" THEN 570 275 GOTO 147 300 REM DETERMINE WHEN TO CALCULATE HEADINGS 301 CLS:IF X$="Y" THEN LPRINT "ANTENNA BEARINGS FOR ORBIT NUMBER";O ELSE PRINT "ANTENNA BEARINGS FOR ORBIT NUMBER";O 303 I9=0I9=0:GOTO 550 330 IFX6>0 THEN 350 349 M=M+T-1 350 M=M+1 351 IF M<60 THEN 450 352 U=U+1 353 M=M-60 354 GOTO 351 450 REM AZ/EL AND OUTPUT 455 K=(SIN(A1*B)-SIN(A1*A)*COS(A1*D))/(COS(A*A1)*SIN(A1*D)) 456 A4=(-ATN(K/SQR(-K*K+1))+1.5708)*57.2958 457 A4=INT(A4) 458 IF (C-S)>0 THEN A4=360-A4 460 A5=90-(ATN(((R+H(N))*SIN(A1*D))/((R+H(N))*COS(A1*D)-R)))*57.2958 461 X6=1 462 A5=INT(A5) 500 I9=I9+1:D(I9)=A4 505 IF X0%=0 THEN Z2=U:Z1=M:X0%=1 507 IF X$="Y" THEN LPRINT U;M,A4,A5 ELSE PRINT U;M,A4,A5 510=(ABS(D(I)-D(I+1)))/6:NEXT:X=INP(3):GOTO700:PRINT "SET ANTENNA TO PROPER INITIAL HEADING AND SET TRACKING SWITCH":INPUT "HIT 'ENTER' TO START TRACKING";X$ 610 FOR I=1 TO I9:FOR J=1 TO 15000:NEXT:REM 30 SEC DELAY 615 X=INP(4):FOR J=1 TO 500*D(I):NEXT:X=INP(3) 620 FOR J=500*D(I) TO 15000:NEXT:NEXT:GOTO555 700 DEFUSR0=&HFE49:REM CALL TO ROUTINE IDENT 705 FOR J=1TO I:IF D(I)>30 THEN D(I)=0 707 NEXT:FOR J=1TOI:D(J)=INT(D(J)):NEXT 708 M=0:FOR J=1 TO I:IF D(J)=0 THEN M=M+1:NEXT 710 X=&HFE01:FOR J=M+1TO I:X.2958+.25*T+R1+.25*(Z-1 )*P(N) 136 K=SIN(A*A1)*SIN(B*A1)+COS(A*A1)*COS(B*A1)*COS(A1*(S-C)) 137 D=(-ATN(K/SQR(-K*K+1))+1.5708)*57.2958 145 IFD<=D1 THEN 200 146 NEXT T 147 H=0:X6=0:NEXT Z 148 PRINT "END AVAILABLE ORBITS" 149 GOTO 570 200 REM THIS SECTION ENTERED IF AN ORBIT AVAILABLE 205 M=INT(M1+P(N)*(Z-1)) 206 U=U1 207 IF M<60 THEN 230 210 M=M-60 215 U=U+1 216 GOTO 207 230 IF Q$="UTC" THEN 260 231 IF Q$="EDT" THEN 250 235 U=U-5 240 IF U=>0 THEN 260 245 U=U+24 246 GOTO 260 250 :IF X$="Y" THEN LPRINT "TIME","AZIMUTH","ELEVATION" ELSE PRINT "TIME","AZIMUTH","ELEVATION" 304 X6=0 310 FOR T=1 TO 60 311 K=SIN(A1*I(N))*SIN(A1*360*T/P(N)) 312 B=(ATN(K/SQR(-K*K+1)))*57.2958 313 K=COS(A1*360*T/P(N))/COS(A1*B) 314 C=(-ATN(K/SQR(-K*K+1))+1.5708)*57.2958+.25*T+R1+.25*(Z-1) *P(N):IF C=>360 THEN C=C-360 315 K=SIN(A*A1)*SIN(B*A1)+COS(A*A1)*COS(B*A1)*COS(A1*(S-C)) 316 D=(-ATN(K/SQR(-K*K+1))+1.5708)*57.2958 318 IF D<=D1 THEN 330 319 IFH>0 THEN 550 320 NEXT T 321  H=1 515 GOTO 320 550 PRINT"END OF USABLE ORBIT":INPUT "DO YOU WISH ANTENNA CONTROL";X$:IF X$="Y" THEN 600 555 PRINT "DO YOU WISH COMPUTATION FOR ANOTHER ORBIT?(Y/N)" 560 INPUT X$ 565 IF X$="Y" THEN 147 570 PRINT "DO YOU WISH COMPUTATION FOR ANOTHER SATELLITE?(Y/n)" 575 INPUT X$ 580 IF X$="Y" THEN 50 ELSE END 600 IF(D(INT(I9/2))<360 AND D(INT(I9/2))>180) THEN FOR I=1 TO I9:IF D(I)<90 THEN D(I)=360:NEXT ELSE NEXT 604 REM GOTO700 IN 605 ENABLES NEW MACH ANTTRK PROGRAM 605 I9=I9-1:FOR I=1 TO I9:D(I)=X+1:POKE X,D(J):NEXT:X=X+1:POKE X,0:REM PUT TIMES INTO MACHINE PROGRAM 730 Z1=Z1+M+1:IF Z1>59 THEN Z1=Z1-60:Z2=Z2+1:IF Z2=24 THEN Z2=0 740 X=&HFE00:POKE X,Z2:POKE X+1,Z1:X=USR(0):CMD"R" 999 END P(3) 620 FOR J=500*D(I) TO 15000:NEXT:NEXT:GOTO555 700 DEFUSR0=&HFE49:REM CALL TO ROUTINE IDENT 705 FOR J=1TO I:IF D(I)>30 THEN D(I)=0 707 NEXT:FOR J=1TOI:D(J)=INT(D(J)):NEXT 708 M=0:FOR J=1 TO I:IF D(J)=0 THEN M=M+1:NEXT 710 X=&HFE01:FOR J=M+1TO I:X   ; ; formham1.asm ; by roderick w. hart wa3mez ; march 26, 1982 ; ;history ;03/26/82 corrected phantom bugs (programmer's error) ; that cause character passed to routine to be ; overwritten. r. w. hart ; ; this routine is called to convert a character into a code that ; permits double bit error detection and single bit error correct- ; ion. the process used is well know to data communication engineers ; as hamming code error correction and detection. ; ; if errors occur randomly and indure used in this routine will cause a file to double ; its size, therefore it will not be of much value on high quality ; circuits. it is anticipated that the use of hamming code will be ; most efficient on high speed radio circuit where the transfer ; media tends to vary causing distortion that could result in dropped ; bits. ; ; ;*************************************************************** ; entry ; a = character ; ; exit ; d = hamming code for most significant 4 bits of character ; e =  ;............to right ani 0fh ;mask 4 least significant bits call adjbyte ;adjust data and check bits call ckbits ;create most significant bit hamming code mov d,a ;store in d lda word ;get least significant bits call adjbyte ;adjust data and check bits call ckbits ;create least significant bit hamming code mov e,a ;store in e ret ; ; adjbyte:push psw ;store bits temporarily ani 8h ;check bit 3 jnz seta ;if = 1 goto seta pop psw ;otherwise retrieve bits ani 7h ;ma and 6 cpe setm ;set m bit if even parity ret ; ; setx1: lda store ori 40h ;set check bit 1 sta store ret ; setx2: lda store ori 20h ;set check bit 2 sta store ret ; setx4: lda store ori 8h ;set check bit 4 sta store ret ; setm: lda store ori 80h ;set m bit sta store ret ; ; word dw 1 store dw 1 end ore ani 07h ;test bits 0,1, and 2 cpe setx4 ;set check bit 4 if even parity lda store ani 7fh ;test bits 0,1,2,3,4,5,; ; AMATEUR RADIO LINK PROGRAM ; HAMLINK4 ; (LATEST VERSION 06/03/81) ; ; AN ADAPTATION OF L.E. HUGHES'S PROGRAM PLINK ; BY RODERICK W. HART WA3MEZ. ; CWID ROUTINE BORROWED FROM DALE HEATHERINGTON'S ; PROGRAM 'PACKET.ASM'. ; ;HAMLINK IS A CP/M TRANSIENT COMMAND WHICH ALLOWS THE USER TO ;ESTABLISH A COMMUNICATION LINK WITH A REMOTE AMATEUR RADIO ;SYSTEM TRANSMITING ASCII. ; ;HAMLINK CURRENTLY SUPPORTS TWO WAY TRANSFER OF TEXT FILES ;BETWEEN THE CP/M DISK SYSTEM AND THE REMOTE STATION. THE dependently, and if the pro- ; bability of a single error occurring is p, then the probability ; of a double error is p^2, and the probability of a triple error ; is p^3. if you assume that the probability of a single error is ; 1/10,000, then the probability of a double error would be 1/100, ; 000,000, and the probability of a triple error would be 1/1,000, ; 000,000,000. as you can see the user has to make a decision at ; some point as to the value of correction and detection overhead. ; the procehamming code for least significant 4 bits of character ;*************************************************************** ; ; makcode:push psw ;store character on stack xra a ;zero accumulator sta word ;make sure everything is zeroed sta store ;do it again.... pop psw ;get character from stack push psw ;store again until later ani 0fh ;mask 4 least significant bits sta word ;store temporarily pop psw ;get character rar ;...shift rar ;......4 rar ;.........places rar sk 3 least significant bits ret ; ; seta: pop psw ;retrieve bits ani 7h ;mask 3 least significant bits ori 10h ;set bit 4 = 1 ret ;return with bit 4 = 1 and bit 3 = 0 ; ; ckbits: sta store ani 15h ;test bits 0,2, and 3 cpe setx1 ;set check bit 1 if even parity lda store ani 13h ;test bits 0,1, and 3 cpe setx2 ;set check bit 2 if even parity lda store ani 07h ;test bits 0,1, and 2 cpe setx4 ;set check bit 4 if even parity lda store ani 7fh ;test bits 0,1,2,3,4,5, ;FOLLOWING CONTROL CODES MAY BE INITIATED FROM THE CONSOLE ;KEYBOARD: ; ; **************************************************** ; * * ; * COMMANDS: * ; * CONTROL X EXIT HAMLINK TO CP/M WARM BOOT * ; * CONSROL S TRANSMIT ASCII FILE TO MODEM. * ; * ASK FOR DRIVE AND FILENAME.TYPE. * ; * CONTROL C ABORT FILE SEND TO MODEM * ;     * CONTROL O SAVE INCOMING ASCII IN RAM BUFFER * ; * FOR LATER TRANSFER TO DISK. * ; * CONTROL Q WRITE RAM BUFFER TO DISK - ASK * ; * FOR DRIVE AND FILENAME.TYPE. * ; * DELETE BACKSPACE WHEN IN COMMAND MODE * ; * ASKING FOR FILENAME. * ; * CONTROL U ABORT CURRENT LINE WHEN IN COMMAND * ; * MODE ASKING FOR FILENAME. * ; * ESCAPE PR * (NOTE: ALL OTHER CONTROL CODES ARE PASSED TO * ; * MODEM OUTPUT. THE EQUATE ERCHAR CAN BE * ; * USED TO PRINT ANY CHOSEN ASCII CHARAC- * ; * TER UPON RECEIPT OF AN ERROR. THIS FEA- * ; * TURE CAN BE USED TO PROPERLY SET MODEM * ; * TO MATCH THE TRANSMITTING STATION'S MODE* ; * I.E. STOP BITS, DATA BITS, AND PARITY) * ; *************************************************** ; ;BDOS ENTRY POINT AND FUNCT DBUF EQU 80H ;DEFAULT DISK BUFFER ADDRESS ; ;ASCII CONTROL CHARACTERS ; CR EQU 0DH ;CARRIAGE RETURN LF EQU 0AH ;LINE FEED DEL EQU 7FH ;DELETE (RUBOUT) ESC EQU 1BH ;ESCAPE BELL EQU 07H ;BELL SIGNAL TAB EQU 09H ;HORIZONTAL TAB VT EQU 0BH ;VERT TAB (CLEAR SCREEN) HOME EQU 0EH ;HOME CURSOR CPUSPD EQU 2 ;CPU CLOCK SPEED IN MHZ ; ;WARNING CHARACTER FOR LOW MEMORY ; WRNSIG EQU BELL ;IF YOU HAVE ONE, PUT 'BELL' HERE ;...ELSE PUT '*' HERE. ; ;STATION CONTROLLER I/O PORT ADDRESS (AMSAT STA EQU 10H ;FRAME ERROR OE EQU 20H ;OVERRUN ERROR PE EQU 40H ;PARITY ERROR ERCHAR EQU 0ABH ;PLACE CHAR. YOU WISH PRINTED UPON ;RECEIPT OF PARITY, OVERRUN, AND ;FRAMING ERRORS. 00H PASSES ALL CHAR. ;WHILE ANYTHING ELSE WILL SUBTITUTE ;ERCHAR FOR EACH BAD CHAR. RECEIVED. ; ;MODEM INITIALIZATION BYTES (300 BAUD) ; I72E EQU 02H ;7BITS,2STOP BITS,EVEN PARITY I72O EQU 06H ;7BITS,2STOP BITS,ODD PARITY I71E EQU 0AH ;7BITS,1STOP BIT,EVEN PARITY I71O EQU 0EH ;7BITS,1STOP BIT,ODD PARITY I820  EQU 1DH ;8BITS,1STOP BIT,ODD PARITY ; ;CONDITIONAL ASSEMBLY SWITCHES ; INIT$REQUIRED EQU 1 ;PUT 0 HERE IF NO INIT. REQ. INIT$CONTLR EQU 1 ;PUT 0 HERE IF NO INIT. REQ. ; ; **MAIN PROGRAM** ; ORG 0100H ; LINK LXI SP,STACK+64 LHLD 1 LXI D,3 DAD D SHLD CITCAL+1 DAD D SHLD RCCAL+1 DAD D SHLD WCCAL+1 ; IF INIT$CONTLR MVI A,98H OUT CONTLR+3 MVI A,0 OUT CONTLR+1 ENDIF ; IF INIT$REQUIRED CALL ORGMOD ENDIF ; IN MODD IN MODD XRA A STA INCH STA OUTCH STA FLAINT MENUE * ; * CONTROL E TRAP RECEIVE ERRORS * ; * CONTROL D PRINT ERROR SUMMARY * ; * CONTROL W RESET ERROR COUNTERS * ; * CONTROL A DEACTIVATE RECEIVE ERROR TRAP * ; * CONTROL Y RECONFIGURE MODEM * ; * CONTROL T TURN TRANSMITTER ON * ; * CONTROL R TURN TRANSMITTER OFF * ; * CONTROL I TRANSMIT CWID * ; ION CODES ; BDOS EQU 0005H RSFC EQU 10 ;READ STRING RESDSK EQU 13 ;RESET DISK SYSTEM OFFC EQU 15 ;OPEN FILE CFFC EQU 16 ;CLOSE FILE SFFC EQU 17 ;SEARCH FIRST SNFC EQU 18 ;SEARCH NEXT DFFC EQU 19 ;DELETE FILE RRFC EQU 20 ;READ RECORD WRFC EQU 21 ;WRITE RECORD MFFC EQU 22 ;MAKE FILE SAFC EQU 26 ;SET ADDRESS ; ;DEFAULT FCB AND FIELD DEFINITIONS ; FCB EQU 5CH FN EQU 1 ;FILE NAME FIELD (REL) FT EQU 9 ;FILE TYPE FIELD (REL) EX EQU 12 ;FILE EXTENT FIELD (REL) NR EQU 32 ;NEXT RECORD FIELD (REL). CONTROLLER) ; CONTLR EQU 00H ;STA. CONTROLLER BASE PORT ; ;STATION CONTROLLER CONTROL CODES ; TON EQU 01H ;TRANSMITTER ON IDON EQU 02H ;ID TONE ON ; ;MODEM I/O PORT ADDRESSES (MITS 2SIO BOARD) ; MODS EQU 12H ;MODEM STATUS PORT MODD EQU 13H ;MODEM DATA PORT MODINIT EQU 16H ;INITIALIZE FOR 300 BAUD ;8 DATA BITS, 1 STOP BITS, NO PARITY ; ;MODEM STATUS PORT BIT DEFINITIONS (MIT 2SIO BOARD) ; MTBE EQU 02H ;MODEM TRANS. BUFFER READY FLAG MRDA EQU 01H ;MODEM RECEIVE DATA AVAIL. FLAG FEEQU 12H ;8BITS,2STOP BITS,NO PARITY I810 EQU 16H ;8BITS,1STOP BIT,NO PARITY I81E EQU 1AH ;8BITS,1STOP BIT,EVEN PARITY I81O EQU 1EH ;8BITS,1STOP BIT,ODD PARITY ; ;MODEM INITIALIZATION BYTES (1200 BAUD) ; X72E EQU 01H ;7BITS,2STOP BITS,EVEN PARITY X72O EQU 05H ;7BITS,2STOP BITS,ODD PARITY X71E EQU 09H ;7BITS,1STOP BIT,EVEN PARITY X71O EQU 0DH ;7BITS,1STOP BIT,ODD PARITY X820 EQU 11H ;8BITS,2STOP BITS,NO PARITY X810 EQU 15H ;8BITS,1STOP BIT,NO PARITY X81E EQU 19H ;8BITS,1STOP BIT,EVEN PARITY X81OG STA ERROR STA ERRFLG STA CR1 MVI A,ERCHAR STA ERROR LXI H,0 SHLD PERR SHLD OERR SHLD FERR LXI H,TBUF SHLD PTR LXI H,0 SHLD SIZE LXI H,LINKMS CALL WCS ; ; MAIN LOOP ; LINK3 CALL CITEST JZ LINK4 CALL RCC CPI 20H CC PCC JC LINK4 ORI 80H STA INCH LINK4 LDA OUTCH ORA A JP LINK5 ANI 7FH CALL WCC XRA A STA OUTCH LINK5 CALL MITEST JZ LINK6 CALL RMC2 CALL SAVE ORI 80H STA OUTCH LINK6 CALL MOTEST JZ LINK7 LDA INCH ORA A JP LINK7 ANI    7FH CPI CR CZ WMCLF ;AUTO LF/CR SEQUENCE CALL WMC CALL WCC XRA A STA INCH LINK7 JMP LINK3 ; LINKMS DB VT,'Amateur Radio Link as of 06/03/81' DB ' by: Roderick W. Hart WA3MEZ' DB CR,LF,'Link established [8 data bits, 1 stop' DB ' bit, no parity - 300 baud]' DB CR,LF,' Special Debug Version' DB CR,LF,LF,BELL,0 ; ; PCC - PROCESS CONTROL CHARACTER ; PCC CPI 'X'-40H JNZ PCC1 PUSH H LXI H,AYS CALL WCS POP H CALL RCC CALL WCC ANI 5FH CPI 'Y' JZ TERM-40H JNZ PCC9 CALL RESET LXI H,RESMSG CALL WCS STC RET ; PCC9 CPI 'A'-40H JNZ PCC9A MVI A,0 STA ERRFLG LXI H,ERR1MSG CALL WCS STC RET ; PCC9A CPI 'T'-40H JNZ PCC9B CALL RFON LXI H,XMTONMSG CALL WCS STC RET ; PCC9B CPI 'R'-40H JNZ PCC9C CALL RFOFF LXI H,XMTOFFMSG CALL WCS STC RET ; PCC9C CPI 'I'-40H JNZ PCC10 CALL CWID STC RET ; PCC10 CPI 'Y'-40H JNZ PCC4 PUSH H LXI H,SPEED CALL WCS POP H CALL RCC CALL WCC CPI '1' JNZ S1200 JMP CONFIG EN1 STC RET ; S1200 CPI '2' JNZ EN1 PUSH H LXI H,CONFMG1 CALL WCS POP H CALL RCC CALL WCC CPI '1' JNZ B1 MVI A,X72E STA CR1 JMP CONFIG B1 CPI '2' JNZ B2 MVI A,X72O STA CR1 JMP CONFIG B2 CPI '3' JNZ B3 MVI A,X71E STA CR1 JMP CONFIG B3 CPI '4' JNZ B4 MVI A,X71O STA CR1 JMP CONFIG B4 CPI '5' JNZ B5 MVI A,X820 STA CR1 JMP CONFIG B5 CPI '6' JNZ B6 MVI A,X810 STA CR1 JMP CONFIG B6 CPI '7' JNZ B7 MVI A,X81E STA CR1 JMP EXIT TO CP/M' DB CR,LF,'CONTROL-S TRANSMIT ASCII FILE' DB CR,LF,'CONTROL-O RECEIVE ASCII FILE' DB CR,LF,'CONTROL-Q WRITE RECEIVED FILE TO DISK' DB CR,LF,'CONTROL-C ABORT FILE TRANSMISSION' DB CR,LF,'CONTROL-U ABORT CURRENT LINE (COMMAND MODE)' DB CR,LF,'CONTROL-A DEACTIVATE ERROR TRAP' DB CR,LF,'CONTROL-E ACTIVATE ERROR TRAP' DB CR,LF,'CONTROL-D PRINT RECEIVE ERROR SUMMARY' DB CR,LF,'CONTROL-W RESET RECEIVE ERROR COUNTERS' STF4 DCR C JNZ STF2 JMP STF1 ; STF5 LXI H,STFSM CALL WCS RET ; STF6 LXI H,STFS1 CALL WCS RET ; STF7 LXI H,STFS2 CALL WCS RET ; STF8 LXI H,STFSA CALL WCS RET ; STFSM DB 'File Transmission Completed',CR,LF,0 STFS1 DB 'File Name Error',CR,LF,0 STFS2 DB 'File Not Found',CR,LF,0 STFSA DB CR,LF,'File Transmission Aborted',CR,LF,0 ; ; SAVE - SAVE CHAR IN TEXT BUFFER IF FLAG ON ; ; ; ENRTY CONDITIONS ; A - CHAR TO SAVE ; SAVE PUSH PSW LDA FLAG ORA A JNZ SAVE1 POP PS CALL WCCR STC RET ; PCC1 CPI 'S'-40H JNZ PCC2 CALL STF STC RET ; PCC2 CPI 'O'-40H JNZ PCC3 MVI A,1 STA FLAG LXI H,PCCMR CALL WCS STC RET ; PCC3 CPI 'Q'-40H JNZ PCC5 XRA A STA FLAG CALL WTB STC RET ; PCC4 STC CMC RET ; PCC5 CPI ESC JNZ PCC6 LXI H,MENUE ;PRINT MENUE CALL WCS STC RET ; PCC6 CPI 'E'-40H JNZ PCC7 MVI A,1 STA ERRFLG LXI H,ERRMSG CALL WCS STC RET ; PCC7 CPI 'D'-40H JNZ PCC8 CALL PCD0 STC RET ; PCC8 CPI 'W' S300 PUSH H LXI H,CONFMSG CALL WCS POP H CALL RCC CALL WCC CPI '1' JNZ A1 MVI A,I72E STA CR1 JMP CONFIG A1 CPI '2' JNZ A2 MVI A,I72O STA CR1 JMP CONFIG A2 CPI '3' JNZ A3 MVI A,I71E STA CR1 JMP CONFIG A3 CPI '4' JNZ A4 MVI A,I71O STA CR1 JMP CONFIG A4 CPI '5' JNZ A5 MVI A,I820 STA CR1 JMP CONFIG A5 CPI '6' JNZ A6 MVI A,I810 STA CR1 JMP CONFIG A6 CPI '7' JNZ A7 MVI A,I81E STA CR1 JMP CONFIG A7 CPI '8' JNZ EN1 MVI A,I81O STA CR1 CONFIG B7 CPI '8' JNZ EN1 MVI A,X81O STA CR1 JMP CONFIG ; ; SPEED DB HOME,CR,LF,'Which Speed Do You Wish [1=300 Baud, 2=1200 Baud] ?',0 AYS DB HOME,CR,LF,'Exit To CP/M - Are You Sure (Y or N) ?',0 PCCMR DB HOME,CR,LF,'Saving Incoming Text In Memory',CR,LF,0 MENUE DB VT DB ' * * * H a m l i n k 3 * * *' DB CR,LF,'CONTROL-I TRANSMIT CWID' DB CR,LF,'CONTROL-T TURN TRANSMITTER ON' DB CR,LF,'CONTROL-R TURN TRANSMITTER OFF' DB CR,LF,'CONTROL-X  DB CR,LF,'CONTROL-Y RECONFIGURE MODEM' DB CR,LF,'DELETE BACKSPACE (COMMAND MODE)' DB CR,LF,'ESCAPE PRINT MENUE' DB CR,LF DB 0 ; ; STF - SEND TEXT FILE (TO MODEM) ; STF CALL GFN JC STF6 CALL OPEN CPI 255 JZ STF7 STF1 CALL READ CPI 1 JZ STF5 LXI H,DBUF MVI C,128 STF2 MOV A,M INX H CPI 'Z'-40H JZ STF5 CALL WMC CALL WCC CPI CR JNZ STF4 STF3 CALL CITEST JZ STF3A CALL RCC CPI 'C'-40H JZ STF8 STF3A CALL WCCR ;SEND LFCR TO CONSOLE W RET ; SAVE1 POP PSW CPI DEL RZ CPI 20H JNC SAVE2 CPI CR JZ SAVE2 CPI LF JZ SAVE2 CPI TAB JZ SAVE2 RET ; SAVE2 PUSH H LHLD SIZE INX H SHLD SIZE LHLD PTR MOV M,A INX H SHLD PTR PUSH PSW LDA 7 CMP H JZ SAVEAB SUI 4 CMP H MVI A,WRNSIG CC WCC POP PSW POP H RET ; ; SAVEAB - RAN OUT OF ROOM, ISSUE MESSAGE AND FLOW ; THROUGH TO DISK SAVE ROUTINE ; SAVEND DB BELL,CR,LF,'Aborting - No Room Left',0 ; SAVEAB LXI SP,STACK+64 LXI H,SAVEND CALL    WCS LXI H,LINK PUSH H ; ; WTB - WRITE TEXT BUFFER TO DISK ; WTB LHLD SIZE MOV A,L ORA H JZ WTB5 MVI C,RESDSK CALL BDOS CALL GFN JC WTB6 CALL DELT CALL MAKE LHLD SIZE XCHG LXI H,DBUF PUSH H LXI H,TBUF WTB1 MVI C,128 WTB2 MOV A,M INX H XTHL MOV M,A INX H XTHL DCX D MOV A,D ORA E JZ WTB3 DCR C JNZ WTB2 CALL WRITE XTHL LXI H,DBUF XTHL JMP WTB1 ; WTB3 POP H WTB4 MVI M,'Z'-40H INX H DCR C JNZ WTB4 CALL WRITE CALL CLOSE LXI H,TBUND LINE FEED) ; WCCR MVI A,LF CALL WCC MVI A,CR ; ; WCC - WRITE CONSOLE CHARACTER ; ; ENTRY CONDITIONS: ; A - CHARACTER TO WRITE ; WCC PUSH PSW PUSH B PUSH D PUSH H MOV C,A WCCAL CALL $-$ POP H POP D POP B POP PSW RET ; ; RCS - READ CONSOLE STRING (WITH ECHO) ; ; EXIT CONDITIONS ; B - NUMBER OF CHARACTERS READ (<255) ; HL - POINTS TO LAST CHAR STORED (CR) ; RCS LXI H,IBUF MVI B,0 RCS1 CALL RCC CPI DEL JNZ RCS2 INR B DCR B JZ RCS1 DCX H MOV A,M CADD RET ; ; RMC - READ MODEM CHARACTER ; ; EXIT CONDITIONS ; A - CHARACTER READ ; RMC IN MODS ANI MRDA JZ RMC RMC2 IN MODD PUSH PSW LDA ERRFLG CPI 0 JNZ ERRCK RMC3 POP PSW ANI 7FH RET ; ; ERRCK - CHECK FOR FRAME, OVERRUN, AND PARITY ERROR ; ERRCK PUSH H IN MODS ;JUMP IF NO FRAME ERROR ANI PE JZ ERRCK1 LHLD PERR INX H SHLD PERR JMP ERRCK4 ERRCK1 IN MODS ;JUMP IF NO OVERRUN ERRORS ANI OE JZ ERRCK2 LHLD OERR INX H SHLD OERR JMP ERRCK4 ERRCK2 IN MODS  LXI H,MSG12 ;PRINT OVERRUN ERROR MSG. CALL WCS LHLD FERR ;PRINT FRAME ERROR COUNT CALL WDWC LXI H,MSG13 ;PRINT FRAME ERROR MSG. CALL WCS JMP PCC4 ;EXIT ; ; WDWC - WRITE DECIMAL WORD TO CONSOLE ; ; ENTRY CONDITIONS: ; ; HL VALUE TO WRITE IN DECIMAL ; WDWC PUSH H PUSH D PUSH B MVI C,0 ;CLEAR DIGIT PRINTED FLAG LXI D,10000 ;WRITE TEN THOUSANDS DIGIT CALL WNDC LXI D,1000 ;WRITE THOUSANDS DIGIT CALL WNDC LXI D,100 ;WRITE HUNDREDS DIGIT CALL WNDC LXI D,10 ;WRITE  MOV H,A JC WNDC2 ;BRANCH IF HL < 0 INR B ;ELSE INCREMENT COUNT JMP WNDC1 ;AND LOOP WNDC2 DAD D ;ADD DE BACK IN ONCE MOV A,B ;GET COUNT ORA A JNZ WNDC3 ;JUMP IF NON-ZERO INR C ;JUMP IF DIGIT PRINTED ALREADY DCR C JNZ WNDC3 MVI A,' ' ;PRINT A BLANK AND EXIT JMP WCC WNDC3 MVI C,1 ;SET DIGIT PRINTED FLAG ADI '0' ;WRITE DIGIT IN ASCII JMP WCC ; ; RESET - RESET ERROR TRAP REGISTERS ; RESET LXI H,0 ;RESET ERROR TRAP REGISTERS SHLD PERR SHLD OERR SHLD FERR JMP PCF SHLD PTR LXI H,0 SHLD SIZE LXI H,WTBSM CALL WCS RET ; WTB5 LXI H,WTBS1 CALL WCS RET ; WTB6 LXI H,WTBS2 CALL WCS RET ; WTBSM DB CR,LF,'Buffer Transferred To Disk',CR,LF DB 'Memory Save Cancelled',CR,LF,0 WTBS1 DB 'Text Buffer Empty',CR,LF,0 WTBS2 DB 'File Name Error',CR,LF,0 ; ; WCS - WRITE CONSOLE STRING ; ; ENTRY CONDITIONS ; HL - POINTS TO STRING (TERM BY ZERO BYTE) ; WCS MOV A,M INX H ORA A RZ CALL WCC JMP WCS ; ; WCCR - WRITE CONSOLE CARRIAGE RETURN (ALL WCC DCR B JMP RCS1 ; RCS2 CPI 'U'-40H JNZ RCS3 CALL WCCR JMP RCS ; RCS3 CALL WCC MOV M,A INR B CPI CR JZ RCS4 INX H JMP RCS1 ; RCS4 MVI A,LF CALL WCC RET ; ; RCC - READ CONSOLE CHARACTER ; ; EXIT CONDITIONS ; A - CHARACTER READ ; RCC PUSH B PUSH D PUSH H RCCAL CALL $-$ POP H POP D POP B RET ; ; WMC - WRITE MODEM CHARACTER ; ; ENTRY CONDITIONS ; A - CHARACTER TO WRITE ; WMC PUSH PSW WMCL IN MODS ANI MTBE JZ WMCL POP PSW ANI 7FH OUT MO ;JUMP IF NO FRAMING ERRORS ANI FE JZ ERRCK5 LHLD FERR INX H SHLD FERR ERRCK4 LDA ERROR ;CHECK ERROR CODE ORA A JZ ERRCK5 ;JUMP IF 00H POP H ;GET RID OF PSW/A REG POP H ;RESTORE REAL HL RET ERRCK5 POP H ;RESTORE HL POP PSW ;GET CHARACTER ANI 7FH RET ; ; PCD0 - PRINT ERROR SUMMARY MESSAGE ; PCD0 LXI H,MSG10 CALL WCS LHLD PERR ;PRINT PARITY ERROR COUNT CALL WDWC LXI H,MSG11 ;PRINT PARITY ERROR MSG. CALL WCS LHLD OERR ;PRINT OVERRUN ERROR COUNT CALL WDWC TENS DIGIT CALL WNDC LXI D,1 ;WRITE UNITS DIGIT MVI C,1 ;FORCE UNITS DIGIT TO PRINT CALL WNDC POP B POP D POP H RET ; ; WNDC - WRITE NEXT DIGIT TO CONSOLE ; ; ENTRY CONDITIONS: ; ; HL VALUE TO PRINT NEXT DIGIT OF ; ; DE DECIMAL ORDER OF MAGINTUDE ; ; C ZERO MEAN LEADING DIGIT NOT YET PRINTED ; ; EXIT CONDITIONS ; ; HL OLD.HL - (OLD.HL / DE) * DE ; ; C SET IFF DIGIT PRINTED ; WNDC MVI B,0 ;CLEAR COUNT WNDC1 MOV A,L ;HL = HL - DE SUB E MOV L,A MOV A,H SBB D C4 ;EXIT ; MSG10 DB HOME,LF,CR,'*** ERROR SUMMARY ***',LF,CR DB ' ',LF,CR,0 MSG11 DB ' Parity Errors ',LF,CR,0 MSG12 DB ' Overrun Errors',LF,CR,0 MSG13 DB ' Framing Errors',LF,CR,0 ERRMSG DB HOME,'*** Receive Error Trap Active ***',CR,LF,0 RESMSG DB HOME,'*** Receive Error Counters Reset ***',CR,LF,0 ERR1MSG DB HOME,'*** Receive Error Trap Deactivated ***',CR,LF,0 ; ; WMCLF - WRITE AUTO LF/CR SEQUENCE ; WMCLF PUSH PSW MVI A,LF CALL WMC CALL WCC POP PSW RET ;     ; GFN - GET FILE NAME ; GFN LXI H,GFNSD CALL WCS CALL RCC CALL WCC ANI 5FH CPI 'A' JNZ GFNA MVI A,1 STA FCB JMP GFNB ; GFNA CPI 'B' JNZ GFN MVI A,2 STA FCB GFNB LXI H,GFNS1 CALL WCS CALL RCS LXI H,FCB+FN MVI C,11 GFN1 MVI M,' ' INX H DCR C JNZ GFN1 LXI H,IBUF LXI D,FCB+FN MVI C,9 GFN2 MOV A,M INX H CPI 61H JC GFN2A SUI 20H GFN2A CPI CR JZ GFN5 CPI '.' JZ GFN3 STAX D INX D DCR C JNZ GFN2 JMP GFN6 ; GFN3 LXI D,FCB+FT MVI C,4 GFNOP B POP D POP H RET ; ; CLOSE - CLOSE DISK FILE ; CLOSE PUSH H PUSH D PUSH B LXI D,FCB MVI C,CFFC CALL BDOS POP B POP D POP H RET ; ; DELT - DELETE DISK FILE ; DELT PUSH H PUSH D PUSH B LXI D,FCB MVI C,DFFC CALL BDOS POP B POP D POP H RET ; ; WRITE - WRITE RECORD TO DISK ; WRITE PUSH H PUSH D PUSH B LXI D,FCB MVI C,WRFC CALL BDOS POP B POP D POP H RET ; ; MAKE - MAKE NEW DISK FILE ; MAKE PUSH H PUSH D PUSH B LXI D,FCB MVI CTRANSMITTER OFF ; RFOFF LDA CRX ANI NOT(TON) AND 255 OUT CONTLR+1 STA CRX RET ; ;TURN CWID TONE ON ; TONEON LDA CRX ORI IDON AND 255 OUT CONTLR+1 STA CRX RET ; ;TURN CWID TONE OFF ; TONEOFF LDA CRX ANI NOT(IDON) OUT CONTLR+1 STA CRX RET ;CWID ROUTINE ; CWID LXI H,IDONMSG CALL WCS LXI H,CALL$SIGN CWID1 MOV A,M ORA A JZ FINI PUSH H MOV C,A CALL SEND$CW$CHAR POP H CWID2 INX H JMP CWID1 SEND$CW$CHAR PUSH B CALL TONEOFF MVI C,2 CALL DELAYX UTINE WITH DE CONTAINING ;THE DELAY VALUE IN MILLISECONDS. ; DELAY CALL WAIT1 DCX D MOV A,E ORA D JNZ DELAY RET ; ; ;1 MILLISECOND WAIT ROUTINE ; WAIT1 MVI A,55*CPUSPD WAIT1X DCR A NOP JNZ WAIT1X RET ; ;ASCII TO CW TRANSLATION TABLE ; ASCII$CW DB 5+10010000B ;/ -..-. DB 5+11111000B ;ZERO DB 5+01111000B ;1 DB 5+00111000B ;2 DB 5+00011000B ;3 DB 5+00001000B ;4 DB 5+00000000B ;5 DB 5+10000000B ;6 DB 5+11000000B ;7 DB 5+11100000B ;8 DB 5+11110000B ;9 DB 0P .--. DB 4+11010000B ;Q --.- DB 3+01000000B ;R .-. DB 3+00000000B ;S ... DB 1+10000000B ;T - DB 3+00100000B ;U ..- DB 4+00010000B ;V ...- DB 3+01100000B ;W .-- DB 4+10010000B ;X -..- DB 4+10110000B ;Y -.-- DB 4+11000000B ;Z --.. ; ; CONFIG - RECONFIGURE MODEM PARAMETERS ; CONFIG MVI A,003 OUT MODS LDA CR1 OUT MODS IN MODD ;EAT UP GARBAGE IN MODD IN MODD IN MODD STC RET ; CONFMG1 DB VT,CR,LF,LF DB ' 1200 Baud Config. Table' DB CR,LF,'Config. Dat4 MOV A,M INX H CPI 61H JC GFN4A SUI 20H GFN4A CPI CR JZ GFN5 STAX D INX D DCR C JNZ GFN4 JMP GFN6 ; GFN5 XRA A STA FCB+EX STA FCB+NR STC CMC RET ; GFN6 STC RET ; GFNSD DB CR,LF,'Which Drive ? ',0 GFNS1 DB CR,LF,'Filename ? ',0 ; ; OPEN - OPEN DISK FILE ; OPEN PUSH H PUSH D PUSH B LXI D,FCB MVI C,OFFC CALL BDOS POP B POP D POP H RET ; ; READ - READ RECORD FROM DISK FILE ; READ PUSH H PUSH D PUSH B LXI D,FCB MVI C,RRFC CALL BDOS P,MFFC CALL BDOS POP B POP D POP H RET ; ; CITEST - CHECK CONSOLE INPUT STATUS ; CITEST PUSH B PUSH D PUSH H CITCAL CALL $-$ ORA A POP H POP D POP B RET ; ; MITEST - CHECK MODEM INPUT STATUS ; MITEST IN MODS ANI MRDA RET ; ; MOTEST - CHECK MODEM OUTPUT STATUS ; MOTEST IN MODS ANI MTBE RET ; ; INITMODEM ; ORGMOD MVI A,003 OUT MODS MVI A,MODINIT OUT MODS RET ; ;TURN TRANSMITTER ON ; RFON LDA CRX ORI TON OUT CONTLR+1 STA CRX RET ; ;TURN  POP B LXI H,ASCII$CW-2FH MOV A,C CPI 20H JNZ CW1 MVI C,7 JMP DELAYX CW1 MVI B,0 DAD B MOV A,M ANI 7 RZ MOV B,A MOV A,M CW2 ADD A MVI E,1 JNC CW3 MVI E,3 CW3 PUSH B PUSH PSW CALL TONEON MOV C,E CALL DELAYX CALL TONEOFF MVI C,1 CALL DELAYX POP PSW POP B DCR B JNZ CW2 RET FINI LXI H,IDOFFMSG CALL WCS RET DELAYX MOV A,C ORA A RZ PUSH B PUSH D DLY1 LXI D,50 CALL DELAY DCR C JNZ DLY1 POP D POP B RET ; ;ENTER THIS DELAY RO ;: NOT USED DB 0 ;; NOT USED DB 0 ;< NOT USED DB 0 ;= NOT USED DB 0 ;> NOT USED DB 0 ;? NOT USED DB 0 ;@ NOT USED DB 2+01000000B ;A .- DB 4+10000000B ;B -... DB 4+10100000B ;C -.-. DB 3+10000000B ;D -.. DB 1+00000000B ;E . DB 4+00100000B ;F ..-. DB 3+11000000B ;G --. DB 4+00000000B ;H .... DB 2+00000000B ;I .. DB 4+01110000B ;J .--- DB 3+10100000B ;K -.- DB 4+01000000B ;L .-.. DB 2+11000000B ;M -- DB 2+10000000B ;N -. DB 3+11100000B ;O --- DB 4+01100000B ;a bits Stop bits Parity' DB CR,LF DB CR,LF,'1 7 2 Even' DB CR,LF,'2 7 2 Odd' DB CR,LF,'3 7 1 Even' DB CR,LF,'4 7 1 Odd' DB CR,LF,'5 8 2 None' DB CR,LF,'6 8 1 None' DB CR,LF,'7 8 1 Even' DB CR,LF,'8 8 1     Odd' DB CR,LF,LF DB 'Which Configuration Do You Wish ?',0 ; CONFMSG DB VT,CR,LF,LF DB ' 300 Baud Config. Table' DB CR,LF,'Config. Data bits Stop bits Parity' DB CR,LF DB CR,LF,'1 7 2 Even' DB CR,LF,'2 7 2 Odd' DB CR,LF,'3 7 1 Even' DB CR,LF,'4 7 1 Odd' DB CR,LF,'5 8 2 None' DB E WA3MEZ',0 CRX DS 1 CR1 DS 1 INCH DS 1 OUTCH DS 1 FLAG DS 1 ERROR DS 1 ERRFLG DS 1 PTR DS 2 SIZE DS 2 PERR DS 2 OERR DS 2 FERR DS 2 ; ; DATA BUFFER AREA ; STACK DS 64 IBUF DS 256 TBUF EQU $ ; END itter activated',CR,LF,0 XMTOFFMSG DB 'Transmitter deactivated',CR,LF,0 IDONMSG DB 'Sending identification',CR,LF,0 IDOFFMSG DB 'Identification sent',CR,LF,0 ; TERM MVI A,0 OUT CONTLR+1 JMP 0000 ;RESTART CP/M ; ; DATA AREA ; CALL$SIGN DB 'D10 FOR I=1 TO 6 20 PRINT 30 NEXT I 40 PRINT " AMATEUR LOG AND SEARCH PROGRAM" 50 PRINT " BY TRUMAN BOERKOEL, K8JUG" 60 PRINT " RCVD 26 JAN 78 / MODS F.B.GHOFULPO" 70 FOR I=1 TO 6 80 PRINT 90 NEXT I 100 CLEAR 4000 110 DIM D$(300),T$(300),ST$(300),B$(300),RS$(300) 120 DIM RR$(300),S$(300),R$(300) 130 INPUT"WHAT IS YOUR CALL";C$ 140 GOSUB 980 150 LET Q=1 160 GOSUB 560 170 PRINT 180 INPUT"COMMAND";A$ 190 IF A$=C$ THEN GOSUB 970 200 IF A$="ENTER" THEN GOSUB <>"LOG" THEN 350 320 PRINT:PRINT:PRINT:GOSUB 980:GOSUB 940 330 GOSUB 720:GOSUB 750:GOSUB 780:GOSUB 810:GOSUB 840 340 GOTO 170 350 IF A$="HALT" THEN STOP 360 PRINT"ILLEGAL COMMAND - RETYPE 'HELP' FOR INSTRUCTIONS" 370 GOTO 170 380 PRINT"INPUT DATE,TIME,STATION,BAND,RST SENT,RST RCVD"; 390 PRINT"# SENT,# RCVD" 400 I=Q 410 INPUT D$(I),T$(I),ST$(I),B$(I),RS$(I),RR$(I),S$(I),R$(I) 420 PRINT:GOSUB 940:GOSUB 910 430 Q=Q+1 440 RETURN 450 PRINT"STATION CALL"; 460 INPUT H$ 470 IF H$=C$ THEN GOSUB 970 CR,LF,'6 8 1 None' DB CR,LF,'7 8 1 Even' DB CR,LF,'8 8 1 Odd' DB CR,LF,LF DB 'Which Configuration Do You Wish ?',0 ; XMTONMSG DB 'Transmitter activated',CR,LF,0 XMTOFFMSG DB 'Transmitter deactivated',CR,LF,0 IDONMSG DB 'Sending identification',CR,LF,0 IDOFFMSG DB 'Identification sent',CR,LF,0 ; TERM MVI A,0 OUT CONTLR+1 JMP 0000 ;RESTART CP/M ; ; DATA AREA ; CALL$SIGN DB 'D380:GOTO 170 210 IF A$="END" THEN 710 220 IF A$="MOD" THEN Q=Q-1:PRINT"RE-ENTER DATA":GOTO 170 230 IF A$="80" THEN GOSUB 940:GOSUB 720:GOTO 170 240 IF A$="40" THEN GOSUB 940:GOSUB 750:GOTO 170 250 IF A$="20" THEN GOSUB 940:GOSUB 780:GOTO 170 260 IF A$="15" THEN GOSUB 940:GOSUB 810:GOTO 170 270 IF A$="10" THEN GOSUB 940:GOSUB 840:GOTO 170 280 IF A$="HELP" THEN GOSUB 560:GOTO 170 290 IF A$="SEARCH"THEN GOSUB 450:GOTO 170 300 IF A$="SEQ" THEN PRINT:PRINT:PRINT:GOSUB 980: GOSUB 870:GOTO 170 310 IF A$ 480 GOSUB 940 490 FOR K=1 TO 300 500 IF H$<>ST$(K) GOTO 530 510 PRINTD$(K)TAB(9);T$(K)TAB(16);ST$(K)TAB(29);B$(K)TAB(36); 520 PRINTRS$(K)TAB(41);RR$(K)TAB(48);S$(K)TAB(54);R$(K) 530 NEXT K 540 PRINT "SEARCH COMPLETED" 550 RETURN 560 PRINT"COMMAND MODE" 570 PRINT"LOG --- DISPLAY COMPLETE LOG 80-40-20-15-10" 580 PRINT"SEQ --- DISPLAY LOG ENTRIES SEQUENTIALLY" 590 PRINT"ENTER --- ENTERS NEW CONTACT INTO LOG" 600 PRINT"MOD --- MODIFY LOGS LAST ENTRY" 610 PRINT"HELP --- PRINTS    THESE INSTRUCTIONS" 620 PRINT"END --- END OF PROGRAM" 630 PRINT"80 --- DISPLAY 80 METER CONTACTS" 640 PRINT"40 --- DISPLAY 40 METER CONTACTS" 650 PRINT"20 --- DISPLAY 20 METER CONTACTS" 660 PRINT"15 --- DISPLAY 15 METER CONTACTS" 670 PRINT"10 --- DISPLAY 10 METER CONTACTS" 680 PRINT"SEARCH --- SEARCHES FOR CALL ON ANY AND ALL BANDS" 690 PRINT"HALT --- STOPS PROGRAM TYPE 'CONT' TO CONTINUE" 700 RETURN 710 END 720 FOR I=1 TO 300:IF B$(I)<>"80" GOTO 740 730S$(I)TAB(41);RR$(I)TAB(48);S$(I)TAB(54);R$(I) 930 RETURN 940 PRINT" RST SERIAL NO." 950 PRINT"DATE TIME STATION BAND SENT RCVD SENT RCVD" 960 RETURN 970 PRINT"T H A T ' S Y O U S T U P I D !!!":RETURN 980 PRINT:PRINT"***** AMATEUR LOG FOR ";C$;" *****":PRINT 990 RETURN 1000 END  A T ' S Y O U S T U P I D OR K>Q GOTO 900 890 I=K:GOSUB 910 900 NEXT K:RETURN 910 PRINTD$(I)TAB(9);T$(I)TAB(16);ST$(I)TAB(29);B$(I)TAB(36); 920 PRINTR10 DIM N(100) 20 PRINT "HANDY HAM PROGRAMS" 30 PRINT "COPYWRIGHT WILLIS SOFTWARE SYSTEMS 1978" 40 PRINT "5192 CRYSTAL DRIVE CHARLESTON W. VA." 50 'CNTRL 3,2 60 PRINT 70 PRINT " 1 OHMS LAW PROGRAM" 80 PRINT " 2 DESIGN DIPOLE ANTENNA" 90 PRINT " 3 DESIGN QUAD ANTENNA" 100 PRINT " 4 DESIGN BEAM ANTENNA" 110 PRINT " 5 CALCULATE PARALLEL RESISTANCES" 120 PRINT " 6 TO RETURN TO BASIC MONITER" 130 PRINT 140 PRINT 150 INPUT "ENTER NUMBER OF OPTION DESIRED AND PRESS RET KEY  410 PRINT 420 GOTO 470 430 R=E/I 440 PRINT "R=";R 450 PRINT 460 PRINT 470 PRINT "DO YOU WANT TO DO ANOTHER Y OR N " 480 LINE INPUT ;R$ 490 IF R$="Y" GOTO 210 500 GOTO 60 510 REM 520 REM DESIGN BEAM ANTENNA 530 PRINT " DESIGN VHF" 540 PRINT 550 PRINT " BEAM ANTENNA" 560 PRINT 570 REM 580 REM 590 REM 600 PRINT 610 PRINT " ENTER" 620 PRINT 630 PRINT "FREQUENCY IN MHZ" 640 PRINT 650 PRINT 660 INPUT ;F 670 D=5600/F 680 A=D*.05 690 R1=D+A 700 A1=D*.05 710 D1=D-N.=";S3 900 PRINT "-----------------";"D2 IN.=";D2 910 PRINT " ! ^ " 920 PRINT " ! ^ ";"S4 IN.=";S4 930 PRINT "-----------------";"D3 IN.=";D3 940 LINE INPUT "DO YOU WANT TO DO ANOTHER YES OR NO";Y$ 950 IF Y$="YES" THEN 520 960 GOTO 60 970 REM DESIGN DIPOLE ANTENNA 980 PRINT " DESIGN" 990 PRINT "DIPOLE ANTENNA" 1000 PRINT 1010 PRINT " ENTER" 1020 PRINT "FREQUENCY IN MHZ." 1030 PRINT 1040 PRINT 1050 PRINT 1060 PRINT 1070 PRINT 1080 PRINT 1090 PRINT 1 GOSUB 910 740 NEXT I:RETURN 750 FOR I=1 TO 300:IF B$(I)<>"40" GOTO 770 760 GOSUB 910 770 NEXT I:RETURN 780 FOR I=1 TO 300:IF B$(I)<>"20" GOTO 800 790 GOSUB 910 800 NEXT I:RETURN 810 FOR I=1 TO 300:IF B$(I)<>"15" GOTO 830 820 GOSUB 910 830 NEXT I:RETURN 840 FOR I=1 TO 300:IF B$(I)<>"10" GOTO 860 850 GOSUB 910 860 NEXT I:RETURN 870 GOSUB 940:FOR K=1 TO 300 880 IF K<0 OR K>Q GOTO 900 890 I=K:GOSUB 910 900 NEXT K:RETURN 910 PRINTD$(I)TAB(9);T$(I)TAB(16);ST$(I)TAB(29);B$(I)TAB(36); 920 PRINTR";O 160 IF O=0 THEN 20 170 IF O>6 THEN 20 180 ON O GOTO 210,970,1270,520,1710,190 190 CNTRL 3,14 200 STOP 210 REM OHMS LAW 220 PRINT "ENTER E IN VOLTS, 0 IF UNKNOWN" 230 INPUT ;E 240 PRINT "ENTER I IN AMPS, 0 IF UNKNOWN" 250 INPUT ;I 260 PRINT "ENTER R IN OHMS, 0 IF UNKNOWN" 270 INPUT ;R 280 IF E+I+R=0 GOTO 470 290 IF E=0 GOTO 330 300 IF I=0 GOTO 380 310 IF R=0 GOTO 430 320 GOTO 470 330 E=I*R 340 PRINT "E=";E 350 PRINT 360 PRINT 370 GOTO 470 380 I=E/R 390 PRINT "I=";I 400 PRINT A1 720 A2=D1*.02 730 D2=D1-A2 740 A3=D2*.02 750 D3=D2-A3 760 S1=492/F*12*2*.208 770 S2=492/F*12*2*.15 780 S3=492/F*12*2*.2 790 S4=492/F*12*2*.256 800 REM 810 PRINT "-----------------";"R1 IN.=";R1 820 PRINT " ! ^ " 830 PRINT " ! ^ ";"S1 IN.=";S1 840 PRINT "-----------------";"D IN.=";D 850 PRINT " ! ^ " 860 PRINT " ! ^ ";"S2 IN.=";S2 870 PRINT "-----------------";"D1 IN.=";D1 880 PRINT " ! ^ " 890 PRINT " ! ^ ";"S3 I100 PRINT 1110 INPUT ;A 1120 PRINT 1130 L=468/A/2 1140 PRINT "MHZ." 1150 PRINT " DIPOLE" 1160 PRINT "CUT AS FIGURE" 1170 PRINT 1180 PRINT 1190 PRINT "O-------O-------O" 1200 PRINT "!<-'L'->!<-'L'->!" 1210 PRINT 1220 PRINT " L=",L," FT" 1230 PRINT 1240 LINE INPUT "DO YOU WANT TO DO ANOTHER YES OR NO ";Y$ 1250 IF Y$="YES" THEN 970 1260 GOTO 60 1270 REM DESIGN QUAD ANTENNA 1280 PRINT "DESIGN QUAD ANTENNA" 1290 PRINT 1300 PRINT "ENTER" 1310 PRINT 1320 PRINT "FREQ   UENCY IN MHZ." 1330 PRINT 1340 PRINT 1350 PRINT 1360 PRINT 1370 PRINT 1380 PRINT 1390 PRINT 1400 PRINT 1410 INPUT F 1420 PRINT 1430 PRINT 1440 PRINT "ENTER" 1450 PRINT "ELEMENT SPACEING IN WAVE LENGTHS" 1460 INPUT A 1470 S=984/F*A 1480 D=246/F 1490 B=D*.05 1500 R=B+D 1510 T=R*4 1520 L=D*4 1530 PRINT "DREVEN ELEMENT" 1540 PRINT "LENGTH EACH SIDE" 1550 PRINT D," FT. " 1560 PRINT "TOTAL LENGTH" 1570 PRINT L," FT. " 1580 PRINT "REFLECTOR ELEMENT" 1590 PRINT "LENGTH EACH SIDE0 1800 PRINT "ENTER R , 0 TO STOP" 1810 INPUT "R= ";N(X) 1820 IF N(X)=0 THEN 1840 1830 NEXT X 1840 PRINT "RESISTANCES ARE" 1850 R=0 1860 X=X-1 1870 FOR K=1 TO X 1880 PRINT "RESISTANCE OF R",K," IS",N(K)," OHMS" 1890 R=R+1/N(K) 1900 NEXT K 1910 R=1/R 1920 PRINT "TOTAL RESISTANCE IS",R," OHMS" 1925 PRINT 1930 LINE INPUT "DO YOU WANT TO DO MORE (YES OR NO) ";Y$ 1940 IF Y$="YES" THEN 1710 1950 GOTO 60 IS",R," OHMS" 1925 PRINT 1930 LINE INPUT "DO YOU WANT TO DO MORE (YES OR NO) ";Y$ 1940 I` MORSE CODE RECEIVER PROGRAMa V():Z: Z=-1 TO PRINT DOTS AND DASHES&a "SPEED";STYPE INDEX.DOC .LIB Macro utilities. .SY Program Us wit you TP I operatin system.  PUBLIC DOMAIN SOFTWARE INDEX PAGE 1 INDEX OF PUBLIC DOMAIN PROGRAMS AND DOCUMENTATION ================================================= Disk 1 BUSINESS. Disk 2 COMMUNICATIONS. Join the Bulletin Board network. Disk 3 GAMES. Disk 4 ADVENTURE GAME. Disk 5 PROGRAMMING LANGUAGES. PASCAL, C, Disk 6 PROGRAMMING UTILITIES. Disk 7 . ADV.COM 4 Adventure game for CP/M users. ADVI.DAT ADVI.PTR ADVT.DAT ADAVT.PTR ALIENS.COM 3 Space Invaders Game for CP/M. ALIENS.DOC ALTDSK.COM 9 Alternate disk format utility for EPSON. APPEND.ASM 9 Utility to append two files. ARCBLD.COM 9 File Archiving utility for CP/M. ARCDIR.COM ARCGET.COT.ASM 6 Allows entry/exit from DDT, CP/M. BANNER.ASM 6 Creates banners on any printer. BANZAI.ASM 9 Massive protection for CP/M files. BARGRAPH.BAS 1 Generates a 3-dimensional bar graph. BASIC-E.LBR 5 BASIC-E compiler and linker utility. BAS2-0.COM BAS2-1.COM RUN.COM RUN2-2.COM RUN3-3.COM RUNTIME.COM P FILE EXTENSION NOTES .ASM Assembly language source code. .BAS Basi Program Us you CP/ operatin syste an MBASI t ru thes programs Example A>MBASI B:BINGO.BAS .CMD Dbase II command file. .COM Program Us wit you CP/ operatin system. Example: A>ALTDISK  Example: A>ATXMODEM Al o th program an documentatio containe i thi packag ar know t b publi domai an n warrantie ar expresse o implied Implementatio an us o an progra i a th user' risk Epso use group an othe RBBS/RTP user ar suggeste a possibl sourc o assistance EPSON QX-10 is a registered trademark of EPSON AMERICA. MBASIC is a product of Microsoft Corporation. PROGRAMMING UTILITIES. Disk 8 UTILITIES. Disk 9 UTILITIES. Disk 10 UTILITIES. Disk 11 UTILITIES. Dis 1 SPECIA INTEREST EDUCATIONA AN SEVERA BASIC PROGRAM THAT REQUIRE SOME WORK. (INDEX) PUBLIC DOMAIN SOFTWARE INDEX PAGE 2 FILENAME DISK PURPOSE 3DBGRAPH.BAS 1 Draws a 3-dimensional bar graphM ARCHIVE.ASM 9 File Archiving utility for CP/M. ASSIGN.ASM 9 Utility to assign devices. ATXMODEM.SYS 2 Modem program for the EPSON QX-10. AUTOBOOT.ASM 9 Utilities for CP/M auto-boot functions. AUTOLOAD.ASM AUTOX.ASM AUTOCPM.ASM 9 Utility to automatically execute HELP.COM. BACCARAT.BAS 12 Baccarat. (Needs work). BACK2DDUBLIC DOMAIN SOFTWARE INDEX PAGE 3 FILENAME DISK PURPOSE BBSLIST.CMD 2 RBBS Dbase II routines and supporting files. BBSLIST.DBF BBSLIST.DOC BBSLIST.FRM BBSMAINT.CMD BBSSEARC.CMD BDLOC.ASM 9 BDOS locator for CP/M. BELL.SYS 2 Rings the bell. BH.BAS 3 MBASIC game of Black Hole. BINGO.BAS 12 Bingo. (Need   s work). BIO.BAS 12 MBASIC biorhythm generator. BIO-FF.BAS 12 MBASIC biorhythm generator for printers. BIORYTH.ASC 12 Biorhythm generator for MBASIC. BISHOW16.ASM 6 Bidirectional file scrolling utility. BKSWITCH.DOC 6 Documentation of bank switching technique. BLACKBOX.BAS 12 Logic game. (Needs work) BLAKJACK.BAS 3 Blackjack for MBASIC. BLASIC. CALC.BAS 1 Calculator emulator for MBASIC. CALLERS. 2 List of all callers to RBBS. CALLS.ASM 2 Counts login attempts and successes. CAMEL.BAS 3 Game in tokenized BASIC. PUBLIC DOMAIN SOFTWARE INDEX PAGE 4 FILENAME DISK PURPOSE CASM.C 6 Utilities for 'C' to MAC conversions. CASM.COM CASM.DOC LTR.ASM 9 Converts MAST.CAT to SuperSort format. CCPPATCH.ASM 9 Utility to auto check drive A for COM files. CDIR.C 9 Utility to allow named user areas. CDOSCPM.COM 9 CDOS for CP/M. CDOSCPM.DOC CHASE.BAS 3 MBASIC game, avoid robots. CHAT.COM 2 Utility to talk to the SYSOP. CHECKERS.BAS 3 MBASIC game of checkers. CHEK15.ASM 9 UNT.BAS 2 RBBS utility. PUBLIC DOMAIN SOFTWARE INDEX PAGE 5 FILENAME DISK PURPOSE COUNTERS. 2 Data file for RIBBS. CP-2.C 9 Mass file copier for 'C'. CPM/PERT.BAS 1 CP/M and PERT emulator for MBASIC. CPMGEN.COM 9 Transfers CP/M to a disk. CPMHDOS.ABS 9 CP/M to HDOS conversion utility (language?) CPMUTIL.ASM R.BAS 1 Statistical Analysis utilities for MBASIC. CRYPT.C 6 Encryption program for 'C'. D.COM 10 Extended directory program. D.DOC DATABASE.ASC 1 Database utility for MBASIC. READ.ME 1 Formatting utilities for dBase II output. PRINT.MEM SCREEN.MEM DBFORMAT.BAS 1 Data base formatter for MBASIC. DBPRNTXT.LBR 1 Multi-lKFRI2.ASC 1 Stock market emulator. BLKJCK.BAS 12 Blackjack. (Needs work) BLOCKREF.ASM 6 Cross reference CP/M with a disk sector. BOARDS.LST 2 A list of RCPM boards. BOGGLE.BAS 3 Boggle word game for MBASIC. BUBLSORT.BAS 9 A bubble sort routine for MBASIC. BYE.SYS 2 Logoff Utility for RBBS. CAL.BAS 1 Business calendar utility for MB CASM.MSG CASM.SUB DEFF2-01.CRL DEFF2-01.CSM DEFF2A01.CSM CASTLE1.BAS 3 CP/M MBASIC version of CASTLE. CASTLE.DOC Documentation for CASTLE-1.BAS. CAT.COM 6 Extended directory utility. CAT.SUB CAT2.COM FDCAT.DOC FMAP.COM UCAT.COM CATALOG.ASM 9 Gets a directory of MAST.CAT. CATFI CRC file check program. CIVILWAR.BAS 3 MBASIC game of Civil War strategy. CKSUM.ASM 9 Checksum utility for CP/M files. CLS.ASM 6 Clears the screen (character code 26). CODE.BAS 12 Tokenized morse code decoder. What BASIC? COMMSN.BAS 1 Computes stock broker commisions. COMMSN.DOC CONCEN.BAS 3 MBASIC version of game show Concentration. CO9 CP/M 8080 utilities. CPU.ASM 9 CPU identifier utility. CRC.COM 9 Generates CRC codes for files. CRCK.SYS 10 CRC generator CRCK44.ASM 9 CRC generator version 4.4. CRCK44.COM CRCK-51.ASM 9 CRC generator. CRCLIB.MAC 6 CRC subroutines in 8080 code. CREATE.BAS 12 Checkbook utility. (BASIC for what PC?) CRUNCHEine text printer for dBase II. DD.COM 8 Extended directory program. DECISION.ASC 1 Executive decision maker for MBASIC. DEEPSPAC.BAS 3 Space exploration game for MBASIC. DEPREC.BAS 1 Depreciation analysis for MBASIC. DEVAL.COM 10 VALDOCS files to ASCII. (EPSON) DEVILS.BAS 3 Adventure game for MBASIC. PUBLIC DOMAIN SOFTWARE INDEX PAGE 6     FILENAME DISK PURPOSE DIALER.BAS 2 Auto dial to Smartmodem from MBASIC. DIF-SSED.DOC 8 UNIX derived CP/M utility to update files. DIF.RNO DIF2.COM DIF2.C 9 Differential file comparison utility for 'C'. DIRR.COM 8 Extended directory program. DISASM.DOC 8 Documentation for DISASM.COM. DISASM.COM 8 Converts a hex firy test. EDITM.COM 7 Enhanced line editor for CP/M. EDITM.DOC EDTEXT.ASC 6 Text editor for MBASIC. ELEGY.ENG 12 Cute poem for engineers--LIST file. ELIZA.COM 3 ELIZA for CP/M (still need overlay file). EMPRDISK.BAS 3 Galactic Empire-MBASIC game. ENTBBS24.BAS 2 RBBS 2.5--subsystem routine. EPROM.ASM 9 Utility to program 2708 and 271 Extended directory utility. FILE14.ASM 7 List all files on all user areas. FILFND12.ASM 7 List all files on all user areas. FINANCE.BAS 12 FIND.ASM 6 Locate a string within a file. FINDBAD.COM 6 Utility to troubleshoot flawed diskettes. FINDVAR.BAS 6 Find variables used in MBASIC programs. FLITPLAN.BAS 12 Flight plan simulator for MBASIC. SIC. GENHEX.COM 6 Generates a hexfile from a COMfile. GO.ASM 6 Goes to specified hex address. GOBANG.BAS 3 MBASIC game like Pente without captures. GOTO11.ASM 10 Allows use of named user areas. HAMHELP.BAS 12 Ham radio utilities. HAMLINK4.ASM 12 Program to communicate w/remote radio sys. HAMLOG.BAS 12 Amateur ham log and search utility.  HELP2.CMD HELP2.ZIP HELP3.CMD HELP3.ZIP HELP4.CMD HELP4.ZIP HELP5.CMD HELP.COM 11 Online documentation program. ASM.HLP 11 Help files for HELP.COM use. ASM2.HLP C.HLP CBASIC.HLP CBASIC2.HLP CPM.HLP CPM2.HLP EBASIC.HLP HELP.HLP HELPCPM.ASM Help for CP/M. MAC.HLP le to ASM. DISSAM.ASM 8 Disassembles OBJ and COM files to Z80. DISSAM.COM DISSAM.DOC DOS.COM 8 System address locator utility. DU.COM 8 Disk Utilities. DU.DOC DU-V77.COM DU-V80.COM DU-V80.DOC DU-V81.ASM Disk Utility version 8.1. DU2.COM DUTIL.ASM DUTIL.COM DYNATEST.ASM 8 Dynamic memo6 EPROMs. EXTEND.ASM 7 Append a string to a file. EZCHECK.CBL 1 Electronic Checkbook Balancer. COBOL. FAST2MAN.DOC 5 Speeds up CP/M a lot (for v. 2.2) FAST.COM PUBLIC DOMAIN SOFTWARE INDEX PAGE 7 FILENAME DISK PURPOSE FED-TAX.BAS 1 1982 1040A form. FIGHTER.BAS 12 Crosshair shooting progrm for Mbasic. FILE-XT2.ASM 7 FLOPCOPY.ASM 7 Floppy disk and hard drive copier utility. FLOPCOPY.DOC FMAP3.ASM 7 Sorting file map. FORMAT.ASC 9 MBASIC input text fromatting utility. FORMHAM1.ASM 12 Hamming code error correction and detection. FORTH.COM 5 FORTH language for CP/M. FROMHARD.ASM 6 Copy files from floppy disk to hard drive. GAMMONB.BAS 3 Another backgammon for MBA HANGMAN.BAS 3 Hangman for MBASIC. HBACK.COM 9 Backup utility for hard drives. HBARGRAF.BAS 1 Horizontal bar graph for MBASIC. PUBLIC DOMAIN SOFTWARE INDEX PAGE 8 FILENAME DISK PURPOSE HELP.ASM 11 Source code for HELP.COM. HELP.CMD 1 Help files for DBase II. HELP.DBF HELP.NDX HELP1.CMD HELP1.ZIP  MASM.HLP MBASIC.HLP PASCAL.HLP INDEXER.BAS 9 INTEREST.BAS 1 MBASIC utility to compute interest payments. I/OCAP11.ASM 7 Capture all I/O in a buffer. INVEST.BAS 1 Investment extrapolation for MBASIC. JONLIFE.BAӠ 12 Gam o patter generation (Needs work) KID.BAS 12 Mimics type in large letters. (Needs work) LABELS.BAS 1 Ma   iling label printer for MBASIC. LABELS4.BAS 1 Mailing label utility 4.0 for MBASIC. LANES.BAS 3 Space Trader games for Mbasic. LCHECK.C 6 Checks for BEGIN/END clauses in 'C' programs. LCOPY.COM 8 COPYFAST program version 3.5. LDIR.COM 8 Library directory utility. CP/M. PUBLIC DOMAIN SOFTWARE INDEX PAGE 9 FILENAME DISK PURPOSE ompute interest payments from MBASIC. LOANPMTS.BAS 12 Calculate loan payments. (Needs work) LOCATE.ASM 8 Relocate a file. LPR.COM 8 Line printer format utility. LPR.C 9 Source code for LPR.COM. LPRINT.ASM 8 Set List Device to LPR or TTY. LPRINTF.C 9 Printer output formatter utility. LRUN20.ASM 8 LRUN 2.0--library execution utility. ds (MBASIC). MATH.DOC MBAS/XR.BAS 9 Variable/line number cross reference utility. MBASEDIT.BAS 7 Data entry and editor program. PUBLIC DOMAIN SOFTWARE INDEX PAGE 10 FILENAME DISK PURPOSE MBASIC.HLP 6 Help file for MBASIC. MBEAUT.BAS 9 Structures MBASIC programs. MBREM.BAS 9 Removes REM statements from MBASIC programs. BAS 1 Mortgage Analysis for MBASIC. MOVER.ASM 8 ROM relocator using bank switching. MYSTERY.BAS 12 How to frustrate a BASIC programmer in fun. NAMEADDR.BAS 1 Label utility for MBASIC. NASA.BAS 3 Apollo flight simulator for MBASIC. NUKEWAR.BAS 3 MBASIC game of atomic war vs. a computer. OSCAR.BAS 12 Determines orbits for antenna info. PAGE.COM.  PIPPATCH.ASM 7 Enhanced copy abilities for PIP.COM. PUBLIC DOMAIN SOFTWARE INDEX PAGE 11 FILENAME DISK PURPOSE PLINK.MAC 2 Modem buffer capture for CP/M. PLINK65.DOC POKER.BAS 3 Poker for MBASIC. POWERS.BAS 12 Calculates powers or factorials. (Needs work) PRGMCRT.BAS 9 MBASIC utility to format the CRT. PRIMES.BAS 12  LDIR.C 9 Source code for LDIR.SYS. LDIR.MSG 8 Message file regarding LDIR.C . LDIR.SYS 9 Library directory utility. CP/M. LINK.COM 5 Assembler with LINK capabilities. LINKASM.COM LINKASM.DOC LIST.SYS 10 Enhanced directory utility. LISTT.COM 6 Allows controlled printing of disk files. LISTT.DOC LOAN.BAS 1 C BUTTONS.LIB 7 Miscellaneous MACRO utilities. COMPARE.LIB DOWHILE.LIB I8085.LIB INTER.LIB NCOMPARE.LIB OSLIB.REL SELECT.LIB SEQIO.LIB SEQIO22.LIB SIMPIO.LIB STACK.LIB TREADLES.LIB WHEN.LIB MAILLIST.BAS 1 Mailing list and label maker for MBASIC. MATH.BAS 12 Addition tutor for ki MBXREF.BAS 9 Cross reference utility for MBASIC. MDIR21.ASM 8 Map Directory 2.1 for CP/M. MEMMAP.ASM 6 Display CP/M memory locations. MENU-V2.ASM 8 Utility for MBASIC, 'C', and COMfiles. MESSAGES. 2 Message file for RBBS. MILLION.BAS 3 MBASIC game to make a million. MONOPOLY.BAS 3 Monopoly for MBASIC users. MONOPD.DAT MORTGAGE. 7 Video formatted listing utility for CP/M. PAS2CPM.ASM 5 PASCAL utilities for CP/M. PASCAL.ASM PASCAL.COM PASCAL.DOC PASTOCPM.ASM PASSWORD.BAS 2 Assign password protection to files. PAYABLE2.BAS 1 Accounts payable utility for MBASIC. PAYROLL.BAS 1 Bookstore payroll sheet. MBASIC. PHONDAT2.BAS 1 Creates a data file of phone numbers.  Generates primes between inputted values. PWRBDGET.BAS 1 Power budget for UHF-VHF communications. QXBULLA.SYS 2 SYSGEN for RBBS for floppy disk. QXBULLB.SYS 2 SYSGEN for RBBS for hard disk. RALLY.BAS 3 MBASIC game to simulate a race car. RAMDISK.ASM 6 Creates a "dummy" disk drive in RAM. RAMDISK.DOC RBBSUTL.SYS 2 RCPMSYS.DOC 2 How to start an R   CPM. REALEVAL.BAS 1 Real estate evaluator for MBASIC. RECOVERY.ASC 1 Calc recovery value of investment, MBASIC. RESOURCE.COM 10 8080 disassembler utility. RESOURCE.DOC REZ.COM 10 Z80 disassembler. REZ.DOC RIBBS.SYS 2 The program which handles the Board. RPIP.ASM 7 PIP patch for multiple drive copies. SCRAMBL2.ASM 2 Scramble CP/M files PURPOSE SEND/REC.ASM 2 Send and receive files between CP/M machines. SEND.ASM SEND.COM SEND.DOC SEND.MBS SEND.SUB SENDRECV.DOC REC.COM SIZE.COM 10 File size utility. SLOT.BAS 3 Slot machine for MBASIC. SLSHIST.BAS 1 Sales History for MBASIC. SMALL-C.DOC 5 Small 'C' Compiler. SMALLC1.COM riangle solution. MBASIC. SPIP.COM 7 Enhanced file copy utility. SPOOLER.BAS 9 50 file spooler utility. STARTREK.BAS 3 Star Trek for MBASIC. STATWILD.ASM 7 Eliminates wild card option in STAT. STOCGRPH.BAS 1 Graph stock activity from MBASIC. STOCGRPH.DOC DRAWDATA.GRF STRIP.COM 7 Converts PRN files to ASM files. STRIP.DOC TICTAC.BAS 3 Tic-Tac-Toe for MBASIC. U.COM 7 Utility to move among user areas. ULTRAPLT.BAS 10 Pattern plotter for MBASIC. UNERA.CO Utilit t "unerase programs USERS. 2 BBRS report file. USER-8/8.ASM 2 Restrict user access. VALINDEX.COM 1 Index cross-reference for VALDOCS. VALMERGE.COM 1 Mailing list generator for VALDOCS.  Configures Winchester hard drives. WNCONFIG.SYR Data file showing config. of hard drive. WORDSRCH.BAS 3 Word search game for MBASIC. WTEST.COM 9 Winchester hard drive test utility. WUMP.BAS 3 Hunt the WUMPus in MBASIC. XCAT37.COM 7 Another extended directory utility. XCAT37.DOC XDIR.COM 9 Extended directory program. XLATE2.COM 7  using an 8-byte password. SCRAMBLE.DOC Protection utility for CP/M. SD.SYS 10 Directory utility. SECRET.CTL 2 Modem utility called by RBBS. SECTION.ASM 10 Allows named user areas. SECURITY.ASM 2 Loader program to foil pirates. SECURSYS.DOC Suggestions to foolproof your board. PUBLIC DOMAIN SOFTWARE INDEX PAGE 12 FILENAME DISK SMALLC2.COM STDIO.H LIB.C SORBAS01.COM 10 Conversion utility for Sorcerer 3.0. SORBAS01.DOC SORT.ASC 9 Sort routines for MBASIC. SORT.BAS SORT3.BAS 9 Matrix search for MBASIC. SORTDIR.COM 7 Alphabetized directory utility. SPECIFIC.BAS 12 MBASIC program to calculate specific heat. SPHERE.BAS 12 Sperical tSUMMARY. 2 Summary file for RBBS. SURVEY.COM 8 System surveyor utility (?). SWORDS.BAS 3 MBASIC game (adventure). PUBLIC DOMAIN SOFTWARE INDEX PAGE 13 FILENAME DISK PURPOSE SYSHELP.COM 8 Help utility for the system--inescapable. TAG.ASM 10 Prevents copying of files. TESTMAKR.BAS 12 MBASIC program to create tests.  VALMERGE.DOC VLIST.COM 6 Control CRT scroll. VLIST.DOC WALL-ST.BAS 3 Stock Market Simulator for MBASIC. WASH.COM 7 Handy disk utility (SIG/M). WHATSNEW.COM 7 Identifies new and deleted files. WHATSNEW.DOC WIPE.ASM 10 Utility to erase PRN, HEX, SYM, REL, BAK fil. WKDAY.BAS 10 Day of week utility. MBASIC. WNCONFIG.COM 9  Translates 8080 code to Z80. XLATE.MAC PUBLIC DOMAIN SOFTWARE INDEX PAGE 14 FILENAME DISK PURPOSE XMODEM.DOC 2 Documentation for XMODEM.SYS. XMODEM.SYS 2 File transfer utility program. XMODEM74.MOD 2 Mod to XMODEM 7.4 to limit xfer time. Z80.LIB 7 Z80.RDF 7 Commentary on the Z80 microprocessor. Z80ASM.COM 1   0 Z80 assembler with documentation. Z80ASM.DOC Z80ASM.MSG ZCMD.ASM 5 Z80 Command Processor 1.0 (NZCPR v.1.0). ZCMD.DOC ZPASS.ASM ZPIP 10 File copy utility. PUBLIC DOMAIN SOFTWARE INDEX PAGE 15                                                                          !   !   "   "   #   #   $   $   %   %   &   &   '   '