home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / EDUCATIN / HEBREW.LBR / SORT.BZS / SORT.BAS
BASIC Source File  |  2000-06-30  |  8KB  |  252 lines
  1. 100 REM ***********************************************************
  2. 110 REM *                    DABAR 1.0                            *
  3. 150 REM *           HEBREW VOCABULARY DRILL SYSTEM                *
  4. 175 REM *                SPECIAL SORT & PRINT                     *
  5. 200 REM *                                                         *
  6. 250 REM * COPYRIGHT 1986 BY DANIEL R. CRIDER                      *
  7. 300 REM *      THIS PROGRAM IS RELEASED INTO THE PUBLIC DOMAIN    *
  8. 350 REM * ON A SHAREWARE BASIS. PLEASE SEND $10 TO DANIEL CRIDER  *
  9. 400 REM * FOR THE RIGHT TO USE THIS PROGRAM. THIS PROGRAM IS NOT  *
  10. 450 REM * TO BE RE-SOLD OR RE-RELEASED WITH ANY COMMERCIAL        *
  11. 470 REM * PRODUCT OR PACKAGE                                      *
  12. 500 REM * FOR NOTICE OF OTHER RIGHTS AND RESTRICTIONS PLEASE      *
  13. 550 REM * SEE THE FILE HEBREW.DOC WHICH SHOULD BE SUPPLIED WITH   *
  14. 600 REM * THIS PROGRAM. PLEASE MAIL YOUR PAYMENT AND ANY COMMENTS *
  15. 950 REM * TO:                                                     *
  16. 1000 REM *                                                        *
  17. 1050 REM *       DANIEL CRIDER                                     *
  18. 1070 REM *       6604 CERVANTES                                *
  19. 1100 REM *       FT. WORTH, TEXAS 76133                            * 
  20. 1150 REM *                                                         *
  21. 1600 REM ************  SET UP ARRAYS
  22. 1650 DIM LI(30),US(30)
  23. 1700 ML=0
  24. 1750 DIM W$(9),W1$(9),W2$(9),WD(3,9)
  25. 1800 DIM CONS$(44,7), CN$(23)
  26. 1850 DIM VOW$(12,3)
  27. 1900 DIM FIN$(4,10)
  28. 1950 GOSUB 4750
  29. 2000 REM ************  LOAD ALPHABET
  30. 2005 PRINT
  31. 2010 PRINT TAB(36);"DABAR 1.0"
  32. 2020 PRINT
  33. 2030 PRINT TAB(24);"COPYRIGHT 1986 BY DANIEL R. CRIDER"
  34. 2040 PRINT
  35. 2050 OPEN "I",1,"LETTERS.BAS"
  36. 2100 FOR I=1 TO 44
  37. 2150 PRINT "PLEASE STANDBY.....LOADING HEBREW CONSONANTS ";I
  38. 2200 GOSUB 5150
  39. 2250 FOR J=1 TO 7
  40. 2300 LINE INPUT#1,AX$
  41. 2350 CONS$(I,J)=MID$(AX$,13,8)
  42. 2400 NEXT J
  43. 2450 NEXT I
  44. 2500 PRINT
  45. 2550 FOR I=1 TO 12
  46. 2600 PRINT "...................LOADING HEBREW VOWELS ";I
  47. 2650 GOSUB 5150
  48. 2700 FOR J=1 TO 3
  49. 2750 LINE INPUT#1,AX$
  50. 2800 VOW$(I,J)=MID$(AX$,13,8)
  51. 2850 NEXT J
  52. 2900 NEXT I
  53. 2950 PRINT
  54. 3000 FOR I=1 TO 4
  55. 3050 PRINT "...................LOADING SPECIAL CHARACTERS ";I
  56. 3100 GOSUB 5150 
  57. 3150 FOR J=1 TO 10
  58. 3200 LINE INPUT#1,AX$
  59. 3250 FIN$(I,J)=MID$(AX$,13,8)
  60. 3300 NEXT J
  61. 3350 NEXT I
  62. 3400 CLOSE #1
  63. 3450 FOR I=1 TO 23:READ CN$(I):NEXT I
  64. 3500 PRINT
  65. 3550 PRINT
  66. 3750 REM ************  OPEN VOCABULARY FILE
  67. 3800 PRINT
  68. 3850 PRINT "PLEASE STANDBY...SCANNING VOCABULARY FILE"
  69. 3900 OPEN "R",#1,"VOCAB",124
  70. 3950 FIELD #1,2 AS W$(1),2 AS W$(2),2 AS W$(3),2 AS W$(4),2 AS W$(5),2 AS W$(6),2 AS W$(7),2 AS W$(8),2 AS W$(9),106 AS Y$
  71. 4000 FIELD #1,18 AS Y3$,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),88 AS Y5$    
  72. 4050 FIELD #1,36 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),70 AS DF$
  73. 4100 LR=1
  74. 4150 DL=0
  75. 4200 GET #1,LR
  76. 4250 IF EOF(1) GOTO 4500
  77. 4300 WD(2,1)=CVI(W1$(1))
  78. 4350 IF WD(2,1)=99 THEN DL=DL+1
  79. 4400 LR=LR+1
  80. 4450 GOTO 4200
  81. 4500 LR=LR-1
  82. 4550 GOTO 5850
  83. 4600 REM ************ RING BELL CODE
  84. 4650 PRINT CHR$(7);CHR$(7);
  85. 4700 RETURN
  86. 4750 REM ************  CLEAR SCREEN CODE
  87. 4850 PRINT CHR$(26)
  88. 4900 RETURN
  89. 5150 REM ************  CURSOR UP SCREEN CODE
  90. 5250 PRINT CHR$(11);
  91. 5300 RETURN
  92. 5500 REM ************ CURSOR DOWN SCREEN CODE
  93. 5600 PRINT CHR$(10);
  94. 5650 RETURN
  95. 5850 REM ************  DISPLAY MENU
  96. 5900 SU=0
  97. 5950 GOSUB 4750
  98. 6000 PRINT TAB(22);"CURRENTLY ";LR-DL;" VOCABULARY WORDS ON FILE"
  99. 6050 PRINT
  100. 6100 PRINT
  101. 6150 PRINT TAB(34);"DABAR V. 1.0"
  102. 6160 PRINT TAB(25);"HEBREW VOCABULARY DRILL SYSTEM"
  103. 6175 PRINT TAB(35);"MASTER MENU"
  104. 6200 PRINT
  105. 6500 PRINT TAB(25);"1-- SORT AND PRINT VOCABULARY"
  106. 6600 PRINT TAB(25);"2-- END PROGRAM"
  107. 6650 PRINT
  108. 6700 PRINT
  109. 6750 PRINT TAB(28);"PLEASE ENTER YOUR CHOICE ";
  110. 6800 INPUT M
  111. 6850 IF M>2 OR M<1 THEN 6750
  112. 6900 ON M GOTO 32200,6950
  113. 6950 REM ************  END PROGRAM
  114. 7000 PRINT "READY TO QUIT? (Y OR N) ";
  115. 7050 INPUT X$
  116. 7100 IF X$<>"Y" AND X$<>"N" THEN 7000
  117. 7150 IF X$="N" THEN 5850
  118. 7200 CLOSE #1
  119. 7250 SYSTEM
  120. 23300 REM ************ READ A WORD *************************
  121. 23350 GET #1, TR
  122. 23400 FOR I=1 TO 9
  123. 23450 WD(1,I)=CVI(W$(I))
  124. 23500 WD(2,I)=CVI(W1$(I))
  125. 23550 WD(3,I)=CVI(W2$(I))
  126. 23600 NEXT I
  127. 23650 IF WD(2,1)=99 THEN TR=TR+1:GOTO 23350
  128. 23700 RETURN
  129. 32200 REM ************  PRINT ENTIRE VOCABULARY
  130. 32250 PRINT "DO YOU WISH TO PRINT OUT THE ENTIRE VOCABULARY? (Y OR N)";
  131. 32300 INPUT AX$
  132. 32350 IF AX$<>"Y" AND AX$<>"N" THEN 32250
  133. 32400 BV=1: LV=LR:IP=0
  134. 32450 IF AX$="Y" THEN 32850
  135. 32500 PRINT "DO YOU WISH TO PRINT OUT PART OF THE VOCABULARY? (Y OR N)";
  136. 32550 INPUT AX$
  137. 32600 IF AX$<>"Y" AND AX$<>"N" THEN 32500
  138. 32650 IF AX$="N" THEN 5850
  139. 32700 INPUT "ENTER FIRST WORD NUMBER TO LIST ";BV
  140. 32750 INPUT "ENTER LAST WORD NUMBER TO LIST ";LV
  141. 32800 GOTO 33050
  142. 32850 PRINT "DO YOU WANT A SORTED LISTING? ";
  143. 32900 INPUT AX$
  144. 32950 IF AX$<>"Y" AND AX$<>"N" THEN 32850
  145. 33000 IF AX$="Y" THEN 33300
  146. 33050 FOR TR=BV TO LV
  147. 33100 GOSUB 23300
  148. 33150 GOSUB 34950
  149. 33200 NEXT TR
  150. 33250 GOTO 5850
  151. 33300 REM ************ SORT ROUTINE **********************
  152. 33350 GOSUB 4750:PRINT "STANDBY FOR SORT (THIS MAY TAKE A WHILE)" 
  153. 33400 DIM SO$(LR), SO(LR)
  154. 33450 FOR TR=1 TO LR
  155. 33500 GOSUB 23300:PRINT "RECORD ";TR:GOSUB 5150
  156. 33550 FOR I=1 TO 8
  157. 33600 IF WD(2,I)=43 AND WD(2,I+1)=43 THEN WL=I-1:GOTO 33700
  158. 33650 NEXT I
  159. 33700 CD$="":FOR I=WL TO 1 STEP -1
  160. 33750 Z=WD(2,I)
  161. 33755 IF Z=24 THEN Z=22
  162. 33760 ZX=Z+65
  163. 33800 IF Z=43 THEN ZX=64
  164. 33850 CD$=CD$+CHR$(ZX)
  165. 33900 NEXT I
  166. 33950 SO$(TR)=CD$:SO(TR)=TR 
  167. 34000 NEXT TR
  168. 34050 PRINT 
  169. 34100 PRINT "FIRST PASS COMPLETE, BEGINNING SECOND PASS":PRINT
  170. 34150 FOR I=1 TO LR-1
  171. 34200 FOR J=1 TO LR-1
  172. 34250 IF SO$(J)<SO$(J+1) THEN 34500
  173. 34300 TP$=SO$(J):TP=SO(J)
  174. 34350 SO$(J)=SO$(J+1):SO(J)=SO(J+1)
  175. 34400 SO$(J+1)=TP$:SO(J+1)=TP
  176. 34450 GOSUB 5150:PRINT "I= ";I;" J= ";J
  177. 34500 NEXT J:NEXT I
  178. 34550 PRINT "SORT COMPLETE....BEGINNING PRINTOUT"
  179. 34600 FOR SI=1 TO LR
  180. 34650 TR=SO(SI)
  181. 34700 GOSUB 23300:GOSUB 34950
  182. 34750 NEXT SI
  183. 34800 LPRINT CHR$(12);CHR$(12)
  184. 34850 ERASE SO$, SO
  185. 34900 GOTO 5850
  186. 34950 REM ************ PRINT A WORD ROUTINE
  187. 35000 IP=IP+1
  188. 35050 IF IP<>4 THEN 35200
  189. 35100 IP=1:LPRINT STRING$(70,"*")
  190. 35150 FOR IZ=1 TO 17:LPRINT:NEXT IZ            
  191. 35200 LPRINT STRING$(70,"*")
  192. 35250 LPRINT "WORD NUMBER ";TR;" DEFINITION IS "
  193. 35300 LPRINT DF$
  194. 35350 Z=WD(2,1)
  195. 35400 LPRINT "   ";
  196. 35450 FOR I=1 TO 9
  197. 35500 Z=WD(1,I)
  198. 35550 LPRINT VOW$(Z,3);
  199. 35600 NEXT I
  200. 35650 LPRINT
  201. 35700 FOR J=1 TO 7
  202. 35750 FOR I=0 TO 9
  203. 35800 Z=WD(2,I)
  204. 35850 IF I<>0 THEN 36400
  205. 35900 Z2=WD(2,1)
  206. 35950 IF Z2<>18 AND Z2<>25 AND Z2<>30 AND Z2<>32 THEN 36350
  207. 36000 Z2=WD(3,1)
  208. 36050 IF J<4 OR J>6 THEN 36350
  209. 36100 Z3$=VOW$(Z2,J-3)
  210. 36150 Z4$=MID$(Z3$,4,3)
  211. 36200 LPRINT Z4$;
  212. 36250 GOTO 36400
  213. 36300 Z=WD(2,1)
  214. 36350 LPRINT "   ";
  215. 36400 IF I<>1 THEN 36750
  216. 36450 IF Z<>18 AND Z<>25 AND Z<>30 AND Z<>32 THEN 36750
  217. 36500 IF Z=18 THEN LPRINT FIN$(1,J);
  218. 36550 IF Z=25 THEN LPRINT FIN$(2,J);
  219. 36600 IF Z=30 THEN LPRINT FIN$(3,J);
  220. 36650 IF Z=32 THEN LPRINT FIN$(4,J);
  221. 36700 GOTO 36800
  222. 36750 LPRINT CONS$(Z,J);
  223. 36800 NEXT I
  224. 36850 LPRINT
  225. 36900 NEXT J
  226. 36950 FOR J=0 TO 3
  227. 37000 FOR I=0 TO 9
  228. 37050 Z2=WD(3,I)
  229. 37100 IF I<>0 THEN 37250
  230. 37150 LPRINT "   ";
  231. 37200 GOTO 37750
  232. 37250 IF I<>1 THEN GOTO 37650
  233. 37300 Z=WD(2,1)
  234. 37350 IF Z<>18 AND Z<>25 AND Z<>30 AND Z<>32 THEN 37650
  235. 37400 IF Z=18 THEN LPRINT FIN$(1,J+7);
  236. 37450 IF Z=25 THEN LPRINT FIN$(2,J+7);
  237. 37500 IF Z=30 THEN LPRINT FIN$(3,J+7);
  238. 37550 IF Z=32 THEN LPRINT FIN$(4,J+7);
  239. 37600 GOTO 37750
  240. 37650 IF J=0 THEN LPRINT "        ";
  241. 37700 IF J<>0 THEN LPRINT VOW$(Z2,J);
  242. 37750 NEXT I
  243. 37800 LPRINT
  244. 37850 NEXT J
  245. 37900 LPRINT
  246. 37950 RETURN
  247. 45050 DATA "ALEP","BET","GIMEL","DALET","HE","WAW","ZAYIN","HET","TET","YOD"
  248. 45100 DATA "KAP","LAMED","MEM","NUN","SAMEK","AYIN","PE","SADE","KOP","RES"
  249. 45150 DATA "SEEN","SHEEN","TAW"
  250. ET","TET","YOD"
  251. 45100 DATA "KAP","LAMED","MEM","NUN","SAMEK","AYIN","PE","SADE","KOP","RES"
  252. 45150 DATA "SEEN","