.CM  SCRIPT , Version - 1.1 , last edited by barbara
.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$VIN58$
.tt 2 $$$
.tt 3 $RaymondR$Test VT-Help Procedures$1998-06-19$
***********************************************************
.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  : VTTEST_Help_procedures
=========
.sp
Purpose : Test des Virt. Terminals
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        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;
 
.CM *-END-* define --------------------------------------
 
.sp;.cp 3
Use     :
 
        FROM
              global_variable : VIN01 ;
 
        VAR
              i01g : tin_global_in_vars;
 
      ------------------------------ 
 
        FROM
              os_filenames : VIN60 ;
 
        PROCEDURE
              i60osfilename (
                    sf     : tin_standardfiles;
                    VAR fn : tsp00_VFilename);
 
      ------------------------------ 
 
        FROM
              RTE_driver : VEN102 ;
 
        PROCEDURE
              sqlfopen (
                    VAR hostfile   : tsp00_VFilename;
                    direction      : tsp00_VFileOpCodes;
                    resource       : tsp00_VfResource;
                    VAR hostfileno : tsp00_Int4;
                    VAR format     : tsp00_VfFormat;
                    VAR rec_len    : tsp00_Int4;
                    poolptr        : tsp00_Int4;
                    buf_count      : tsp00_Int2;
                    VAR block      : tsp_vf_bufaddr;
                    VAR error      : tsp00_VfReturn;
                    VAR errtext    : tsp00_ErrText);
 
        PROCEDURE
              sqlfclose (
                    VAR hostfileno : tsp00_Int4;
                    erase          : boolean;
                    poolptr        : tsp00_Int4;
                    buf_count      : tsp00_Int2;
                    block          : tsp_vf_bufaddr;
                    VAR error      : tsp00_VfReturn;
                    VAR errtext    : tsp00_ErrText);
 
        PROCEDURE
              sqlfwrite (
                    VAR hostfileno : tsp00_Int4;
                    block          : tsp_vf_bufaddr;
                    length         : tsp00_Int4;
                    VAR error      : tsp00_VfReturn;
                    VAR errtext    : tsp00_ErrText);
 
        PROCEDURE
              sqlcharsetname (
                    VAR charsetname : tsp00_KnlIdentifier );
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG101 ;
 
        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 : tsp00_Line) : tsp_vf_bufaddr;
 
        FUNCTION
              s30klen (
                    VAR str : tsp00_C20;
                    val     : char; cnt : integer) : integer;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s30gad;
 
              tsp00_MoveObj tsp00_Line
              tsp00_Addr tsp_vf_bufaddr
 
        PROCEDURE
              s30klen;
 
              tsp00_MoveObj tsp00_C20
 
        PROCEDURE
              sqlfopen;
 
              tsp00_VFilename    tsp00_VFilename
              tsp00_VFileOpCodes tsp00_VFileOpCodes
              tsp00_VfResource   tsp00_VfResource
              tsp00_Int4         tsp00_Int4
              tsp00_VfFormat     tsp00_VfFormat
              tsp00_Int4         tsp00_Int4
              tsp00_Int4         tsp00_Int4
              tsp00_Int2         tsp00_Int2
              tsp00_VfBufaddr    tsp_vf_bufaddr
              tsp00_VfReturn     tsp00_VfReturn
              tsp00_ErrText      tsp00_ErrText
 
        PROCEDURE
              sqlfwrite;
 
              tsp00_Int4      tsp00_Int4
              tsp00_VfBufaddr tsp_vf_bufaddr
              tsp00_Int4      tsp00_Int4
              tsp00_VfReturn  tsp00_VfReturn
              tsp00_ErrText   tsp00_ErrText
 
        PROCEDURE
              sqlfclose;
 
              tsp00_Int4      tsp00_Int4
              tsp00_Int4      tsp00_Int4
              tsp00_Int2      tsp00_Int2
              tsp00_VfBufaddr tsp_vf_bufaddr
              tsp00_VfReturn  tsp00_VfReturn
              tsp00_ErrText   tsp00_ErrText
 
        PROCEDURE
              sqlcharsetname;
 
              tsp00_KnlIdentifier tsp00_KnlIdentifier
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  :
.sp
.cp 3
Created : 1991-12-05
.sp
.cp 3
.sp
.cp 3
Release :      Date : 1998-06-19
.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    :
 
 
TYPE
 
      vtt_string = RECORD
            text   : tsp00_Line;
            length : tin_natural;
      END;
 
 
 
