
**********************************************************************
files: Strings.TXT, Strings.TAP
       FNw.BAS, FNi.BAS, FNj$.BAS, Screen2String.BAS, STR$fix.ASM
       http://www.users.globalnet.co.uk/~jg27paw4/pourri/find-fill-copy.zip
       ScrDol0.ASM
**********************************************************************


** String DEF FNs
   ==============

This function scans a string for a character match without needing to use FOR...NEXT and IF...THEN.

FNw.BAS [code] DEF FN w(w$,w,o$,c)=VAL (("FN w(w$,w,o$,c+1)" AND w$(c OR c>w)<>o$ AND c<=w)+("c AND c<=w" AND (w$(c OR c>w)=o$ OR c>w))) [/code]

The expression "a OR b" returns 1 if 'b' is true or 'a' if 'b' is false. Hence "c OR c>w" returns 1 if c>w or 'c' if c<=w, to avoid a "Subscript wrong" error when c>w.

Examples:

FN w(w$,LEN w$,o$,1)
returns the first position of o$ in w$, otherwise zero if there's no match.

w$( TO FN w(w$,LEN w$,o$,1))
returns the leftmost matching segment, otherwise null if there's no match.

GO SUB 1000+FN w(w$,LEN w$,o$,1)*100
will call a different subroutine depending upon the returned value.


Here's a simpler one which just returns the position of o$ in w$ or 0 if it's not there:

DEF FN w(w$,o$)
=VAL (("FN w(w$(2 TO),o$)+" AND w$(1)<>o$ AND LEN w$>1)+("(w$(1)=o$)"))

   ==============

Here's a recursive DEF FN INSTR function. It returns the start of o$ in w$, searching from position c onwards, returning zero if not found or if either string is null or if o$ is longer than w$ or if c is past the end of w$. It relies on the perhaps little known ZX BASIC fact that the expression w$(a TO b) does not return an error if b is zero (or, in general, less than a) but returns a convenient null string instead. Parameter 'w' must always be set to "LEN w$" and parameter 'o' to "LEN o$-1".

FNi.BAS [code]
   4 DEF FN i(w$,w,o$,o,c)=
VAL (("FN i(w$,w,o$,o,c+1)"
      AND (w$(c TO (c+o) AND c+o<=w)<>o$ AND c+o<=w))
    +("c-(c AND (c+o>w OR NOT LEN o$))"
      AND (w$(c TO (c+o) AND c+o<=w)=o$ OR c+o>w)
    ))
[/code]


**********************************************************************


** Find-Fill-Copy functions for BASIC
   ==================================
FFC
Here's three machine code routines to provide some data manipulation functions which are otherwise slow to do from BASIC.

* find array 'a' [& optionally rename as 'b']
. eg. FN f("z$()","b",find) -or- FN f("z()","",find)
* fill array 'a' elements with value 'b'
. eg. FN f("z$()","wxyz",fill) -or- FN f("z()","INT PI",fill)
* [optionally copy string 'c' to address 'a' then]
. copy 'l' bytes from address 'a' to address 'b' (may overlap)
. eg. FN c(22528,22529,127,CHR$ 4)
will set the top four screen lines to green on black.

If no initialisation string is defined then 'copy' will start from the top or bottom end as appropriate, depending on the positions of 'a' & 'b', in order to preserve the source data at the destination in case the two areas overlap; ie. it effectively does a shift up or down as appropriate.

There are two versions of each routine, using either:
"PRINT USR r0,p1[,p2...,pn],r1" or "DEF FN f(p1[,p2...,pn])=USR r1"
with separate BAS,Z80,ASM,TAP files for each set, including demo programs which provide for testing all the options; files suffixed "_pu" or "_fn".

The routines are self-relocating, so can be loaded & run at any reasonable address. If assembling to run at a fixed point then the 'initsr' routine can be discarded (this alters the two call addresses marked "***"). There's more comments with the listings in [url=http://www.users.globalnet.co.uk/~jg27paw4/pourri/find-fill-copy.zip]Find-Fill-Copy.zip[/url] . The LABELS0 block at the end of the assembler listing is so that routine addresses can be calculated by the BASIC program; see lines 15 & 20.


**********************************************************************


** Bytes to String
   ===============

This function PEEKs 'b' bytes from memory starting at 's' and returns them as a string.

