' ********************
' *** ARRAYSTR.LST ***
' ********************
' *** important : element with index 0 is ignored !!
'
DEFWRD "a-z"
'
> PROCEDURE freq.string.array(elem$,VAR proc$(),freq)
  ' *** returns frequency of elem$ in string array
  LOCAL last,n
  last=DIM?(proc$())-1
  freq=0
  FOR n=1 TO last
    IF proc$(n)=elem$
      INC freq
    ENDIF
  NEXT n
RETURN
' **********
'
> PROCEDURE trim.string.array(VAR proc$())
  ' *** remove spaces from beginning and end of all strings
  LOCAL n
  FOR n=1 TO DIM?(proc$())-1
    proc$(n)=TRIM$(proc$(n))
  NEXT n
RETURN
' **********
'
> PROCEDURE show.text(title$,VAR proc$())
  ' *** show text in array proc$() on screen (20 lines/screen)
  ' *** ETX (CHR$(3) may be used in array as marker for end of text
  ' *** empty lines at end of text are ignored, unless ETX follows
  ' *** use in High or Medium resolution
  '
  ' *** uses Procedures Message.on, Message.off, Scroll.text.up,Scroll.text.down
  ' *** uses Standard-Globals & Standard-Functions !
  '
  LOCAL line.up$,line.dwn$,page.up$,page.dwn$,first.page$,last.page$
  LOCAL last,command$,n,empty,etx!,total$,in$
  LOCAL screen$,first.line,show!,regel
  last=DIM?(proc$())-1
  line.up$=CHR$(0)+CHR$(72)            ! down arrow
  line.dwn$=CHR$(0)+CHR$(80)           ! up arrow
  page.up$=CHR$(56)                    ! <Shift> up arrow
  page.dwn$=CHR$(50)                   ! <Shift> down arrow
  first.page$=CHR$(0)+CHR$(59)         ! <F1>
  last.page$=CHR$(0)+CHR$(68)          ! <F10>
  command$=esc$+line.up$+line.dwn$+page.up$+page.dwn$+first.page$+last.page$
  FOR n=1 TO last
    IF proc$(n)<>""
      empty=n                          ! possibly blank lines from empty+1
    ENDIF
    etx!=TRUE
    EXIT IF proc$(n)=CHR$(3)           ! ETX (End Of Text) found in array
    etx!=FALSE
  NEXT n
  IF etx!
    last=n-1
  ELSE
    IF empty<last
      last=empty                       ! blank lines from empty+1
    ENDIF
  ENDIF
  '
  CLS
  PRINT @center$(@rev$(" "+title$+" "))
  total$="total : "+STR$(last)+" lines"
  PRINT AT(scrn.col.max-LEN(total$),1);total$;
  PRINT AT(1,1);" line"
  DEFLINE 1,5
  LINE 0,1.5*char.height,scrn.x.max,1.5*char.height
  LINE 0,22.5*char.height,scrn.x.max,22.5*char.height
  DEFLINE 1,1
  PRINT AT(1,24);" ";
  OUT 5,1
  PRINT " = line up";
  PRINT AT(1,25);" ";
  OUT 5,2
  PRINT " = line down";
  PRINT AT(20,24);"<Shift> ";
  OUT 5,1
  PRINT " = page up";
  PRINT AT(20,25);"<Shift> ";
  OUT 5,2
  PRINT " = page down";
  PRINT AT(45,24);"<F1>  = first page";
  PRINT AT(45,25);"<F10) = last page";
  PRINT AT(68,24);"<Esc> = exit";
  '
  SGET screen$
  first.line=1
  show!=TRUE
  DO
    IF show!
      regel=1
      n=first.line
      WHILE regel<=20 AND n<=last
        IF LEN(proc$(n))>80
          PRINT AT(1,2+regel);LEFT$(proc$(n),79);
          OUT 5,3
        ELSE
          PRINT AT(1,2+regel);proc$(n)
        ENDIF
        INC regel
        INC n
      WEND
      DEC n
      PRINT AT(7,1);first.line;" - ";n
    ENDIF
    '
    REPEAT
      in$=INKEY$
    UNTIL INSTR(command$,in$)
    EXIT IF in$=esc$
    '
    IF in$=line.up$
      IF first.line=1
        PRINT bel$;
        @message.on("first line !")
        PAUSE 50
        @message.off
        show!=FALSE
      ELSE
        DEC first.line
        show!=FALSE
        @scroll.text.down(3,21)
        PRINT AT(1,3);STRING$(80," ");
        IF LEN(proc$(first.line))>80
          PRINT AT(1,3);LEFT$(proc$(first.line),79);
          OUT 5,3
        ELSE
          PRINT AT(1,3);proc$(first.line)
        ENDIF
        n=first.line+19
        PRINT AT(7,1);first.line;" - ";n;"     "
      ENDIF
    ENDIF
    '
    IF in$=line.dwn$
      IF n=last OR first.line+20>last
        PRINT bel$;
        @message.on("last line !")
        PAUSE 50
        @message.off
        show!=FALSE
      ELSE
        INC first.line
        show!=FALSE
        @scroll.text.up(4,22)
        n=first.line+19
        PRINT AT(1,22);STRING$(80," ");
        IF LEN(proc$(n))>80
          PRINT AT(1,22);LEFT$(proc$(n),79);
          OUT 5,3
        ELSE
          PRINT AT(1,22);proc$(n)
        ENDIF
        PRINT AT(7,1);first.line;" - ";n;"     "
      ENDIF
    ENDIF
    '
    IF in$=page.up$
      IF first.line=1
        PRINT bel$;
        @message.on("first line !")
        PAUSE 50
        @message.off
        show!=FALSE
      ELSE
        IF first.line>20
          SUB first.line,20
        ELSE
          first.line=1
        ENDIF
        SPUT screen$
        show!=TRUE
      ENDIF
    ENDIF
    '
    IF in$=page.dwn$
      IF n>=last
        PRINT bel$;
        @message.on("last line !")
        PAUSE 50
        @message.off
        show!=FALSE
      ELSE
        IF first.line+20<last
          ADD first.line,20
        ELSE
          first.line=last-19
        ENDIF
        IF first.line<1
          first.line=1
        ENDIF
        SPUT screen$
        show!=TRUE
      ENDIF
    ENDIF
    '
    IF in$=first.page$
      first.line=1
      SPUT screen$
      show!=TRUE
    ENDIF
    IF in$=last.page$
      first.line=last-19
      IF first.line<1
        first.line=1
      ENDIF
      SPUT screen$
      show!=TRUE
    ENDIF
    '
  LOOP
