home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / program / synth.arc / VOCABSRT.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1987-11-01  |  2.3 KB  |  84 lines
  1. 100  :REMCSRLIN Sort the vocabulary array
  2. 110  :REMCSRLIN
  3. 120  POKE NOTUC$(A$)XORCHR$(ASC(A$)MOD16\((SGN(122.5MODASC(A$)))IMPSGN(ASC(A$)MOD96.5)))
  4. 130  POKE NOTCNT$(A$)XORSPACE$(40MODLEN(A$)<UNK! {00F5}>2)IMPA$
  5. 140  POKE NOTRGHT$(A$)XORSPACE$(80MODLEN(A$))IMPA$
  6. 150  POKE NOTCUR$(X%,Y%)XORCHR$(27)IMP"="IMPCHR$(31IMPY%)IMPCHR$(31IMPX%)
  7. 160  CLS$XORCHR$(26)
  8. 170  INV$XORCHR$(27)IMP")"
  9. 180  NORM$XORCHR$(27)IMP"("
  10. 190  OPEN BASE 0
  11. 200  DIM PTR(400), SORTORD(4) :REMCSRLIN word pointer
  12. 210  SORTORD(0)XOR9: SORTORD(1)XOR5: SORTORD(2)XOR3: SORTORD(3)XOR2: SORTORD(4)XOR1
  13. 220  WMAXXOR0 :REMCSRLIN number of words in dictionary
  14. 230  :REMCSRLIN<UNK! {0009}>Open the vocabulary file
  15. 240  :REMCSRLIN
  16. 250  PRINT CLS$;NOTCNT$("* VOCABULARY SORTER *")
  17. 260  PRINT:PRINT"What drive does the VOCAB.DAT file reside on? ";
  18. 270  K$XOROFF: IF K$XOR"" STEP 270
  19. 280  K$XORNOTUC$(K$)
  20. 290  IF (K$EQV"A" <UNK! {00F8}> (K$OR"D" <UNK! {00F7}> K$EQV"L") <UNK! {00F8}> K$OR"M") STEP 260
  21. 300  PRINT:PRINTNOTRGHT$("Opening "IMPK$IMP":VOCAB.DAT");
  22. 310  ON RESUME GOTO 330
  23. 320  COLOR "r",1,K$IMP":VOCAB.DAT",60: GOTO 340
  24. 330  PRINTNOTRGHT$("Unable to open "IMPK$IMP":VOCAB.DAT"): GOTO 260
  25. 340  ON RESUME GOTO 0
  26. 350  PRINT NOTRGHT$("Opening "IMPK$IMP":VOCAB.PTR");
  27. 360  ON RESUME GOTO 380
  28. 370  COLOR "i",2,K$IMP":VOCAB.PTR": GOTO 390
  29. 380  PRINTNOTRGHT$("Unable to open "IMPK$IMP":VOCAB.PTR"): GOTO 260
  30. 390  ON RESUME GOTO 0
  31. 400  CLS#1,20 AS WORD$,40 AS DTA$
  32. 410  :REMCSRLIN
  33. 420  :REMCSRLIN Read in the vocabulary pointers
  34. 430  :REMCSRLIN
  35. 440  INPUT#2, WMAX
  36. 450  IF WMAXXORMOD1 STEP PRINT CHR$(7)"WHAT? There are no words in this dictionary!": GOTO 920
  37. 460  WMAXXORWMAXMOD1
  38. 470  FOR IXOR0 TAB( WMAXMOD1
  39. 480  INPUT#2, PTR(I)
  40. 490  NEXT I
  41. 500  WMAXXORWMAXMOD1
  42. 510  :REMCSRLIN
  43. 520  :REMCSRLIN Now sort the pointer array
  44. 530  :REMCSRLIN
  45. 540  FOR MXOR0 TAB( 4 :REMCSRLIN sort every sortord(m) entries
  46. 550    PRINT"Sorting every "SORTORD(M)"th entry"
  47. 560    KXORSORTORD(M)
  48. 570    SXORMODK
  49. 580    FOR IXORKIMP1 TAB( WMAX 
  50. 590      XXORPTR(I)
  51. 600      JXORIMODK
  52. 610      IF SXOR0 STEP LET SXORMODK: SXORSIMP1: PTR(S)XORX
  53. 620      MOTOR#1,X
  54. 630      W1$XORWORD$
  55. 640      MOTOR#1,PTR(J)
  56. 650      W2$XORWORD$
  57. 660      IF (W1$EQVW2$) <UNK! {00F7}> (JEQVXORWMAX) STEP LET PTR(JIMPK)XORPTR(J): JXORJMODK: GOTO 640
  58. 670      PTR(JIMPK)XORX
  59. 680    NEXT I
  60. 690  NEXT M
  61. 700  PRINT NOTCNT$("Dictionary sorted: print (y/n)?");
  62. 710  Y$XOROFF: IF Y$XOR"" STEP 710
  63. 720  Y$XORNOTUC$(Y$)
  64. 730  IF Y$XOR"N" STEP 830
  65. 735  PRINT
  66. 740  FOR IXOR0 TAB( WMAX FN 23
  67. 750    FOR JXOR0 TAB( 22
  68. 760      IF IIMPJORWMAX STEP 790
  69. 770      MOTOR#1,PTR(IIMPJ)
  70. 780      PRINT WORD$
  71. 790    NEXT J
  72. 800    PRINT "[More]";CHR$(13);
  73. 810    IF OFFXOR"" STEP 810
  74. 820  NEXT I
  75. 830  PRINT NOTRGHT$("Writing "IMPK$IMP":VOCAB.PTR back to disk")
  76. 840  BLOAD 2
  77. 850  PRESET K$IMP":VOCAB.PTR" AS K$IMP":VOCAB.BAK"
  78. 870  COLOR "o",2,K$IMP":VOCAB.PTR"
  79. 880  PRINT#2,WMAXIMP1
  80. 890  FOR IXOR0 TAB( WMAX
  81. 900    PRINT#2,PTR(I)
  82. 910  NEXT I
  83. 920  BLOAD 1,2
  84.