FNj$.BAS [code] DEF FN j$(s,b)=CHR$ PEEK (s)+VAL$ (("FN j$("+STR$ (s+1)+","+STR$ (b-1)+")" AND b>1)+("""""" AND b=1)) [/code]

To clarify the solution for those interested. A recursive function needs an evaluating bit, a looping bit and an exiting bit; in this case these being the CHR$ ... + VAL$ bit, the FN j$ bit and the """""" bit, respectively. This function returns a single character from RAM each time it's executed, appending this to any characters returned by previous iterations.

The problem I have with constructing recursive functions is being able to see what the function will see when it's running, which is why I get "Nonsense in BASIC" more often than not until I get it right. The function has to be constructed so that it will no longer see the looping bit when the limit is reached and will instead just see the exiting bit, hence the "looping bit" AND b>1 and "exiting bit" and b=1 structure.

As it's a string function, VAL$ needs to be used to evaluate the looping expression; the three elements can be summarised as:
* CHR$ PEEK (s) returns the addressed byte from memory;
* ("FN j$("+STR$ (s+1)+","+STR$ (b-1)+")" AND b>1) increments the address, decrements the counter and calls FN j$(s,b) again with those new values;
* ("""""" AND b=1) will return nothing until the last byte is reached and will then return """", which VAL$ will evaluate as ""; ie. a null string.

For the looping bit what I want it to see is "FN j$((s+1),(b-1))" but if I quote it just like that it gives an error as VAL$ doesn't know about evaluating numeric expressions and so I had to deconstruct the statement so that the parameter values are calculated before VAL$ sees the string. Thus for the function call FN j$(56168,8) the first iteration gives CHR$ PEEK (56168) and then VAL$ sees "FN j$((56169),(7))" and so on until 'b' is reduced to 1 when VAL$ just sees (""+"""") which terminates the function.

Even when a recursive function is defined correctly it can still fail with "Out of memory", as each iteration creates a new DEFADD area for its version of the variables plus entries get added to the stack every time.


**********************************************************************


** Screen2String
   =============

Further to writing that BASIC one-liner to redirect CAT to a string I thought that I'd do a general redirection routine for anything which normally prints characters to the upper screen (PRINT, LIST, CAT, LOAD ... errmm ... can't think of any others). I'm not quite sure of what uses it might have, but anyway ...

At first I did it all in BASIC but it was a bit clunky, so I added nine bytes of machine code to streamline it. The comments in the listing explain how to use it. The string is called s$ but can be anything; just change the "S" in the DATA statement; it starts 12 bytes above RAMTOP (the first 11 bytes being occupied by the string pointer (2) & machine code (9)), but can be placed anywhere within reason.

Take care on the 128k that the string is placed so that the maximum expected length does not extend over the 48k paging boundary, as otherwise it won't work very well. As nothing is being written to the screen when the redirection is active the string could be put in the display file, but it would have to be copied elsewhere before restoring normal screen output.

GO SUB 9200 starts redirection with an empty string; GO SUB 9220 stops redirection; GO SUB 9210 updates the definition and should be called before referencing s$ if anything has been written to it since the last call. It would probably be a good idea to put an overflow check in line 9211.

Note that because of the way the string is defined (s$ is a DEF FN parameter) it can only be sliced on the source side of an expression; ie. "LET ... =s$(b TO c)" will work but not "LET s$(b TO c)= ...". To alter part of it either copy it to a regular string or do all the slicing on the source side; eg. "LET s$=s$(TO b-1)+whatever+s$(c+1 TO)".

Screen2String.BAS [code]
   3 DEF FN p(a)=PEEK a+256*PEEK (a+1):
     DEF FN g(v)=v-FN h(v)*256: DEF FN h(v)=INT (v/256)
   4 CLEAR appropriately: LET ch=FN p(23631)
   5 REM 23563=DEFADD; 23631=CHANS; 23730=RAMTOP
  60 REM so=channel 'S' output routine address; ro=redirected address
  61 LET so=FN p(ch+5): LET sp=FN p(23730)+1: LET ro=sp+2
  64 REM machine code; sp=pointer to position in string
  65 REM ld hl,(ptr) : ld (hl),a : inc hl : ld (ptr),hl : ret
  66 DATA 42,FN g(sp),FN h(sp),119,35,34,FN g(sp),FN h(sp),201
  70 REM string: sa=start; sl=length; sd=pointer to FN s$()
  71 FOR p=ro TO ro+8: READ v: POKE p,v: NEXT p: LET sa=p:
     LET slo=FN g(sa): LET shi=FN h(sa)
  72 REM string pointer (incremented by m/c as bytes are redirected)
  73 POKE sp,slo: POKE sp+1,shi
  80 REM string parameters
  81 DEF FN s$(s$)="": DATA 0,slo,shi,0,0
  84 RESTORE 81: LET sd=FN p(23639)+9:
     FOR p=sd+3 TO sd+7: READ v: POKE p,v: NEXT p
  90 REM Main Program
  91 PRINT "LIST to S$": GO SUB 9200: LIST 9100: GO SUB 9220:
     PRINT "S$ to screen": GO SUB 9210: PRINT s$: STOP
