REM   STRING OPERATORS.TXT
REM
REM   This file contains as much of the string handling capability in Vesta
REM   Multi-Tasking Basic as can be implemented for the SBC2000-074 board.
REM
REM   This file does not contain a standalone application ... it contains
REM   subroutines and functions only and must be included by a file which
REM   has the main application.
REM
REM   Author: Andrew Jonathan Fine
REM
REM   Copyright 1998 Vesta Technology, Inc.
REM   All rights reserved.


CONSTANT STRING_SIZE_MAX     AS INTEGER = 254
CONSTANT STRING_INDEX_MAX    AS INTEGER = 253
CONSTANT STRING_LENGTH_BYTES AS INTEGER = 2
CONSTANT STRING_SINGLE_BYTE  AS INTEGER = 1




REM ---
REM - Versions of EEPROM_DPEEK and DPOKE. If you have handlers for timers or
REM - other ON events which access the EEPROM, you should declare these
REM - routines to be VITAL.
REM ---
FUNCTION   EEPROM_DPEEK (s AS INTEGER) AS INTEGER
  EEPROM_DPEEK = (256 * EEPROM_PEEK(s + 1)) OR EEPROM_PEEK (s)
END


REM   Since division is signed, we can't do a direct divide by 256 in this
REM   routine. For this reason, we divide by 2, mask off the high bit to get a
REM   positive argument, then divide by 128.
SUBROUTINE EEPROM_DPOKE (s AS INTEGER, i AS INTEGER)
  EEPROM_POKE (s, i)		: REM   Poke the low byte
  i = (i / 2) AND 0x7F80	: REM   Force positive before main divide
  EEPROM_POKE (s + 1, i / 128)	: REM   Poke the high byte
END



REM ---
REM - How many bytes are in s?
REM ---
FUNCTION s_len (s AS INTEGER) AS INTEGER
  s_len = EEPROM_DPEEK (s)

  IF s_len < 0
    s_len = 0
    RETURN
  ENDIF

  IF s_len > STRING_SIZE_MAX
    s_len = STRING_SIZE_MAX
  ENDIF
END



REM ---
REM - How many bytes are in s?
REM ---
FUNCTION s_max (s AS INTEGER) AS INTEGER
  s_max = EEPROM_DPEEK (s)
  s_max = s_max - 1

  IF s_max < 0
    s_max = 0
    RETURN
  ENDIF

  IF s_max > STRING_INDEX_MAX
    s_max = STRING_INDEX_MAX
  ENDIF
END



REM ---
REM - Set the size of string s 
REM ---
SUBROUTINE s_set_size (s AS INTEGER, size AS INTEGER)
  IF size < 0
    size = 0
  ENDIF

  IF size > STRING_SIZE_MAX
    size = STRING_SIZE_MAX
  ENDIF

  EEPROM_DPOKE (s, size)
END


REM ---
REM - Create a single byte string s from character c
REM ---
SUBROUTINE s_chr (s AS INTEGER, c AS INTEGER)
  s_set_size   (s, 1)
  EEPROM_POKE  (s + STRING_LENGTH_BYTES, c)
END 



REM ---
REM - Construct a string by appending a character 
REM - to it.
REM ---
SUBROUTINE s_cons (s AS INTEGER, c AS INTEGER)
  IF s_len (s) = 0
    s_chr (s, c)
    RETURN
  ENDIF

  IF s_len (s) >= STRING_INDEX_MAX
    RETURN
  ENDIF

  EEPROM_DPOKE (s, s_len(s) + 1)

  s = s + STRING_LENGTH_BYTES + s_max (s)
  EEPROM_POKE  (s, c)
END



REM ---
REM - Send string to current PIPE PRINT device
REM ---
SUBROUTINE s_print (x AS INTEGER)
  LOCAL i as INTEGER

  IF s_len(x) = 0
    RETURN
  ENDIF

  i = s_max (x)
  x = x + STRING_LENGTH_BYTES

  DO WHILE i >= 0
    PRINT CHR (EEPROM_PEEK (x))
    i = i - 1
    x = x + 1
  LOOP
END



REM ---
REM - x <-- y
REM ---
SUBROUTINE s_assign (x AS INTEGER, y AS INTEGER)
  LOCAL l AS INTEGER

  FOR l = s_len(y) TO -1 STEP -1
    EEPROM_POKE (X, EEPROM_PEEK (Y))
    X = X + 1
    Y = Y + 1
  NEXT
END



REM ---
REM - i <-- 0 <= i < |x|
REM --- 
FUNCTION   s_limit (x as INTEGER, i as INTEGER) AS INTEGER
  IF i > s_max (x)
    s_limit = s_max (x)
    RETURN
  ENDIF

  IF i < 0
    s_limit = 0
    RETURN
  ENDIF

  s_limit   = i
END