(*------------------------------*) 
 
PROCEDURE
      i58prottermdesc;
 
VAR
      hostfilen  : tsp00_VFilename;
      errtext    : tsp00_C40 (* errortext *);
      hostfileno : tsp00_Int4 ;
      format     : tsp00_VfFormat;
      rec_len    : tsp00_Int4;
      dummy      : tsp_vf_bufaddr;
      error      : tsp00_VfReturn;
 
BEGIN
i60osfilename (testprotfile,hostfilen);
format := vf_plaintext;
rec_len := 0;
sqlfopen (hostfilen,voverwrite, vf_stack,
      hostfileno,format,rec_len,
      i01g^.vf_pool_ptr, 0, dummy,
      error,errtext);
IF  error = vf_ok
THEN
    WITH i01g^.vt.desc DO
        BEGIN
        prot_returnkeys(hostfileno,returnkeys);
        prot_attributes(hostfileno,attributes);
        prot_colors(hostfileno);
        prot_hifparms(hostfileno,has_sysline,labels);
        prot_size(hostfileno,num_of_lines, num_of_cols);
        prot_boolean(hostfileno,'graphic chars :     ', graphic_chars);
        prot_boolean(hostfileno,'mark          :     ', mark);
        prot_boolean(hostfileno,'windows       :     ', windows);
        prot_dbcs   (hostfileno,'dbcs informations : ',
              dbcs, so_char [1] , si_char [1] );
        prot_charsetname ( hostfileno );
        sqlfclose (hostfileno, false, i01g^.vf_pool_ptr,
              0, dummy, error, errtext);
        END;
    (*ENDWITH*) 
(*ENDIF*) 
END; (* i58prottermdesc *)
 
(*------------------------------*) 
 
PROCEDURE
      prot_returnkeys (
            hostfileno : tsp00_Int4 ;
            returnkeys : tsp00_VtKeys);
 
CONST
      keylen = 11;
 
VAR
      block   : tsp00_Line;
      error   : tsp00_VfReturn;
      errtext : tsp00_C40 (* errortext *);
      piece   : tsp00_C20;
      str     : vtt_string;
      k       : tsp00_VtKey;
 
BEGIN
piece := 'Keys:               ';
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,1,keylen);
str.length := keylen;
FOR k := vt_character_key TO vt_mouse_dbl DO
    IF  k IN returnkeys
    THEN
        BEGIN
        IF  str.length + keylen > 79
        THEN
            BEGIN
            sqlfwrite ( hostfileno,s30gad( str.text ), str.length, error,
                  errtext);
            piece := '                    ';
            s10mv(20,LINE_MXSP00,
                  @piece,1,
                  @str.text,1,keylen);
            str.length := keylen;
            END;
        (*ENDIF*) 
        i58encpf(k,keylen-1,str);
        str.length := str.length + 1;
        str.text [ str.length  ] := bsp_c1;
        END;
    (*ENDIF*) 
(*ENDFOR*) 
IF  str.length > keylen (* anything left *)
THEN
    sqlfwrite ( hostfileno,s30gad( str.text), str.length, error, errtext);
(*ENDIF*) 
END; (* prot_returnkeys *)
 
(*------------------------------*) 
 
PROCEDURE
      prot_attributes (
            hostfileno : tsp00_Int4;
            attributes : tsp00_VtAttrib);
 
VAR
      str     : vtt_string;
      error   : tsp00_VfReturn;
      errtext : tsp00_C40 (* errortext *);
 
BEGIN
i58buildtext(attributes,12,str);
sqlfwrite ( hostfileno,s30gad( str.text), str.length, error, errtext);
END; (* prot_attributes *)
 
(*------------------------------*) 
 
PROCEDURE
      prot_colors (
            hostfileno : tsp00_Int4);
 
CONST
      keylen = 11;
 
VAR
      c       : tsp00_VtColor;
      str     : vtt_string;
      error   : tsp00_VfReturn;
      errtext : tsp00_C40 (* errortext *);
      piece   : tsp00_C20;
 
