'===========================================================================
' Subject: REPLACES PB (LINE)INPUT           Date: 12-19-96 (12:38)       
' Author:  Egbert Zijlema                    Code: PB                     
' Origin:  E.Zijlema@uni4nn.iaf.nl         Packet: PB.ABC
'===========================================================================
' PBINPUT.BAS - replaces Basic's (LINE)INPUT
' Author      : Egbert Zijlema (E.Zijlema@uni4nn.iaf.nl)
' (up)Date    : 19 December 1996
' Status      : Public Domain
' Language    : Power Basic 3.2

DEFINT A - Z                        ' all vars integer, unless tagged

' ----- data for character translation
quotation:
DATA  16
DATA  65, 142
DATA  79, 153
DATA  85, 154
DATA  97, 132
DATA 101, 137
DATA 105, 139
DATA 111, 148
DATA 117, 129

apostrofe:
DATA  12
DATA  69, 144
DATA  97, 160
DATA 101, 130
DATA 105, 161
DATA 111, 162
DATA 117, 163

semicolon:
DATA  4
DATA 67, 128
DATA 99, 135

circmflex:
DATA  10
DATA  97, 131
DATA 101, 136
DATA 105, 140
DATA 111, 147
DATA 117, 150

backaccnt:
DATA  10
DATA  97, 133
DATA 101, 138
DATA 105, 141
DATA 111, 149
DATA 117, 151

manana:
DATA   4
DATA  78, 165
DATA 110, 164
' ----- end of character data

%NO = 0 : %YES = NOT %NO            ' true/false Boolean
%F10  = 68 * 256                    ' save text / see: SUB editor()
%HOME = 71 * 256 : %UP    = 72 * 256 : %PGUP = 73 * 256
%LEFT = 75 * 256 : %RIGHT = 77 * 256 : %END  = 79 * 256
%DOWN = 80 * 256 : %PGDN  = 81 * 256 : %DEL  = 83 * 256
%BACKSPACE =  8  : %ESC   = 27
%ENTER     = 13  : %CTRLY = 25

' equates for special characters:
%ALTA      = 30 * 256               ' Alt-a = �
%ALTB      = 48 * 256               ' Alt-b = �
%ALTC      = 46 * 256               ' Alt-c = dollar �ent
%ALTF      = 33 * 256               ' Alt-f = Dutch �lorin
%ALTL      = 38 * 256               ' pound sterling
%ALTP      = 25 * 256               ' Spanish peseta
%ALTY      = 21 * 256               ' Japanes �en

SUB editor (row, col, text$, length, rows, last)
  OldInsert = IsIns                                    ' save insert modus
  InsertOn                                             ' insert
  text$ = LTRIM$(RTRIM$(text$))
  COLOR 15, 0
  LOCATE row, col : PRINT text$
  cursor = LEN(text$) + 1

  DO
    COLOR 15, 0                                        ' bold edit line

    ' display insert status
    LOCATE 25, 73
    IF IsIns THEN
      PRINT " INS ";
    ELSE
      PRINT SPACE$(5);
    END IF

    LOCATE row, col + cursor - 1, 1                    ' visible cursor
    KeyIn = GetKey
    SELECT CASE KeyIn
      CASE %HOME: cursor = 1
      CASE %END : cursor = LEN(text$) + 1
      CASE %LEFT
        IF cursor > 1 THEN DECR cursor
      CASE %RIGHT
        IF cursor < LEN(text$) + 1 THEN INCR cursor
      CASE %DEL
        text$ = LEFT$(text$, cursor - 1) + MID$(text$, cursor + 1)
      CASE %BACKSPACE
        IF cursor > 1 THEN
          text$ = LEFT$(text$, cursor - 2) + MID$(text$, cursor)
          DECR cursor
        END IF
      CASE %CTRLY
        cursor = 1: text$ = ""                         ' erase line
      CASE %UP
        IF rows > 1 THEN
          DECR rows
          EXIT DO
        END IF
      CASE %ENTER
        INCR rows
        EXIT DO
      CASE %DOWN
        ' same as ENTER but not when in the last line
        IF rows < last THEN
          INCR rows
          EXIT DO
        END IF
      CASE %PGUP
        IF rows <> 1 THEN
          rows = 1
          EXIT DO
        END IF
      CASE %PGDN
        IF rows <> last THEN
          rows = last
          EXIT DO
        END IF
      CASE %F10
        ' after editing the last line, pressing ENTER will save all
        ' however, after you made a last minute modification
        ' elsewhere, there is no need to re-scroll to the bottom line
        ' F10 saves your edited work instead
        rows = last + 1
        EXIT DO
      CASE %ESC
        text$ = ""
        rows = last + 2                                ' don 't save
        EXIT DO
      CASE 32, 33, 35 TO 38, 40 TO 58, 60 TO 93, 95, 97 TO 123, 125
        IF previous THEN
          SELECT CASE previous
            CASE 34 : RESTORE quotation
            CASE 39 : RESTORE apostrofe
            CASE 59 : RESTORE semicolon
            CASE 94 : RESTORE circmflex
            CASE 96 : RESTORE backaccnt
            CASE 126: RESTORE manana
          END SELECT
          READ HowMany
          FOR reading = 1 TO HowMany
            READ AskiCode
            IF AskiCode = KeyIn THEN
              READ KeyIn
              DeadKey = %NO                ' skip dead key
              EXIT FOR
            ELSE
              DeadKey = %YES               ' save dead key
            END IF
          NEXT
        END IF
        IF DeadKey THEN
          DeadKey = %NO
          text$ = modify(cursor, text$, previous, length)
        END IF
        previous = 0
        text$ = modify(cursor, text$, KeyIn, length)
      CASE 34, 39, 59, 94, 96, 126                     ' dead keys
        IF previous = KeyIn THEN
          previous = 0
          text$ = modify(cursor, text$, KeyIn, length)
        ELSE
          previous = KeyIn
        END IF
      CASE %ALTA, %ALTB, %ALTC, %ALTF, %ALTL, %ALTP, %ALTY
        SELECT CASE KeyIn
         CASE %ALTA : KeyIn = 134                      ' �
         CASE %ALTB : KeyIn = 143                      ' �
         CASE %ALTC : KeyIn = 155                      ' dollar cent
         CASE %ALTF : KeyIn = 159                      ' dutch florin
         CASE %ALTL : KeyIn = 156                      ' sterling
         CASE %ALTP : KeyIn = 158                      ' Sp. peseta
         CASE %ALTY : KeyIn = 157                      ' Jap. yen
        END SELECT
        text$ = modify(cursor, text$, KeyIn, length)
    END SELECT
    LOCATE row, col : PRINT SPACE$(length)             ' clear field
    LOCATE row, col : PRINT text$
  LOOP

  IF OldInsert THEN InsertOn ELSE InsertOff            ' restore insert modus
  COLOR 7, 0
  LOCATE 25, 73 : PRINT SPACE$(5);                     ' clear INS-field
  LOCATE row, col : PRINT text$                        ' unbold ready text
