home *** CD-ROM | disk | FTP | other *** search
100 REM *********************************************************** 150 REM * RHEMA 1.0 * 200 REM * GREEK VOCABULARY DRILL SYSTEM * 220 REM * SORT SUB-PROGRAM * 250 REM * * 300 REM * COPYRIGHT 1987 BY DANIEL R. CRIDER * 350 REM * THIS PROGRAM IS RELEASED INTO THE PUBLIC DOMAIN * 400 REM * ON A SHAREWARE BASIS. PLEASE SEND $15 TO DANIEL CRIDER * 450 REM * FOR THE RIGHT TO USE THIS PROGRAM. THIS PROGRAM IS NOT * 500 REM * TO BE RE-SOLD OR RE-RELEASED WITH ANY COMMERCIAL * 550 REM * PACKAGE OR PROGRAM. * 600 REM * FOR NOTICE OF OTHER RIGHTS AND RESTRICTIONS PLEASE * 650 REM * SEE THE FILE RHEMA.DOC WHICH SHOULD BE SUPPLIED WITH * 700 REM * THIS PROGRAM. PLEASE MAIL YOUR PAYMENT AND ANY COMMENTS * 750 REM * TO: * 900 REM * DANIEL CRIDER * 950 REM * 6604 CERVANTES AVE * 1000 REM * FT. WORTH, TEXAS 76133 * 1050 REM * * 1070 REM ************************************************************ 1100 REM ************ SET UP ARRAYS 1150 DIM LI(30),US(30) 1160 DIM GC(6) 1170 FOR I=1 TO 6:GC(I)=0:NEXT I 1200 ML=0 1250 DIM W1$(12),W2$(12),WD(2,12) 1300 DIM LETT$(30,9),LN$(30),CN$(15) 1350 DIM ACC$(15,3) 1400 DIM EG$(30),GZ$(6) 1450 GOSUB 4700 1500 REM ************ LOAD ALPHABET 1550 PRINT 1600 PRINT TAB(36);"RHEMA 1.0" 1650 PRINT 1700 PRINT TAB(18);" COPYRIGHT 1987 BY DANIEL R. CRIDER" 1750 PRINT 1800 OPEN "I",1,"ALPHA.BAS" 1850 FOR I=1 TO 30 1950 PRINT "PLEASE STANDBY.....LOADING GREEK LETTERS ";I 2000 GOSUB 4850 2050 FOR J=1 TO 9 2100 LINE INPUT#1,AX$ 2150 LETT$(I,J)=MID$(AX$,13,6) 2200 NEXT J 2250 NEXT I 2300 PRINT 2350 FOR I=1 TO 15 2450 PRINT "...................LOADING GREEK ACCENTS ";I 2500 GOSUB 4850 2550 FOR J=1 TO 3 2600 LINE INPUT#1,AX$ 2650 ACC$(I,J)=MID$(AX$,13,6) 2700 NEXT J 2750 NEXT I 2800 PRINT 2850 CLOSE #1 2900 FOR I=1 TO 30:READ LN$(I):NEXT I 2950 FOR I=1 TO 15:READ CN$(I):NEXT I 3000 FOR I=1 TO 30:READ EG$(I):NEXT I 3020 FOR I=1 TO 6:READ GZ$(I):NEXT I 3050 PRINT 3100 PRINT 3150 PRINT "ENTER SOME NUMBER FOR THE RANDOM SEED" 3200 PRINT "THE SAME NUMBER USED EACH TIME WILL GIVE THE SAME DRILLS" 3250 RANDOMIZE 3300 REM ************ OPEN VOCABULARY FILE 3350 PRINT 3400 PRINT "PLEASE ENTER THE NAME OF YOUR VOCABULARY FILE" 3450 PRINT "STRIKE THE CARRIAGE RETURN KEY ONLY IF YOU WISH TO" 3500 PRINT "USE THE DEFAULT NAME OF VOCAB" 3550 PRINT "VOCABULARY FILE NAME....."; 3600 INPUT AX$ 3650 IF AX$="" THEN AX$="VOCAB" 3700 GOSUB 4850 3750 PRINT "VOCABULARY FILE NAME.....";AX$ 3800 AX$=AX$ + ".GRK" 3850 PRINT "PLEASE STANDBY...SCANNING VOCABULARY FILE" 3900 OPEN "R",#1,AX$,125 3950 FIELD #1,2 AS W1$(1),2 AS W1$(2),2 AS W1$(3),2 AS W1$(4),2 AS W1$(5),2 AS W1$(6),2 AS W1$(7),2 AS W1$(8),2 AS W1$(9),2 AS W1$(10),2 AS W1$(11),2 AS W1$(12),101 AS Y5$ 4000 FIELD #1,24 AS Y4$,2 AS W2$(1),2 AS W2$(2),2 AS W2$(3),2 AS W2$(4),2 AS W2$(5),2 AS W2$(6),2 AS W2$(7),2 AS W2$(8),2 AS W2$(9),2 AS W2$(10),2 AS W2$(11),2 AS W2$(12),2 AS KG$, 65 AS DF$ 4050 LR=1 4100 DL=0 4150 GET #1,LR 4160 GZ=CVI(KG$) 4170 GC(GZ)=GC(GZ)+1 4200 IF EOF(1) GOTO 4450 4250 WD(2,1)=CVI(W2$(1)) 4300 IF WD(2,1)=99 THEN DL=DL+1 4350 LR=LR+1 4400 GOTO 4150 4450 LR=LR-1 4500 GOTO 5150 4550 REM ************ RING BELL CODE 4600 PRINT CHR$(7);CHR$(7); 4650 RETURN 4700 REM ************ CLEAR SCREEN CODE 4750 PRINT CHR$(26) 4800 RETURN 4850 REM ************ CURSOR UP SCREEN CODE 4900 PRINT CHR$(11); 4950 RETURN 5000 REM ************ CURSOR DOWN SCREEN CODE 5050 PRINT CHR$(10); 5100 RETURN 5150 REM ************ DISPLAY MENU 5200 REM ************* RESET SOME VARIABLES BEFORE MENU DISPLAY 5210 LM$="N" 5250 SX$="" 5300 TX=0 5350 SU=0 5400 GOSUB 4700 5450 PRINT TAB(22);"CURRENTLY ";LR-DL;" VOCABULARY WORDS ON FILE" 5500 PRINT 5550 PRINT 5600 PRINT TAB(35);"RHEMA 1.0" 5650 PRINT TAB(25);"GREEK VOCABULARY DRILL SYSTEM" 5700 PRINT TAB(35);"SORT SUB-PROGRAM" 5750 PRINT 6050 PRINT TAB(25);"1-- PRINT VOCABULARY" 6150 PRINT TAB(25);"2-- END PROGRAM" 6200 PRINT 6250 PRINT 6300 PRINT TAB(28);"PLEASE ENTER YOUR CHOICE "; 6350 INPUT M 6400 IF M>2 OR M<1 THEN 6300 6450 ON M GOTO 31800,6500 6500 REM ************ END PROGRAM 6550 PRINT "READY TO QUIT? (Y OR N) "; 6600 INPUT X$ 6650 IF X$<>"Y" AND X$<>"N" THEN 6550 6700 IF X$="N" THEN 5150 6750 CLOSE #1 6800 SYSTEM 24100 REM ************ READ A WORD 24150 GET #1, TR 24200 EL$="" 24250 FOR I=1 TO 12 24300 WD(1,I)=CVI(W1$(I)) 24350 WD(2,I)=CVI(W2$(I)) 24400 EL$=EL$ + EG$(WD(2,I)) 24450 NEXT I 24455 X=INSTR(EL$,"GG") 24456 IF X=0 THEN 24460 24457 MID$(EL$,X,2)="NG" 24460 IF WD(1,1)<> 2 AND WD(1,1)<>10 AND WD(1,1)<>11 AND WD(1,1)<>12 AND WD(1,2)<> 2 AND WD(1,2)<>10 AND WD(1,2)<> 11 AND WD(1,2)<> 12 THEN 24470 24461 Z=WD(2,1) 24462 IF Z=1 OR Z=2 OR Z=6 OR Z=8 OR Z=9 OR Z=11 OR Z=17 OR Z=23 OR Z=27 OR Z=28 THEN EL$="H" + EL$:GOTO 24470 24464 EL$=MID$(EL$,1,1) + "H" + MID$(EL$,2,11) 24470 GZ=CVI(KG$) 24500 IF WD(2,1)=99 THEN TR=TR+1:GOTO 24150 24550 RETURN 31800 REM ************ PRINT ENTIRE VOCABULARY 31808 SH$="Y" 31810 PRINT "DO YOU WISH TO PRINT ACTUAL GREEK? "; 31815 INPUT SH$ 31817 IF SH$<>"Y" AND SH$<>"N" THEN 31810 31850 PRINT "DO YOU WISH TO PRINT OUT THE ENTIRE VOCABULARY? (Y OR N)"; 31900 INPUT AX$ 31950 IF AX$<>"Y" AND AX$<>"N" THEN 31850 32000 BV=1: LV=LR:IP=0 32050 IF AX$="Y" THEN 32550 32100 PRINT "DO YOU WISH TO PRINT OUT PART OF THE VOCABULARY? (Y OR N)"; 32150 INPUT AX$ 32200 IF AX$<>"Y" AND AX$<>"N" THEN 32100 32250 IF AX$="N" THEN 5150 32300 INPUT "ENTER FIRST WORD NUMBER TO LIST ";BV 32350 INPUT "ENTER LAST WORD NUMBER TO LIST ";LV 32400 IF BV<1 THEN BV=1 32450 IF LV>LR THEN LV=LR 32500 GOTO 32750 32550 PRINT "DO YOU WANT A SORTED LISTING? "; 32600 INPUT AX$ 32650 IF AX$<>"Y" AND AX$<>"N" THEN 32550 32700 IF AX$="Y" THEN 33000 32750 FOR TR=BV TO LV 32800 GOSUB 24100 32850 GOSUB 34800 32900 NEXT TR 32905 LPRINT STRING$(70,"*") 32910 LPRINT CHR$(12);CHR$(12) 32950 GOTO 5150 33000 REM ************ SORT ROUTINE ********************** 33050 GOSUB 4700:PRINT "STANDBY FOR SORT (THIS WILL TAKE A WHILE)" 33100 DIM SO$(LR), SO(LR) 33150 FOR TR=1 TO LR 33200 GOSUB 24100:PRINT "RECORD ";TR:GOSUB 4850 33250 FOR I=1 TO 11 33300 IF WD(2,I)=29 AND WD(2,I+1)=29 THEN WL=I-1:GOTO 33400 33350 NEXT I 33400 CD$="":FOR I=1 TO WL STEP 1 33450 Z=WD(2,I) 33550 ZX=Z+65 33600 IF Z=29 THEN ZX=64 33650 CD$=CD$+CHR$(ZX) 33700 NEXT I 33750 SO$(TR)=CD$:SO(TR)=TR 33800 NEXT TR 33850 PRINT 33900 PRINT "FIRST PASS COMPLETE, BEGINNING SECOND PASS":PRINT 33950 FOR I=1 TO LR-1 34000 FOR J=1 TO LR-1 34050 IF SO$(J)<SO$(J+1) THEN 34250 34100 TP$=SO$(J):TP=SO(J) 34150 SO$(J)=SO$(J+1):SO(J)=SO(J+1) 34200 SO$(J+1)=TP$:SO(J+1)=TP 34250 NEXT J 34270 GOSUB 4850:PRINT "WORD # ";I 34300 NEXT I 34350 PRINT "SORT COMPLETE....BEGINNING PRINTOUT" 34400 FOR SI=1 TO LR 34450 TR=SO(SI) 34500 IF TR<1 OR TR>LR THEN 34600 34550 GOSUB 24100:GOSUB 34800 34600 NEXT SI 34610 LPRINT STRING$(70,"*") 34650 LPRINT CHR$(12);CHR$(12) 34700 ERASE SO$, SO 34750 GOTO 5150 34800 REM ************ PRINT A WORD ROUTINE 34850 IP=IP+1 34860 IF SH$="N" AND IP<>9 THEN 35050 34870 IF SH$="N" AND IP=9 THEN 34950 34900 IF IP<>4 THEN 35050 34950 IP=1:LPRINT STRING$(70,"*") 35000 LPRINT CHR$(12) 35050 LPRINT STRING$(70,"*") 35100 LPRINT "WORD NUMBER ";TR;" WORD TYPE IS ";GZ$(GZ);" DEFINITION IS " 35150 LPRINT DF$ 35155 LPRINT 35157 IF SH$="N" THEN 35420 35160 FOR I = 1 TO 11 35170 IF WD(2,I)=29 AND WD(2,I+1)=29 THEN WL=I-1:GOTO 35190 35180 NEXT I 35182 IF WD(2,12)=29 THEN WL=11 35184 IF WD(2,12)<>29 THEN WL=12 35190 Z=WD(2,1) 35200 TX=INT((12-WL)/2)*6 35210 SX$="" 35220 IF WL<12 THEN SX$=" " 35230 FOR J=1 TO 3 35240 LPRINT TAB(TX); 35250 FOR I=1 TO WL 35260 Z=WD(1,I) 35270 LPRINT ACC$(Z,J); 35280 LPRINT SX$; 35290 NEXT I 35300 NEXT J 35310 LPRINT 35320 FOR J=1 TO 9 35330 LPRINT TAB(TX); 35340 FOR I=1 TO WL 35350 Z=WD(2,I) 35360 LPRINT LETT$(Z,J); 35370 LPRINT SX$; 35380 NEXT I 35390 LPRINT 35400 NEXT J 35410 LPRINT 35420 X=LEN(EL$) 35430 Y=40-X/2 35435 IF SH$="N" THEN Y=1 35440 LPRINT TAB(Y);EL$ 35450 LPRINT 35460 RETURN 43400 DATA "ALPHA","ALPHA-IOTA DIPTHONG","BETA","GAMMA","DELTA","EPSILON","ZETA" 43450 DATA "ETA","ETA-IOTA DIPTHONG","THETA","IOTA","KAPPA","LAMBDA","MU","NU" 43500 DATA "XI","OMICRON","PI","RHO","SIGMA","FINAL SIGMA","TAU","UPSILON" 43550 DATA "PHI","CHI","PSI","OMEGA","OMEGA-IOTA DIPTHONG","BLANK","HYPHEN" 43600 DATA "SMOOTH BREATH","ROUGH BREATH","ACUTE","CIRCUMFLEX","GRAVE" 43650 DATA "DIAERSIS","SMOOTH + GRAVE","SMOOTH + ACUTE", "SMOOTH + CIRC." 43700 DATA "ROUGH + GRAVE", "ROUGH + ACUTE", "ROUGH + CIRC.","CORONIS" 43750 DATA "APOSTROPHE","BLANK (NO MARK)" 43800 DATA "A","AI","B","G","D","E","Z","E","EI","TH","I","K","L","M","N" 43850 DATA "X","O","P","R","S","S","T","U","PH","CH","PS","O","OI"," ","-" 43860 DATA "VERB","NOUN","PRONOUN","ADJECTIVE","ADVERB","OTHER" ,"O","P","R","S"," 