BEGIN
piece := 'Colors:             ';
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,1,keylen);
str.length := keylen;
FOR c := vt_white TO vt_light_blue DO
    IF  c IN i01g^.vt.desc.colors
    THEN
        BEGIN
        IF  str.length + keylen > 79
        THEN
            BEGIN
            sqlfwrite ( hostfileno,s30gad( str.text) , str.length, error,
                  errtext);
            piece := '                    ';
            s10mv(20,LINE_MXSP00,
                  @piece,1,
                  @str.text,1,keylen);
            str.length := keylen;
            END;
        (*ENDIF*) 
        put_color_text(c,keylen-1,str);
        str.length := str.length + 1;
        str.text [ str.length  ] := bsp_c1;
        END;
    (*ENDIF*) 
(*ENDFOR*) 
IF  str.length > keylen (* anything left *)
THEN
    sqlfwrite ( hostfileno,s30gad( str.text), str.length, error, errtext);
(*ENDIF*) 
END; (* prot_colors *)
 
(*------------------------------*) 
 
PROCEDURE
      put_color_text (
            c       : tsp00_VtColor;
            lablen  : tin_natural;
            VAR str : vtt_string);
 
VAR
      piece : tsp00_C20;
 
BEGIN
CASE c OF
    vt_white:
        piece := 'white               ';
    vt_black:
        piece := 'black               ';
    vt_red:
        piece := 'red                 ';
    vt_green:
        piece := 'green               ';
    vt_yellow:
        piece := 'yellow              ';
    vt_blue:
        piece := 'blue                ';
    vt_pink:
        piece := 'pink                ';
    vt_light_blue:
        piece := 'light_blue          ';
    END;
(*ENDCASE*) 
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,str.length+1,lablen);
str.length := str.length + lablen;
END; (* put_color_text *)
 
(*------------------------------*) 
 
PROCEDURE
      prot_hifparms (
            hostfileno  : tsp00_Int4;
            has_sysline : boolean;
            labels      : tsp00_SkLabel);
 
CONST
      lablen = 20;
 
VAR
      piece   : tsp00_C20;
      str     : vtt_string;
      error   : tsp00_VfReturn;
      errtext : tsp00_C40 (* errortext *);
 
BEGIN
str.length := 0;
IF  has_sysline
THEN
    piece := 'has sysline         '
ELSE
    piece := 'no sysline          ';
(*ENDIF*) 
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,str.length+1,lablen);
str.length := str.length + lablen;
CASE labels OF
    no_sk_labels:
        piece := 'no sk labels        ';
    short_sk_labels:
        piece := 'short sk labels     ';
    long_sk_labels:
        piece := 'long sk labels      ';
    END;
(*ENDCASE*) 
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,str.length+1,lablen);
str.length := str.length + lablen;
sqlfwrite ( hostfileno,s30gad( str.text), str.length, error, errtext);
END; (* prot_hifparms *)
 
(*------------------------------*) 
 
PROCEDURE
      prot_boolean (
            hostfileno : tsp00_Int4;
            lbl        : tsp00_C20;
            b          : boolean);
 
CONST
      lablen = 20;
 
VAR
      piece   : tsp00_C20;
      str     : vtt_string;
      error   : tsp00_VfReturn;
      errtext : tsp00_C40 (* errortext *);
 
BEGIN
str.length := 0;
s10mv(20,LINE_MXSP00,
      @lbl,1,
      @str.text,str.length+1,lablen);
str.length := str.length + lablen;
IF  b
THEN
    piece := 'TRUE                '
ELSE
    piece := 'FALSE               ';
(*ENDIF*) 
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,str.length+1,lablen);
str.length := str.length + lablen;
sqlfwrite ( hostfileno,s30gad( str.text), str.length, error, errtext);
END; (* prot_boolean *)
 
(*------------------------------*) 
 
PROCEDURE
      prot_dbcs (
            hostfileno : tsp00_Int4;
            lbl        : tsp00_C20;
            dbcs       : tsp00_Dbcs;
            so_char    : char;
            si_char    : char);
 
CONST
      lablen = 20;
 
VAR
      str     : vtt_string;
      error   : tsp00_VfReturn;
      errtext : tsp00_C40 (* errortext *);
 
BEGIN
str.length := 0;
s10mv(20,LINE_MXSP00,
      @lbl,1,
      @str.text,str.length+1,lablen);
str.length := str.length + lablen;
encode_dbcs(dbcs,str);
encode_number(ord(so_char), 5, str);
encode_number(ord(si_char), 5, str);
sqlfwrite ( hostfileno,s30gad( str.text), str.length, error, errtext);
END; (* prot_dbcs *)
 
(*------------------------------*) 
 
