.CM  SCRIPT , Version - 1.1 , last edited by holger
.pa
.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 2000-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VIN59$
.tt 2 $$$
.tt 3 $RaymondR$Test VT$1999-11-23$
***********************************************************
.nf
 
.nf
 
 .nf

    ========== licence begin  GPL
    Copyright (c) 2000-2005 SAP AG

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
.fo

 
.fo
 
 
.fo
.nf
.sp
MODULE  : Testmodul f?ur das virtuelle Terminal
=========
.sp
Purpose : Test des Virt. Terminals
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
&       ifndef WINDOWS
        PROCEDURE
              in59main;
&       else
 
        FUNCTION
              sqlininit (
                    cancelb_ptr : tsp00_BoolAddr) : tsp00_Int4;
 
        PROCEDURE
              sqlinmain (
                    VAR i59g : vtt_global );
 
        PROCEDURE
              sqlinterminate (
                    VAR i59g : vtt_global );
 
        FUNCTION
              sqlincallback (
                    VAR g           : tsp00_MoveObj;
                    rf              : tin_ls_releasemode;
                    context         : tsp00_BufAddr;
                    callback_switch : tsp00_Int2;
                    VAR csr_pos     : tin_ls_position) : tsp00_DgcallbackResult;
&       endif
 
.CM *-END-* define --------------------------------------
 
