
 1010  *---------------------------------
 1020  *
 1030  *      SUBSTRING SEARCH FUNCTION FOR APPLESOFT
 1040  *      ---------------------------------------
 1050  *
 1060  *      & SUB$( A$, B$, I )
 1070  *
 1080  *      SEARCHES FOR FIRST OCCURRENCE OF
 1090  *      B$ IN A$; PUTS RESULT IN I
 1100  *
 1110  *      RETURNS I=0 IF B$ IS NOT IN A$
 1120  *
 1130  *      (REFERENCE:  CALL A.P.P.L.E. ARTICLE
 1140  *      IN JANUARY 1981 ISSUE BY LEE REYNOLDS,
 1150  *      PAGES 26-30.)
 1160  *
 1170  *---------------------------------
 1180  FACMO       .EQ $A0
 1190  TEMPPT      .EQ $52
 1200  MAIN.LENGTH .EQ $18
 1210  MAIN        .EQ $19,1A
 1220  KEY.LENGTH  .EQ $1B
 1230  KEY         .EQ $1C,1D
 1240  *---------------------------------
 1250  ASSIGN .EQ $DA5C    STORE VALUE IN VARIABLE
 1260  SYNCHR .EQ $DEC0    REQUIRE (A) AS NEXT CHAR
 1270  FRMEVL .EQ $DD7B    EVALUATE FORMULA
 1280  SYNCOM .EQ $DEBE    REQUIRE COMMA
 1290  SYNRPN .EQ $DEB8    REQUIRE ")"
 1300  CHKSTR .EQ $DD6C    REQUIRE STRING
 1310  PTRGET .EQ $DFE3    GET POINTER
 1320  FRETMP .EQ $E604    FREE TEMPORARY STRING
 1330  SNGFLT .EQ $E301    FLOAT (Y)
 1340  *---------------------------------
 1350         .OR $300
 1360         .TF B.SUBSTRING SEARCH
 1370  *---------------------------------
 1380  SETUP.AMPERSAND
 1390         LDA #$4C     JMP OPCODE
 1400         STA $3F5
 1410         LDA #SUB
 1420         STA $3F6
 1430         LDA /SUB
 1440         STA $3F7
 1450         RTS
 1460  *---------------------------------
 1470  SUBQT  .AS "($BUS"  SUB$( BACKWARDS
 1480  *---------------------------------
 1490  SUB
 1500         LDX #4       COMPARE FOR "SUB$("
 1510  .1     LDA SUBQT,X
 1520         JSR SYNCHR   COMPARE WITH INPUT
 1530         DEX
 1540         BPL .1
 1550  *---------------------------------
 1560         LDY #MAIN.LENGTH
 1570         JSR GET.STRING
 1580         LDY #KEY.LENGTH
 1590         JSR GET.STRING
 1600         JSR PTRGET   GET VARIABLE FOR RESULT
 1610         STA $85
 1620         STY $86
 1630         JSR SYNRPN   REQUIRE RIGHT PAREN
 1640  *---------------------------------
 1650         JSR FREE.STRINGS
 1660  *---------------------------------
 1670         LDX #0       ANSWER OFFSET
 1680  .2     LDA MAIN.LENGTH SEE IF IT CAN STILL FIT
 1690         CMP KEY.LENGTH
 1700         BCC .8       WILL NOT FIT
 1710         LDY #0
 1720  .3     LDA (KEY),Y
 1730         CMP (MAIN),Y
 1740         BNE .6
 1750         INY
 1760         CPY KEY.LENGTH
 1770         BCC .3
 1780         INX          X IS RESULT
 1790         TXA
 1800         TAY
 1810  .4     JSR SNGFLT   FLOAT THE BYTE IN Y
 1820         LDA $12
 1830         PHA
 1840         LDA $11
 1850         JMP ASSIGN   STORE VALUE IN VARIABLE
 1860  .6     INC MAIN
 1870         BNE .7
 1880         INC MAIN+1
 1890  .7     INX
 1900         DEC MAIN.LENGTH
 1910         BNE .2
 1920  .8     LDY #0       RESULT IS 0
 1930         BEQ .4       ...ALWAYS
 1940  *---------------------------------
 1950  *      GET STRING EXPRESSION
 1960  *---------------------------------
 1970  GET.STRING
 1980         STY GS2      PLUG OUTPUT VECTOR
 1990         JSR FRMEVL   EVALUATE FORMULA
 2000         JSR SYNCOM   REQUIRE TRAILING COMMA
 2010         JSR CHKSTR   REQUIRE STRING
 2020         LDY #2       GET STRING DATA
 2030  * THE NEXT LINE IS A "SECRET" 6502 OPCODE,
 2040  * WHICH DOES BOTH LDA (FACMO),Y AND LDX (FACMO),Y
 2050  * AT THE SAME TIME.
 2060  GS1    .DA #$B3,#FACMO
 2070         STX *-*,Y    PLUGGED IN FROM ABOVE
 2080  GS2    .EQ *-1
 2090         DEY
 2100         BPL GS1
 2110         RTS
 2120  *---------------------------------
 2130  *      FREE UP ANY TEMPORARY STRINGS
 2140  *---------------------------------
 2150  FREE.ONE.STRING
 2160         LDA TEMPPT+1
 2170         LDY #0
 2180         JSR FRETMP
 2190  FREE.STRINGS
 2200         LDA TEMPPT
 2210         CMP #$56     EMPTY?
 2220         BCS FREE.ONE.STRING
 2230         RTS