PROCEDURE
      prot_size (
            hostfileno                : tsp00_Int4;
            num_of_lines, num_of_cols : tsp00_Int2);
 
VAR
      num     : vtt_string;
      error   : tsp00_VfReturn;
      errtext : tsp00_C40 (* errortext *);
 
BEGIN
num.length := 0;
encode_number(num_of_lines,3,num);
encode_number(num_of_cols,3,num);
sqlfwrite ( hostfileno,s30gad( num.text), num.length, error, errtext);
END; (* prot_size *)
 
(*------------------------------*) 
 
PROCEDURE
      i58encpf (
            key     : tsp00_VtKey;
            lablen  : integer;
            VAR str : vtt_string);
 
VAR
      piece : tsp00_C20;
 
BEGIN
CASE key OF
    vt_character_key:
        piece := 'character_key       ';
    vt_enter:
        piece := 'enter               ';
    vt_pf01:
        piece := 'pf01                ';
    vt_pf02:
        piece := 'pf02                ';
    vt_pf03:
        piece := 'pf03                ';
    vt_pf04:
        piece := 'pf04                ';
    vt_pf05:
        piece := 'pf05                ';
    vt_pf06:
        piece := 'pf06                ';
    vt_pf07:
        piece := 'pf07                ';
    vt_pf08:
        piece := 'pf08                ';
    vt_pf09:
        piece := 'pf09                ';
    vt_pf10:
        piece := 'pf10                ';
    vt_pf11:
        piece := 'pf11                ';
    vt_pf12:
        piece := 'pf12                ';
    vt_clear:
        piece := 'clear               ';
    vt_unknown:
        piece := 'unknown             ';
    vt_do_key:
        piece := 'do_key              ';
    vt_sk01:
        piece := 'sk01                ';
    vt_sk02:
        piece := 'sk02                ';
    vt_sk03:
        piece := 'sk03                ';
    vt_sk04:
        piece := 'sk04                ';
    vt_sk05:
        piece := 'sk05                ';
    vt_sk06:
        piece := 'sk06                ';
    vt_sk07:
        piece := 'sk07                ';
    vt_sk08:
        piece := 'sk08                ';
    vt_sk09:
        piece := 'sk09                ';
    vt_help_key:
        piece := 'help_key            ';
    vt_up_key:
        piece := 'up_key              ';
    vt_down_key:
        piece := 'down_key            ';
    vt_left_key:
        piece := 'left_key            ';
    vt_right_key:
        piece := 'right_key           ';
    vt_cmd_key:
        piece := 'cmd_key             ';
    vt_pick_key:
        piece := 'pick_key            ';
    vt_put_key:
        piece := 'put_key             ';
    vt_mark_key:
        piece := 'mark_key            ';
    vt_select_key:
        piece := 'select_key          ';
    vt_move_key:
        piece := 'move_key            ';
    vt_copy_key:
        piece := 'copy_key            ';
    vt_insert_key:
        piece := 'insert_key          ';
    vt_delete_key:
        piece := 'delete_key          ';
    vt_top_key:
        piece := 'top_key             ';
    vt_bottom_key:
        piece := 'bottom_key          ';
    vt_cancel_key:
        piece := 'cancel_key          ';
    vt_undo_key:
        piece := 'undo_key            ';
    vt_end_key:
        piece := 'end_key             ';
    vt_escape_key:
        piece := 'escape_key          ';
    vt_hscroll:
        piece := 'hscoll              ';
    vt_vscroll:
        piece := 'vscoll              ';
    vt_file_open:
        piece := 'file-open           ';
    vt_file_save:
        piece := 'file-save           ';
    vt_exit:
        piece := 'exit                ';
    vt_print:
        piece := 'print               ';
    vt_find:
        piece := 'find                ';
    vt_replace:
        piece := 'replace             ';
    vt_cursor_up:
        piece := 'cursor_up           ';
    vt_cursor_down:
        piece := 'cursor_down         ';
    vt_cursor_right:
        piece := 'cursor_right        ';
    vt_cursor_left:
        piece := 'cursor_left         ';
    vt_cursor_home:
        piece := 'cursor_home         ';
    vt_cursor_end:
        piece := 'cursor_end          ';
    vt_next_field:
        piece := 'next_field          ';
    vt_prev_field:
        piece := 'prev_field          ';
    vt_insert_char:
        piece := 'insert_char         ';
    vt_delete_char:
        piece := 'delete_char         ';
    vt_rubout:
        piece := 'rubout              ';
    vt_del_eof:
        piece := 'del_eof             ';
    vt_mouse_down:
        piece := 'mouse_down          ';
    vt_mouse_up:
        piece := 'mouse_up            ';
    vt_mouse_move:
        piece := 'mouse_move          ';
    vt_mouse_dbl:
        piece := 'mouse_dbl           ';
    OTHERWISE:
        i58encnumber(ord(key), lablen, piece);
    END;