REM ---
REM - Specific case |y| == |{a,b}|:  x {a, b} <-- y
REM ---
SUBROUTINE s_cat_fill    (x AS INTEGER, y AS INTEGER, a AS INTEGER, b AS INTEGER)
  LOCAL incr AS INTEGER
  LOCAL idx  AS INTEGER

  x = x + STRING_LENGTH_BYTES + a
  y = y + STRING_LENGTH_BYTES

  IF a <= b
    incr =  1
  ELSE
    incr = -1
  ENDIF

  FOR IDX = a TO b STEP incr
    EEPROM_POKE (x, EEPROM_PEEK (y))
    x = x + incr
    y = y + 1
  NEXT
END



REM ---
REM - x {$} <-- y
REM ---
SUBROUTINE s_cat (x AS INTEGER, y AS INTEGER, a AS INTEGER)
  a = s_limit (x, a)

  IF a > STRING_INDEX_MAX
    RETURN
  ENDIF

  a = a + 1

  IF s_len (y) = 0
    RETURN
  ENDIF

  IF s_len (x) = 0
    s_assign (x, y)
    RETURN
  ENDIF 

  IF ((a + s_len (y)) > STRING_INDEX_MAX)
    s_cat_fill (x, y, a, STRING_INDEX_MAX)
    s_set_size (x, STRING_SIZE_MAX)
  ELSE
    s_cat_fill (x, y, a, a  + s_max (y))
    s_set_size (x, s_len(x) + s_len (y))
  ENDIF
END



REM ---
REM - x {$} <-- reverse(y)
REM ---
SUBROUTINE s_rappend (x AS INTEGER, y AS INTEGER)
  LOCAL index  AS INTEGER
  LOCAL letter AS INTEGER
  LOCAL eos    AS INTEGER

  FOR index = s_max(y) to 0 step -1
    letter = EEPROM_PEEK (y + STRING_LENGTH_BYTES + index)
    s_cons (x, letter)
  NEXT
END



REM ---
REM - What is the ASCII value for first byte of s?
REM ---
FUNCTION   s_asc (s AS INTEGER) AS INTEGER
  IF s_len (s)
    s_asc = EEPROM_PEEK (s + STRING_LENGTH_BYTES)
  ENDIF
END



REM ---
REM - What is the ASCII value of i'th byte of s?
REM ---
FUNCTION   s_byte  (s AS INTEGER, i AS INTEGER) AS INTEGER
  IF i < 0
    s_byte = 0
    RETURN
  ENDIF

  IF i <= s_max (s)
    s_byte = EEPROM_PEEK (s + i + STRING_LENGTH_BYTES)
  ENDIF
END



REM ---
REM - x <-- y {i}
REM ---
SUBROUTINE s_pick  (x AS INTEGER, y AS INTEGER, i AS INTEGER)
  IF s_len (y) = 0
    s_set_size (x, 0)
    RETURN
  ENDIF

  s_chr (x, s_byte (y, i))
END


REM ---
REM - return |{a,b}| 
REM ---
FUNCTION   s_interval (a AS INTEGER, b AS INTEGER) AS INTEGER
  s_interval = ABS (b - a) + 1
END



REM ---
REM - x <-- y {a, b}
REM ---
SUBROUTINE s_substring (x AS INTEGER, y AS INTEGER, a AS INTEGER, b AS INTEGER)
  LOCAL dir   AS INTEGER
  LOCAL index AS INTEGER

  a = s_limit (y, a)
  b = s_limit (y, b)

  IF a = b
    s_chr (x, s_byte (y, a))
    RETURN
  ENDIF

  IF a <= b
    dir =  1
  ELSE
    dir = -1
  ENDIF

  s_set_size (x, s_interval (a, b))    : REM set length of new string

  x = x + STRING_LENGTH_BYTES   
  y = y + STRING_LENGTH_BYTES

  FOR index = a TO b STEP dir
    EEPROM_POKE (x, EEPROM_PEEK (y + index))
    x = x + 1
  NEXT
END 



REM ---
REM - Get string from current PIPE INPUT device
REM ---
SUBROUTINE s_input (x AS INTEGER)
  LOCAL i      as INTEGER
  LOCAL letter as INTEGER
  LOCAL where  as INTEGER

  i = 0
  s_set_size (x, 0)
  
  DO WHILE i <= STRING_INDEX_MAX
    letter = INKEY ()

    IF letter = 13
      EXIT
    ENDIF

    IF letter >= 0  
      where = x + STRING_LENGTH_BYTES + i
      EEPROM_POKE  (where, letter)
      i = i + 1
    ENDIF
  LOOP

  s_set_size (x, i)
END


