LEX    'POSILEX'
* (c) Copyright PPC Paris 1986

*************************************************
* Nom:     POSI                                 *
*                                               *
* Syntaxe: POSI(C$,C1[,C2])                     *
*                                               *
* But: dans la chaÑne C$, renvoie la position   *
* du premier caractÉre dont le code ASCII       *
* est compris entre C1 & C2. (C2=255 par dÅfaut)*
* ValiditÅ: 0<= C1,C2 <=255                     *
*                                               *
* Exemples:                                     *
*    POSI("ABCd4c",NUM('0'),NUM('9'))  -->  5   *
*    POSI("V1EkR",NUM('a'),NUM('z'))   -->  4   *
*************************************************

        ID     #E1
        MSG    0
        POLL   0

t       EQU    89

RNDAHX  EQU    #136CB   dÅpile un nombre rÅel et
         *              le convertit en hexa en
         *              A[A]
RANGE   EQU    #1B07C   teste si A[B] est compris
         *              ds l'intervalle
         *              C[B] (borne inf) / C[3-2]
         *              (borne sup)
POP1S   EQU    #0BD38   dÅpile une chaÑne :
         *              A[A]=longueur, D1=adresse
HDFLT   EQU    #1B31B   A[A] h -> A[W] d flottant
CSLC5   EQU    #1B435   rotation de 5 digits vers
         *              la gauche du registre C
CSRC5   EQU    #1B41B   idem È droite
FNRTN1  EQU    #0F216   fin de routine :
         *              A[W]=argument, D1 @ MStack

IVAERR  EQU    #0E920   ARGUMENT NON VALIDE

        ENTRY  POSIe
        CHAR   #F
        KEY    'POSI'
        TOKEN  t
        ENDTXT

        NIBHEX 884      une chaÑne, 2 nombres
        NIBHEX 23       2 ou 3 arguments
POSIe   P=C    15       C[S]= nombre d'arguments
        ?P=    3        3 arguments?
        GOYES  PRM3     oui
        A=0    A        non: le 3Éme vaudra 255
         *              par dÅfaut
        A=A-1  B        A[A]=000FF
        GOC    PRM2     B.E.T.

*
* POPARG dÅpile un nombre rÅel et vÅrifie qu'il
* est compris entre 0 et 255, sinon ERReur
*
POPARG  GOSBVL RNDAHX   A[A]= nombre hexa
        GONC   ivaerr   erreur si nÅgatif
        D1=D1+ 16       pointe l'argument suivant
         *              de la Math Stack
        C=0    A
        C=C-1  B        C[A]= 255
        C=C-A  A        argument > 255 ?
        RTNNC           non: retour
ivaerr  GOVLNG IVAERR

PRM3    GOSUB  POPARG
PRM2    R0=A
        GOSUB POPARG    A[A]= 2Éme argument
        C=R0            C[A]= 1er    "
        ?A>C   B
        GOYES  FD1
        ACEX   B

FD1     ASL    A        en entrÅe :
         *              A[B]=MAX(A,C) ; C[B]=MIN
        ASL    A        A[3-2]= borne sup
        A=C    B        A[B]  = borne inf
        B=A    A        B[3-0]= intervalle
        GOSBVL POP1S    A[A]= long, D1 @ dernier
         *              caractÉre
        D1=D1- 2
        CD1EX
        D1=C
        C=C+A  A        C[A] @ 1er caractÉre
        GOSBVL CSLC5
        CD1EX           C[A] @ dernier caractÉre
        D=C    W        D[9-0]= nb de contrÂle :
         *              adr sup [9-5], adr inf
         *              [4-0]
        C=C+A  A        on commence la recherche
         *              È partir du 1er caractÉre
         *              (adr sup)
        CD1EX           D1= pointeur de chaÑne
         *              (adr sup en entrÅe)

SEARCH  A=DAT1 B        A[B]= octet de la chaÑne
        C=B    A        C[A]= intervalle de
         *              recherche
        GOSBVL RANGE    caractÉre dans
         *              l'intervalle ?
        GONC   FND      oui
        D1=D1- 2        octet suivant
        CD1EX
        D1=C
        ?C>D   A        pointeur > adr inf ?
        GOYES  SEARCH   oui: on continue la
         *              recherche
NOTFND  A=0    A        pas trouvÅ: on retourne 0
        C=D    W
        GOSBVL CSRC5
        D1=C            D1= adr inf= adr de base
         *              de la Math Stack
        GONC   ENDF     fin

FND     A=0    W        trouvÅ: on va calculer la
         *              position du pointeur dans
         *              la chaÑne
        AD1EX           A[A]= pointeur
        C=D    W
        GOSBVL CSRC5    C[A]= adr du 1er caractÉre
        D1=C
        A=A-C  A
        A=-A   A        A[A]= adr sup - pointeur
        ASRB            A[A]= A[A]/2   (nb
         *              quartets -> nb octets)
        A=A+1  A        position [0...] ->
         *              position [1...]

ENDF    GOSBVL HDFLT    position : A[A] hex ->
         *              dÅcimal flottant en A[W]
        C=A    W
        D1=D1+ 2
        GOVLNG FNRTN1   renvoie C[W] au BASIC

        END