(*ENDCASE*) 
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,str.length+1,lablen);
str.length := str.length + lablen;
END; (* i58encpf *)
 
(*------------------------------*) 
 
PROCEDURE
      i58encmouse_pos (
            mouse_pos   : tsp00_VtKeyStroke;
            VAR pos_str : vtt_string);
 
CONST
      digits  = 3;
 
VAR
      tmp_str     : tsp00_C11;
      str_col     : vtt_string;
      str_line    : vtt_string;
      i           : integer;
      pos         : integer;
 
BEGIN
str_col.length  := 0;
str_line.length := 0;
tmp_str         := '           ';
pos             := 0;
encode_number(mouse_pos.mouse_x, digits, str_col);
encode_number(mouse_pos.mouse_y, digits, str_line);
tmp_str[pos + 1] := 'x';
tmp_str[pos + 2] := ':';
pos := pos + 2;
FOR i := 1 TO str_col.length DO
    tmp_str[pos + i] := str_col.text [i] ;
(*ENDFOR*) 
pos := pos + i;
tmp_str[pos + 1] := ' ';
tmp_str[pos + 2] := 'y';
tmp_str[pos + 3] := ':';
pos := pos + 3;
FOR i := 1 TO str_line.length DO
    tmp_str[pos + i] := str_line.text [i] ;
(*ENDFOR*) 
s10mv(11,LINE_MXSP00,
      @tmp_str,1,
      @pos_str.text,1,11);
pos_str.length := 11;
END; (* i58encmouse_pos *)
 
(*------------------------------*) 
 
PROCEDURE
      i58buildtext (
            field_att : tsp00_VtAttrib;
            lablen    : tin_natural;
            VAR str   : vtt_string);
 
VAR
      m : tsp00_VtMode;
 
BEGIN
WITH str DO
    BEGIN
    length := 0;
    FOR m := vt_bright TO vt_grayed DO
        IF  m <> vt_mixed
        THEN
            IF  m IN field_att
            THEN
                build_label(m,lablen,str);
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDFOR*) 
    IF  str.length = 0
    THEN
        i58defaultlabel(str);
    (*ENDIF*) 
    END;
(*ENDWITH*) 
END; (* i58buildtext *)
 
(*------------------------------*) 
 
PROCEDURE
      encode_dbcs (
            dbcs    : tsp00_Dbcs;
            VAR str : vtt_string);
 
BEGIN
CASE dbcs OF
    no_dbcs:
        i58move('no_dbcs             ', false, str.text, str.length);
    dbcs_with_shifts:
        i58move('dbcs_with_shifts    ', false, str.text, str.length);
    dbcs_no_shifts:
        i58move('dbcs_no_shifts      ', false, str.text, str.length);
    OTHERWISE:
        i58move('*** dbcs undef ***  ', false, str.text, str.length);
    END;
(*ENDCASE*) 
END; (* encode_dbcs *)
 
(*------------------------------*) 
 
PROCEDURE
      encode_number (
            n       : integer;
            digits  : integer;
            VAR str : vtt_string);
 
VAR
      i        : integer;
      dig      : integer;
      negative : boolean;
      first    : boolean;
 
BEGIN
negative := (n < 0);
IF  negative
THEN
    BEGIN
    n := -n;
    digits := digits + 1;
    END;
(*ENDIF*) 
first := true;
FOR i := digits DOWNTO 1 DO
    BEGIN
    dig := n MOD 10;
    IF  (n > 0)
    THEN
        str.text [str.length+i ] := chr( dig + ord('0'))
    ELSE
        IF  first
        THEN
            str.text [str.length+i ] := '0'
        ELSE
            str.text [str.length+i ] := bsp_c1;
        (*ENDIF*) 
    (*ENDIF*) 
    first := false;
    n := n DIV 10;
    END;
(*ENDFOR*) 
IF  negative
THEN
    WITH str DO
        BEGIN
        text [length+1 ] := '-';
        END;
    (*ENDWITH*) 