END SUB

FUNCTION GetKey AS INTEGER
  DO
  LOOP UNTIL INSTAT
  FUNCTION = CVI(INKEY$ + CHR$(0))
END FUNCTION

SUB InsertOff
  DEF SEG = 64
  POKE 23, PEEK(23) AND 127
  DEF SEG
END SUB

SUB InsertOn
  DEF SEG = 64
  POKE 23, PEEK(23) OR 128
  DEF SEG
END SUB

FUNCTION IsIns AS INTEGER
  DEF SEG = 64
  FUNCTION = (PEEK(23) AND 128) = 128
  DEF SEG
END FUNCTION

FUNCTION modify(cursor, text$, KeyIn, length) AS STRING
  txt$ = LEFT$(text$, cursor - 1) + CHR$(KeyIn) + _
         MID$(text$, cursor + IsIns + 1)
  IF LEN(txt$) > length THEN txt$ = LEFT$(txt$, length)
  IF cursor < LEN(txt$) + 1 THEN INCR cursor
  FUNCTION = txt$
END FUNCTION

'  main module
CLS
  COLOR 7, 0

  ' The following text  only serves this demo. It may be left out

  LOCATE 1, 2 : PRINT "PBINPUT.BAS (Author: Egbert Zijlema)"
  LOCATE 2, 2 : PRINT "===================================="
  LOCATE 4, 2 : PRINT "These line editor includes accented characters ";
                PRINT "to match the needs of"
  LOCATE 5, 2 : PRINT "our European friends. It uses ";CHR$(39);"dead";
                PRINT CHR$(39);" keys. After pressing such a key"
  LOCATE 6, 2 : PRINT "nothing happens until you press another key."
  LOCATE 8, 2 : PRINT "Dead keys are: ";
  COLOR 15    : PRINT CHR$(34, 32, 39, 32, 59, 32, 94, 32, 96, 32, 126)
  COLOR 7
  LOCATE 10, 2 : PRINT "Examples:"
  LOCATE 11, 2: PRINT "Pressing the quotation mark (";CHR$(34);
                PRINT ") followed by the character a returns: ";
                PRINT CHR$(132);"."
  LOCATE 12, 2: PRINT "Apostrophe (";CHR$(39);") followed by e = ";
                PRINT CHR$(130);", circumflex (";CHR$(94);") + o = ";
                PRINT CHR$(147);". And so forth."
  LOCATE 13, 2: PRINT "Pressing a dead key twice means the character ";
                PRINT "itself will be displayed."
  LOCATE 15, 2: PRINT "In addition, some characters can be generated by ";
                PRINT "pressing the Alt key,"
  LOCATE 16, 2: PRINT "followed by a character key (see: equates above). ";
                PRINT "Alt-f, for instance,"
  LOCATE 17, 2: PRINT "returns Dutch florin (";CHR$(159);")."
  LOCATE 25, 2: PRINT "Press any key to try it yourself";

  DO : LOOP UNTIL LEN(INKEY$)

  ' ------- end of redundant screen text

  ' program starts here:
  CLS
  rows = 1   ' start at first row
  last = 4   ' edit 4 rows
  LOCATE 2, 2: PRINT "First line : "
  LOCATE 3, 2: PRINT "Second line: "; second$
  LOCATE 4, 2: PRINT "Third line : "
  LOCATE 5, 2: PRINT "Fourth line: "

  DO
    SELECT CASE rows
      CASE 1
        length = 30             ' maximum 30 chars
        editor 2, 15, first$, length, rows, last
      CASE 2
        length = 30
        editor 3, 15, second$, length, rows, last
      CASE 3
        length = 8
        editor rows + 1, 15, third$, length, rows, last
      CASE 4
        length = 15
        editor rows + 1, 15, fourth$, length, rows, last
    END SELECT
  LOOP UNTIL rows > last

  LOCATE 10, 2
  IF rows = last + 1 THEN                     ' normal exit
    ' normally you save your work here
    PRINT "No, there is no 5th line; we don't compose limericks after all!"
  ELSE
    PRINT "You pressed Esc; your work will not be saved"
  END IF
END