'===========================================================================
' Subject: FILL-OUT FORM                     Date: 08-27-97 (11:37)       
' Author:  Alexander Podkolzin               Code: PB                     
' Origin:  app@nw.sbank.e-burg.su          Packet: PB.ABC
'===========================================================================
'$PBB /f/u1/i2/p40 - string for PBB formatter

 $IF 0

 Hi, PB - users!

 This short demo proggy shows how to prepare some simple
 formatted lines of a text. Hope you'll understand my
 "creation" and enjoy it. In any case I'll be very glad
 to get a couple of words from you ! (app@nw.sbank.e-burg.su)

   Restrictions for using of fFillForm function:

   1. Any field has to begin with blank + "@" (" @") .
   2. Any field has to end with blank(inside of a field instead of
      blanks have To be "@"s ) . To understand how to prepare template
      of a form see the "DEMO ORDER FORM" .
   3. Number of lines of a form has to be less then number of lines
      of the screen + 1 and number of cloumns less then 80 + 1.
   4. Length of a Form equals to the length of its first line.
   5. To exit fFillForm press < Esc > or input its last field (<Enter>).

 $ENDIF


'---------------------------------------------------------------------------

 $COMPILE MEMORY
 $DIM ARRAY

 Defint a - z

 Declare Function fFillForm$(x%, y%, Template$(), Dest$(), Cta%, Cba%, Ctb%, Cbb%)
 Declare Function fCountItems%(m$, k%)
 Declare Function fInputField$(x%, y%, n%, Ctb%, Cbb%)
 Declare Function fGetField$(x%, y%, n%)
 Declare Sub APrint(x%, y%, s$, a%)
 Declare Sub CPrint(x%, y%, s$, t%, b%)
 Declare Sub Qprint(x%, y%, st$)
 Declare Sub ClWin(xb%, yb%, xe%, ye%, ct%, cb%)

 %MaxLines = 100
 Dim Template$(%MaxLines)              ' Form template
 Dim Dest$(%MaxLines)                  ' Filled Form

 Template$(01) = "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
 Template$(02) = "³                          DEMO ORDER FORM                            ³"
 Template$(03) = "³                                                                     ³"
 Template$(04) = "³ Name:    @Alexander@Podkolzin@@@@@@@@@@@  Daytime Phone: @227-180@@ ³"
 Template$(05) = "³ Company: @Bla@SoftWare,Inc.@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ³"
 Template$(06) = "³ Address: @Russia,@620149,@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ³"
 Template$(07) = "³ City:    @Ekaterinburg,@P.O.@Box@389@@@@ State: @@@@ Zip: @@@@@@@@@ ³"
 Template$(08) = "³ Payment (check one):  @@@ Check   @X@ Visa   @@@ Master Card        ³"
 Template$(09) = "³ Credit Card Number:   @@0000000000@@@@@@@@@@@@@@@@ Expires: @@@@@@@ ³"
 Template$(10) = "³ Card Holder Name:     @@Bla@Bla@Bla@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ³"
 Template$(11) = "³ Authorized Signature: @@@@@@@@@@@@@@@@@@@@@@@ Date: @08-27-1997@@@@ ³"
 Template$(12) = "³                                                                     ³"
 Template$(13) = "³ Quantity   Product                             Price     Total      ³"
 Template$(14) = "³ ========   =================================   =====    =======     ³"
 Template$(15) = "³ @1@@@@@    BlaBlaBla Professional               $002    @@$002@     ³"
 Template$(16) = "³ @@@@@@@    BlaBlaBla Usual Edition              $001    @@@@@@@     ³"
 Template$(17) = "³                                               Total:    @@$002@     ³"
 Template$(18) = "³                                                                     ³"
 Template$(19) = "³ Bla Software, Inc.         Use Up and Down keys to navigate...      ³"
 Template$(20) = "³                                                                     ³"
 Template$(21) = "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
 Template$(22) = ""

 Cls

 s$ = fFillForm(1, 1, Template$(), Dest$(), 0, 7, 0, 3)

 i = 1
 Do While Dest$(i) <> ""
   CPrint 1, i, Dest$(i), 15, 1
   Incr i
 Loop

 Color 7, 0
 Locate 25, 1
 Print "You have got your Form. Press a key...";

 s$ = Input$(1)                        ' Pause

 Cls
 Print "Bye!"

 End

'---------------------------------------------------------------------------
 Function fFillForm$(x%, y%, Template$(), Dest$(), Cta%, Cba%, Ctb%, Cbb%)
