home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 983.dms / 983.adf / Tutor / TAILOR (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-09-24  |  9KB  |  324 lines
  1.  'TAILOR PROGRAM -- COMPANION TO THE TUTOR PROGRAM OF THE
  2.  'TALKING SPELLER TUTOR  -- written by James W. Kummer
  3.  'COPYRIGHT 1987
  4.  DIM WORDS$(4,90),COUNT(4,90)
  5.  ON MOUSE GOSUB HITMOUSE  ' ----- DEFINE ENTRY POINT FOR MOUSE INTERRUPTS
  6.  MOUSE OFF
  7.  PRINT "TALKING SPELLER TUTOR - TAILOR PROGRAM - SHAREWARE"
  8.  PRINT "COPYRIGHT 1987 - NOT FOR RESALE - MAY BE GIVEN FREELY"
  9.  PRINT "PLEASE PAY FOR USE OF TUTOR, TAILOR & FILES - SEND $5 TO:"
  10.  PRINT "JAMES W. KUMMER "
  11.  PRINT "784 S. HOYT STREET, LAKEWOOD CO 80226"
  12.  PRINT
  13.  Q$="DO YOU WANT TO EDIT AN EGZISTING FILE"
  14.  SAY TRANSLATE$(Q$)
  15.  Q$="DO YOU WANT TO EDIT AN EXISTING FILE"
  16.  PRINT Q$;" (1)
  17.  Q$="OR CREATE A NEW ONE?"
  18.  SAY TRANSLATE$(Q$)
  19.  PRINT Q$;" (2)"
  20.  INPUT NEW2 
  21.  Q$="SPECIFY YOUR FILE NAME BY PATH (e.g. GERMAN1 - IF YOU BOOT WITH THIS DISK)"
  22.  PRINT Q$
  23.  Q$="SPECIHFY YOUR FILE NAME BY PATH"
  24.  SAY TRANSLATE$(Q$)
  25.  ON ERROR GOTO GOOF
  26. STARTER: 
  27.  PRINT "File Name? "
  28.  INPUT AME$
  29.  NWORD=0
  30.  IF NEW2=2 THEN DUNINPT ' ----- IF NEW FILE - DON'T INPUT
  31.  OPEN "I",#1,AME$
  32. ILOOP:
  33.  IF EOF(1) THEN CEOF           
  34.  INPUT #1,A$
  35.  LA=LEN(A$)
  36.  IF LA=0 THEN CEOF
  37.  Q$=SPACE$(LA)
  38.  IF A$=Q$ THEN CEOF
  39.  NWORD=NWORD+1
  40.  FOR I=1 TO 4 : WORDS$(I,NWORD)="" : NEXT I 
  41.  LEQ=INSTR(A$,"=") ' ------------------- LOCATION OF EQUAL-SIGN
  42.  LSEM=INSTR(A$,";") ' ------------------ LOCATION OF SEMICOLON
  43.  IF LEQ=0 THEN SIDE1
  44.    IF LSEM>LEQ THEN LSEM=0
  45.    LSEM2=INSTR(LEQ,A$,";") ' ----------- LOCATION OF 2nd SEMICOLON
  46.    IF LSEM2=0 THEN YEQ
  47.      L2=LA-LSEM2
  48.      WORDS$(4,NWORD)=MID$(A$,LSEM2+1,L2) ' ---- EXTRACT 4th FIELD
  49. YEQ:
  50.    IF LSEM2=0 THEN LSEM2=LA+1
  51.    L2=LSEM2-LEQ-1
  52.    WORDS$(3,NWORD)=MID$(A$,LEQ+1,L2) ' ---- EXTRACT 3rd FIELD
  53. SIDE1:
  54.    IF LSEM=0 THEN PART1
  55.      IF LEQ=0 THEN LEQ=LA+1
  56.      L2=LEQ-LSEM-1
  57.      WORDS$(2,NWORD)=MID$(A$,LSEM+1,L2) ' ---- EXTRACT 2nd FIELD
  58. PART1:
  59.   IF LEQ=0 THEN LEQ=LA+1
  60.   IF LSEM=0 THEN LSEM=LEQ
  61.   L2=LSEM-1
  62.   WORDS$(1,NWORD)=MID$(A$,1,L2)  ' ---- EXTRACT 1st FIELD
  63.  FOR J=1 TO 4
  64.    IF WORDS$(J,NWORD)<>"" THEN WORDS$(J,NWORD)=UCASE$(WORDS$(J,NWORD))
  65.    COUNT(J,NWORD)=LEN(WORDS$(J,NWORD))
  66.  NEXT J
  67.  GOTO ILOOP
  68. CEOF:            
  69.  CLOSE #1
  70. DUNINPT:
  71.   ON ERROR GOTO 0
  72.   KWORD=NWORD : IF KWORD=0 THEN KWORD=90
  73.   LINE (0,0)-(625,380),0,BF
  74. '-- DRAW UPPER-LEFT MOUSE BOX --  
  75.   LINE (5,5)-(280,65),3,BF
  76.   LOCATE 5,9
  77.   PRINT "ACCEPT GROUP"
  78.   LOCATE 6,9
  79.   PRINT "& EDIT NEXT"
  80. '-- DRAW UPPER-RIGHT MOUSE BOX --  
  81.   LINE (320,5)-(600,65),3,BF
  82.   LOCATE 5,55
  83.   PRINT "QUIT EDIT &"
  84.   LOCATE 6,55
  85.   PRINT "SAVE FILE"
  86. '-- DRAW LARGE BOX --
  87.   LINE (5,85)-(625,180),2,BF
  88.   LOCATE 12,8
  89.   PRINT " PHRASE GROUP #      "                   
  90.   L2=12
  91.   QSP$=SPACE$(69)
  92.   FOR I=1 TO 4
  93.   L2=L2+2
  94.   LOCATE L2,2  '-- FIELDS ON LINES 14,16,18,20 --
  95.   PRINT QSP$
  96.   NEXT I
  97. '-- DRAW "SAY" MOUSE BOXES --
  98.   LINE (580,103)-(635,128),3,BF
  99.   LOCATE 15,74
  100.   PRINT "SAY"
  101.   LINE (580,135)-(635,160),3,BF
  102.   LOCATE 19,74
  103.   PRINT "SAY"
  104.   MOUSE ON
  105. '-- CYCLE THRU EACH PHRASE GROUPS FOR EDITS --
  106.   FOR I=1 TO KWORD
  107.     COLOR 1,0
  108.     LOCATE 12,24
  109.     PRINT I
  110.     L2=12
  111.     FOR LA=1 TO 4  '-- DISPLAY PHRASE GROUP --
  112.       L2=L2+2
  113.       LOCATE L2,2
  114.       PRINT QSP$
  115.       LOCATE L2,3
  116.       PRINT WORDS$(LA,I)
  117.     NEXT LA
  118. TYPE1:
  119.     KLINE=14 : KCHAR=1 : LA=1 : KOL=3 : COLOR 1,0
  120. TYPE2:
  121.     LOCATE KLINE,KOL
  122.     IF COUNT(LA,I)>0 THEN ICHAR$=MID$(WORDS$(LA,I),KCHAR,1) :ELSE ICHAR$=" "   
  123.     IF COUNT(LA,I)=KCHAR THEN ICHAR$=ICHAR$+" "  :  COLOR 1,0
  124.     IF ICHAR$="" THEN PRINT " " :ELSE PRINT ICHAR$
  125.     FLASH=0
  126. TYPER:
  127.     TCHAR$=INKEY$
  128. '-- FLASH-CURSOR LOGIC --
  129.     FLASH=FLASH+1
  130.     IF FLASH=40 THEN   ' ------- 20/60 OF THE TIME, THE CURSOR CHAR IS RED
  131.       LOCATE KLINE,KOL
  132.       COLOR 3,0
  133.       IF ICHAR$=" " OR ICHAR$="" THEN PRINT CHR$(140) :ELSE PRINT ICHAR$
  134.     ELSEIF FLASH=60 THEN  ' ------- restore color of cursor char
  135.       LOCATE KLINE,KOL : COLOR 1,0
  136.       IF ICHAR$="" THEN PRINT " " :ELSE PRINT ICHAR$
  137.       FLASH=0
  138.     END IF
  139.     IF TCHAR$="" THEN TYPER
  140.     COLOR 1,0
  141.     LOCATE KLINE,KOL : PRINT ICHAR$   '-- RESTORE CHAR AT CURSOR --
  142.     TC=ASC(TCHAR$)
  143.     IF TC=13 OR TC=29 OR TC=9 THEN ' -------- tab, down-arrow or <CR>
  144.       IF KCHAR>COUNT(LA,I) THEN
  145.         LOCATE KLINE,KOL : PRINT " "
  146.       END IF
  147.       KLINE=KLINE+2 : KCHAR=1 : LA=LA+1  : KOL=3
  148.       IF LA<5 THEN TYPE2 :ELSE TYPE1
  149.     ELSEIF TC=28 THEN  ' --------------------------- input is up-arrow
  150.       IF KCHAR>COUNT(LA,I) THEN
  151.         LOCATE KLINE,KOL : PRINT " "
  152.       END IF
  153.       KLINE=KLINE-2 : KCHAR=1 : LA=LA-1 : KOL=3
  154.       IF LA<1 THEN
  155.         LA=4 : KLINE=KLINE+8
  156.       END IF
  157.       GOTO TYPE2
  158.     ELSEIF TC=30 THEN ' ------------------------------- input is right-arrow
  159.       IF KCHAR>=COUNT(LA,I)+1 THEN
  160.         BEEP : GOTO TYPER
  161.       ELSE
  162.         KCHAR=KCHAR+1 : KOL=KOL+1 : GOTO TYPE2
  163.       END IF
  164.     ELSEIF TC=31 THEN  ' -------------------- input is left-arrow
  165.       IF KCHAR=1 THEN
  166.         BEEP :  GOTO TYPER
  167.       ELSE
  168.         KCHAR=KCHAR-1 : KOL=KOL-1 : GOTO TYPE2
  169.       END IF
  170.     ELSEIF TC=8 THEN  ' --------------- back-space - delete to left
  171.       IF KCHAR=1 THEN
  172.         BEEP : GOTO TYPER
  173.       ELSE
  174.         KCHAR=KCHAR-1 : KOL=KOL-1
  175.         GOSUB REMOVE
  176.         GOTO TYPE2
  177.       END IF
  178.     ELSEIF TC=127 THEN  ' --------- delete char - remove current character
  179.       GOSUB REMOVE
  180.       GOTO TYPE2
  181.     ELSEIF TC>31 AND TC<127 THEN  ' ------- input is a valid character
  182.       IF KCHAR=COUNT(LA,I)+1 THEN
  183.         WORDS$(LA,I)=WORDS$(LA,I)+TCHAR$ ' -- append new char at end of line
  184.         LOCATE KLINE,KOL :  PRINT TCHAR$
  185.       ELSE
  186.         TL$=LEFT$(WORDS$(LA,I),KCHAR-1) ' --- insert new char in middle
  187.         TR$=RIGHT$(WORDS$(LA,I),COUNT(LA,I)-KCHAR+1)
  188.         A$=TCHAR$+TR$
  189.         LOCATE KLINE,KOL : PRINT A$
  190.         WORDS$(LA,I)=TL$+A$
  191.       END IF
  192.       KCHAR=KCHAR+1 : KOL=KOL+1
  193.       COUNT(LA,I)=LEN(WORDS$(LA,I)) : GOTO TYPE2
  194.     ELSEIF TC=130 THEN ' -------------------------- input is F2
  195.         IF WORDS$(4,I)="" THEN
  196.           SAY TRANSLATE$(WORDS$(3,I))
  197.         ELSE
  198.           SAY TRANSLATE$(WORDS$(4,I))
  199.         END IF
  200.       GOTO TYPER  
  201.     ELSEIF TC=129 THEN ' -------------------------- input is F1
  202.         IF WORDS$(2,I)="" THEN
  203.           SAY TRANSLATE$(WORDS$(1,I))
  204.         ELSE
  205.           SAY TRANSLATE$(WORDS$(2,I))
  206.         END IF
  207.       GOTO TYPER
  208.     ELSEIF TC=134 THEN ' -------------------------- input is F6
  209.       IF WORDS$(2,I)="" THEN
  210.         WORDS$(2,I)=WORDS$(1,I)
  211.         LA=2 : KLINE=16 : KOL=3 : KCHAR=1
  212.         LOCATE KLINE,KOL : PRINT WORDS$(LA,I)
  213.         COUNT(LA,I)=COUNT(1,I)
  214.         GOTO TYPE2
  215.       ELSE
  216.         BEEP : GOTO TYPER
  217.       END IF
  218.     ELSEIF TC=135 THEN  ' -------------------------- input is F7
  219.       IF WORDS$(4,I)="" THEN
  220.         WORDS$(4,I)=WORDS$(3,I)
  221.         LA=4 : KLINE=20 : KOL=3 : KCHAR=1
  222.         LOCATE KLINE,KOL : PRINT WORDS$(LA,I)
  223.         COUNT(LA,I)=COUNT(3,I)
  224.         GOTO TYPE2
  225.       ELSE
  226.         BEEP : GOTO TYPER
  227.       END IF
  228.     ELSEIF TC=197 THEN ' -------------------------- input is <alt>-Q
  229.       GOTO KENDA
  230.     ELSEIF TC=175 THEN  ' -------------------------- input is <alt>-N
  231.       GOTO LOOPIT
  232.     ELSE
  233.       BEEP : GOTO TYPER
  234.     END IF
  235.     GOTO TYPER ' ------------ end of type-in loop
  236. LOOPIT:  
  237.   NEXT I
  238. KENDA:
  239.   MOUSE OFF
  240.   PRINT CHR$(12) : COLOR 1,0
  241.  Q$="STORE AS FILE "+AME$ ' ------ ask if output file is same is input name
  242.  SAY TRANSLATE$(Q$)
  243.  PRINT Q$+" (Y/N)?"
  244.  INPUT Q$
  245.  IF UCASE$(Q$)="Y" THEN GOTO FILEOPEN 
  246.  Q$="SPECIFY THE NEW FILE NAME BY PATH (e.g., DF1:GERMAN/LESSON1)"
  247.  PRINT Q$
  248.  Q$="SPECIHFY THE NEW FILE NAME BY PATH"
  249.  SAY TRANSLATE$(Q$)
  250.  PRINT "File Name? "
  251.  INPUT AME$
  252. FILEOPEN:
  253.  OPEN "O",#1,AME$
  254.  FOR I=1 TO KWORD
  255. '-----------------  figure out format to store this record -------------
  256.    IF WORDS$(3,I)="" THEN
  257.      IF WORDS$(2,I)="" THEN
  258.        PRINT #1,WORDS$(1,I)
  259.      ELSE
  260.        PRINT #1,WORDS$(1,I);";";WORDS$(2,I)
  261.      END IF
  262.    ELSE
  263.      IF WORDS$(4,I)="" THEN
  264.        IF WORDS$(2,I)="" THEN
  265.          PRINT #1,WORDS$(1,I);"=";WORDS$(3,I)
  266.        ELSE
  267.          PRINT #1,WORDS$(1,I);";";WORDS$(2,I);"=";WORDS$(3,I)
  268.        END IF
  269.      ELSE
  270.        IF WORDS$(2,I)="" THEN
  271.          PRINT #1,WORDS$(1,I);"=";WORDS$(3,I);";";WORDS$(4,I)
  272.        ELSE
  273.          PRINT #1,WORDS$(1,I);";";WORDS$(2,I);"=";WORDS$(3,I);";";WORDS$(4,I)
  274.        END IF
  275.      END IF
  276.    END IF
  277.  NEXT I
  278.  CLOSE #1
  279.  END
  280. HITMOUSE:
  281.   IF MOUSE(0)=0 THEN RETURN
  282.   IF MOUSE(0)>0 THEN RETURN
  283.   IF MOUSE(2)>75 THEN
  284.     IF MOUSE(1)<570 THEN
  285.       RETURN
  286.     ELSE
  287.       IF MOUSE(2)>133 THEN ' ------- upper SAY was moused
  288.         IF WORDS$(4,I)="" THEN
  289.           SAY TRANSLATE$(WORDS$(3,I))
  290.         ELSE
  291.           SAY TRANSLATE$(WORDS$(4,I)) 
  292.         END IF
  293.       ELSE ' ------------------------ lower SAY was moused
  294.         IF WORDS$(2,I)="" THEN 
  295.           SAY TRANSLATE$(WORDS$(1,I))
  296.         ELSE
  297.           SAY TRANSLATE$(WORDS$(2,I))
  298.         END IF
  299.       END IF
  300.     END IF
  301.   ELSE
  302.     IF MOUSE(1)>300 THEN
  303.       RETURN KENDA  ' ------------- upper-right box moused
  304.     ELSE
  305.       RETURN LOOPIT  ' ------------- upper-left box moused
  306.     END IF
  307.   END IF
  308.   RETURN
  309. REMOVE:
  310.   IF KCHAR>COUNT(LA,I) THEN ' ------ blank right-most character
  311.     LOCATE KLINE,KOL : PRINT  " "
  312.   ELSE
  313.     TL$=LEFT$(WORDS$(LA,I),KCHAR-1) ' -------- delete character from middle
  314.     TR$=RIGHT$(WORDS$(LA,I),COUNT(LA,I)-KCHAR)
  315.     WORDS$(LA,I)=TL$+TR$
  316.     LOCATE KLINE,KOL : PRINT TR$+" "
  317.   END IF
  318.   COUNT(LA,I)=LEN(WORDS$(LA,I))
  319.   RETURN
  320. GOOF:
  321.   PRINT "YOU HAVE SPECIFIED A NON-EXISTENT FILE NAME - TRY AGAIN"
  322.   GOTO STARTER
  323.   
  324.