(*ENDIF*) 
str.length := str.length + digits
END; (* encode_number *)
 
(*------------------------------*) 
 
PROCEDURE
      i58encnumber (
            n       : integer;
            digits  : integer;
            VAR s20 : tsp00_C20);
 
VAR
      str : vtt_string;
      i   : integer;
 
BEGIN
str.length := 0;
s20 := bsp_c20;
encode_number(n, digits, str);
WITH str DO
    FOR i := 1 TO length DO
        s20 [i]  := text [i] ;
    (*ENDFOR*) 
(*ENDWITH*) 
END; (* i58encnumber *)
 
(*------------------------------*) 
 
PROCEDURE
      build_label (
            m       : tsp00_VtMode;
            lablen  : tin_natural;
            VAR str : vtt_string);
 
VAR
      piece : tsp00_C20;
 
BEGIN
CASE m OF
    vt_bright:
        piece := 'bright              ';
    vt_inverse:
        piece := 'inverse             ';
    vt_underline:
        piece := 'underline           ';
    vt_blink:
        piece := 'blink               ';
    vt_invisible:
        piece := 'invisible           ';
    vt_mixed:
        piece := 'mixed               ';
    vt_grayed:
        piece := 'grayed              ';
    END;
(*ENDCASE*) 
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,str.length+1,lablen);
str.length := str.length + lablen;
END; (* build_label *)
 
(*------------------------------*) 
 
PROCEDURE
      i58defaultlabel (
            VAR str : vtt_string);
 
VAR
      piece : tsp00_C20;
 
BEGIN
piece := 'normal              ';
s10mv(20,LINE_MXSP00,
      @piece,1,
      @str.text,str.length+1,10);
str.length := str.length + 10;
END; (* i58defaultlabel *)
 
(*------------------------------*) 
 
PROCEDURE
      i58move (
            piece      : tsp00_C20;
            strip      : boolean;
            VAR field  : tsp00_Line;
            VAR length : tin_natural);
 
VAR
      piece_len : tin_natural;
 
BEGIN
IF  strip
THEN
    piece_len := s30klen (piece, bsp_c1, mxsp_c20) + 1
ELSE
    piece_len := mxsp_c20;
(*ENDIF*) 
s10mv(mxsp_c20,LINE_MXSP00,
      @piece,1,
      @field,length+1,piece_len);
length := length + piece_len;
END; (* i58move *)
 
(*------------------------------*) 
 
PROCEDURE
      prot_charsetname (
            hostfileno : tsp00_Int4 );
 
CONST
      lbl = 'charsetname =       ';
      lbl_len = 14;
 
VAR
      charsetname : tsp00_KnlIdentifier;
      error       : tsp00_VfReturn;
      errtext     : tsp00_C40 (* errortext *);
      out         : tsp00_Line;
      i           : integer;
      length      : integer;
      piece       : tsp00_C20;
 
BEGIN
sqlcharsetname ( charsetname );
piece := lbl;
FOR i := 1 TO lbl_len DO
    out[i] := piece[i];
(*ENDFOR*) 
FOR i := 1 TO mxsp_c64 DO
    out[lbl_len + i] := charsetname[i];
(*ENDFOR*) 
length := lbl_len + mxsp_c64;
sqlfwrite ( hostfileno,s30gad( out ), length, error,
      errtext);
END; (* prot_charsetname *)
 
(*------------------------------*) 
 
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;
 
VAR
      cmd         : tin_screenline;
      i           : integer;
      pos         : integer;
      token       : tsp00_C6;
      size_screen : tsp00_Int2;
 
BEGIN
i58splitcommand := false;
nr_min := 0;
nr_max := 0;
lines1 := 0;
lines2 := 0;
upstring ( buf, cmd, len );
FOR i := len+1 TO mxin_screenline DO
    cmd[i] := bsp_c1;