'
' Returns NULL string "" if ESC was pressed.
' Returns blank string " " if the last field of a form was inputted.
' In any case returns the result form in Dest$() array.
'
   FormLen% = Len(Template$(1))

   FirstLine% = 0
   LastLine% = 0
   For i% = 1 To Ubound(Template$())   ' Find first and
     s$ = Template$(i%)
     If s$ = "" Then
       TotalLines% = i% - 1
       Exit For
     End If
     If Instr(s$, "@") And FirstLine% = 0 Then
       FirstLine% = i%
     End If
   Next

   For i% = TotalLines% To 1 Step - 1  ' last lines numbers
     If Instr(Template$(i), "@") Then
       LastLine% = i%
       Exit For
     End If
   Next

   Items% = 0
   For i% = FirstLine% To LastLine%    ' Find number of fields of a Form
     Incr Items%, Tally(Template$(i%), " @")
   Next

   Redim Items%(Items%, 3)             ' X coord, Y coord, Len of a field
   TotalItems% = 1
   For i% = FirstLine% To LastLine%
     k% = 1
     Do
       k% = Instr(k%, Template$(i%), " @")
       If k% = 0 Then Exit Loop
       Items%(TotalItems%, 1) = k% + 1
       Items%(TotalItems%, 2) = i%
       z% = fCountItems(Template$(i%), k%)
       Items%(TotalItems%, 3) = z%
       Incr k%, z%
       Incr TotalItems%
     Loop
   Next
   Decr TotalItems%

   Clwin x%, y%, x% + FormLen% - 1, y% + TotalLines% - 1, Cta%, Cba%

   For i% = 1 To TotalItems%
     Call Cprint(Items%(i%, 1) + x% - 1, Items%(i%, 2) + y% - 1, Space$(Items%(i%, 3)), Ctb%, Cbb%)
   Next

   For i% = 1 To TotalLines%
     s$ = Template$(i%)
     Replace "@" With " " In s$
     Call Qprint(x%, y% + i% - 1, s$)
   Next

   s$ = ""
   i% = 1
   Do
     If i% > TotalItems% And s$ <> "" Then
       Function = " "
       Exit Loop
     End If

     s$ = fInputField(Items%(i%, 1) + x% - 1, Items%(i%, 2) + y% - 1, Items%(i%, 3), Ctb%, Cbb%)


     If s$ = "" Then
       Function = ""
       Exit Loop
     End If

     If s$ = "U" Then
       Decr i%
       s$ = ""
     Elseif s$ = "D" Then
       Incr i%
       s$ = ""
     End If

     If i% > TotalItems% Then i% = 1
     If i% < 1 Then i% = TotalItems%

     If s$ <> "" Then
       Mid$(Dest$(Items%(i%, 2)), Items%(i%, 1), Items%(i%, 3)) = s$
       Incr i%
     End If
   Loop

   Gosub GetForm
   Exit Function

   GetForm:

   For k% = 0 To TotalLines% - 1
     Dest$(k% + 1) = fGetField(x%, y% + k%, FormLen%)
   Next

   Return

 End Function
'---------------------------------------------------------------------------
 Function fCountItems%(m$, k%)         ' Calculates number of fields in a string
   n% = 0
   For i% = 1 To Len(m$) - k% + 1
     If Mid$(m$, k% + i%, 1) = " " Then Exit For
     Incr n%
   Next
   Function = n%
 End Function
'---------------------------------------------------------------------------
 Function fInputField$(x%, y%, n%, Ctb%, Cbb%)

   Static Ins%                         ' Switcher of Ins-mode.

   Enter$ = Chr$(13)                   ' List of keys, we need in
   Esc$ = Chr$(27)                     ' our function.
   BcSp$ = Chr$(8)                     '
   Ins$ = Chr$(0, 82)
   Home$ = Chr$(0, 71)
   Del$ = Chr$(0, 83)
   EndKey$ = Chr$(0, 79)
   LeftKey$ = Chr$(0, 75)
   RightKey$ = Chr$(0, 77)
   UpKey$ = Chr$(0, 72)
   DownKey$ = Chr$(0, 80)
   TabKey$ = Chr$(9)

   TextColor% = 15                     ' Bright white
   BackColor% = 4                      ' on Red
   OldX% = Pos(0)                      ' As well-bred programmers, :)
   OldY% = Csrlin                      ' we have to save screen parameters.
   OldColor% = Pbvscrntxtattr          ' Internal PB variables: color,
   Vis% = Pbvcursorvis                 ' cursor is visiable (TRUE or FALSE),
   Sl1% = Pbvcursor1                   ' top line of cursor,
   Sl2% = Pbvcursor2                   ' bottom line.

   Ptr% = x%                           ' Current cursor position.
   Color textcolor%, backcolor%        ' Colors we'll use in our function.

   Edit$ = fGetField$(x%, y%, n%)
   Locate y%, x%
   Print Edit$;
   f% = 0
   MaxPtr% = x% + n% - 1

   Do                                  ' Main loop:

     If Ptr% < x% Then                 ' First of all we
       Ptr% = x%                       ' have
       Iterate Loop                    ' to
     End If                            ' normalize

     If Ptr% > MaxPtr% Then            ' the
       Ptr% = MaxPtr%                  ' cursor position.
       Iterate Loop
     End If

     If Ins% = 0 Then
       Locate y%, Ptr%, 1, 7, 8        ' Usual cursor
     Else                              '
       Locate y%, Ptr%, 1, 5, 8        ' "Ins" cursor
     End If

     While Not Instat: Wend
     s$ = Inkey$

     If Len(s$) = 2 Then
       f% = 1
     End If

     Select Case s$
     Case TabKey$
       Iterate Loop
     Case Esc$
       s$ = ""
       Edit$ = fGetField(x%, y%, n%)
       Function = ""
       Exit Loop
     Case Enter$
       s$ = fGetField(x%, y%, n%)
       If s$ = "" Then s$ = " "
       Function = s$
       Exit Loop
     Case Ins$
       Ins% = Ins% Xor 1
       Iterate Loop
     Case Home$
       Ptr% = x%
       Iterate Loop
     Case EndKey$
       Ptr% = x% + Len(Rtrim$(fGetField(x%, y%, n%)))
       Iterate Loop
     Case LeftKey$
       Decr Ptr%
       Iterate Loop
     Case RightKey$
       Incr Ptr%
       Iterate Loop
     Case UpKey$
       Function = "U"                  ' Up
       Exit Loop
     Case DownKey$
       Function = "D"                  ' Down
       Exit Loop
     Case Del$
       m% = Ptr% - x%
       k% = x% + n% - Ptr%
       Edit$ = fGetField$(x%, y%, m%) + fGetField$(Ptr% + 1, y%, k%)
     Case BcSp$                        ' Exception!
       f% = 1
       Decr Ptr%                       '
       If Ptr% < x% Then               ' Normalize the cursor
         Ptr% = x%                     ' position here.
         Iterate Loop                  '
       End If
       m% = Ptr% - x%
       k% = x% + n% - Ptr%
       Edit$ = fGetField$(x%, y%, m%) + fGetField$(Ptr% + 1, y%, k%)
     Case Else
       If Len(s$) = 1 Then
         If f% = 0 Then
           Locate y%, x%