REM ---
REM - x {t, t + size - 1} <-- x {f, f + size - 1}
REM ---
SUBROUTINE s_sub_shift (s AS INTEGER, t AS INTEGER, f AS INTEGER, size AS INTEGER)
  s = s + STRING_LENGTH_BYTES

  IF f <  0
    f = 0
  ENDIF

  IF f >  STRING_INDEX_MAX
    f = STRING_INDEX_MAX
  ENDIF

  IF t < 0
    t = 0
  ENDIF

  IF t >  STRING_INDEX_MAX
    t = STRING_INDEX_MAX
  ENDIF
    
  IF f <= t
    IF (f - size) < 0
      size = f + 1
    ENDIF
  ENDIF

  IF f >= t
    IF (f + size) > STRING_INDEX_MAX
      size = STRING_INDEX_MAX - f + 1
    ENDIF
  ENDIF 

  DO WHILE size > 0
    EEPROM_POKE (s + t, EEPROM_PEEK (s + f))
    t    = t    + 1
    f    = f    + 1
    size = size - 1
  LOOP
END 

REM ---
REM - Restricted case |y| == |{a,b}|, 0 <= a < |x|, 0 <= b < |x| :  x {a, b} <-- y
REM ---
SUBROUTINE s_fwd_replace (x   AS INTEGER, 
                          y   AS INTEGER, 
                          a   AS INTEGER, 
                          b   AS INTEGER)
  LOCAL index    AS INTEGER
  LOCAL letter   AS INTEGER
  a = s_limit (x, a)
  b = s_limit (x, b)
  y = y + STRING_LENGTH_BYTES

  FOR index = a TO b
    letter = EEPROM_PEEK (y)
    EEPROM_POKE (x + STRING_LENGTH_BYTES + index, letter)
    y = y + 1
  NEXT
END



REM ---
REM - Restricted case |y| == |{a,b}|, 0 <= a < |x|, 0 <= b < |x| :  x {a, b} <-- y
REM ---
SUBROUTINE s_rvs_replace (x   AS INTEGER, 
                          y   AS INTEGER, 
                          a   AS INTEGER, 
                          b   AS INTEGER)
  LOCAL index  AS INTEGER
  LOCAL letter AS INTEGER
  a = s_limit (x, a)
  b = s_limit (x, b)
  y = y + STRING_LENGTH_BYTES + s_max (y)

  FOR index = a TO b 
    letter = EEPROM_PEEK (y)
    EEPROM_POKE (x + STRING_LENGTH_BYTES + index, letter)
    y = y - 1
  NEXT
END
 


REM ---
REM - General case:  x {a, b} <-- y
REM --- 
SUBROUTINE s_replace (x AS INTEGER, y AS INTEGER, a AS INTEGER, b AS INTEGER)
  LOCAL difference AS INTEGER
  LOCAL magnitude  AS INTEGER
  LOCAL temp       AS INTEGER
  LOCAL reversal   AS INTEGER

  IF b < a
    reversal = 1
  ELSE
    reversal = 0
  ENDIF

  IF a > s_max (x)
    IF b > s_max (x)
      IF reversal
        s_rappend (x, y)                        : REM degenerate cases implies catenation
      ELSE
        s_cat     (x, y, a)
      ENDIF
      RETURN
    ENDIF
  ENDIF

  a         = s_limit (x, a)
  b         = s_limit (x, b)
  magnitude = s_interval (a, b)
  
  IF s_len (x) <= magnitude
    s_assign (x, y)                             : REM degenerate case implies replacement
    RETURN
  ENDIF

  IF s_len (y) = 0
    difference = s_len (x) - magnitude          : REM degenerate case simplifies deletion
    
    IF (a <= b)
      s_sub_shift (x, a, b + 1, difference)     : REM (direction of interval is irrelevant)
    ELSE
      s_sub_shift (x, b, a + 1, difference)
    ENDIF

    s_set_size  (x, difference)
    RETURN
  ENDIF

  IF s_len (y) = 1
    IF magnitude = 1
      magnitude  = x + STRING_LENGTH_BYTES + a  : REM degenerate case (single char replace)
      difference = EEPROM_PEEK (y + STRING_LENGTH_BYTES) 
      EEPROM_POKE (magnitude, difference)       : REM (NOTE, reuse variables)
      RETURN                 
    ENDIF
  ENDIF

  IF b < a
    temp = a                                    : REM the following cases are general.
    a    = b                                    : REM this condition makes them respond
    b    = temp                                 : REM symmetrically with respect to interval
  ENDIF

  IF s_len (y) < magnitude
    difference = magnitude - s_len (y)          : REM net delete of string
    s_sub_shift   (x, b + 1 - difference, b + 1, s_max (x) - b)
    s_set_size    (x, s_len(x)  - difference)   
  ENDIF

  IF s_len (y) > magnitude                         
    difference   = s_len (y) - magnitude        : REM net increase of string
    s_sub_shift   (x, s_max (x), s_max (x) - difference, difference)
    s_set_size    (x, s_len (x) + difference)  
  ENDIF

  IF reversal
    s_rvs_replace (x, y, a, a + s_max (y))
  ELSE
    s_fwd_replace (x, y, a, a + s_max (y))
  ENDIF
END