A database written in BBC Basic

   10 REM A database that uses a record structure and a sequential file.
   20 DIM details{name$, phone$, email$,response%(1,10)}
   30 DIM contact{(100)} = details{}
   40 DIM temp{(1)} = contact{(100)}
   50 counter = 0
   60 FOR d = 1 TO 100
   70   FOR c = 1 TO 10
   80     contact{(d)}.response%(1,c) = 0
   90   NEXT c
  100 NEXT d
  110 REPEAT
  120   PRINT
  130   PRINT"1. Create a record."
  140   PRINT"2. Save records to file."
  150   PRINT"3. Delete a record."
  160   PRINT"4. Sort records."
  170   PRINT"5. List records."
  180   PRINT"6. Search for a record."
  190   PRINT"7. Input a reply from a contact method."
  200   PRINT"8. List total number of different responses."
  210   PRINT"9. Load file."
  220   PRINT"10. Exit."
  230   INPUT"Choose... "choice
  240   PRINT
  250   IF choice = 1 THEN PROCcreate
  260   IF choice = 2 THEN PROCsave
  270   IF choice = 3 THEN PROCdelete
  280   IF choice = 4 THEN PROCsort
  290   IF choice = 5 THEN PROClist
  300   IF choice = 6 THEN PROCsearch
  310   IF choice = 7 THEN PROCresponse
  320   IF choice = 8 THEN PROClistresponse
  330   IF choice = 9 THEN PROCload
  340 UNTIL choice = 10
  350 END
  360
  370 DEFPROCcreate
  380 counter = counter + 1
  390 INPUT"Name " contact{(counter)}.name$
  400 INPUT"Phone number ",contact{(counter)}.phone$
  410 INPUT"Email address ", contact{(counter)}.email$
  420 ENDPROC
  430
  440 DEFPROCsave
  450 phonenos=OPENOUT "Phonenos.txt"
  460 PRINT "File Name Phonenos.txt Opened as Channel ";phonenos
  470 PRINT
  480 FOR j= 1 TO counter
  490   PRINT#phonenos,contact{(j)}.name$,contact{(j)}.phone$,contact{(j)}.email$
  500   FOR f = 1 TO 10
  510     PRINT#phonenos, contact{(j)}.response%(1,f)
  520   NEXT f
  530  
  540 NEXT j
  550 CLOSE#phonenos
  560 PRINT "Data saved."
  570 ENDPROC
  580
  590 DEFPROCdelete
  600 INPUT"Enter the name of a record you wish to delete "delete$
  610 FOR h = 1 TO counter
  620   IF contact{(h)}.name$ = delete$ THEN
  630     FOR loop = h TO counter
  640       contact{(loop)}.name$ =  contact{(loop+1)}.name$
  650       contact{(loop)}.phone$ = contact{(loop+1)}.phone$
  660       contact{(loop)}.email$ = contact{(loop+1)}.email$
  670     NEXT loop
  680     counter = counter -1
  690   ENDIF
  700 NEXT h
  710 ENDPROC
  720
  730 DEFPROCsort
  740 REPEAT
  750   noswaps = TRUE
  760   FOR t = 1 TO counter - 1
  770     IF contact{(t)}.name$ > contact{(t+1)}.name$ THEN PROCswap
  780   NEXT t
  790 UNTIL noswaps = TRUE
  800 ENDPROC
  810
  820 DEFPROClist
  830 CLS
  840 h = 0
  850 FOR g = 1 TO counter
  860   h = h +1
  870   PRINT
  880   PRINT"Record number ";g
  890   PRINT contact{(g)}.name$
  900   PRINT contact{(g)}.phone$
  910   PRINT contact{(g)}.email$
  920   PRINT
  930   IF h = 3 THEN
  940     INPUT"More... type Y or y for yes, or N or n for no "reply$
  950     IF reply$ = "Y" OR reply$ = "y" THEN
  960       PRINT"PRESS ANY KEY TO CONTINUE."
  970       TEMP = GET
  980       h = 0
  990     ELSE
 1000       IF reply$ = "N" OR reply$ = "n" THEN EXIT FOR
 1010     ENDIF
 1020   ENDIF
 1030 NEXT g
 1040 ENDPROC
 1050
 1060 DEFPROCswap
 1070 temp{(1)} = contact{(t)}
 1080 contact{(t)}= contact{(t+1)}
 1090 contact{(t+1)} = temp{(1)}
 1100 noswaps = FALSE
 1110 ENDPROC
 1120
 1130 DEFPROCsearch
 1140 INPUT"Enter the name of a record to look for "person$
 1150 FOR i = 1 TO counter
 1160   IF contact{(i)}.name$ = person$ THEN
 1170     PRINT
 1180     PRINT contact{(i)}.name$
 1190     PRINT contact{(i)}.phone$
 1200     PRINT contact{(i)}.email$
 1210     PRINT"Number of replys from the following approaches:-"
 1220     PRINT"Phone ";contact{(i)}.response%(1,1)
 1230     PRINT"Email ";contact{(i)}.response%(1,2)
 1240     PRINT"Letter ";contact{(i)}.response%(1,3)
 1250     PRINT"Flyer ";contact{(i)}.response%(1,4)
 1260     PRINT"Word of mouth ";contact{(i)}.response%(1,5)
 1270     PRINT"Circulars ";contact{(i)}.response%(1,6)
 1280     PRINT"Visit ";contact{(i)}.response%(1,7)
 1290     PRINT"Advertising ";contact{(i)}.response%(1,8)
 1300     PRINT"Website ";contact{(i)}.response%(1,9)
 1310     PRINT"Publication ";contact{(i)}.response%(1,10)
 1320     PRINT
 1330   ENDIF
 1340 NEXT
 1350 ENDPROC
 1360
 1370 DEFPROCresponse
 1380 INPUT"Enter the name of a record to look for "person$
 1390 FOR i = 1 TO counter
 1400   IF contact{(i)}.name$ = person$ THEN
 1410     PRINT
 1420     PRINT contact{(i)}.name$
 1430     PRINT contact{(i)}.phone$
 1440     PRINT contact{(i)}.email$
 1450    
 1460     PRINT"Which contact method did you receive a response$ from, (p)hone, (e)mail,"
 1470     PRINT"(l)etter, (f)lyer, (w)ord of mouth, (c)irculars, (v)isit, (a)dvertising,"
 1480     PRINT"(we)bsite, (pu)ublication"
 1490     INPUT method$
 1500     IF method$ = "p" THEN contact{(i)}.response%(1,1) = contact{(i)}.response%(1,1) + 1
 1510     IF method$ = "e" THEN contact{(i)}.response%(1,2) = contact{(i)}.response%(1,2) + 1
 1520     IF method$ = "l" THEN contact{(i)}.response%(1,3) = contact{(i)}.response%(1,3) + 1
 1530     IF method$ = "f" THEN contact{(i)}.response%(1,4) = contact{(i)}.response%(1,4) + 1
 1540     IF method$ = "w" THEN contact{(i)}.response%(1,5) = contact{(i)}.response%(1,5) + 1
 1550     IF method$ = "c" THEN contact{(i)}.response%(1,6) = contact{(i)}.response%(1,6) + 1
 1560     IF method$ = "v" THEN contact{(i)}.response%(1,7) = contact{(i)}.response%(1,7) + 1
 1570     IF method$ = "a" THEN contact{(i)}.response%(1,8) = contact{(i)}.response%(1,8) + 1
 1580     IF method$ = "we" THEN contact{(i)}.response%(1,9) = contact{(i)}.response%(1,9) + 1
 1590     IF method$ = "pu" THEN contact{(i)}.response%(1,10) = contact{(i)}.response%(1,10) + 1
 1600   ENDIF
 1610 NEXT
 1620 ENDPROC
 1630
 1640 DEFPROClistresponse
 1650 one% = 0
 1660 two% = 0
 1670 three% = 0
 1680 four% = 0
 1690 five% = 0
 1700 six% = 0
 1710 eight% = 0
 1720 nine% = 0
 1730 ten% = 0
 1740 FOR a = 1 TO counter
 1750   one% = one% + contact{(a)}.response%(1,1)
 1760   two% = two% + contact{(a)}.response%(1,2)
 1770   three% = three% + contact{(a)}.response%(1,3)
 1780   four% = four% + contact{(a)}.response%(1,4)
 1790   five% = five% + contact{(a)}.response%(1,5)
 1800   six% = six% + contact{(a)}.response%(1,6)
 1810   seven% = seven% + contact{(a)}.response%(1,7)
 1820   eight% = eight% + contact{(a)}.response%(1,8)
 1830   nine% = nine% + contact{(a)}.response%(1,9)
 1840   ten% = ten% + contact{(a)}.response%(1,10)
 1850 NEXT
 1860 PRINT"Phone ";one%
 1870 PRINT"Email ";two%
 1880 PRINT"Letter ";three%
 1890 PRINT"Flyer ";four%
 1900 PRINT"Word of mouth ";five%
 1910 PRINT"Circular ";six%
 1920 PRINT"Visit ";seven%
 1930 PRINT"Advertising ";eight%
 1940 PRINT"Website ";nine%
 1950 PRINT"Publication ";ten%
 1960 ENDPROC
 1970
 1980 DEFPROCload
 1990 phonenos=OPENIN "Phonenos.txt"
 2000 PRINT "File Name Phonenos.txt Opened as Channel ";phonenos
 2010 PRINT
 2020 REPEAT
 2030   counter = counter + 1
 2040   INPUT#phonenos,contact{(counter)}.name$,contact{(counter)}.phone$,contact{(counter)}.email$
 2050   FOR e = 1 TO 10
 2060     INPUT#phonenos, contact{(counter)}.response%(1,e)
 2070   NEXT e
 2080 UNTIL EOF#phonenos
 2090 CLOSE#phonenos
 2100 ENDPROC
 2110