'''           Print Space$(n%)       ''' Try uncommented ! :)
           f% = 1
         End If
         m% = Ptr% - x%                ' Symbols before cursor
         k% = MaxPtr% - Ptr%           ' Symbols after cursor
         If Ins% = 1 Then              ' Editing in Ins-mode
           Edit$ = fGetField$(x%, y%, m%) + s$ + fGetField$(Ptr%, y%, k%)
           Edit$ = Left$(Edit$, n%)
         Else                          ' Editing in usual mode
           Edit$ = fGetField$(x%, y%, m%) + s$ + fGetField$(Ptr% + 1, y%, k%)
         End If
         Incr Ptr%
       End If
     End Select
     Locate y%, x%, 0, 0, 0            ' Make cursor invisiable
     Print Edit$;                      '
   Loop                                ' End of main loop.
   If Vis% Then                        ' Now we have
     Vs% = 0                           ' to
   Else                                ' restore the
     Vs% = 1                           ' screen parameters.
   End If                              '
   ct% = OldColor% And 15
   cb% = OldColor% \ 16
   Color ct%, cb%
   Locate Oldy%, OldX%, Vs%, Sl1%, Sl2%
   Call Cprint(x%, y%, Edit$, Ctb%, Cbb%)

 End Function
'---------------------------------------------------------------------------
' Fast replacement of SCREEN function (about 100 times faster).

 Function fGetField$(x%, y%, n%)

   Dim Cell As Byte Ptr
   Dim TextPtr As Byte Ptr

   st$ = Space$(n%)
   TextPtr = Strptr32(st$)
   Cell = Pbvscrnbuff + (y% - 1) * 160 + (x% - 1) * 2

   For i% = 1 To Len(st$)
     @TextPtr = @Cell
     Incr TextPtr
     Incr Cell, 2
   Next

   Function = st$

 End Function
'---------------------------------------------------------------------------
' Here goes some simplified subs...

 Sub APrint(x%, y%, s$, a%)

   Dim t As Integer
   Dim b As Integer
   Dim ox As Integer
   Dim oy As Integer

   OldColor = Pbvscrntxtattr
   ox = Pos(0)
   oy = Csrlin

   t = a% And 15
   b = a% \ 16

   Color t, b
   Locate y%, x%
   Print s$;

   Locate oy, ox
   Pbvscrntxtattr = OldColor

 End Sub
'---------------------------------------------------------------------------
 Sub CPrint(x%, y%, s$, t%, b%)

   Dim a As Integer

   a = b% * 16 + t%
   Aprint x%, y%, s$, a

 End Sub
'---------------------------------------------------------------------------
 Sub Qprint(x%, y%, st$)

   Dim Cell As Byte Ptr
   Dim TextPtr As Byte Ptr

   TextPtr = Strptr32(st$)
   Cell = Pbvscrnbuff + (y% - 1) * 160 + (x% - 1) * 2

   For i% = 1 To Len(st$)
     @Cell = @TextPtr
     Incr TextPtr
     Incr Cell, 2
   Next

 End Sub
'---------------------------------------------------------------------------
 Sub ClWin(xb%, yb%, xe%, ye%, ct%, cb%)

   Reg 1, &H0600
   Reg 2, cb% * 4096 + ct% * 256
   Reg 3,(yb% - 1) * 256 + (xb% - 1)
   Reg 4,(ye% - 1) * 256 + (xe% - 1)
   Call Interrupt &H10

 End Sub
'---------------------------------------------------------------------------

' Formatted : 11:17:26  08-27-1997