(*ENDFOR*) 
pos := 1;
IF  get_token ( cmd, pos, token )
THEN
    BEGIN
    IF  token = 'SPLIT '
    THEN
        i58splitcommand := true;
    (*ENDIF*) 
    WHILE get_token ( cmd, pos, token ) DO
        BEGIN
        IF  token = 'MIN   '
        THEN
            nr_min := inttoken( cmd, pos )
        ELSE
            IF  token = 'MAX   '
            THEN
                nr_max := inttoken( cmd, pos )
            ELSE
                IF  token = 'SIZE  '
                THEN
                    BEGIN
                    size_screen := inttoken( cmd, pos ) ;
                    CASE size_screen OF
                        1:
                            lines1 := inttoken( cmd, pos ) ;
                        2:
                            lines2 := inttoken( cmd, pos ) ;
                        OTHERWISE
                            BEGIN
                            lines1 := 0;
                            lines2 := 0;
                            END;
                        END;
                    (*ENDCASE*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
END; (* i58splitcommand *)
 
(*------------------------------*) 
 
PROCEDURE
      upstring (
            VAR buf1 : tin_screenline;
            VAR buf2 : tin_screenline;
            len      : integer );
 
VAR
      i : integer;
 
BEGIN
FOR i := 1 TO len DO
    IF  buf1[i] IN ['a' .. 'z']
    THEN
        buf2[i] := chr( ord(buf1[i]) - ord('a') + ord('A') )
    ELSE
        buf2[i] := buf1[i];
    (*ENDIF*) 
(*ENDFOR*) 
END; (* upstring *)
 
(*------------------------------*) 
 
FUNCTION
      get_token (
            VAR cmd   : tin_screenline;
            VAR pos   : integer;
            VAR token : tsp00_C6) : boolean;
 
VAR
      loc_pos : tsp00_Int2;
      len     : integer;
 
BEGIN
loc_pos := pos;
loc_pos := next_token( cmd, loc_pos );
IF  loc_pos = 0
THEN
    get_token := false
ELSE
    BEGIN
    get_token := true;
    token := bsp_c6;
    pos := end_token( cmd, loc_pos );
    len := pos - loc_pos;
    IF  len > mxsp_c6
    THEN
        len := mxsp_c6;
    (*ENDIF*) 
    s10mv (mxin_screenline,mxsp_c6,
          @cmd,loc_pos,
          @token,1,len );
    END;
(*ENDIF*) 
END; (* get_token *)
 
(*------------------------------*) 
 
FUNCTION
      next_token(
            VAR cmd : tin_screenline;
            pos     : integer) : tsp00_Int2;
 
VAR
      stop : boolean;
 
BEGIN
REPEAT
    stop := cmd[pos] <> bsp_c1;
    IF  NOT stop
    THEN
        stop := pos = mxin_screenline;
    (*ENDIF*) 
    IF  NOT stop
    THEN
        pos := pos + 1;
    (*ENDIF*) 
UNTIL
    stop;
(*ENDREPEAT*) 
IF  cmd[pos] = bsp_c1
THEN
    next_token := 0
ELSE
    next_token := pos;
(*ENDIF*) 
END; (* next_token *)
 
(*------------------------------*) 
 
FUNCTION
      end_token (
            VAR cmd : tin_screenline;
            pos     : integer) : tsp00_Int2;
 
VAR
      stop : boolean;
 
BEGIN
REPEAT
    stop := cmd[pos] = bsp_c1;
    IF  NOT stop
    THEN
        BEGIN
        stop := pos = mxin_screenline;
        pos := pos + 1;
        END;
    (*ENDIF*) 
UNTIL
    stop;
(*ENDREPEAT*) 
end_token := pos;
END; (* end_token *)
 
(*------------------------------*) 
 
FUNCTION
      inttoken(
            VAR cmd : tin_screenline;
            VAR tpos : integer) : tsp00_Int2;
 
VAR
      token : tsp00_C6;
      npos   : tsp00_Int2;
      num   : tsp00_Int4;
      ok    : boolean;
      stop  : boolean;
 
BEGIN
inttoken := 0;
IF  get_token ( cmd, tpos, token )
THEN
    BEGIN
    npos := 1;
    num := 0;
    ok := false;
    REPEAT
        stop := token[ npos ] = bsp_c1;
        IF  NOT stop
        THEN
            BEGIN
            ok := (token[ npos ] >= '0') AND ( token[ npos ] <= '9');
            IF  ok
            THEN
                BEGIN
                num := num * 10 + ord( token[ npos ] ) - ord( '0' );
                ok := num <= csp_maxint2;
                END;
            (*ENDIF*) 
            IF  ok
            THEN
                npos := npos + 1;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    UNTIL
        stop OR (NOT ok);
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
IF  ok
THEN
    inttoken := num
ELSE
    inttoken := 0;
(*ENDIF*) 
END; (* inttoken *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
.PA 