Program listings for BBC Basic

   10 REM A PROGRAM TO GUESS RANDOM SHAPES AND ARRIVE AT AN E.S.P. RATING
   20 CORRECT = 0
   30 GUESS=0
   40 TRIANGLE = 0
   50 CIRC = 0
   60 SQUARE = 0
   70 OBLONG = 0
   80 TRIANGLECORRECT = 0
   90 CIRCCORRECT = 0
  100 SQUARECORRECT = 0
  110 OBLONGCORRECT = 0
  120 PRINT"THIS IS A PROGRAM TO GUESS RANDOM SHAPES."
  130 REPEAT
  140   CLS
  150   SHAPE = RND(4)
  160   GUESS = GUESS + 1
  170   INPUT"ENTER A NUMBER, 1 TRIANGLE, 2 CIRCLE, 3 SQUARE, 4 OBLONG.",NUMBER
  180   IF NUMBER = SHAPE PRINT"CORRECT." : CORRECT = CORRECT +1 ELSE PRINT"INCORRECT."
  190   IF NUMBER = SHAPE AND NUMBER = 1 THEN TRIANGLECORRECT = TRIANGLECORRECT + 1
  200   IF NUMBER = SHAPE AND NUMBER = 2 THEN CIRCCORRECT = CIRCCORRECT + 1
  210   IF NUMBER = SHAPE AND NUMBER = 3 THEN SQUARECORRECT = SQUARECORRECT + 1
  220   IF NUMBER = SHAPE AND NUMBER = 4 THEN OBLONGCORRECT = OBLONGCORRECT + 1
  230   PRINT CORRECT, " OUT OF "; GUESS
  240   IF SHAPE = 1  PROCTRIANGLE : TRIANGLE = TRIANGLE + 1
  250   IF SHAPE = 2 PROCCIRCLE : CIRC = CIRC + 1
  260   IF SHAPE = 3 PROCSQUARE : SQUARE = SQUARE + 1
  270   IF SHAPE = 4 PROCOBLONG : OBLONG = OBLONG + 1
  280   PRINT"PRESS ANY KEY TO CONTINUE."
  290   TEMP = GET
  300   INPUT"CONTINUE Y/y, N/n ",REPLY$
  310   IF REPLY$="y" OR REPLY$="Y" OR REPLY$="n" OR REPLY$="N" GOTO 320 ELSE GOTO 300
  320 UNTIL REPLY$="n" OR REPLY$="N"
  330 PROCDISPLAYRESULTS
  340 END
  350 DEF PROCTRIANGLE
  360 GCOL 0,1
  370 MOVE 100,600
  380 DRAW 200,700
  390 DRAW 300, 600
  400 DRAW 100,600
  410 ENDPROC
  420 DEF PROCCIRCLE
  430 GCOL 0,1
  440 MOVE 200, 600
  450 PLOT  145, 0,100
  460 ENDPROC
  470 DEF PROCSQUARE
  480 GCOL 0,1
  490 MOVE 100, 600
  500 DRAW 100, 800
  510 DRAW 300, 800
  520 DRAW 300, 600
  530 DRAW 100, 600
  540 ENDPROC
  550 DEF PROCOBLONG
  560 GCOL 0,1
  570 MOVE 100, 600
  580 DRAW 100, 800
  590 DRAW 500, 800
  600 DRAW 500, 600
  610 DRAW 100, 600
  620 ENDPROC
  630 DEF PROCDISPLAYRESULTS
  640 CLS
  650 PRINT"NUMBER OF TRIANGLES ";TRIANGLE
  660 PRINT
  670 PRINT"AVERAGE PROBALITY OF TRIANGLE "; TRIANGLE/GUESS
  680 PRINT
  690 PRINT"YOUR PROBABILITY OF A TRIANGLE ";TRIANGLECORRECT/GUESS
  700 PRINT
  710 PRINT"NUMBER OF CICLES ";CIRC
  720 PRINT
  730 PRINT"AVERAGE PROBABILITY OF CIRCLE ";CIRC/GUESS
  740 PRINT
  750 PRINT"YOUR PROBILITY OF A CIRCLE ";CIRCCORRECT/GUESS
  760 PRINT
  770 PRINT"NUMBER OF SQUARES ";SQUARE
  780 PRINT
  790 PRINT "AVERAGE PROBABILITY OF SQUARE "; SQUARE/GUESS
  800 PRINT
  810 PRINT"YOUR PROBABILITY OF A SQUARE ";SQUARECORRECT/GUESS
  820 PRINT
  830 PRINT"NUMBER OF OBLONGS ";OBLONG
  840 PRINT
  850 PRINT"AVERAGE PROBABILITY OF OBLONG ";OBLONG/GUESS
  860 PRINT
  870 PRINT"YOUR PROBABILITY OF AN OBLONG ";OBLONGCORRECT/GUESS
  880 PRINT
  890 PRINT"EXPECTED NUMBER OF EACH SHAPE "; 0.25*GUESS
  900 PRINT
  910 PRINT"NUMBER OF GUESSES "; GUESS
  920 PRINT
  930 PRINT"NUMBER CORRECT ";CORRECT
  940 PRINT
  950 PRINT"YOUR AVERAGE PROBABILITY OF GUESSING RIGHT SHAPE ";CORRECT /GUESS
  960 ENDPROC