RETURN
' **********
'
> PROCEDURE show.text.page(VAR proc$())
  ' *** show text in array proc$() on screen (20 lines/screen)
  ' *** ETX (CHR$(3) may be used in array as marker for end of text
  ' *** empty lines at end of text are ignored, unless ETX follows
  ' *** use in High or Medium resolution
  '
  ' *** uses Standard-Globals
  '
  LOCAL last,n,empty,etx!,total$,in$,block,gap,y1,y2,x1,x2,x3
  LOCAL t1$,t2$,t3$,screen$,first.line,show!,regel,x,y,k,key$
  last=DIM?(proc$())-1
  FOR n=1 TO last
    IF proc$(n)<>""
      empty=n                         ! possibly blank lines from empty+1
    ENDIF
    etx!=TRUE
    EXIT IF proc$(n)=CHR$(3)          ! ETX (End Of Text) found in array
    etx!=FALSE
  NEXT n
  IF etx!
    last=n-1
  ELSE
    IF empty<last
      last=empty                      ! blank lines from empty+1
    ENDIF
  ENDIF
  '
  CLS
  DEFLINE 1,5
  LINE 0,22*char.height,scrn.x.max,22*char.height
  DEFLINE 1,1
  DEFFILL ,2,4
  FILL scrn.x.max,scrn.y.max
  DEFFILL ,0
  block=17*8
  gap=(scrn.x.max-3*block)/4
  y1=23*char.height-1
  y2=24*char.height+1
  x1=gap-1
  x2=2*gap+block-3
  x3=3*gap+2*block-1
  PBOX x1,y1,x1+block+1,y2
  PBOX x2,y1,x2+block+1,y2
  PBOX x3,y1,x3+block+1,y2
  GET x1,y1,x1+block+1,y2,t1$
  GET x2,y1,x2+block+1,y2,t2$
  GET x3,y1,x3+block+1,y2,t3$
  PRINT AT(10,24);"  next page    "
  PRINT AT(33,24);" previous page "
  PRINT AT(57,24);"      exit     "
  LOCATE 8,24
  OUT 5,2
  LOCATE 24,24
  OUT 5,2
  LOCATE 32,24
  OUT 5,1
  LOCATE 48,24
  OUT 5,1
  LOCATE 57,24
  OUT 5,27
  LOCATE 72,24
  OUT 5,27
  BOX x1,y1,x1+block+1,y2
  BOX x2,y1,x2+block+1,y2
  BOX x3,y1,x3+block+1,y2
  '
  SGET screen$
  first.line=1
  show!=TRUE
  SHOWM
  REPEAT
  UNTIL INKEY$=""
  DO
    IF show!
      regel=1
      n=first.line
      WHILE regel<=20 AND n<=last
        IF LEN(proc$(n))>80
          PRINT AT(1,1+regel);LEFT$(proc$(n),79);
          OUT 5,3
        ELSE
          PRINT AT(1,1+regel);proc$(n)
        ENDIF
        INC regel
        INC n
      WEND
      DEC n
    ENDIF
    '
    CLR page.dwn!,page.up!,exit!
    REPEAT
      MOUSE x,y,k
      key$=INKEY$
      IF y>23*char.height AND k=1
        IF x>=x1 AND x<=x1+block
          page.dwn!=TRUE
          PUT x1,y1,t1$,10
        ENDIF
        IF x>=x2 AND x<=x2+block
          page.up!=TRUE
          PUT x2,y1,t2$,10
        ENDIF
        IF x>=x3 AND x<=x3+block
          exit!=TRUE
          PUT x3,y1,t3$,10
        ENDIF
      ENDIF
      SELECT ASC(RIGHT$(key$))
      CASE 80
        page.dwn!=TRUE
        PUT x1,y1,t1$,10
      CASE 72
        page.up!=TRUE
        PUT x2,y1,t2$,10
      CASE 27
        exit!=TRUE
        PUT x3,y1,t3$,10
      ENDSELECT
    UNTIL page.dwn! OR page.up! OR exit!
    PAUSE 10
    '
    EXIT IF exit!
    '
    IF page.up!
      IF first.line=1
        PRINT bel$;
        PUT x2,y1,t2$,10
        show!=FALSE
      ELSE
        IF first.line>20
          SUB first.line,20
        ELSE
          first.line=1
        ENDIF
        SPUT screen$
        show!=TRUE
      ENDIF
    ENDIF
    '
    IF page.dwn!
      IF n>=last
        PRINT bel$;
        PUT x1,y1,t1$,10
        show!=FALSE
      ELSE
        IF first.line+20<last
          ADD first.line,20
        ELSE
          first.line=last-19
        ENDIF
        IF first.line<1
          first.line=1
        ENDIF
        SPUT screen$
        show!=TRUE
      ENDIF
    ENDIF
    '
  LOOP
  '
