;Author:   Mark McDonald
;          mmcdonald1@qwest.net
;Writen:   Jan 2000
;Compiler: Compile with TASM or MASM
;
; TITLE:   XWORD
;
;  DESC:   Returns a "word" contained in a string.  Words are separated by one
;          or more characters such as a space(32), comma(44), etc.
;          Word delimiters are not returned, just the word.
;
; PROTO:   DECLARE FUNCTION XWORD(BYVAL W$,BYVAL WN, BYVAL SCHAR) AS STRING
;
; NOTES:   Does not check to see if desired word is present.  If you ask for the
;          3rd comma delimited word and only two exist, an error will occur.
;          Use the XWORDS function to determine how many words are present.
;
; EXAMP:   A$ = "one, two, three, four, 5, 6sixth, seven"
;          T$ = XWORD(A$,1,44)      RETURNS  'one'
;          T$ = XWORD(A$,2,44)      RETURNS  'two'
;          T$ = XWORD(A$,3,44)      RETURNS  'three'
;          T$ = XWORD(A$,4,44)      RETURNS  'four'
;          T$ = XWORD(A$,5,44)      RETURNS  '5'
;          T$ = XWORD(A$,6,44)      RETURNS  '6sixth'
;          T$ = XWORD(A$,7,44)      RETURNS  'seven'
;
; EXAMP:   A$ = "NOW IS A GOOD, TIME FOR ALL GOOD MEN, TO COME HOME"
;          T$ = XWORD(A$,1,44)      RETURNS  'NOW IS A GOOD'
;
;
;--- Declare PowerBasic 3.5 Internal Routines ---
Extrn   Get$Loc: Far
extrn   Get$Alloc: Far
Extrn   Rls$Alloc: Far
;--- Specify Code Segment (1 of 16) ---
MCODE Segment Byte
        Assume  CS: MCODE

        Public  xword
;--- Declare Name and Parms ---
xword Proc Far

ARG     schar:WORD, wordnum:WORD, StrHandle: WORD = Retbytes
        jmp over_data
           iwfg  DW   0h
           spos  DW   0h
over_data:
        push    BP                      ; Save PB Stacks
        mov     BP,SP                   ;
        push    DS                      ;
                                        ; GET STRING POINTER
        mov     AX, StrHandle           ; put string handle in AX
        push    AX                      ; push it on the on stack
        call    Get$Loc                 ; get location of string
        mov     DS,DX                   ; put returned segment in DS
        mov     SI,AX                   ; put returned offset in SI
        push    DS                      ; save DS for later
        push    SI                      ; save SI for later

        xor     AX,AX                   ; clear AX
        xor     BX,BX                   ; clear BX
        jcxz    Exit                    ; is passed string null?
        cmp     AX,wordnum              ; is passed word number 0?
        jz      Exit
        xor     DX,DX                   ; clear DX
        mov     [iwfg],1                ; init in word flag
        mov     [spos],0                ; word start position flag

ReadChar:
        lodsb                           ; load a character
        cmp     AX,schar                ; is character a space?
        jnz     Notsp                   ; if not 0 jump to Notsp
        mov     [iwfg],0                ; is a space, init in word flag

        cmp     BX,0                    ; not a space, must be in word
        jnz     Exit                    ; if so then we are done counting
        jmp     R2                      ; else get next character

Notsp:
        cmp     [iwfg],2                ; in word flag already set?
        jz      R1                      ; if so pass to char counter
        mov     [iwfg],2                ; else set in word flag
        inc     DX                      ; add 1 to word count
R1:
        cmp     DX,wordnum              ; is this the desired word?
        jnz     R2                      ; if not get next character
        cmp     [spos],0
        jnz     R12
        mov     [spos],SI
        dec     [spos]
R12:
        inc     BX                      ; is the word, count character
R2:
        loop ReadChar
Exit:
;--- Allocate Working String Space ----------------------------------
        pop     SI                      ; restore SI
        pop     DS                      ; restore DS
        cmp     BX,0
        jz      Exit2
        mov     CX,BX                   ; put length of word into CX
        push    CX                      ; push desired length on stack
        call    Get$Alloc               ; allocate a new string
        push    AX                      ; save pointer to new string
        push    AX                      ; save pointer for exit
        call    Get$Loc                 ; find new string
        mov     ES, DX                  ; put segment in ES - for use
        mov     DI, AX                  ; put offset in DI  - wth stosb
        mov     SI,spos
Gchar:
        lodsb
        stosb
        loop Gchar
Exit2:
        push    Word Ptr StrHandle      ; push string handle
        call    Rls$Alloc               ; release string
        pop     AX                      ;
        pop     DS                      ;
        pop     BP                      ;
        retf    Retbytes                ;
xword EndP
MCODE EndS
        End