9100 REM -----------------------
9200 REM start redirection
9201 POKE ch+5,FN g(ro): POKE ch+6,FN h(ro): RETURN
9210 REM update string definition
9211 LET sl=FN p(sp)-sa: POKE sd+6,FN g(sl): POKE sd+7,FN h(sl):
     POKE 23563,FN g(sd): POKE 23564,FN h(sd): RETURN
9220 REM stop redirection
9221 POKE ch+5,FN g(so): POKE ch+6,FN h(so): RETURN
9229 REM -----------------------
[/code]

   =============

Considering the problem of how to put the output of CAT into a string, I realised that there was an easy way to do that with a little bit of BASIC trickery (using the 'R' channel, which can't actually be opened from BASIC, but by pretending that it's the 'S' channel it works). So then I enhanced the routine so that any 'S' channel output would be sent to a string variable when the redirection function was turned on instead of being displayed on the screen. It just changes the channel 'S' output routine address in the (CHANS) area to point to my 9-byte m/code routine, which in turn just takes the bytes being output by PRINT or whatever and appends them to the string space pointed to by the s$ string definition pointed to by DEFADD.

An alternative use to CAT could be to use it with LOAD to catalogue the contents of cassettes. If LOAD is run with a non-existent name (eg. CHR$ 7 is unlikely to be used as a name) then rather than all the file types & names on the cassette being listed on the screen they would be saved in s$ instead. (With that particular example there'd need to be an option to break out of the LOAD at the end of the tape and continue with the next line in the program. Refer to McTrap.ASM in Errors.TXT.)


**********************************************************************


** STR$ bug fix
   ============

This routine provides a BASIC replacement for STR$ which fixes the bugs; use "FN s$(numeric_expression)" instead of "STR$ (numeric_expression)". I copied the ROM's method used in CIRCLE & DRAW for checking -1<n<1 so it should be OK.

I found that with complex expressions there may already be items on the calculator stack which are unrelated to the STR$ function, so I couldn't just reset the stack, so to fix the fractions bug I had to check whether the number was small enough to produce the error and then remove the penultimate entry from the stack if so. I've tried it with loads of different numbers in a RND loop, both inside & outside the range. I also tried string slicing, such as:
PRINT PAPER 5;("abcde"+FN s$(.1))(TO 5)
which gives a subscript error if STR$ is used.

STR$fix.ASM [code]
STRDOL: ld   hl,(23563)      ;HL=(DEFADD)
        inc  hl
        inc  hl
        ld   a,(HL)          ;check exponent byte for -1<n<1
        or   a
        jr   z,STACKIT
        cp   $81
STACKIT:push af              ;save Carry
        call $33b4           ;STACK_NUM
        pop  af
        ld   a,(23695)       ;A =(ATTR_T)
        ex   af,af'          ;save Carry & (ATTR_T)
        call $361f           ;STR$
        ex   af,af'
        ld   (23695),a
        jr   nc,STACKOK
        rst  $28             ;balance calculator stack
        defb $01             ;exchange
        defb $02             ;delete
        defb $38             ;end_calc
        ;reorganise the machine stack so that this string
        ;becomes the output from the function instead of BC
STACKOK:pop  bc              ;BC=$2d2b (discard)
        pop  bc              ;BC=$3365
        pop  de              ;DE=$0000
        inc  sp
        inc  sp
        pop  hl              ;HL=$000D
        ex   (sp),hl         ;HL=$106E
        push hl
        push de
        push bc
        ld   de,(23653)      ;DE=(STKEND) (for RE_ENTRY)
        ret                  ;return via $3365 RE_ENTRY
[/code]


**********************************************************************


** SCREEN$ bug fix
   ===============

I've been using the SCREEN$() function recently for reading data off the screen rather than taking up space with an array and I got fed up with the stacking bug in it so I wrote this little replacement fix for it. Instead of SCREEN$(row,col) use FN c$(row,col) where FN c$() is defined as DEF FN c$(r,c)=STR$ USR ScrDol0 .

ScrDol0.ASM [code]
; Fixed & enhanced SCREEN$() function
; Fixes ROM stacking error
; Handles regular characters, UDGs & block graphics
; Number of characters of each type is user-definable
; Handles full 24*32 screen, up to 112 UDGs

; IMPORTANT NOTE
; SCREEN$ treats plain & inverse CHR$ as equal, so if a UDG has an inverse
; form then it must be assigned a CHR$ using the same "XOR $0f" method as
; used for block graphics; eg. if CHR$ $92 has a separate inverse UDG form
; defined then it must use CHR$ $92 XOR $0f = $9d otherwise it won't be
; recognised as a distinct form and CHR$ 92 will be returned instead. This
; rule is derived from that which already applied to the 16 block graphics.
; Only 8 block graphics need to be defined (although all 16 are recognised).

        org  40000           ;relocatable
DOFF:   equ  BlockData - BlockGen
STKEND: equ  23653

; Initialisation: Generates bitmaps for the lower 8 block graphics ($80-$87)
;                 and initialises character sets parameters used by ScrDol0.
; USAGE:
;    LET ScrDol0=num1+(num2+(num3+USR BlockGen))-(num1+num2+num3)
; OR to use default settings, just:
;    LET ScrDol0=USR BlockGen
; where num1, etc = number of each character type to check (zero allowed)
; 1=BLOCKset/2, 2=UDGset, 3=CHARSset; defaults 8, 21, 96
BlockGen:
        push bc              ;save runtime address of BlockGen
        ld   hl,DOFF
        add  hl,bc
        ex   de,hl           ;DE=BlockData =runtime address for bitmaps
        push de
        pop  ix
        ld   (ix-2),e
        ld   (ix-1),d        ;(BLOCK)=runtime BlockData
        dec  de
        dec  de              ;DE=BLOCK
        ld   (ix+76),e
        ld   (ix+77),d       ;ScrData:BLOCK =runtime value

        ld   bc,(STKEND)
        ld   hl,(STKEND-2)   ;HL=(STKBOT)
        sbc  hl,bc
        push ix              ;save BlockData
        jr   z,SetDE         ;no parameters, use defaults
        push bc              ;save (STKEND)
        ld   b,3
DLOOP:  push bc              ;apply ScrData changes
        call $2dd5           ;FP_TO_A   from calculator stack: A
        ld   (ix+68),a       ;characters to check
        add  a,(ix+69)       ;add 1st CHR$
        sub  $80
        ld   (ix+66),a       ;CHR$ adjustment
        ld   bc,6
        add  ix,bc
        pop  bc
        djnz DLOOP
        pop  bc
        ld   (STKEND),bc

SetDE:  pop  de
        ld   a,$80
BLOOP:  ld   b,a
        ex   af,af'
        call $0b38           ;PO_GR_1 builds block graphic in MEMBOT
        ld   hl,23698        ;MEMBOT
        ld   bc,8
        ldir
        ex   af,af'
        inc  a
        cp   $88
        jr   c,BLOOP

        pop  hl                   ;HL=runtime address of BlockGen
        ld   bc, ScrDol0-BlockGen ;BC=ScrDol0 offset from BlockGen
        add  hl,bc
        ld   b,h
        ld   c,l                   ;return runtime address of ScrDol0
        ret

BLOCK:  defw BlockData
BlockData:
        defs 64

;1,2: address of character set base address
;  3: lo-byte = CHR$ adjustment = (1st CHR$)-$80+(characters to check)
;eg.: CHARS   = $20 - $80 + $60 = $00
;     UDG     = $90 - $80 + $15 = $25
;     BLOCK   = $80 - $80 + $08 = $08
;  4: hi-byte = base address adjustment = (256-offset)/256 = 0 or 1
;  5: characters to check (user-definable, see BlockGen)
;  6: 1st CHR$ of set
ScrData:defw 23606
        defb $00,$00,$60,$20
        defw 23675
        defb $25,$01,$15,$90
        defw BLOCK           ;recalculated by BlockGen
        defb $08,$01,$08,$80
        defw $0000

; USAGE:
; DEF FN s$(r,c)=STR$ USR ScrDol0
; ... FN s$(row,col) ...
ScrDol0:di                   ;BC must hold ScrDol0 address
        push bc
        pop  ix              ;IX=ScrDol0 runtime address =ScrData pointer

ScrLoop:ld   l,(ix-20)
        ld   h,(ix-19)
        ld   e,(hl)
        inc  hl
        ld   a,(hl)
        sub  (ix-17)
        ld   d,a             ;DE=character set pointer

ScrDol1:ld   hl,(23563)      ;HL=(DEFADD)
        inc  hl
        inc  hl
        inc  hl
        inc  hl
        ld   a,(hl)          ;A =row
        ld   bc,8
        add  hl,bc
        ld   c,a
        ld   b,(hl)          ;BC=col,row

        ex   de,hl
        inc  h               ;HL=character set address
        ld   a,c             ;A =row
        rrca
        rrca
        rrca
        and  %11100000
        or   b
        ld   e,a             ;E =lo-byte of screen address
        ld   a,c             ;A =row
        and  %00011000
        xor  %01000000
        ld   d,a             ;D =hi-byte of screen address
        ld   (23680),de
        ld   b,(ix-16)       ;B =number of characters

        xor  a
        ld   c,a
        cp   b
        jr   z,Stack0        ;if no characters in selected set
        call $254f           ;S_SCRN_LP returns via $2ab2 STK_STO_$
        bit  0,c             ;DE=address, BC=length (0 or 1)
        jr   nz,ScrFone      ;NZ=match found

ScrDol2:ld   de,6
        add  ix,de
        ld   a,(ix-19)
        or   a
        jr   z,ScrDone       ;all checks completed, no match
        call nz,$2bf1        ;STK_FETCH discard
        jr   ScrLoop

Stack0: call $2ab6           ;STK_STORE stack a dummy entry
        jr   ScrDol2

ScrFone:ld   a,(de)
        add  a,(ix-18)       ;=CHR$ adjustment
        cp   $20
        jr   nz,NoSpace
        ld   a,$80           ;treat space as block space, in case it's inverse
NoSpace:ld   (de),a
        ;check that graphic codes >=$80 match the screen character,
        ;if not use the inverse character code (=CHR$ XOR $0f),
        ;as SCREEN$ doesn't distinguish between plain & inverse characters
        cp   $80
        jr   c,ScrDone
        push hl              ;HL=(STKEND)
        push de              ;DE=CHR$ address
        ld   l,(ix-20)
        ld   h,(ix-19)
        ld   e,(hl)
        inc  hl
        ld   d,(hl)
        ex   de,hl           ;HL=graphic set base address
        sub  (ix-15)         ;sub 1st CHR$ of set
        ld   d,0
        sla  a
        rl   d
        sla  a
        rl   d
        sla  a
        rl   d
        ld   e,a             ;DE=bitmap offset
        add  hl,de           ;HL=bitmap address
        ld   de,(23680)      ;DE=display address for r,c
        ld   a,(de)
        cp  (hl)             ;compare first bytes
        pop  de              ;(will always be different if inverse character)
        ld   a,(de)
        jr   z,Matched
        xor  $0f             ;change to graphic inverse code
Matched:cp   $80
        jr   nz,DoSpace
        ld   a,$20           ;treat block space as space, in case it's plain
DoSpace:ld   (de),a
        pop  ix
        ld   (ix-5),a        ;update calculator stack entry

ScrDone:;At this point the CHR$ parameters are the top entry
        ;on the calculator stack; also A=CHR$, DE=pointer, BC=length (0 or 1)
        pop  hl              ;HL=$2d2b (discard)
            push hl          ;save return in case not to BASIC
            ld   a,h
            cp   $40         ;called from BASIC?
            ret  nc          ;no, A'=CHR$ code, C=length (0 or 1), no EI
        ;Reorganise the machine stack so that this string
        ;becomes the output from the function instead of BC.
            pop  hl          ;discard return
        pop  bc              ;BC=$3365
        pop  de              ;DE=$0000
        inc  sp
        inc  sp
        pop  hl              ;HL=$000D
        ex   (sp),hl         ;HL=$106E
        push hl
        push de
        push bc
        ld   de,(STKEND)      ;(for RE_ENTRY)
        ei
        ret                  ;return via $3365 RE_ENTRY
[/code]


**********************************************************************