RETURN
' **********
'
> PROCEDURE initio.text.array
  ' *** fill text-array with DATA-lines
  ' *** end of text indicated with ***
  ' *** use in High or Medium resolution
  ' *** global :  TEXT$()
  LOCAL lines,line$,n
  lines=0
  RESTORE txt.data
  READ line$
  REPEAT
    INC lines
    READ line$
  UNTIL line$="***"
  ERASE text$()
  DIM text$(lines)
  RESTORE txt.data
  FOR n=1 TO lines
    READ text$
    text$(n)=SPACE$(5)+text$           ! left margin of 5 spaces !!
  NEXT n
  '
  ' *** switch editor to Overwrite-mode before entering text
  ' *** 70 characters/line
  txt.data:
  DATA "1234567890123456789012345678901234567890123456789012345678901234567890"
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "                                                                      "
  DATA "1234567890123456789012345678901234567890123456789012345678901234567890"
  DATA ***
RETURN
' **********
'
> PROCEDURE initio.text.array.low
  ' *** fill text-array with DATA-lines
  ' *** end of text indicated with ***
  ' *** use in Low resolution
  ' *** global :  TEXT$()
  LOCAL lines,line$,n
  lines=0
  RESTORE txt.low.data
  READ line$
  REPEAT
    INC lines
    READ line$
  UNTIL line$="***"
  ERASE text$()
  DIM text$(lines)
  RESTORE txt.data
  FOR n=1 TO lines
    READ text$
    text$(n)=text$
  NEXT n
  '
  ' *** switch editor to Overwrite-mode before entering text
  ' *** 40 characters/line
  txt.low.data:
  DATA "1234567890123456789012345678901234567890"
  DATA "                                        "
  DATA "                                        "
  DATA "                                        "
  DATA "                                        "
  DATA "                                        "
  DATA "                                        "
  DATA "                                        "
  DATA "                                        "
  DATA "                                        "
  DATA "                                        "
  DATA "1234567890123456789012345678901234567890"
  DATA ***
RETURN
' **********
'