.sp;.cp 3
Use     :
 
        FROM
              VTTEST_Help_procedures : VIN58 ;
 
        PROCEDURE
              i58prottermdesc;
 
        PROCEDURE
              i58encpf (
                    key     : tsp00_VtKey;
                    lablen  : integer;
                    VAR str : vtt_string);
 
        PROCEDURE
              i58encmouse_pos (
                    mouse_pos   : tsp00_VtKeyStroke;
                    VAR pos_str : vtt_string);
 
        PROCEDURE
              i58buildtext (
                    field_att : tsp00_VtAttrib;
                    lablen    : tin_natural;
                    VAR str   : vtt_string);
 
        PROCEDURE
              i58defaultlabel (
                    VAR str : vtt_string);
 
        PROCEDURE
              i58move (
                    piece      : tsp00_C20;
                    strip      : boolean;
                    VAR field  : tsp00_Line;
                    VAR length : tin_natural);
 
        PROCEDURE
              i58encnumber (
                    n       : integer;
                    digits  : integer;
                    VAR s20 : tsp00_C20);
 
        FUNCTION
              i58splitcommand(
                    VAR buf    : tin_screenline;
                    len        : tsp00_Int2 ;
                    VAR nr_min : tsp00_Int2;
                    VAR nr_max : tsp00_Int2 ;
                    VAR lines1 : tsp00_Int2;
                    VAR lines2 : tsp00_Int2) : boolean;
 
      ------------------------------ 
 
        FROM
              global_variable : VIN01;
 
        VAR
              i01g : tin_global_in_vars;
 
      ------------------------------ 
 
        FROM
              global_init : VIN02;
 
        PROCEDURE
              i02init (
                    VAR g_area : tin_global_in_vars );
 
      ------------------------------ 
 
        FROM
              SQLDB-command-interface: VIN20;
 
        PROCEDURE
              i20dbcrash;
 
      ------------------------------ 
 
        FROM
              logical_screen : VIN50;
 
        PROCEDURE
              i50autoscroll;
 
        PROCEDURE
              i50vscroll (
                    screen_nr    : integer;
                    screen_part  : tin_ls_part;
                    scroll_lines : tsp00_Int2);
 
        PROCEDURE
              i50on (
                    VAR ok : boolean);
 
        PROCEDURE
              i50off (
                    VAR msg : tsp00_Line);
 
        PROCEDURE
              i50keymap;
 
        PROCEDURE
              i50insertlabel (
                    VAR lab : tsp00_VtLabel;
                    ft      : tin_ls_fieldtype;
                    pos     : tin_ls_position);
 
        PROCEDURE
              i50put1field (
                    VAR field  : tsp00_Line;
                    length     : tin_natural;
                    fieldpos   : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put2field (
                    VAR field  : tsp00_C4;
                    length     : tin_natural;
                    fieldpos   : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put3field (
                    VAR field  : tsp00_C20;
                    length     : tin_natural;
                    fieldpos   : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put4field (
                    VAR field  : tsp00_C40;
                    length     : tin_natural;
                    fieldpos   : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50put5field (
                    VAR field  : tin_screenline;
                    length     : tin_natural;
                    fieldpos   : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50putattribute (
                    fieldpos   : tin_ls_position;
                    field_type : tin_ls_fieldtype);
 
        PROCEDURE
              i50clear (
                    screen_part : tin_ls_part );
 
        PROCEDURE
              i50clwindow (
                    first_pos    : tin_ls_position;
                    window_len   : tin_natural;
                    window_width : tin_natural);
 
        PROCEDURE
              i50getwindow (
                    first_pos          : tin_ls_position;
                    window_len         : tin_natural;
                    window_width       : tin_natural;
                    VAR window_changed : boolean);
 
        PROCEDURE
              i50getfield (
                    VAR vt_input    : tin_ls_input_field;
                    VAR field_found : boolean);
 
        PROCEDURE
              i50standardattributes;
 
      ------------------------------ 
 
        FROM
              logical_screen_layout : VIN51;
 
        PROCEDURE
              i51layout (
                    functionmenu_length : tin_natural;
                    inputarea_length    : tin_natural;
                    msglines            : tin_natural);
 
        PROCEDURE
              i51size (
                    screen_part : tin_ls_part;
                    VAR length  : tin_natural;
                    VAR width   : tin_natural);
 
        PROCEDURE
              i51onwindow (
                    defined_part : tin_ls_part;
                    VAR win      : tin_screen_window;
                    VAR ok       : boolean );
 
        PROCEDURE
              i51offwindow (
                    VAR refresh : boolean );
 
        PROCEDURE
              i51split (
                    screens : tin_natural);
 
        PROCEDURE
              i51splminmax (
                    screens   : tin_natural;
                    minimized : tsp00_Int2;
                    maximized : tsp00_Int2 );
 
        PROCEDURE
              i51splsize (
                    screens : tin_natural;
                    lines1  : tsp00_Int2;
                    lines2  : tsp00_Int2 );
 
        PROCEDURE
              i51size2 (
                    sno            : integer;
                    screen_part    : tin_ls_part;
                    VAR partlength : tin_natural;
                    VAR partwidth  : tin_natural);
 
      ------------------------------ 
 
        FROM
              logical_screen_modules : VIN56;
 
        PROCEDURE
              i56putlabels (
                    fct_cursorpos      : tin_ls_releasemode;
                    functionline_label : boolean);
 
        PROCEDURE
              i56putframe (
                    with_name  : boolean;
                    with_parms : boolean );
 
        PROCEDURE
              i56hrange (
                    screen_nr  : integer;
                    VAR hrange : tin_display_range);
 
        PROCEDURE
              i56vrange (
                    screen_nr  : integer;
                    VAR lbl    : tsp00_C8;
                    VAR vrange : tin_display_range);
 
        PROCEDURE
              i56title (
                    blinking_modefield : boolean;
                    screen_nr          : integer;
                    VAR title          : tsp00_OnlineHeader);
&       ifdef WINDOWS
 
        PROCEDURE
              i56standardbox (
                    mode      : tsp00_VtUsageMode;
                    immediate : boolean ;
                    enable    : boolean );
&       endif
 
        PROCEDURE
              i56getmark (
                    screen_nr         : tsp00_Int2;
                    screenpart        : tin_ls_part;
                    VAR mode          : tsp00_VtMark;
                    VAR top, left     : tsp00_Int2;
                    VAR bottom, right : tsp00_Int2 );
 
        PROCEDURE
              i56setmark (
                    screen_nr     : tsp00_Int2;
                    screenpart    : tin_ls_part;
                    mode          : tsp00_VtMark;
                    top, left     : tsp00_Int2;
                    bottom, right : tsp00_Int2 );
 
        PROCEDURE
              i56errormessage (
                    screen_nr   : tsp00_Int2;
                    VAR errtext : tsp00_ErrText;
                    length      : tin_natural );
 
      ------------------------------ 
 
        FROM
              logical_screen_IO : VIN57 ;
 
        PROCEDURE
              i57ioscreen (
                    VAR csr_pos        : tin_ls_position;
                    VAR rf             : tin_ls_releasemode;
                    VAR screen_changed : boolean);
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102;
 
        PROCEDURE
              sqlos (
                    VAR os : tsp00_Os);
 
        PROCEDURE
              sqlttable (
                    i          : tsp00_Int2;
                    att        : tsp00_VtAttrib;
                    foreground : tsp00_VtColor;
                    background : tsp00_VtColor);
 
        PROCEDURE
              sqlfinit (
                    buffer_pool_size : tsp00_Int2;
                    VAR poolptr      : tsp00_Int4;
                    VAR ok           : boolean);
 
        PROCEDURE
              sqlinit (
                    VAR component : tsp00_CompName;
                    canceladdr    : tsp00_BoolAddr);
 
        PROCEDURE
              sqlfinish (
                    terminate : boolean);
 
        PROCEDURE
              sqlpon (
                    VAR printer : tsp00_PrtName;
                    VAR vpok    : boolean);
 
        PROCEDURE
              sqlprint (
                    VAR l       : tsp00_Line;
                    length      : tsp00_Int2;
                    lfeeds      : tsp00_VpLinefeeds;
                    VAR errtext : tsp00_ErrText;
                    VAR vpok    : boolean);
 
        PROCEDURE
              sqlpoff (
                    print          : boolean;
                    VAR errtext    : tsp00_ErrText;
                    VAR ok         : boolean);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101;
 
        PROCEDURE
              SAPDB_PascalForcedFill (
                    size        : tsp00_Int4;
                    m           : tsp00_MoveObjPtr;
                    pos         : tsp00_Int4;
                    len         : tsp00_Int4;
                    fillchar    : char);
 
        PROCEDURE
              SAPDB_PascalForcedMove (
                    source_upb  : tsp00_Int4;
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
        PROCEDURE
              s10mv (
                    source_upb  : tsp00_Int4;       
                    destin_upb  : tsp00_Int4;
                    source      : tsp00_MoveObjPtr;    
                    source_pos  : tsp00_Int4;
                    destin      : tsp00_MoveObjPtr;    
                    destin_pos  : tsp00_Int4;
                    length      : tsp00_Int4);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30: VSP30;
 
        FUNCTION
              s30gad (
                    VAR b : boolean) : tsp00_BoolAddr;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              sqlinit;
 
              tsp00_CompName tsp00_C64
 
        PROCEDURE
              m90buf1;
 
              tsp00_Buf tsp00_Line
 
        PROCEDURE
              sqlprint;
 
              tsp00_PrtLine tsp00_Line
 
        PROCEDURE
              i50off;
 
              tin_screenline tsp00_Line
 
        PROCEDURE
              i50put1field;
 
              tsp00_MoveObj tsp00_Line
 
        PROCEDURE
              i50put2field;
 
              tsp00_MoveObj tsp00_C4
 
        PROCEDURE
              i50put3field;
 
              tsp00_MoveObj tsp00_C20
 
        PROCEDURE
              i50put4field;
 
              tsp00_MoveObj tsp00_C40
 
        PROCEDURE
              i50put5field;
 
              tsp00_MoveObj tin_screenline
 
        PROCEDURE
              m90buf;
 
              tsp00_Buf tsp00_ScreenBuf
 
        PROCEDURE
              i56errormessage;
 
              tin_screenline tsp00_ErrText
 
        PROCEDURE
              s30gad;
 
              tsp00_MoveObj boolean
              tsp00_Addr tsp00_BoolAddr
 
        PROCEDURE
              sqlos;
 
              tsp00_Os  tsp00_Os
 
        PROCEDURE
              sqlttable;
 
              tsp00_Int2      tsp00_Int2
              tsp00_VtAttrib  tsp00_VtAttrib
              tsp00_VtColor   tsp00_VtColor
              tsp00_VtColor   tsp00_VtColor
 
        PROCEDURE
              sqlfinit;
 
              tsp00_Int2  tsp00_Int2
              tsp00_Int4  tsp00_Int4
 
        PROCEDURE
              sqlinit;
 
              tsp00_CompName  tsp00_CompName
              tsp00_BoolAddr  tsp00_BoolAddr
 
        PROCEDURE
              sqlpon;
 
              tsp00_PrtName  tsp00_PrtName
 
        PROCEDURE
              sqlprint;
 
              tsp00_PrtLine     tsp00_Line
              tsp00_Int2        tsp00_Int2
              tsp00_VpLinefeeds tsp00_VpLinefeeds
              tsp00_ErrText     tsp00_ErrText
 
        PROCEDURE
              sqlpoff;
 
              tsp00_ErrText tsp00_ErrText
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1987-11-19
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1999-11-23
.sp
***********************************************************
.sp
.cp 20
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2.fo
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
 
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
CONST
      cin59_component_name    = 'VTTEST  ';
      mxin59_compname         =  6;
      cin59_releaseno = '6.1.1   ';
      vttest_linelength = 80;
      label_length = 6;
      nr_attribs = 2;
      ls_special = 13;
      testdb = 'Testdb            ';
      print_label     = 'Print   ';
      left_label      = 'Left    ';
      right_label     = 'Right   ';
      nomark_label    = 'nO_mark ';
      blockmark_label = 'Block_mk';
      linemark_label  = 'lIne_mk ';
      contmark_label  = 'Cont_mk ';
      keys_label      = 'keYs    ';
      mixed_label     = 'Mixed   ';
      up_label        = 'Up      ';
      down_label      = 'Down    ';
      help_label      = 'Help    ';
      main_label      = 'maiN    ';
      error_label     = 'eRror   ';
      nextrow_label   = 'neXt row';
      empty_label     = '        ';
      max_edit_lines  = 40;
      ls_black = 6;
      hscroll_page = 999;
      command_inputcol = 6 (* cin_first_scol + 4 + 1 *);
 
TYPE
      vttest_status = (primary_menu, graphic_screen, running_screen,
            mixed_screen, edit_screen, key_test, help_menu, exit_vttest);
 
      vtt_string = RECORD
            text   : tsp00_Line;
            length : tin_natural;
      END;
 
      labeltab = ARRAY [ 0..15 ] OF vtt_string;
 
      edit_block = RECORD
            top : integer;
            left : tsp00_Int2;
            mark1_line : tsp00_Int2;
            mark1_col  : tsp00_Int2;
            mark2_line : tsp00_Int2;
            mark2_col  : tsp00_Int2;
            changed : boolean;
            text : ARRAY [1..max_edit_lines ] OF tsp00_Line;
      END;
 
 
      vtt_global = RECORD
            cursor : tin_ls_position;
            col       : tin_natural;
            row       : tin_natural;
            sys       : boolean;
            labels    : labeltab;
            firstcall : boolean;
            lines     : edit_block;
            mark      : tsp00_VtMark;
            split     : boolean;
            actscreen : integer;
      END;
 
 
 
(*------------------------------*) 
 
FUNCTION
      sqlininit (
            cancelb_ptr : tsp00_BoolAddr) : tsp00_Int4;
 
VAR
      ok : boolean;
&     ifdef WINDOWS
      dummy : ^vtt_global;
&     endif
 
BEGIN
i02init(i01g);
init_ddb4_rte ( cancelb_ptr );
i01g^.cancelb_ptr := cancelb_ptr;
sqlfinit (0, i01g^.vf_pool_ptr, ok);
&ifdef WINDOWS
sqlininit := sizeof(dummy^);
&else
sqlininit := 0;
&endif
END; (* sqlininit *)
 
(*------------------------------*) 
 
PROCEDURE
      sqlinmain (
            VAR i59g : vtt_global );
 
VAR
      status : vttest_status;
      ok     : boolean;
 
BEGIN
first_init(i59g, ok);
IF  ok
THEN
    BEGIN
    status := primary_menu;
    REPEAT
        CASE status OF
            primary_menu:
                main_menu(i59g, status);
            graphic_screen:
                graphic_menu(i59g, status);
            running_screen:
                running_menu(i59g, status);
            mixed_screen:
                mixed_menu(i59g, status);
            edit_screen:
                edit_menu(i59g, status);
            key_test:
                key_test_menu(i59g, status);
            exit_vttest:
                BEGIN
                END;
            END;
        (*ENDCASE*) 
    UNTIL
        status = exit_vttest;
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
i58exit ( ok );
sqlfinish (true);
END; (* sqlinmain *)
 
(*------------------------------*) 
 
PROCEDURE
      sqlinterminate (
            VAR i59g : vtt_global );
 
BEGIN
END; (* sqlinterminate *)
 
&ifdef WINDOWS
(*------------------------------*) 
 
FUNCTION
      sqlincallback (
            VAR g           : tsp00_MoveObj;
            rf              : tin_ls_releasemode;
            context         : tsp00_BufAddr;
            callback_switch : tsp00_Int2;
            VAR csr_pos     : tin_ls_position) : tsp00_DgcallbackResult;
 
BEGIN
sqlincallback := dg_ok;
END; (* sqlincallback *)
 
&endif
(*------------------------------*) 
 
PROCEDURE
      i58exit (
            term_ok : boolean );
 
VAR
      piece : tsp00_C40;
      msg   : tsp00_Line;
 
BEGIN
SAPDB_PascalForcedFill (LINE_MXSP00,@msg,1,vttest_linelength,bsp_c1);
IF  term_ok
THEN
    BEGIN
    piece := 'This message is just a message; not more';
    s10mv(40,LINE_MXSP00,
          @piece,1,
          @msg,1,40);
    piece := ' than a message to test the exit message';
    s10mv(40,LINE_MXSP00,
          @piece,1,
          @msg,41,40);
    END
ELSE
    BEGIN
    piece := 'No Terminal                             ';
    s10mv(40,LINE_MXSP00,
          @piece,1,
          @msg,1,40);
    END;
(*ENDIF*) 
i50off( msg );
END; (* i58exit *)
 
(*------------------------------*) 
 
PROCEDURE
      main_menu (
            VAR i59g   : vtt_global;
            VAR status : vttest_status);
 
VAR
      rk         : tin_ls_releasemode;
      new_init   : boolean;
      cursor_sno : integer;
 
BEGIN
cursor_sno := 1;
init_main_menu( i59g );
put_sysline(i59g);
REPEAT
    IF  i59g.actscreen > 0
    THEN
        cursor_sno := i59g.actscreen ;
    (*ENDIF*) 
    main_output(i59g, i01g^.ls.nr_screens );
    main_input(i59g, cursor_sno, rk);
    check_function(i59g, rk,status,new_init);
    IF  new_init
    THEN
        BEGIN
        init_main_menu (i59g );
        main_output(i59g, 1);
        put_sysline(i59g);
        END;
    (*ENDIF*) 
UNTIL
    status <> primary_menu;
(*ENDREPEAT*) 
i50standardattributes;
i01g^.vt.parms.standard_attributes := true;
&ifdef WINDOWS
i56standardbox ( vt_form, true, false );
&endif
END; (* main_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      put_headerline (
            status : vttest_status);
 
VAR
      i     : integer;
      title : tsp00_OnlineHeader;
 
BEGIN
FOR i := 1 TO i01g^.ls.nr_screens DO
    BEGIN
    WITH title DO
        BEGIN
        id_field := cin59_component_name ;
        relno_field := cin59_releaseno ;
        mode_field := 'EXECUTE     ';
        get_status_text(status,text_field, i);
        END;
    (*ENDWITH*) 
    i56title(false, i, title);
    END;
(*ENDFOR*) 
END; (* put_headerline *)
 
(*------------------------------*) 
 
PROCEDURE
      put_sysline (
            VAR i59g : vtt_global);
 
VAR
      field      : tsp00_C40;
      length     : tin_natural;
      fieldpos   : tin_ls_position;
      field_type : tin_ls_fieldtype;
      i          : integer;
      slength    : tin_natural;
      swidth     : tin_natural;
 
BEGIN
i50clear(cin_ls_sysline);
i51size(cin_ls_sysline,slength,swidth);
FOR i := 1 TO i01g^.ls.nr_screens DO
    BEGIN
    field := 'This is the system line                 ';
    IF  i01g^.ls.nr_screens > 1
    THEN
        BEGIN
        length := 26;
        field [length ] := numval( i );
        END
    ELSE
        length := 24;
    (*ENDIF*) 
    WITH fieldpos DO
        BEGIN
        screen_nr := i;
        screen_part := cin_ls_sysline;
        sline := slength;
        scol := cin_first_scol;
        END;
    (*ENDWITH*) 
    WITH field_type DO
        BEGIN
        field_att := ls_special;
        fieldmode := [  ] ;
        END;
    (*ENDWITH*) 
    i50put4field(field,length,fieldpos,field_type);
    END;
(*ENDFOR*) 
i59g.sys := true;
END; (* put_sysline *)
 
(*------------------------------*) 
 
PROCEDURE
      put_errtext (
            VAR i59g    : vtt_global;
            VAR errtext : tsp00_ErrText );
 
BEGIN
i56errormessage ( i01g^.ls.nr_screens, errtext, 40 );
i59g.sys := true;
END; (* put_errtext *)
 
(*------------------------------*) 
 
PROCEDURE
      get_status_text (
            status    : vttest_status;
            VAR field : tin_text_field;
            sno       : tsp00_Int2);
 
BEGIN
CASE status OF
    primary_menu:
        field := 'Main Menu                               ';
    graphic_screen:
        field := 'Graphic Mode                            ';
    running_screen:
        field := 'Running Mode                            ';
    mixed_screen:
        field := 'Mixed Mode                              ';
    edit_screen:
        field := 'Edit Mode                               ';
    key_test:
        field := 'Key Test                                ';
    help_menu:
        field := 'Info                                    ';
    exit_vttest:
        BEGIN
        END;
    END;
(*ENDCASE*) 
IF  i01g^.ls.nr_screens > 1
THEN
    add_screennr( field, sno );
(*ENDIF*) 
END; (* get_status_text *)
 
(*------------------------------*) 
 
PROCEDURE
      add_screennr (
            VAR field : tin_text_field;
            sno       : tsp00_Int2);
 
VAR
      i     : tsp00_Int2;
      found : boolean;
 
BEGIN
found := false;
i := 0;
WHILE (i < mxin_text_field) AND (NOT found) DO
    BEGIN
    i := i + 1;
    found := field [i]  = bsp_c1;
    END;
(*ENDWHILE*) 
IF  found
THEN
    BEGIN
    IF  i < mxin_text_field
    THEN
        i := i + 1;
    (*ENDIF*) 
    field [i]  := numval(sno );
    END;
(*ENDIF*) 
END; (* add_screennr *)
 
(*------------------------------*) 
 
PROCEDURE
      graphic_menu (
            VAR i59g   : vtt_global;
            VAR status : vttest_status);
 
VAR
      rk       : tin_ls_releasemode;
      new_init : boolean;
 
BEGIN
init_graphic_menu ( i59g );
put_sysline(i59g);
put_headerline(status);
REPEAT
    graphic_output;
    graphic_input(i59g, rk);
    check_function(i59g, rk,status,new_init);
    IF  new_init
    THEN
        BEGIN
        init_graphic_menu ( i59g );
        put_sysline(i59g);
        put_headerline(status);
        END;
    (*ENDIF*) 
UNTIL
    status <> graphic_screen;
(*ENDREPEAT*) 
END; (* graphic_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      running_menu (
            VAR i59g   : vtt_global;
            VAR status : vttest_status);
 
VAR
      rk       : tin_ls_releasemode;
      new_init : boolean;
 
BEGIN
init_running_menu ( i59g );
put_sysline(i59g);
put_headerline(status);
REPEAT
    running_output;
    graphic_input(i59g, rk);
    check_function(i59g, rk,status,new_init);
    IF  new_init
    THEN
        BEGIN
        init_running_menu ( i59g );
        put_sysline(i59g);
        put_headerline(status);
        END;
    (*ENDIF*) 
UNTIL
    status <> running_screen;
(*ENDREPEAT*) 
END; (* running_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      mixed_menu (
            VAR i59g   : vtt_global;
            VAR status : vttest_status);
 
VAR
      rk : tin_ls_releasemode;
 
VAR
      new_init : boolean;
 
BEGIN
init_mixed_menu;
put_sysline(i59g);
put_headerline(status);
REPEAT
    mixed_output;
    mixed_input(i59g, rk);
    check_function(i59g, rk,status,new_init);
    IF  new_init
    THEN
        BEGIN
        init_mixed_menu;
        put_sysline(i59g);
        put_headerline(status);
        END;
    (*ENDIF*) 
UNTIL
    status <> mixed_screen;
(*ENDREPEAT*) 
END; (* mixed_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      check_function (
            VAR i59g     : vtt_global;
            rk           : tin_ls_releasemode;
            VAR status   : vttest_status;
            VAR new_init : boolean);
 
BEGIN
new_init := false;
CASE rk OF
    f1:
        status := mixed_screen;
    f2:
        status := key_test;
    f3:
        IF  i01g^.key_type.key_labels [f3]  = print_label
        THEN
            print_edit_lines ( i59g )
        ELSE
            IF  i01g^.key_type.key_labels [f3]  = nextrow_label
            THEN
                scroll_cursor( i59g, -1 )
            ELSE
                status := edit_screen;
            (*ENDIF*) 
        (*ENDIF*) 
    f_print:
        print_edit_lines ( i59g );
    f_pick:
        BEGIN
        END;
    f4:
        IF  i01g^.key_type.key_labels [f4]  = left_label
        THEN
            hscroll_edit_form(i59g, -hscroll_page)
        ELSE
            BEGIN
            layout_inputlines;
            new_init := true;
            END;
        (*ENDIF*) 
    f5:
        IF  i01g^.key_type.key_labels [f5]  = right_label
        THEN
            hscroll_edit_form(i59g, +hscroll_page)
        ELSE
            BEGIN
            layout_functionmenu;
            new_init := true;
            END;
        (*ENDIF*) 
    f6:
        IF  i01g^.key_type.key_labels [f6]  = error_label
        THEN
            produce_syserror(99)
        ELSE
            IF  NOT mark_command(i59g, rk, vt_mark_block)
            THEN
                status := graphic_screen;
            (*ENDIF*) 
        (*ENDIF*) 
    f7:
        IF  NOT mark_command(i59g, rk, vt_mark_line)
        THEN
            status := running_screen;
        (*ENDIF*) 
    f8:
        IF  NOT mark_command(i59g, rk, vt_mark_contiguous)
        THEN
            BEGIN
            layout_msglines;
            new_init := true;
            END;
        (*ENDIF*) 
    f9, f_end:
        IF  status = primary_menu
        THEN
            status := exit_vttest
        ELSE
            status := primary_menu;
        (*ENDIF*) 
    f_exit:
        status := exit_vttest;
    f_enter,
    f_local:
        BEGIN
        END;
    f_up:
        page_scroll(i59g, -1);
    f_down:
        page_scroll(i59g, +1);
    f_hscroll:
        hscroll_edit_form(i59g, i01g^.vt.parms.scroll_dir);
    f_vscroll:
        vscroll_edit_form(i59g, i01g^.vt.parms.scroll_dir);
    f_help:
        BEGIN
        IF  status = primary_menu
        THEN
            i51split(1);
        (*ENDIF*) 
        help_function(i59g, status, new_init );
        IF  (status = primary_menu)
            OR (status = edit_screen)
        THEN
            new_init := true;
        (*ENDIF*) 
        END;
    END;
(*ENDCASE*) 
END; (* check_function *)
 
(*------------------------------*) 
 
FUNCTION
      mark_command (
            VAR i59g : vtt_global;
            rk       : tin_ls_releasemode;
            opt      : tsp00_VtMark) : boolean;
 
VAR
      is_mark : boolean;
      flabel  : tin_ls_sk_label;
 
BEGIN
is_mark := true;
CASE opt OF
    vt_mark_block:
        flabel := blockmark_label;
    vt_mark_line:
        flabel := linemark_label;
    vt_mark_contiguous:
        flabel := contmark_label;
    END;
(*ENDCASE*) 
WITH  i01g^.key_type DO
    IF  key_labels [rk]  = nomark_label
    THEN
        BEGIN
        reset_mark_range ( i59g );
        key_labels [rk]  := flabel;
        END
    ELSE
        IF  key_labels [rk]  = flabel
        THEN
            BEGIN
            i59g.mark := opt;
            set_mark_range ( i59g );
            key_labels [rk]  := nomark_label;
            IF  rk <> f6
            THEN
                key_labels [f6]  := blockmark_label;
            (*ENDIF*) 
            IF  rk <> f7
            THEN
                key_labels [f7]  := linemark_label;
            (*ENDIF*) 
            IF  rk <> f8
            THEN
                key_labels [f8]  := contmark_label;
            (*ENDIF*) 
            END
        ELSE
            is_mark := false;
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDWITH*) 
mark_command := is_mark;
END; (* mark_command *)
 
(*------------------------------*) 
 
PROCEDURE
      help_function (
            VAR i59g    : vtt_global;
            VAR status  : vttest_status ;
            VAR refresh : boolean );
 
VAR
      ok         : boolean;
      old_status : vttest_status;
      key_type   : tin_ls_key_type;
      win        : tin_screen_window;
      scols      : tin_natural;
 
BEGIN
old_status := status;
key_type := i01g^.key_type;
i51size(cin_ls_workarea,win.lines,scols);
win.cols := win.lines * 4;
WITH win.first_pos DO
    BEGIN
    screen_part := cin_ls_workarea;
    sline := 1;
    scol := (scols DIV 2) - (win.cols DIV 2) + 1;
    IF  scol < 1
    THEN
        scol := 1;
    (*ENDIF*) 
    IF  scol + win.cols - 1 > scols
    THEN
        win.cols := scols - scol + 1;
    (*ENDIF*) 
    screen_nr := 1;
    END;
(*ENDWITH*) 
WITH i01g^.vt.wopt DO
    BEGIN
    background_part := cin_ls_workarea;
    WITH frame_ft DO
        BEGIN
        field_att := cin_ls_enhanced;
        fieldmode := [  ] ;
        END;
    (*ENDWITH*) 
    WITH background_ft DO
        BEGIN
        (* field_att := [  vt_greyed ] ; *)
        field_att := cin_ls_normal;
        fieldmode := [  ] ;
        END;
    (*ENDWITH*) 
    with_frame := old_status <> help_menu;
    END;
(*ENDWITH*) 
i51onwindow ( cin_ls_basic_window, win, ok);
IF  ok
THEN
    BEGIN
    status := help_menu;
    help_screen(i59g, status);
    i51offwindow (refresh );
    i50clear(cin_ls_workarea);
    END;
(*ENDIF*) 
IF  status <> exit_vttest
THEN
    status := old_status;
(*ENDIF*) 
i01g^.key_type := key_type;
i56putlabels(f_clear,true);
END; (* help_function *)
 
(*------------------------------*) 
 
PROCEDURE
      help_screen (
            VAR i59g   : vtt_global;
            VAR status : vttest_status);
 
VAR
      rk       : tin_ls_releasemode;
      new_init : boolean;
 
BEGIN
init_help_screen( i59g );
put_sysline(i59g);
put_headerline(status);
REPEAT
    help_output( i59g );
    help_input(i59g, rk);
    check_function(i59g, rk,status,new_init);
UNTIL
    (rk IN [  f9,f_end, f_exit ] )
    OR (status = exit_vttest);
(*ENDREPEAT*) 
END; (* help_screen *)
 
(*------------------------------*) 
 
PROCEDURE
      layout_inputlines;
 
VAR
      functionmenu_length : tin_natural;
      inputarea_length    : tin_natural;
      msglines            : tin_natural;
 
BEGIN
get_layout_parms(functionmenu_length,inputarea_length,msglines);
switch_layout(inputarea_length);
i51layout(functionmenu_length, inputarea_length,msglines);
END; (* layout_inputlines *)
 
(*------------------------------*) 
 
PROCEDURE
      layout_msglines;
 
VAR
      functionmenu_length : tin_natural;
      inputarea_length    : tin_natural;
      msglines            : tin_natural;
 
BEGIN
get_layout_parms(functionmenu_length,inputarea_length,msglines);
switch_layout(msglines);
i51layout(functionmenu_length, inputarea_length,msglines);
END; (* layout_msglines *)
 
(*------------------------------*) 
 
PROCEDURE
      layout_functionmenu;
 
VAR
      functionmenu_length : tin_natural;
      inputarea_length    : tin_natural;
      msglines            : tin_natural;
 
BEGIN
get_layout_parms(functionmenu_length,inputarea_length,msglines);
switch_layout(functionmenu_length);
i51layout(functionmenu_length, inputarea_length,msglines);
END; (* layout_functionmenu *)
 
(*------------------------------*) 
 
PROCEDURE
      get_layout_parms (
            VAR functionmenu_length : tin_natural;
            VAR inputarea_length    : tin_natural;
            VAR msglines            : tin_natural);
 
VAR
      width : tin_natural;
 
BEGIN
i51size(cin_ls_functionmenu,functionmenu_length,width);
i51size(cin_ls_inputarea,inputarea_length,width);
i51size(cin_ls_sysline,msglines,width);
END; (* get_layout_parms *)
 
(*------------------------------*) 
 
PROCEDURE
      switch_layout (
            VAR parm : tin_natural);
 
BEGIN
parm := (parm + 1) MOD 3;
END; (* switch_layout *)
 
(*------------------------------*) 
 
PROCEDURE
      first_init (
            VAR i59g : vtt_global;
            VAR ok   : boolean);
 
CONST
      functionmenu_length = 2;
      inputarea_length  = 1;
      msglines = 1;
 
VAR
      f : tin_ls_releasemode;
 
BEGIN
i59g.sys := false;
i59g.split := false;
i59g.actscreen := 1;
i01g^.is_batch := false;
i20dbcrash; (* do not use the database for messages *)
i01g^.dbno := 1;
WITH i01g^, session [ dbno ] DO
    BEGIN
    serverdb   := testdb;
    user_ident :=
          'TESTUSER                                                        ';
    END;
(*ENDWITH*) 
i50on(ok);
reset_mark_range ( i59g );
IF  ok
THEN
    BEGIN
    i58prottermdesc;
    i51layout(functionmenu_length, inputarea_length,msglines);
    i50keymap;
    WITH i01g^.key_type DO
        FOR f := f1 TO f_down DO
            key_labels [f]  := '        ';
        (*ENDFOR*) 
    (*ENDWITH*) 
    i59g.firstcall := true;
    set_sqlttable(i59g, vt_white, vt_black);
    init_edit_lines ( i59g );
    END;
(*ENDIF*) 
END; (* first_init *)
 
(*------------------------------*) 
 
PROCEDURE
      set_sqlttable (
            VAR i59g   : vtt_global;
            foreground : tsp00_VtColor;
            background : tsp00_VtColor);
 
BEGIN
standard_attr_settings(i59g, foreground, background);
(* now further settings *)
IF  (foreground = vt_blue)
    AND (background = vt_green)
THEN
    sqlttable_entry ( i59g, cin_ls_enhanced, 'Enhanced',
          [  ] , vt_red, background)
ELSE
    IF  (foreground = vt_black)
        AND (background = vt_white)
    THEN
        BEGIN
        IF  vt_blue IN i01g^.vt.desc.colors
        THEN
            sqlttable_entry ( i59g, cin_ls_enhanced, 'Enhanced',
                  [  ] , vt_blue, background)
        ELSE
            sqlttable_entry ( i59g, cin_ls_enhanced, 'Enhanced',
                  [  vt_bright ] , foreground, background);
        (*ENDIF*) 
        END
    ELSE
        sqlttable_entry ( i59g, cin_ls_enhanced, 'Enhanced',
              [  vt_bright ] , foreground, background);
    (*ENDIF*) 
(*ENDIF*) 
sqlttable_entry ( i59g, cin_ls_invisible, bsp_c8,
      [  vt_invisible ] , foreground, background);
sqlttable_entry ( i59g, cin_ls_inverse, bsp_c8,
      [  vt_inverse ] , foreground, background);
sqlttable_entry ( i59g, cin_ls_blink, bsp_c8,
      [  vt_blink, vt_inverse ] ,
      foreground, background);
sqlttable_entry ( i59g, cin_ls_errormsg, 'Error   ',
      [  vt_bright ] , vt_white, vt_red);
END; (* set_sqlttable *)
 
(*------------------------------*) 
 
PROCEDURE
      standard_attr_settings (
            VAR i59g   : vtt_global;
            foreground : tsp00_VtColor;
            background : tsp00_VtColor);
 
VAR
      i        : integer;
      att      : tsp00_VtAttrib;
      m, n     : tsp00_VtMode;
      finished : boolean;
 
BEGIN
(* predefined attribute settings *)
FOR i := 0 TO 15 DO
    IF  i = ls_black
    THEN
        i59g.labels [i] .length := 0
    ELSE
        IF  i59g.firstcall
        THEN
            set_attributelabel ( i59g,  i, [ ] , 'Normal  ')
        ELSE
            sqlttable_entry ( i59g, i, bsp_c8, [  ] ,
                  foreground, background);
        (*ENDIF*) 
    (*ENDIF*) 
(*ENDFOR*) 
set_attributelabel ( i59g,  cin_ls_enhanced, [ ] , 'Enhanced');
set_attributelabel ( i59g,  cin_ls_invisible, [ ] , 'Invisibl');
i := -1;
(* set all combinations of three attributes *)
FOR m := vt_bright TO vt_grayed DO
    IF  (m <> vt_invisible) AND (m <> vt_mixed)
    THEN
        FOR n := vt_bright TO vt_grayed DO
            IF  (n <> vt_invisible) AND (n <> vt_mixed)
            THEN
                BEGIN
                att := [  m, n ] ;
                IF  att * i01g^.vt.desc.attributes = att
                THEN
                    BEGIN
                    next_free_index(i, finished);
                    IF  NOT finished
                    THEN
                        sqlttable_entry ( i59g, i, bsp_c8,
                              att, foreground, background);
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDFOR*) 
    (*ENDIF*) 
(*ENDFOR*) 
i59g.firstcall := false;
END; (* standard_attr_settings *)
 
(*------------------------------*) 
 
PROCEDURE
      next_free_index (
            VAR i        : integer;
            VAR finished : boolean);
 
VAR
      free : boolean;
 
BEGIN
REPEAT
    i := i + 1;
    free := (i > cin_ls_invisible)
          AND (i <> cin_ls_errormsg)
          AND (i <> cin_ls_inverse)
          AND (i <> cin_ls_blink)
          AND (i <> ls_special)
          AND (i <> ls_black);
    finished := (i > 15);
UNTIL
    free OR finished;
(*ENDREPEAT*) 
END; (* next_free_index *)
 
(*------------------------------*) 
 
PROCEDURE
      sqlttable_entry (
            VAR i59g   : vtt_global;
            i          : tsp00_Int2;
            lbl        : tsp00_C8;
            att        : tsp00_VtAttrib;
            foreground : tsp00_VtColor;
            background : tsp00_VtColor);
 
BEGIN
IF  att <= i01g^.vt.desc.attributes
THEN
    BEGIN
    set_attributelabel ( i59g, i, att, lbl);
    ttable(i, att, foreground, background);
    END
ELSE
    ttable(i, [ ] , foreground, background );
(*ENDIF*) 
END; (* sqlttable_entry *)
 
(*------------------------------*) 
 
PROCEDURE
      ttable (
            i          : tsp00_Int2;
            att        : tsp00_VtAttrib;
            foreground : tsp00_VtColor;
            background : tsp00_VtColor);
 
BEGIN
&if $OS=UNIX
IF  vt_inverse in att
THEN
    sqlttable(i, att, background, foreground)
ELSE
    sqlttable(i, att , foreground, background );
(*ENDIF*) 
&else
sqlttable(i, att , foreground, background );
&endif
END; (* ttable *)
 
(*------------------------------*) 
 
PROCEDURE
      set_attributelabel (
            VAR i59g : vtt_global;
            i        : tsp00_Int2;
            att      : tsp00_VtAttrib;
            lbl      : tsp00_C8);
 
VAR
      m : tsp00_VtMode;
      j : integer;
 
BEGIN
i59g.labels [i] .length := 0;
IF  lbl = bsp_c8
THEN
    i58buildtext(att, 8, i59g.labels [i] )
ELSE
    WITH i59g.labels [i]  DO
        BEGIN
        FOR j := 1 TO 8 DO
            text [length + j ] := lbl [j] ;
        (*ENDFOR*) 
        length := length + 8;
        END;
    (*ENDWITH*) 
(*ENDIF*) 
IF  i59g.labels [i] .length = 0
THEN
    i58defaultlabel(i59g.labels [i] );
(*ENDIF*) 
END; (* set_attributelabel *)
 
(*------------------------------*) 
 
PROCEDURE
      init_main_menu (
            VAR i59g : vtt_global );
 
BEGIN
&ifdef WINDOWS
i56standardbox ( vt_form, true, true );
&endif
i01g^.vt.parms.standard_attributes := false;
set_sqlttable(i59g, vt_white, vt_blue);
i50clear(cin_ls_workarea);
split_screen(i59g, primary_menu, 0, 0, 0, 0 );
assign_keys(f_clear);
WITH i01g^.key_type DO
    BEGIN
    key_labels [f9]  := 'eXit    ';
&   ifndef WINDOWS
    activated := activated - [ f_exit] ;
&   endif
    END;
(*ENDWITH*) 
insert_label(true, 'Insert  ');
i56putlabels(f_clear,true);
i56putframe (true, true);
put_headerline(primary_menu);
put_commandline( [  ls_input  ] );
END; (* init_main_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      split_screen(
            VAR i59g  : vtt_global ;
            status    : vttest_status;
            split_min : tsp00_Int2;
            split_max : tsp00_Int2 ;
            lines1    : tsp00_Int2;
            lines2    : tsp00_Int2 );
 
VAR
      nr_screens : integer;
 
BEGIN
IF  i59g.split
THEN
    nr_screens := 2
ELSE
    nr_screens := 1;
(*ENDIF*) 
IF  nr_screens <> i01g^.ls.nr_screens
THEN
    BEGIN
    i50clear(cin_ls_basic_window);
    IF  i59g.split
    THEN
        BEGIN
        IF  (split_min = 0) AND (split_max = 0)
            AND (lines1 = 0) AND (lines2 = 0)
        THEN
            i51split(2)
        ELSE
            IF  (split_min > 0) OR (split_max > 0)
            THEN
                i51splminmax(2, split_min, split_max )
            ELSE
                i51splsize( 2, lines1, lines2 );
            (*ENDIF*) 
        (*ENDIF*) 
        main_output(i59g, 1 );
        END
    ELSE
        i51split(1);
    (*ENDIF*) 
    i56putframe (true, true);
    put_sysline(i59g);
    put_headerline(status);
    i56putlabels(f_clear,true);
    END;
(*ENDIF*) 
END; (* split_screen *)
 
(*------------------------------*) 
 
PROCEDURE
      insert_label (
            visible : boolean;
            lab     : tsp00_VtLabel);
 
VAR
      ft     : tin_ls_fieldtype;
      pos    : tin_ls_position;
      length : tin_natural;
      width  : tin_natural;
 
BEGIN
i51size(cin_ls_workarea,length,width);
WITH pos DO
    BEGIN
    screen_nr := i01g^.ls.nr_screens;
    screen_part := cin_ls_header;
    IF  visible
    THEN
        BEGIN
        sline := 1;
        scol := width - VTLABEL_MXSP00 + 1;
        END
    ELSE
        BEGIN
        sline := 0;
        scol := 0;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
WITH ft DO
    BEGIN
    field_att := cin_ls_inverse;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
i50insertlabel(lab,ft,pos);
END; (* insert_label *)
 
(*------------------------------*) 
 
PROCEDURE
      assign_keys (
            exclude_key : tin_ls_releasemode);
 
BEGIN
WITH i01g^.key_type DO
    BEGIN
    activated := [ f_enter,f1..f9,f_end,f_exit,f_help] ;
    IF  exclude_key <> f6
    THEN
        activated := activated - [  exclude_key ] ;
    (*ENDIF*) 
    key_labels [f1]  := mixed_label;
    key_labels [f2]  := keys_label;
    key_labels [f3]  := 'Edit    ';
    key_labels [f4]  := 'Inp-lns ';
    key_labels [f5]  := 'Fct-lns ';
    IF  exclude_key = f6
    THEN
        key_labels [f6]  := error_label
    ELSE
        key_labels [f6]  := 'graPhic ';
    (*ENDIF*) 
    key_labels [f7]  := 'rUnning ';
    key_labels [f8]  := 'sysLines';
    key_labels [f9]  := main_label;
    key_labels [f_help ] := help_label;
    IF  i01g^.vt.desc.labels <> no_sk_labels
    THEN
        activated := activated - [  f5 ] ;
&   ifdef WINDOWS
    (*ENDIF*) 
    activated := activated + [  f_cmd ] ;
&   endif
    END;
(*ENDWITH*) 
END; (* assign_keys *)
 
(*------------------------------*) 
 
PROCEDURE
      put_commandline (
            fm : tin_ls_fieldmode);
 
VAR
      field      : tsp00_Line;
      length     : tin_natural;
      fieldpos   : tin_ls_position;
      field_type : tin_ls_fieldtype;
      cmd        : tsp00_C4;
 
BEGIN
cmd := '===>';
WITH fieldpos DO
    BEGIN
    screen_nr := i01g^.ls.nr_screens;
    screen_part := cin_ls_inputarea;
    sline := 1;
    scol := cin_first_scol;
    END;
(*ENDWITH*) 
WITH field_type DO
    BEGIN
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
i50put2field(cmd,4,fieldpos,field_type);
length := 0;
IF  ls_input IN fm
THEN
    BEGIN
    i58move('Here you can write s', false,field,length);
    i58move('omething in.        ', false,field,length);
    i58move('                    ', false,field,length);
    END
ELSE
    BEGIN
    i58move('Here you cannot writ', false,field,length);
    i58move('e anything.         ', false,field,length);
    i58move('                    ', false,field,length);
    END;
(*ENDIF*) 
i58move('                    ', false,field,length);
WITH fieldpos DO
    BEGIN
    scol := command_inputcol;
    length := vttest_linelength - scol;
    END;
(*ENDWITH*) 
WITH field_type DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := fm;
    END;
(*ENDWITH*) 
i50put1field(field,length,fieldpos,field_type);
END; (* put_commandline *)
 
(*------------------------------*) 
 
PROCEDURE
      init_graphic_menu (
            VAR i59g : vtt_global );
 
BEGIN
i51split(1);
assign_keys(f6);
i50standardattributes;
(*set_sqlttable(vt_black, vt_white);*)
i50clear(cin_ls_basic_window);
i56putframe (true, true);
insert_label(false,'        ');
i56putlabels(f_clear,false);
put_commandline( [ls_input] );
END; (* init_graphic_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      init_running_menu (
            VAR i59g : vtt_global );
 
BEGIN
i51split(1);
assign_keys(f7);
set_sqlttable(i59g, vt_blue, vt_green);
i50clear(cin_ls_basic_window);
i56putframe (true, true);
insert_label(false,'        ');
i56putlabels(f_clear,false);
put_commandline( [ls_input] );
END; (* init_running_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      init_mixed_menu;
 
BEGIN
i51split(1);
assign_keys(f1);
(*WITH i01g^.key_type DO
      activated := activated + [  f_local ] ; *)
set_mixed_sqlttable;
i50clear(cin_ls_basic_window);
i56putframe (true, true);
insert_label(true, 'Insert  ');
i56putlabels(f_clear,false);
put_commandline( [   ] );
END; (* init_mixed_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      set_mixed_sqlttable;
 
VAR
      i          : integer;
      foreground : tsp00_VtColor;
      background : tsp00_VtColor;
 
BEGIN
background := vt_white;
foreground := succ(background);
FOR i := 0 TO 15 DO
    IF  i <> ls_black
    THEN
        BEGIN
        sqlttable(i, [  ] , foreground, background);
        next_color(foreground, background);
        IF  foreground = background
        THEN
            next_color(foreground, background);
        (*ENDIF*) 
        END;
    (*ENDIF*) 
(*ENDFOR*) 
END; (* set_mixed_sqlttable *)
 
(*------------------------------*) 
 
PROCEDURE
      next_color (
            VAR foreground : tsp00_VtColor;
            VAR background : tsp00_VtColor);
 
BEGIN
IF  foreground < vt_light_blue
THEN
    foreground := succ(foreground)
ELSE
    BEGIN
    background := succ(background);
    foreground := vt_white;
    END;
(*ENDIF*) 
END; (* next_color *)
 
(*------------------------------*) 
 
PROCEDURE
      main_output (
            VAR i59g  : vtt_global;
            screen_nr : tin_natural);
 
VAR
      ft     : tin_ls_fieldtype;
      a,b    : tin_ls_attribute_index;
      m,n    : tin_ls_attribute_index;
      length : tin_natural;
      width  : tin_natural;
 
BEGIN
i51size2(screen_nr, cin_ls_workarea,length,width);
i59g.row := 1;
i59g.col := cin_first_scol;
put_screennr( i59g, screen_nr, length);
ft.fieldmode := [  ls_input, ls_continued ] ;
FOR m := 0 TO 15 DO
    BEGIN
    ft.field_att := m;
    put_field ( i59g, screen_nr, ft, length );
    END;
(*ENDFOR*) 
ft.field_att := cin_ls_normal;
(* continuation line for insert *)
put_empty_field(i59g, screen_nr, ft, length);
put_last_line( i59g , screen_nr );
i59g.row := 1;
i59g.col := cin_first_scol;
END; (* main_output *)
 
(*------------------------------*) 
 
PROCEDURE
      put_last_line(
            VAR i59g : vtt_global ;
            sno      : tsp00_Int2);
 
VAR
      pos    : tin_ls_position;
      length : tin_natural;
      width  : tin_natural;
      field  : tsp00_Line;
      ft     : tin_ls_fieldtype;
 
BEGIN
i51size2(sno, cin_ls_workarea,length,width);
WITH pos DO
    BEGIN
    screen_nr := sno;
    screen_part := cin_ls_workarea;
    sline := length;
    scol := 1;
    END;
(*ENDWITH*) 
length := 0;
i58move('*** Last Line  ***  ', false,field,length);
WITH ft DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
i50put1field(field,length, pos, ft );
END; (* put_last_line *)
 
(*------------------------------*) 
 
FUNCTION
      double_attributes (
            n     : tsp00_VtMode;
            VAR b : tsp00_VtAttrib) : boolean;
 
VAR
      m      : tsp00_VtAttrib;
      double : boolean;
 
BEGIN
m := [  n ] ;
double_attributes := m * b <> [  ] ;
END; (* double_attributes *)
 
(*------------------------------*) 
 
PROCEDURE
      main_input (
            VAR i59g       : vtt_global ;
            VAR cursor_sno : integer;
            VAR rf         : tin_ls_releasemode);
 
VAR
      csr_pos        : tin_ls_position;
      screen_changed : boolean;
      sno            : integer;
 
BEGIN
WITH i01g^.vt.opt DO
    BEGIN
    returnkeys      := [  vt_enter..vt_end_key, vt_exit ] ;
    END;
(*ENDWITH*) 
WITH csr_pos DO
    BEGIN
    IF  cursor_sno <= i01g^.ls.nr_screens
    THEN
        BEGIN
        screen_nr := cursor_sno;
        screen_part := cin_ls_workarea;
        scol := cin_first_scol;
        END
    ELSE
        BEGIN
        screen_nr := 1;
        screen_part := cin_ls_inputarea;
        scol := command_inputcol;
        END;
    (*ENDIF*) 
    sline := 1;
    END;
(*ENDWITH*) 
cursor_sno := cursor_sno + 1;
IF  cursor_sno > i01g^.ls.nr_screens + 1
THEN
    cursor_sno := cursor_sno - i01g^.ls.nr_screens - 1;
(*ENDIF*) 
i57ioscreen(csr_pos,rf,screen_changed);
IF  rf = f_enter
THEN
    BEGIN
    FOR sno := 1 TO i01g^.ls.nr_screens DO
        read_fields( i59g, sno);
    (*ENDFOR*) 
    END;
(*ENDIF*) 
END; (* main_input *)
 
(*------------------------------*) 
 
PROCEDURE
      clear_sysline (
            VAR i59g : vtt_global );
 
VAR
      field      : tsp00_Line;
      length     : tin_natural;
      fieldpos   : tin_ls_position;
      field_type : tin_ls_fieldtype;
      i          : integer;
 
BEGIN
IF  i59g.sys
THEN
    BEGIN
    length := i01g^.vt.desc.num_of_cols - 1;
    SAPDB_PascalForcedFill(LINE_MXSP00,@field,1,length,bsp_c1);
    WITH field_type DO
        BEGIN
        field_att := cin_ls_normal;
        fieldmode := [  ] ;
        END;
    (*ENDWITH*) 
    FOR i := 1 TO i01g^.ls.nr_screens DO
        BEGIN
        WITH fieldpos DO
            BEGIN
            screen_nr := i;
            screen_part := cin_ls_sysline;
            sline := 1;
            scol := 1;
            END;
        (*ENDWITH*) 
        i50put1field(field,length,fieldpos,field_type);
        END;
    (*ENDFOR*) 
    END;
(*ENDIF*) 
i59g.sys := false;
END; (* clear_sysline *)
 
(*------------------------------*) 
 
PROCEDURE
      read_fields (
            VAR i59g : vtt_global;
            sno      : integer);
 
CONST
      first_oline = 6;
 
VAR
      first_ipos : tin_ls_position;
      first_opos : tin_ls_position;
      length     : tin_natural;
      width      : tin_natural;
 
BEGIN
i51size2(sno, cin_ls_workarea, length, width);
WITH first_ipos DO
    BEGIN
    screen_nr := sno;
    screen_part := cin_ls_workarea;
    sline := 1;
    scol := 1;
    END;
(*ENDWITH*) 
WITH first_opos DO
    BEGIN
    screen_nr := sno;
    screen_part := cin_ls_workarea;
    sline := length - 1;
    IF  sline < 1
    THEN
        sline := 1;
    (*ENDIF*) 
    scol := cin_first_scol;
    END;
(*ENDWITH*) 
read_fields_1( i59g, first_ipos, first_opos);
WITH first_ipos DO
    BEGIN
    screen_nr := sno;
    screen_part := cin_ls_inputarea;
    sline := 1;
    scol := 1;
    END;
(*ENDWITH*) 
WITH first_opos DO
    BEGIN
    sline := sline + 1;
    scol := 1;
    END;
(*ENDWITH*) 
read_fields_1( i59g, first_ipos, first_opos);
END; (* read_fields *)
 
(*------------------------------*) 
 
PROCEDURE
      read_fields_1(
            VAR i59g       : vtt_global;
            VAR first_ipos : tin_ls_position;
            VAR first_opos : tin_ls_position );
 
VAR
      window_changed : boolean;
      vt_input       : tin_ls_input_field;
      field_found    : boolean;
      ft             : tin_ls_fieldtype;
      lines,cols     : tin_natural;
      split          : boolean;
      split_max      : tsp00_Int2;
      split_min      : tsp00_Int2;
      lines1         : tsp00_Int2;
      lines2         : tsp00_Int2;
 
BEGIN
split := false;
i50getwindow(first_ipos,99,99,window_changed);
i50clwindow(first_opos,99,99);
window_changed := true; (* !!! *)
IF  window_changed
THEN
    BEGIN
    i51size2(first_ipos.screen_nr, cin_ls_workarea, lines, cols );
    WITH ft DO
        BEGIN
        field_att := cin_ls_inverse;
        fieldmode := [  ] ;
        END;
    (*ENDWITH*) 
    REPEAT
        i50getfield(vt_input,field_found);
        IF  field_found AND vt_input.changed
        THEN
            BEGIN
            check_commandline(i59g, vt_input, split,
                  split_min, split_max, lines1, lines2 );
            WITH first_opos DO
                IF  scol + vt_input.len > cols
                THEN
                    BEGIN
                    scol := cin_first_scol;
                    sline := sline + 1;
                    END;
                (*ENDIF*) 
            (*ENDWITH*) 
            i50put5field(vt_input.buf,vt_input.len,
                  first_opos,ft);
            WITH first_opos DO
                scol := scol + vt_input.len + 1;
            (*ENDWITH*) 
            END;
        (*ENDIF*) 
    UNTIL
        NOT field_found;
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
IF  split
THEN
    BEGIN
    i59g.split := NOT i59g.split;
    split_screen(i59g, primary_menu, split_min, split_max,
          lines1, lines2 );
    put_commandline ( [ ls_input ] );
    END;
(*ENDIF*) 
END; (* read_fields_1 *)
 
(*------------------------------*) 
 
PROCEDURE
      check_commandline (
            VAR i59g     : vtt_global;
            VAR vt_input : tin_ls_input_field;
            VAR split    : boolean ;
            VAR nr_min   : tsp00_Int2;
            VAR nr_max   : tsp00_Int2;
            VAR lines1   : tsp00_Int2;
            VAR lines2   : tsp00_Int2 );
 
VAR
      i          : integer;
      ft         : tin_ls_fieldtype;
      lines,cols : tin_natural;
 
BEGIN
split := (vt_input.fld_pos.screen_part = cin_ls_inputarea);
IF  split
THEN
    BEGIN
    split := (vt_input.len >= 5);
    i51size(cin_ls_inputarea, lines, cols );
    ft.field_att := cin_ls_enhanced;
    ft.fieldmode := [  ls_input ] ;
    WITH vt_input DO
        BEGIN
        FOR i := len+1 TO cols - fld_pos.scol + 1 DO
            buf [i]  := bsp_c1;
        (*ENDFOR*) 
        i50put5field(buf, cols-fld_pos.scol + 1, fld_pos, ft );
        END;
    (*ENDWITH*) 
    END;
(*ENDIF*) 
IF  split
THEN
    BEGIN
    split := i58splitcommand( vt_input.buf, vt_input.len,
          nr_min, nr_max, lines1, lines2 );
    IF  split
    THEN
        BEGIN
        IF  nr_max = 3
        THEN
            i59g.actscreen := 0
        ELSE
            i59g.actscreen := nr_max;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* check_commandline *)
 
(*------------------------------*) 
 
PROCEDURE
      put_field (
            VAR i59g  : vtt_global;
            screen_nr : tin_natural;
            ft        : tin_ls_fieldtype;
            limit     : tsp00_Int2 );
 
VAR
      str : vtt_string;
 
BEGIN
WITH str DO
    length := 0;
(*ENDWITH*) 
str := i59g.labels [ ft.field_att ] ;
put_text ( i59g, str,screen_nr,ft, limit );
END; (* put_field *)
 
(*------------------------------*) 
 
PROCEDURE
      put_empty_field (
            VAR i59g  : vtt_global;
            screen_nr : tin_natural;
            ft        : tin_ls_fieldtype;
            limit     : tsp00_Int2);
 
VAR
      str   : vtt_string;
      piece : tsp00_C20;
 
BEGIN
piece := '                    ';
str.length := 0;
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,str.length+1,10);
str.length := str.length + 10;
put_text ( i59g, str,screen_nr,ft, limit );
END; (* put_empty_field *)
 
(*------------------------------*) 
 
PROCEDURE
      put_text (
            VAR i59g : vtt_global;
            str      : vtt_string;
            sno      : tin_natural;
            ft       : tin_ls_fieldtype;
            limit    : tsp00_Int2 );
 
VAR
      fieldpos : tin_ls_position;
 
BEGIN
WITH fieldpos DO
    BEGIN
    screen_nr := sno;
    screen_part := cin_ls_workarea;
    sline := i59g.row;
    scol := i59g.col;
    IF  scol + label_length * nr_attribs > 79
    THEN
        BEGIN
        scol := cin_first_scol;
        sline := sline + 1;
        END;
    (*ENDIF*) 
    IF  sline <= limit
    THEN
        BEGIN
        i50put1field(str.text,str.length,fieldpos,ft);
        i59g.row := sline;
        i59g.col := scol + label_length * nr_attribs + 3;
        END;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* put_text *)
 
(*------------------------------*) 
 
PROCEDURE
      graphic_output;
 
CONST
      left_pos = 10;
      first_l = 2;
 
VAR
      field          : tsp00_Line;
      length         : tin_natural;
      fieldpos       : tin_ls_position;
      field_type     : tin_ls_fieldtype;
      i              : tin_natural;
      tl,tr,vl,pl,ch : tsp00_C4;
      lines,cols     : tin_natural;
      right_pos      : integer;
      mid_pos        : integer;
      last_l         : integer;
      mid_l          : integer;
      charpos_1      : integer;
      charpos_2      : integer;
      charl_1        : integer;
      charl_2        : integer;
 
BEGIN
i51size(cin_ls_workarea, lines, cols );
right_pos := cols - left_pos;
last_l := lines - first_l - 1;
length := right_pos - left_pos + 1;
mid_pos := (right_pos + left_pos) DIV 2;
charpos_1 := (left_pos + mid_pos) DIV 2;
charpos_2 := (mid_pos + right_pos) DIV 2;
mid_l := (last_l + first_l) DIV 2;
charl_1 := (first_l + mid_l) DIV 2;
charl_2 := (mid_l + last_l) DIV 2;
SAPDB_PascalForcedFill (LINE_MXSP00,@field,2,length-2,csp_horizontal_bar );
field [1]  :=  csp_u_left_corner ;
field [mid_pos - left_pos + 1 ] :=  csp_top_t ;
field [length ] :=  csp_u_right_corner ;
WITH field_type DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
WITH fieldpos DO
    BEGIN
    screen_part := cin_ls_workarea;
    sline := first_l;
    scol := left_pos;
    END;
(*ENDWITH*) 
i50put1field(field, length, fieldpos, field_type);
field [1]  :=  csp_l_left_corner ;
field [mid_pos - left_pos + 1 ] :=  csp_bottom_t ;
field [length ] :=  csp_l_right_corner ;
WITH fieldpos DO
    sline := last_l;
(*ENDWITH*) 
i50put1field(field, length, fieldpos, field_type);
field [1]  :=  csp_left_t ;
field [mid_pos - left_pos + 1  ] :=  csp_crossing_lines ;
field [length ] :=  csp_right_t ;
WITH fieldpos DO
    sline := mid_l;
(*ENDWITH*) 
i50put1field(field, length, fieldpos, field_type);
tl [1]  :=  csp_left_t ;
tr [1]  :=  csp_right_t ;
vl [1]  :=  csp_vertical_bar ;
pl [1]  := '+';
FOR i := first_l+1 TO last_l-1 DO
    IF  i <> mid_l
    THEN
        BEGIN
        fieldpos.sline := i;
        fieldpos.scol := left_pos;
        i50put2field(vl, 1 , fieldpos, field_type);
        fieldpos.scol := mid_pos;
        i50put2field(vl, 1 , fieldpos, field_type);
        fieldpos.scol := right_pos;
        i50put2field(vl, 1 , fieldpos, field_type);
        END;
    (*ENDIF*) 
(*ENDFOR*) 
field_type.field_att := cin_ls_normal;
FOR i := 1 TO 2 DO
    BEGIN
    IF  i = 1
    THEN
        fieldpos.sline := first_l-1
    ELSE
        fieldpos.sline := last_l+1;
    (*ENDIF*) 
    fieldpos.scol := left_pos;
    i50put2field(pl, 1 , fieldpos, field_type);
    fieldpos.scol := mid_pos;
    i50put2field(pl, 1 , fieldpos, field_type);
    fieldpos.scol := right_pos;
    i50put2field(pl, 1 , fieldpos, field_type);
    END;
(*ENDFOR*) 
(* one horizontal line *)
field [1]  :=  csp_horizontal_bar ;
field [ length  ] :=  csp_horizontal_bar ;
field_type.field_att := cin_ls_normal;
fieldpos.sline := last_l + 2;
fieldpos.scol := left_pos;
i50put1field(field, length, fieldpos, field_type);
(* *)
field_type.field_att := cin_ls_enhanced;
fieldpos.sline := charl_1;
fieldpos.scol := charpos_1;
ch [1]  := 'A';
i50put2field(ch, 1 , fieldpos, field_type);
fieldpos.scol := charpos_2;
ch [1]  := 'B';
i50put2field(ch, 1 , fieldpos, field_type);
fieldpos.sline := charl_2;
fieldpos.scol := charpos_1;
ch [1]  := 'C';
i50put2field(ch, 1 , fieldpos, field_type);
fieldpos.scol := charpos_2;
ch [1]  := 'D';
i50put2field(ch, 1 , fieldpos, field_type);
END; (* graphic_output *)
 
(*------------------------------*) 
 
PROCEDURE
      running_output;
 
VAR
      i              : integer;
      s              : tsp00_C20;
      field_type     : tin_ls_fieldtype;
      csr_pos        : tin_ls_position;
      rf             : tin_ls_releasemode;
      screen_changed : boolean;
 
BEGIN
WITH csr_pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    scol := 6;
    sline := 6;
    END;
(*ENDWITH*) 
WITH field_type DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
FOR i := 1 TO 100 DO
    BEGIN
    i58encnumber(i, 10, s);
    i50put3field(s, 10, csr_pos, field_type);
    WITH i01g^.vt.opt DO
        wait_for_input := false;
    (*ENDWITH*) 
    i57ioscreen(csr_pos,rf,screen_changed);
    END;
(*ENDFOR*) 
END; (* running_output *)
 
(*------------------------------*) 
 
PROCEDURE
      mixed_output;
 
VAR
      pos : tin_ls_position;
 
BEGIN
different_colors ( pos );
protected_unprotected ( pos );
charset_test ( pos );
END; (* mixed_output *)
 
(*------------------------------*) 
 
PROCEDURE
      different_colors (
            VAR fieldpos : tin_ls_position );
 
VAR
      field      : tsp00_Line;
      length     : tin_natural;
      field_type : tin_ls_fieldtype;
      index      : integer;
      repcount   : integer;
      text       : tsp00_C30;
      ipos       : integer;
 
BEGIN
WITH field_type DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := [  ls_input, ls_mixed ] ;
    END;
(*ENDWITH*) 
WITH fieldpos DO
    BEGIN
    screen_part := cin_ls_workarea;
    sline := 2;
    scol := cin_first_scol;
    END;
(*ENDWITH*) 
length := 0;
ipos := 0;
text := 'These are different colors    ';
FOR index := 0 TO 15 DO
    IF  index <> ls_black
    THEN
        FOR repcount := 1 TO 3 DO
            BEGIN
            length := length + 1;
            ipos := ipos + 1;
            field [length ] := text [ipos] ;
            IF  ipos = 30
            THEN
                ipos := 0;
            (*ENDIF*) 
            END;
        (*ENDFOR*) 
    (*ENDIF*) 
(*ENDFOR*) 
i50put1field(field, length, fieldpos, field_type);
FOR index := 0 TO 15 DO
    IF  index <> ls_black
    THEN
        BEGIN
        field_type.field_att := index;
        FOR repcount := 1 TO 3 DO
            BEGIN
            i50putattribute(fieldpos,field_type);
            fieldpos.scol := fieldpos.scol + 1;
            END;
        (*ENDFOR*) 
        END;
    (*ENDIF*) 
(*ENDFOR*) 
END; (* different_colors *)
 
(*------------------------------*) 
 
PROCEDURE
      protected_unprotected(
            VAR fieldpos : tin_ls_position);
 
VAR
      field      : tsp00_C40;
      field_type : tin_ls_fieldtype;
      fore, back : tsp00_VtColor;
      ipos       : integer;
 
BEGIN
WITH field_type DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := [  ls_input, ls_mixed ] ;
    END;
(*ENDWITH*) 
WITH fieldpos DO
    BEGIN
    screen_part := cin_ls_workarea;
    sline := 3;
    scol := cin_first_scol;
    END;
(*ENDWITH*) 
field := 'This is a write protected field>#<------';
i50put4field(field, 40, fieldpos, field_type);
fieldpos.scol := 33 + cin_first_scol - 1;
field_type.field_att := cin_ls_inverse;
field_type.fieldmode := [  ls_mixed ] ;
i50putattribute(fieldpos,field_type);
WITH field_type DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := [  ls_input, ls_mixed ] ;
    END;
(*ENDWITH*) 
WITH fieldpos DO
    BEGIN
    screen_part := cin_ls_workarea;
    sline := 4;
    scol := cin_first_scol;
    END;
(*ENDWITH*) 
field := '#<------- Now it''s here -------------->#';
i50put4field(field, 40, fieldpos, field_type);
fieldpos.scol := 1 + cin_first_scol - 1;
field_type.field_att := cin_ls_inverse;
field_type.fieldmode := [  ls_mixed ] ;
i50putattribute(fieldpos,field_type);
fieldpos.scol := cin_first_scol + 40 - 1;
i50putattribute(fieldpos,field_type);
END; (* protected_unprotected *)
 
(*------------------------------*) 
 
PROCEDURE
      charset_test (
            VAR pos : tin_ls_position );
 
VAR
      text1        : tsp00_Line;
      text2        : tsp00_Line;
      length       : integer;
      lines , cols : tin_natural;
      c            : integer;
      ft           : tin_ls_fieldtype;
 
BEGIN
ft.field_att := cin_ls_normal;
pos.sline := pos.sline + 2;
pos.scol := 1;
length := 0;
i51size(cin_ls_workarea, lines, cols );
FOR c := 128 TO 255 DO
    BEGIN
    IF  length + 4 > cols
    THEN
        BEGIN
        i50put1field ( text1, length, pos, ft );
        pos.sline := pos.sline + 1;
        i50put1field ( text2, length, pos, ft );
        pos.sline := pos.sline + 1;
        length := 0;
        END;
    (*ENDIF*) 
    put_charset_char( text2, length, chr(c) );
    put_charset_int( text1, length, c );
    length := length + 4;
    END;
(*ENDFOR*) 
END; (* charset_test *)
 
(*------------------------------*) 
 
PROCEDURE
      put_charset_char(
            VAR text : tsp00_Line;
            length   : integer;
            c        : char );
 
VAR
      pos : integer;
 
BEGIN
pos := length + 1;
text[pos] := bsp_c1;
pos := pos + 1;
text[pos] := c;
pos := pos + 1;
text[pos] := bsp_c1;
pos := pos + 1;
text[pos] := bsp_c1;
END; (* put_charset_char *)
 
(*------------------------------*) 
 
PROCEDURE
      put_charset_int(
            VAR text : tsp00_Line;
            length   : integer;
            c        : integer);
 
VAR
      pos    : integer;
      digits : ARRAY[1..3] OF integer;
      i      : integer;
 
BEGIN
pos := length + 1;
text[pos] := bsp_c1;
FOR i := 3 DOWNTO 1 DO
    BEGIN
    digits[i] := c MOD 10;
    c := c DIV 10;
    END;
(*ENDFOR*) 
FOR i := 1 TO 3 DO
    BEGIN
    pos := pos + 1;
    text[pos] := chr( ord('0') + digits[i] );
    END;
(*ENDFOR*) 
END; (* put_charset_int *)
 
(*------------------------------*) 
 
PROCEDURE
      graphic_input (
            VAR i59g : vtt_global;
            VAR rf   : tin_ls_releasemode);
 
VAR
      csr_pos        : tin_ls_position;
      screen_changed : boolean;
 
BEGIN
WITH csr_pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    scol := cin_first_scol;
    sline := 1;
    END;
(*ENDWITH*) 
clear_sysline( i59g );
i57ioscreen(csr_pos,rf,screen_changed);
END; (* graphic_input *)
 
(*------------------------------*) 
 
PROCEDURE
      mixed_input (
            VAR i59g : vtt_global;
            VAR rf   : tin_ls_releasemode);
 
VAR
      csr_pos        : tin_ls_position;
      screen_changed : boolean;
      sno            : integer;
 
BEGIN
WITH i01g^.vt.opt DO
    BEGIN
    return_on_last  := true;
    return_on_first := true;
    returnkeys      := [  vt_enter..vt_end_key, vt_exit ] ;
    reject_keys     := [  vt_clear,vt_cursor_home, vt_cursor_end ] ;
    bell := true;
    END;
(*ENDWITH*) 
WITH csr_pos DO
    BEGIN
    screen_nr := i01g^.ls.nr_screens;
    screen_part := cin_ls_workarea;
    scol := cin_first_scol;
    sline := 2;
    END;
(*ENDWITH*) 
clear_sysline( i59g );
i57ioscreen(csr_pos,rf,screen_changed);
FOR sno := 1 TO i01g^.ls.nr_screens DO
    read_fields( i59g, sno);
(*ENDFOR*) 
WITH i01g^.vt.opt DO
    BEGIN
    return_on_last  := false;
    return_on_first := false;
    returnkeys      := [  vt_enter..vt_end_key, vt_exit ] ;
    reject_keys     := [  ] ;
    END;
(*ENDWITH*) 
END; (* mixed_input *)
 
(* Beispiel fuer Barbara *)
(*------------------------------*) 
 
PROCEDURE
      key_test_menu (
            VAR i59g   : vtt_global;
            VAR status : vttest_status);
 
VAR
      rk      : tin_ls_releasemode;
      row,col : tin_natural;
 
BEGIN
init_keytest_menu(i59g, row,col);
put_headerline(status);
REPEAT
    keytest_output(row,col);
    keytest_input(rk);
    IF  rk IN [  f9, f_end  ]
    THEN
        status := primary_menu;
    (*ENDIF*) 
UNTIL
    status <> key_test;
(*ENDREPEAT*) 
END; (* key_test_menu *)
 
(* Beispiel fuer Barbara *)
(*------------------------------*) 
 
PROCEDURE
      init_keytest_menu (
            VAR i59g    : vtt_global;
            VAR row,col : tin_natural);
 
VAR
      text : tsp00_C40;
      ft   : tin_ls_fieldtype;
      pos  : tin_ls_position;
 
BEGIN
i51split(1);
assign_keys( f2 );
WITH i01g^.key_type DO
    BEGIN
    activated := [ f1..f_end] ;
    key_labels [f1]  := '        ';
    key_labels [f2]  := '        ';
    key_labels [f3]  := '        ';
    key_labels [f4]  := '        ';
    key_labels [f5]  := '        ';
    key_labels [f6]  := '        ';
    key_labels [f9]  := main_label;
    END;
(*ENDWITH*) 
row := 3;
col := cin_first_scol;
set_sqlttable(i59g, vt_white, vt_blue);
i50clear(cin_ls_basic_window);
i56putframe (true, true);
i56putlabels(f_clear,false);
put_commandline( [ ] );
insert_label(false,'        ');
WITH ft DO
    BEGIN
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
WITH pos DO
    BEGIN
    screen_part := cin_ls_sysline;
    sline := 1;
    scol := cin_first_scol;
    END;
(*ENDWITH*) 
text := 'Please press any key                    ';
i50put4field(text, 33, pos, ft);
i59g.sys := true;
END; (* init_keytest_menu *)
 
(* Beispiel fuer Barbara *)
(*------------------------------*) 
 
PROCEDURE
      keytest_output (
            VAR row,col : tin_natural);
 
CONST
      keylen = 10;
 
VAR
      keystr  : vtt_string;
      posstr  : vtt_string;
      ft      : tin_ls_fieldtype;
      pos     : tin_ls_position;
      tmp_str : tsp00_C11;
 
BEGIN
keystr.length := 0;
posstr.length := 0;
IF  i01g^.vt.parms.key.key <> vt_character_key
THEN
    WITH i01g^.vt.parms DO
        i58encpf(key.key,keylen,keystr)
    (*ENDWITH*) 
ELSE
    BEGIN
    keystr.text [1]  := '''';
    keystr.text [2]  := i01g^.vt.parms.key.ch;
    keystr.text [3]  := '''';
    keystr.text [4]  := ' ';
    keystr.text [5]  := ' ';
    keystr.text [6]  := ' ';
    keystr.text [7]  := ' ';
    keystr.text [8]  := ' ';
    keystr.text [9]  := ' ';
    keystr.text [10] := ' ';
    keystr.length := 10;
    END;
(*ENDIF*) 
WITH ft DO
    BEGIN
    field_att := cin_ls_inverse;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
IF  col + keylen > 79
THEN
    BEGIN
    col := cin_first_scol;
    row := row + 1;
    IF  row > 17
    THEN
        row := 3;
    (*ENDIF*) 
    END;
(*ENDIF*) 
WITH pos DO
    BEGIN
    screen_part := cin_ls_workarea;
    sline := row;
    scol := col;
    END;
(*ENDWITH*) 
i50put1field(keystr.text, keystr.length, pos, ft);
col := col + keylen + 1;
IF  i01g^.vt.parms.key.key in [ vt_mouse_down, vt_mouse_up,
    vt_mouse_move, vt_mouse_dbl ]
THEN
    BEGIN
    WITH i01g^.vt.parms DO
        i58encmouse_pos ( i01g^.vt.parms.key, posstr );
    (*ENDWITH*) 
    END
ELSE
    BEGIN
    tmp_str := '           ';
    s10mv(11,LINE_MXSP00,
          @tmp_str,1,
          @posstr.text,1,11);
    posstr.length := 11;
    END;
(*ENDIF*) 
WITH pos DO
    BEGIN
    screen_part := cin_ls_workarea;
    sline := 1;
    scol  := 1;
    END;
(*ENDWITH*) 
i50put1field(posstr.text, posstr.length, pos, ft);
END; (* keytest_output *)
 
(*------------------------------*) 
 
PROCEDURE
      keytest_input (
            VAR rf : tin_ls_releasemode);
 
VAR
      csr_pos        : tin_ls_position;
      screen_changed : boolean;
 
BEGIN
WITH i01g^.vt.opt DO
    returnkeys      := [  vt_character_key .. vt_del_eof,
          vt_mouse_down, vt_mouse_up,
          vt_mouse_move, vt_mouse_dbl , vt_exit ] ;
(*ENDWITH*) 
WITH csr_pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_header;
    scol := cin_first_scol;
    sline := 1;
    END;
(*ENDWITH*) 
i57ioscreen(csr_pos,rf,screen_changed);
END; (* keytest_input *)
 
(*------------------------------*) 
 
PROCEDURE
      init_help_screen (
            VAR i59g : vtt_global );
 
VAR
      ft  : tin_ls_fieldtype;
      pos : tin_ls_position;
 
BEGIN
WITH i01g^.key_type DO
    BEGIN
    activated := [ f9, f_end, f_exit, f_help] ;
    key_labels [f9]  := 'Back    ';
    END;
(*ENDWITH*) 
set_sqlttable(i59g, vt_white, vt_pink);
i50clear(cin_ls_basic_window);
i56putframe (true, true);
i56putlabels(f_clear,true);
put_commandline( [ ls_input ] );
END; (* init_help_screen *)
 
(*------------------------------*) 
 
PROCEDURE
      help_output (
            VAR i59g : vtt_global );
 
VAR
      length     : tin_natural;
      fieldpos   : tin_ls_position;
      field_type : tin_ls_fieldtype;
      fore, back : tsp00_VtColor;
      text       : tsp00_C40;
      i          : integer;
      lines,cols : tin_natural;
 
BEGIN
WITH field_type DO
    BEGIN
    field_att := cin_ls_enhanced;
    fieldmode := [  ] ;
    END;
(*ENDWITH*) 
WITH fieldpos DO
    BEGIN
    screen_part := cin_ls_workarea;
    scol := cin_first_scol;
    END;
(*ENDWITH*) 
length := 22;
text := 'This is a help text                     ';
i51size(cin_ls_workarea, lines, cols );
FOR i := 2 TO lines-1 DO
    BEGIN
    WITH fieldpos DO
        sline := i;
    (*ENDWITH*) 
    i50put4field(text, length, fieldpos, field_type);
    END;
(*ENDFOR*) 
put_last_line( i59g, i01g^.ls.nr_screens );
END; (* help_output *)
 
(*------------------------------*) 
 
PROCEDURE
      help_input (
            VAR i59g : vtt_global;
            VAR rf   : tin_ls_releasemode);
 
VAR
      csr_pos        : tin_ls_position;
      screen_changed : boolean;
 
BEGIN
WITH i01g^.vt.opt DO
    returnkeys      := [  ] ;
(*ENDWITH*) 
WITH csr_pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_inputarea;
    scol := 6;
    sline := 1;
    END;
(*ENDWITH*) 
clear_sysline( i59g );
i57ioscreen(csr_pos,rf,screen_changed);
END; (* help_input *)
 
(*------------------------------*) 
 
PROCEDURE
      edit_menu (
            VAR i59g   : vtt_global;
            VAR status : vttest_status);
 
VAR
      rk       : tin_ls_releasemode;
      new_init : boolean;
 
BEGIN
init_edit_menu( i59g );
put_sysline(i59g);
put_headerline(status);
WITH i59g.cursor DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    scol := cin_first_scol;
    sline := 1;
    END;
(*ENDWITH*) 
REPEAT
    edit_output ( i59g );
    edit_input(i59g, rk );
    check_function(i59g, rk,status,new_init);
    IF  new_init
    THEN
        BEGIN
        init_edit_menu( i59g );
        put_sysline(i59g);
        put_headerline(status);
        END
    ELSE
        IF  status = edit_screen
        THEN
            i56putlabels(f_clear,false);
        (*ENDIF*) 
    (*ENDIF*) 
UNTIL
    status <> edit_screen;
(*ENDREPEAT*) 
END; (* edit_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      init_edit_menu (
            VAR i59g : vtt_global );
 
BEGIN
i51split(1);
(* set_sqlttable(vt_blue, vt_white); *)
i50clear(cin_ls_basic_window);
assign_edit_keys;
i50clear(cin_ls_basic_window);
i56putframe (true, true);
insert_label(true, 'Insert  ');
i56putlabels(f_clear,true);
i56putframe (true, true);
set_edit_ranges( i59g );
put_commandline( [  ls_input  ] );
i59g.lines.changed := true;
END; (* init_edit_menu *)
 
(*------------------------------*) 
 
PROCEDURE
      assign_edit_keys;
 
BEGIN
WITH i01g^.key_type DO
    BEGIN
    activated := [ f_enter,f1..f9,f_end,f_exit,f_help, f_up, f_down,
          f_hscroll, f_vscroll, f_pick ] ;
    key_labels [f1]  := mixed_label;
    key_labels [f2]  := keys_label;
&   ifdef WINDOWS
    key_labels [f3]  := nextrow_label;
    activated := activated + [  f_print ] ;
&   else
    key_labels [f3]  := print_label;
&   endif
    key_labels [f4]  := left_label;
    key_labels [f5]  := right_label;
    key_labels [f6]  := blockmark_label;
    key_labels [f7]  := linemark_label;
    key_labels [f8]  := contmark_label;
    key_labels [f9]  := main_label;
    key_labels [f_help ] := help_label;
    key_labels [f_up ] := up_label;
    key_labels [f_down ] := down_label;
    IF  i01g^.vt.desc.labels <> no_sk_labels
    THEN
        activated := activated - [  f5 ] ;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* assign_edit_keys *)
 
(*------------------------------*) 
 
PROCEDURE
      edit_output (
            VAR i59g : vtt_global );
 
VAR
      slength : tin_natural;
      swidth  : tin_natural;
 
BEGIN
i51size(cin_ls_workarea,slength,swidth);
IF  i59g.lines.changed
THEN
    output_edit_lines(i59g, 1, slength);
(*ENDIF*) 
END; (* edit_output *)
 
(*------------------------------*) 
 
PROCEDURE
      output_edit_lines (
            VAR i59g  : vtt_global;
            first_lno : integer;
            last_lno  : integer);
 
VAR
      i         : integer;
      ft        : tin_ls_fieldtype;
      pos       : tin_ls_position;
      curline   : integer;
      blankline : tsp00_Line;
      slength   : tin_natural;
      swidth    : tin_natural;
 
BEGIN
i51size(cin_ls_workarea,slength,swidth);
SAPDB_PascalForcedFill (LINE_MXSP00, @blankline, 1, LINE_MXSP00, bsp_c1);
WITH pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    scol := 1;
    END;
(*ENDWITH*) 
WITH ft DO
    BEGIN
    field_att := cin_ls_normal;
    fieldmode := [  ls_input ] ;
    END;
(*ENDWITH*) 
IF  first_lno < 1
THEN
    first_lno := 1;
(*ENDIF*) 
IF  last_lno > slength
THEN
    last_lno := slength;
(*ENDIF*) 
FOR i := first_lno TO last_lno DO
    BEGIN
    pos.sline := i;
    WITH i59g.lines DO
        BEGIN
        curline := top+i-1;
        IF  curline <= max_edit_lines
        THEN
            BEGIN
            output_field(text [ curline ] , i59g.lines.left,
                  swidth, pos, ft);
            ft.fieldmode := [  ls_input, ls_continued ] ;
            END
        ELSE
            BEGIN
            ft.fieldmode := [  ] ;
            i50put1field(blankline, LINE_MXSP00, pos, ft);
            END;
        (*ENDIF*) 
        changed := false;
        END;
    (*ENDWITH*) 
    END;
(*ENDFOR*) 
set_mark_range ( i59g );
END; (* output_edit_lines *)
 
(*------------------------------*) 
 
PROCEDURE
      output_field (
            VAR lin : tsp00_Line;
            left    : integer;
            length  : integer;
            VAR pos : tin_ls_position;
            VAR ft  : tin_ls_fieldtype);
 
VAR
      temp : tsp00_Line;
 
BEGIN
IF  left + length - 1 > LINE_MXSP00
THEN
    length := LINE_MXSP00 - left + 1;
(*ENDIF*) 
s10mv(LINE_MXSP00,LINE_MXSP00,
      @lin,left,
      @temp,1,length);
i50put1field(temp, length, pos, ft);
END; (* output_field *)
 
(*------------------------------*) 
 
PROCEDURE
      set_edit_ranges (
            VAR i59g : vtt_global );
 
VAR
      hrange  : tin_display_range;
      lbl     : tsp00_C8;
      vrange  : tin_display_range;
      slength : tin_natural;
      swidth  : tin_natural;
 
BEGIN
i51size(cin_ls_workarea,slength,swidth);
WITH hrange DO
    BEGIN
    total_begin := 1;
    total_end   := mxin_screenline;
    displ_begin := i59g.lines.left;
    displ_end   := swidth;
    displ_end   := displ_begin + swidth - 1;
    IF  displ_end > LINE_MXSP00
    THEN
        displ_end := LINE_MXSP00;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
WITH vrange DO
    BEGIN
    total_begin := 1;
    total_end   := max_edit_lines;
    displ_begin := i59g.lines.top;
    displ_end   := displ_begin + slength - 1;
    IF  displ_end > max_edit_lines
    THEN
        displ_end := max_edit_lines;
    (*ENDIF*) 
    END;
(*ENDWITH*) 
lbl := 'Lines   ';
i56hrange(1, hrange);
i56vrange(1, lbl, vrange);
END; (* set_edit_ranges *)
 
(*------------------------------*) 
 
PROCEDURE
      reset_mark_range (
            VAR i59g : vtt_global );
 
BEGIN
i59g.lines.mark1_line := -1;
i59g.mark := vt_mark_off;
set_mark_range ( i59g );
END; (* reset_mark_range *)
 
(*------------------------------*) 
 
PROCEDURE
      get_mark_range (
            VAR i59g : vtt_global );
 
VAR
      mode          : tsp00_VtMark;
      top, left     : tsp00_Int2;
      bottom, right : tsp00_Int2 ;
      temp          : tsp00_Int4;
      marked        : boolean;
 
BEGIN
i56getmark (1, cin_ls_workarea, mode, top, left, bottom, right );
marked := ( mode <> vt_mark_off );
IF  marked
THEN
    BEGIN
    IF  (top > bottom) OR ( left > right)
    THEN
        marked := false;
    (*ENDIF*) 
    END;
(*ENDIF*) 
IF  marked
THEN
    BEGIN
    temp := top + i59g.lines.top - 1;
    IF  temp < 1
    THEN
        temp := 1;
    (*ENDIF*) 
    i59g.lines.mark1_line := temp;
    (* *)
    temp := left + i59g.lines.left - 1;
    IF  temp < 1
    THEN
        temp := 1;
    (*ENDIF*) 
    i59g.lines.mark1_col := temp;
    (* *)
    temp := bottom + i59g.lines.top - 1;
    IF  temp > max_edit_lines
    THEN
        temp := max_edit_lines ;
    (*ENDIF*) 
    i59g.lines.mark2_line := temp;
    (* *)
    temp := right + i59g.lines.left - 1;
    IF  temp > LINE_MXSP00
    THEN
        temp := LINE_MXSP00;
    (*ENDIF*) 
    i59g.lines.mark2_col := temp;
    END
ELSE
    i59g.lines.mark1_line := -1;
(*ENDIF*) 
END; (* get_mark_range *)
 
(*------------------------------*) 
 
PROCEDURE
      set_mark_range (
            VAR i59g : vtt_global );
 
VAR
      mode          : tsp00_VtMark;
      top, left     : tsp00_Int2;
      bottom, right : tsp00_Int2 ;
      undefined     : boolean;
 
BEGIN
mode := i59g.mark;
undefined := (mode = vt_mark_off);
IF  NOT undefined
THEN
    undefined := (i59g.lines.mark1_line < 0);
(*ENDIF*) 
IF  undefined
THEN
    BEGIN
    top := 1;
    left := 1;
    bottom := 0;
    right := 0;
    END
ELSE
    BEGIN
    top := i59g.lines.mark1_line - i59g.lines.top + 1;
    left := i59g.lines.mark1_col - i59g.lines.left + 1;
    bottom := i59g.lines.mark2_line - i59g.lines.top + 1;
    right := i59g.lines.mark2_col - i59g.lines.left + 1;
    END;
(*ENDIF*) 
i56setmark (1, cin_ls_workarea, mode,
      top, left, bottom, right );
END; (* set_mark_range *)
 
(*------------------------------*) 
 
PROCEDURE
      set_mark_pos (
            lno, col : tsp00_Int2;
            VAR pos  : tin_ls_position);
 
BEGIN
WITH pos DO
    BEGIN
    screen_nr   := 1;
    screen_part := cin_ls_workarea;
    scol        := col;
    sline       := lno;
    END;
(*ENDWITH*) 
END; (* set_mark_pos *)
 
(*------------------------------*) 
 
PROCEDURE
      print_edit_lines (
            VAR i59g : vtt_global );
 
CONST
      pagesize = 24;
 
VAR
      i           : integer;
      printer     : tsp00_PrtName;
      errtext     : tsp00_ErrText;
      vpok        : boolean;
      lfeeds      : tsp00_VpLinefeeds;
      repeatcount : integer;
      pagecount   : integer;
      j           : integer;
 
BEGIN
errtext := 'sqlpon failed                           ';
get_printername(printer);
sqlpon (printer, vpok);
FOR i := 1 TO max_edit_lines DO
    IF  vpok
    THEN
        BEGIN
        repeatcount := 1;
        lfeeds := vp_onelf;
        pagecount := i MOD pagesize;
        CASE pagecount OF
            0:
                lfeeds := vp_page;
            3,9:
                repeatcount := 3;
            7:
                lfeeds := vp_twolf;
            11:
                lfeeds := vp_threelf;
            OTHERWISE:
            END;
        (*ENDCASE*) 
        WITH i59g.lines DO
            FOR j := 1 TO repeatcount DO
                IF  vpok
                THEN
                    BEGIN
                    sqlprint (text [i] , LINE_MXSP00, lfeeds,
                          errtext, vpok);
                    lfeeds := vp_nolf;
                    END;
                (*ENDIF*) 
            (*ENDFOR*) 
        (*ENDWITH*) 
        END;
    (*ENDIF*) 
(*ENDFOR*) 
IF  vpok
THEN
    sqlpoff ( true, errtext, vpok)
          (* B.J. 24.6.94 neu:errtext bei sqlpoff*)
ELSE
    put_errtext(i59g, errtext);
(*ENDIF*) 
END; (* print_edit_lines *)
 
(*------------------------------*) 
 
PROCEDURE
      get_printername (
            VAR printer : tsp00_PrtName);
 
VAR
      os        : tsp00_Os;
      shortname : tsp00_C6;
      i         : integer;
 
BEGIN
SAPDB_PascalForcedFill(PRTNAME_MXSP00, @printer, 1, PRTNAME_MXSP00, bsp_c1);
sqlos (os);
CASE os OF
    os_windows, os_win32, os_os2:
        shortname := 'LPT1  ';
    OTHERWISE:
        shortname := '      ';
    END;
(*ENDCASE*) 
FOR i := 1 TO 6 DO
    printer [i]  := shortname [i] ;
(*ENDFOR*) 
END; (* get_printername *)
 
(*------------------------------*) 
 
PROCEDURE
      edit_input (
            VAR i59g : vtt_global;
            VAR rf   : tin_ls_releasemode);
 
VAR
      first_pos      : tin_ls_position;
      screen_changed : boolean;
      window_changed : boolean;
 
BEGIN
WITH first_pos DO
    BEGIN
    screen_nr := 1;
    screen_part := cin_ls_workarea;
    scol := cin_first_scol;
    sline := 1;
    END;
(*ENDWITH*) 
i50autoscroll;
WITH i01g^.vt.opt DO
    usage_mode := vt_edit;
(*ENDWITH*) 
i57ioscreen(i59g.cursor,rf,screen_changed);
i50autoscroll;
IF  rf = f_enter
THEN
    BEGIN
    END;
(*ENDIF*) 
IF  screen_changed
THEN
    BEGIN
    i50getwindow(first_pos,99,99,window_changed);
    IF  window_changed
    THEN
        read_editlines ( i59g );
    (*ENDIF*) 
    END;
(*ENDIF*) 
get_mark_range ( i59g );
END; (* edit_input *)
 
(*------------------------------*) 
 
PROCEDURE
      read_editlines (
            VAR i59g : vtt_global );
 
VAR
      vt_input    : tin_ls_input_field;
      field_found : boolean;
      curline     : integer;
 
BEGIN
WITH i59g.lines DO
    curline := top;
(*ENDWITH*) 
REPEAT
    i50getfield(vt_input, field_found);
    IF  field_found
    THEN
        WITH i59g.lines, vt_input DO
            IF  changed
            THEN
                BEGIN
                s10mv(LINE_MXSP00,LINE_MXSP00,
                      @buf,1,
                      @text [ curline ] ,left,len);
                IF  len+left < LINE_MXSP00
                THEN
                    SAPDB_PascalForcedFill (LINE_MXSP00, @text [ curline ] , len+left,
                          LINE_MXSP00-len-left, bsp_c1);
                (*ENDIF*) 
                END;
            (*ENDIF*) 
        (*ENDWITH*) 
    (*ENDIF*) 
    curline := curline + 1;
UNTIL
    NOT field_found;
(*ENDREPEAT*) 
END; (* read_editlines *)
 
(*------------------------------*) 
 
PROCEDURE
      init_edit_lines (
            VAR i59g : vtt_global );
 
VAR
      i : integer;
 
BEGIN
WITH i59g.lines DO
    BEGIN
    top := 1;
    left := 1;
    FOR i := 1 TO max_edit_lines DO
        set_edit_line(i, text [i] );
    (*ENDFOR*) 
    changed := true;
    END;
(*ENDWITH*) 
END; (* init_edit_lines *)
 
(*------------------------------*) 
 
PROCEDURE
      set_edit_line (
            lno      : integer;
            VAR text : tsp00_Line);
 
CONST
      t = 'This is the ##### line of the Edit Form ';
      subst_pos = 13;
      subst_len = 5;
 
VAR
      piece   : tsp00_C40;
      ordinal : tsp00_C6;
      i       : integer;
 
BEGIN
SAPDB_PascalForcedFill (LINE_MXSP00, @text, 1, LINE_MXSP00, bsp_c1);
piece := t;
encode_ordinal(lno,ordinal);
s10mv(40,LINE_MXSP00,
      @piece,1,
      @text,1,40);
FOR i := 1 TO subst_len DO
    text [ subst_pos + i - 1  ] := ordinal [i] ;
(*ENDFOR*) 
END; (* set_edit_line *)
 
(*------------------------------*) 
 
PROCEDURE
      encode_ordinal (
            n           : integer;
            VAR ordinal : tsp00_C6);
 
VAR
      lastdig : integer;
      num     : tsp00_C20;
      i       : integer;
      postfix : tsp00_C6;
      digs    : integer;
 
BEGIN
ordinal := '      ';
lastdig := n MOD 10;
CASE lastdig OF
    1:
        postfix := 'st    ';
    2:
        postfix := 'nd    ';
    3:
        postfix := 'rd    ';
    OTHERWISE:
        postfix := 'th    ';
    END;
(*ENDCASE*) 
IF  n < 10
THEN
    digs := 1
ELSE
    digs := 2;
(*ENDIF*) 
i58encnumber(n,digs,num);
FOR i := 1 TO digs DO
    ordinal [i]  := num [i] ;
(*ENDFOR*) 
FOR i := digs + 1 TO 6 DO
    ordinal [i]  := postfix [ i-digs ] ;
(*ENDFOR*) 
END; (* encode_ordinal *)
 
(*------------------------------*) 
 
PROCEDURE
      page_scroll (
            VAR i59g : vtt_global;
            dir      : integer);
 
VAR
      slength : tin_natural;
      swidth  : tin_natural;
 
BEGIN
i51size(cin_ls_workarea,slength,swidth);
slength := slength - 1;
IF  slength = 0
THEN
    slength := 1;
(*ENDIF*) 
vscroll_edit_form( i59g, dir*slength );
END; (* page_scroll *)
 
(*------------------------------*) 
 
PROCEDURE
      vscroll_edit_form (
            VAR i59g : vtt_global;
            lines    : tsp00_Int2);
 
VAR
      newtop  : integer;
      slength : tin_natural;
      swidth  : tin_natural;
 
BEGIN
newtop := i59g.lines.top + lines;
scroll_cursor( i59g, lines );
IF  newtop > max_edit_lines - 3
THEN
    newtop := max_edit_lines - 3;
(*ENDIF*) 
IF  newtop < 1
THEN
    newtop := 1;
(*ENDIF*) 
lines := newtop - i59g.lines.top;
i59g.lines.top := newtop;
i50vscroll(1, cin_ls_workarea, lines);
IF  lines < 0
THEN
    output_edit_lines(i59g, 1, -lines)
ELSE
    BEGIN
    i51size(cin_ls_workarea,slength,swidth);
    output_edit_lines(i59g, slength - lines + 1, slength);
    END;
(*ENDIF*) 
set_edit_ranges ( i59g );
END; (* vscroll_edit_form *)
 
(*------------------------------*) 
 
PROCEDURE
      scroll_cursor (
            VAR i59g : vtt_global;
            lines    : tsp00_Int2 );
 
VAR
      length : tin_natural;
      width  : tin_natural;
 
BEGIN
WITH i59g.cursor DO
    sline := sline - lines;
(*ENDWITH*) 
IF  i59g.cursor.sline < 1
THEN
    i59g.cursor.sline := 1
ELSE
    BEGIN
    i51size(cin_ls_workarea, length, width);
    IF  i59g.cursor.sline > length
    THEN
        i59g.cursor.sline := length;
    (*ENDIF*) 
    END;
(*ENDIF*) 
END; (* scroll_cursor *)
 
(*------------------------------*) 
 
PROCEDURE
      hscroll_edit_form (
            VAR i59g : vtt_global;
            columns  : tsp00_Int2);
 
CONST
      overlap = 5;
 
VAR
      slength : tin_natural;
      swidth  : tin_natural;
      sign    : tsp00_Int2;
      old_left: tsp00_Int2;
 
BEGIN
i51size(cin_ls_workarea,slength,swidth);
IF  columns < 0
THEN
    BEGIN
    sign := -1;
    columns := -columns;
    END
ELSE
    sign := +1;
(*ENDIF*) 
IF  columns = hscroll_page
THEN
    columns := swidth - overlap;
(*ENDIF*) 
columns := sign * columns;
WITH i59g.lines DO
    BEGIN
    old_left := left;
    left := left + columns;
    IF  left + swidth - 1 > LINE_MXSP00
    THEN
        left := LINE_MXSP00 - swidth + 1;
    (*ENDIF*) 
    IF  left < 1
    THEN
        left := 1;
    (*ENDIF*) 
    columns := left - old_left;
    i59g.lines.changed := true;
    END;
(*ENDWITH*) 
WITH i59g.cursor DO
    scol := scol - columns;
(*ENDWITH*) 
i56putframe (true, true);
set_edit_ranges ( i59g );
END; (* hscroll_edit_form *)
 
(*------------------------------*) 
 
PROCEDURE
      put_screennr (
            VAR i59g  : vtt_global;
            screen_nr : tin_natural;
            limit : tsp00_Int2 );
 
CONST
      screen_text = 'Screen #            ';
      screen_pos = 8;
 
VAR
      ft  : tin_ls_fieldtype;
      str : vtt_string;
 
BEGIN
IF  i01g^.ls.nr_screens > 1
THEN
    BEGIN
    ft.field_att := cin_ls_normal;
    ft.fieldmode := [  ] ;
    str.length := 0;
    i58move (screen_text, true, str.text, str.length);
    str.text [ screen_pos  ] := numval( screen_nr );
    put_text ( i59g, str,screen_nr,ft, limit );
    END;
(*ENDIF*) 
END; (* put_screennr *)
 
(*------------------------------*) 
 
PROCEDURE
      init_ddb4_rte (
            cancelb_ptr : tsp00_BoolAddr) ;
 
VAR
      comp_name : tsp00_C64;
 
BEGIN
comp_name := bsp_c64;
comp_name  [1]  := 'V';
comp_name  [2]  := 'T';
comp_name  [3]  := 'T';
comp_name  [4]  := 'E';
comp_name  [5]  := 'S';
comp_name  [6]  := 'T';
sqlinit (comp_name, cancelb_ptr);
END; (* init_ddb4_rte *)
 
(*------------------------------*) 
 
PROCEDURE
      produce_syserror (
            tag : tsp00_Int2);
 
VAR
      i : integer;
 
BEGIN
(* tag will be 99 so that a Case Error will occur *)
CASE tag OF
    1:
        i := 100;
    2:
        i := 200;
    END;
(*ENDCASE*) 
END; (* produce_syserror *)
 
(*------------------------------*) 
 
FUNCTION
      numval (
            i : tsp00_Uint1) : char;
 
BEGIN
IF  (i < 10) AND (i >= 0)
THEN
    numval := chr( ord('0') + i )
ELSE
    numval := '*';
(*ENDIF*) 
END; (* numval *)
 
&ifndef WINDOWS
(*------------------------------*) 
 
PROCEDURE
      main_program;
 
VAR
      i59g        : vtt_global;
      dummy       : tsp00_Int4;
      cancel_bool : boolean;
 
BEGIN
cancel_bool := false;
dummy := sqlininit( NIL );
sqlinmain( i59g );
END; (* main_program *)
 
(*------------------------------*) 
 
PROCEDURE
      in59main;
 
BEGIN
main_program;
END;
 
&endif
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
