.CM  SCRIPT , Version - 1.1 , last edited by D.Dittmar
.CM Anfang
.ad 8
.bm 8
.fm 4
.bt $Copyright by   SAP AG, 1995$$Page %$
.tm 12
.hm 6
.hs 3
.TT 1 $SQL$Project Distributed Database System$VMT95$
.tt 2 $$$
.TT 3 $$ls_screen_io$1995-11-01$
***********************************************************
.nf


    ========== licence begin LGPL
    Copyright (C) 2000 SAP AG

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

    This library 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
    Lesser General Public License for more details.

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

.fo
.nf
.sp
MODULE  : logical_screen_procedures
=========
.sp
Purpose : Ein/Ausgabe ?uber das virtuelle Terminal
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        PROCEDURE
              m95clear (background : tsp_vt_color;
                    maxchars      : integer;
                    VAR vt_screen : tsp_screenbuf;
                    VAR vt_att    : tsp_screenbuf);
 
        PROCEDURE
              m95putfield(VAR field : tsp_moveobj;
                    length        : integer;
                    field_slno    : integer;
                    field_scol    : integer;
                    field_type    : tin_ls_fieldtype;
                    maxlines      : integer;
                    maxcols       : integer;
                    VAR vt_screen : tsp_screenbuf;
                    VAR vt_att    : tsp_screenbuf);
 
        PROCEDURE
              m95getfield (row : integer;
                    col           : integer;
                    VAR length    : integer;
                    VAR input     : tin_screenline;
                    maxcols       : integer;
                    VAR vt_screen : tsp_screenbuf);
 
        PROCEDURE
              m95nextfield (VAR row : integer;
                    VAR col           : integer;
                    VAR length        : integer;
                    VAR found         : boolean;
                    VAR field_changed : boolean;
                    maxlines          : integer;
                    maxcols           : integer;
                    VAR vt_screen     : tsp_screenbuf;
                    VAR vt_att        : tsp_screenbuf);
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              RTE-Extension-10 : VSP10;
 
        PROCEDURE
              s10mv1 (size1 : tsp_int4; size2 : tsp_int4;
                    VAR val1 : tsp_moveobj; p1 : tsp_int4;
                    VAR val2 : tsp_screenbuf; p2  :tsp_int4;
                    anz: tsp_int4);
 
        PROCEDURE
              s10mv2 (size1 : tsp_int4; size2 : tsp_int4;
                    VAR val1 : tsp_screenbuf; p1 : tsp_int4;
                    VAR val2 : tin_screenline; p2  :tsp_int4;
                    anz: tsp_int4);
 
        PROCEDURE
              s10fil (size : tsp_int4;
                    VAR m : tsp_screenbuf;
                    pos : tsp_int4;
                    len : tsp_int4;
                    fillchar : char);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-30 : VSP30;
 
        FUNCTION
              s30lenl ( VAR str : tsp_screenbuf;
                    val : char;
                    start : tsp_int4;
                    cnt : tsp_int4) : tsp_int4;
 
        FUNCTION
              s30klen (VAR str : tin_screenline;
                    val : char; cnt : integer) : integer;
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              s10mv1;
 
              tsp_moveobj tsp_screenbuf
 
        PROCEDURE
              s10mv2;
 
              tsp_moveobj tsp_screenbuf
              tsp_moveobj tin_screenline
 
        PROCEDURE
              s10fil;
 
              tsp_moveobj tsp_screenbuf
 
        FUNCTION
              s30lenl;
 
              tsp_moveobj tsp_screenbuf;
 
        FUNCTION
              s30klen;
 
              tsp_moveobj tin_screenline
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : 
.sp
.cp 3
Created : 1984-07-30
.sp
.cp 3
Version : 1995-11-01
.sp
.cp 3
Release :  6.1.2     Date : 1995-11-01
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
 
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.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
      byte = 0..255;
      bit  = 0..1;
 
      int_to_attribute = PACKED RECORD
            CASE boolean OF
                true:
                    (b : byte);
                false:
                    (a : tsp_vt_attrib);
                END;
            (*ENDCASE*) 
 
 
 
(*------------------------------*) 
 
PROCEDURE
      m95clear (background : tsp_vt_color;
            maxchars      : integer;
            VAR vt_screen : tsp_screenbuf;
            VAR vt_att    : tsp_screenbuf);
 
VAR
      i : integer;
      c : char;
 
BEGIN
s10fil (mxsp_screen_chars, vt_screen, 1, maxchars, bsp_c1);
vt_screen  [1]  := chr (csp_vt_eof);
(* background att *)
s10fil (mxsp_screen_chars, vt_att, 1, maxchars, chr(csp_vt_eof));
(* background color *)
END; (* m95clear *)
 
(*------------------------------*) 
 
PROCEDURE
      m95putfield(VAR field : tsp_moveobj;
            length        : integer;
            field_slno    : integer;
            field_scol    : integer;
            field_type    : tin_ls_fieldtype;
            maxlines      : integer;
            maxcols       : integer;
            VAR vt_screen : tsp_screenbuf;
            VAR vt_att    : tsp_screenbuf);
 
VAR
      att      : char;
      color    : char;
      old_mark : char;
      pos      : integer;
      fpos     : integer;
      i        : integer;
 
BEGIN
pos := (field_slno - 1) * maxcols + field_scol;
fpos := 1;
IF  pos = 1
THEN
    BEGIN
    fpos := 2;
    pos := pos + 1;
    length := length - 1;
    END
ELSE
    IF  pos + length > maxlines * maxcols
    THEN
        length := maxlines * maxcols - pos;
    (*ENDIF*) 
(*ENDIF*) 
m95_get_actual_fieldmark (vt_screen, vt_att, pos, length, old_mark);
IF  ls_continued IN field_type.fieldmode
THEN
    vt_screen [ pos - 1 ] := chr (csp_vt_socf)
ELSE
    vt_screen [ pos - 1 ] := chr (csp_vt_soncf);
(*ENDIF*) 
(* color bytes *)
(* text *)
s10mv1(mxsp_moveobj, mxsp_screen_chars,
      field, fpos, vt_screen, pos, length);
(* attribute bytes *)
m95_fieldtype_to_char (field_type, att);
s10fil (mxsp_screen_chars, vt_att, pos, length, att);
pos := pos + length; (* behind field *)
IF  (ord(vt_screen [pos] ) <> csp_vt_soncf)
    AND (ord(vt_screen [pos] ) <> csp_vt_socf)
THEN
    vt_screen [pos ] := old_mark; (* SOF or EOF *)
(*ENDIF*) 
END; (* m95putfield *)
 
(*------------------------------*) 
 
PROCEDURE
      m95getfield (row : integer;
            col           : integer;
            VAR length    : integer;
            VAR input     : tin_screenline;
            maxcols       : integer;
            VAR vt_screen : tsp_screenbuf);
 
VAR
      pos : integer;
 
BEGIN
pos := (row - 1) * maxcols + col;
s10mv2 (mxsp_screen_chars, mxin_screenline,
      vt_screen, pos, input, 1, length);
length := s30klen (input, bsp_c1, length);
END; (* m95getfield *)
 
(*------------------------------*) 
 
PROCEDURE
      m95nextfield (VAR row : integer;
            VAR col           : integer;
            VAR length        : integer;
            VAR found         : boolean;
            VAR field_changed : boolean;
            maxlines          : integer;
            maxcols           : integer;
            VAR vt_screen     : tsp_screenbuf;
            VAR vt_att        : tsp_screenbuf);
 
VAR
      pos       : integer;
      first_pos : integer;
      maxlength : integer;
      ft        : tin_ls_fieldtype;
      maxchars  : integer;
      stop      : boolean;
 
BEGIN
REPEAT
    skip_field (row, col, found, maxlines, maxcols, vt_screen);
    stop := NOT found;
    IF  NOT stop
    THEN
        BEGIN
        pos := (row - 1) * maxcols + col;
        char_to_ft_95 (vt_att [pos] , ft);
        IF  ls_mixed IN ft.fieldmode
        THEN
            found := m95_has_inputchar (vt_screen, vt_att, pos)
        ELSE
            found := ls_input IN ft.fieldmode;
        (*ENDIF*) 
        END;
    (*ENDIF*) 
UNTIL
    found OR stop;
(*ENDREPEAT*) 
IF  found
THEN
    BEGIN
    row := ((pos - 1) DIV maxcols) + 1;
    col := ((pos - 1) MOD maxcols) + 1;
    length := m95length (row, col, maxlines, maxcols, vt_screen);
    field_changed := m95_inputfield_changed (vt_att, pos, length);
    END;
(*ENDIF*) 
END; (* m95nextfield *)
 
(*------------------------------*) 
 
PROCEDURE
      skip_field (VAR row : integer;
            VAR col   : integer;
            VAR found : boolean;
            maxlines  : integer;
            maxcols   : integer;
            VAR vt_screen : tsp_screenbuf);
 
VAR
      pos       : integer;
      rel_pos   : integer;
      rel_pos2  : integer;
      maxlength : integer;
 
BEGIN
pos := (row - 1) * maxcols + col (* + 1 *); (* next pos *)
IF  pos <= 0
THEN
    pos := 1;
(*ENDIF*) 
maxlength := maxcols * maxlines - pos + 1;
rel_pos := s30lenl (vt_screen, chr(csp_vt_soncf), pos, maxlength);
rel_pos2 := s30lenl (vt_screen, chr(csp_vt_socf), pos, maxlength);
IF  rel_pos2 < rel_pos
THEN
    rel_pos := rel_pos2;
(*ENDIF*) 
found := (rel_pos < maxlength);
IF  found
THEN
    pos := pos + rel_pos + 1; (* skip stf *)
(*ENDIF*) 
IF  found
THEN
    BEGIN
    row := ((pos - 1) DIV maxcols) + 1;
    col := ((pos - 1) MOD maxcols) + 1;
    END;
(*ENDIF*) 
END; (* skip_field *)
 
(*------------------------------*) 
 
FUNCTION
      m95length (row, col : integer;
            maxlines : integer;
            maxcols : integer;
            VAR vt_screen : tsp_screenbuf) : integer;
 
VAR
      maxchars : integer;
      length,  pos : integer;
      stop : boolean;
 
BEGIN
length := 0;
maxchars := maxcols * maxlines(*- 1*);
pos := (row - 1) * maxcols + col;
REPEAT
    stop := (pos >= maxchars);
    IF  NOT stop
    THEN
        stop := ord( vt_screen [pos ] ) <= csp_vt_socf;
    (*ENDIF*) 
    IF  NOT stop
    THEN
        BEGIN
        length := length + 1;
        pos := pos + 1;
        END;
    (*ENDIF*) 
UNTIL
    stop;
(*ENDREPEAT*) 
m95length := length;
END; (* m95length *)
 
(*------------------------------*) 
 
FUNCTION
      m95_has_inputchar( VAR vt_screen : tsp_screenbuf;
            VAR vt_att : tsp_screenbuf;
            pos : integer) : boolean;
 
CONST
      stf = 1;
 
VAR
      i : integer;
      ft : tin_ls_fieldtype;
 
BEGIN
i := pos - 1;
REPEAT
    i := i + 1;
    IF  ord(vt_screen [i] ) > stf
    THEN
        char_to_ft_95 (vt_att [ i ] , ft);
    (*ENDIF*) 
UNTIL
    (ord(vt_screen [i] ) <= stf)
    OR (ls_input IN ft.fieldmode);
(*ENDREPEAT*) 
m95_has_inputchar := (ord(vt_screen [i] ) > stf)
END; (* m95_has_inputchar *)
 
(*------------------------------*) 
 
PROCEDURE
      m95_fieldtype_to_char(ft : tin_ls_fieldtype;
            VAR att : char);
 
VAR
      n : byte;
      a : tin_ls_fmode;
 
BEGIN
WITH ft DO
    BEGIN
    n := 0;
    FOR a := ls_input TO ls_mixed DO
        IF  ls_input IN fieldmode
        THEN
            BEGIN
            n := 2 * n; (* shift left *)
            IF  a IN fieldmode
            THEN
                n := n + 1;
            (*ENDIF*) 
            END;
        (*ENDIF*) 
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
n := 2 * n; (* change bit is 0 *)
n := n * 16; (* shift 4 bits left *)
n := n + ft.field_att;
att := chr(n);
END; (* m95_fieldtype_to_char *)
 
(*------------------------------*) 
 
PROCEDURE
      char_to_ft_95(att : char;
            VAR ft : tin_ls_fieldtype);
 
VAR
      m : integer;
      a : tin_ls_fmode;
 
BEGIN
m := ord(att);
WITH ft DO
    BEGIN
    field_att := m MOD 16; (* lower half is attribute index *)
    fieldmode := [  ] ;
    m := m DIV 16; (* upper half *)
    m := m DIV 2; (* skip changed bit *)
    FOR a := ls_mixed DOWNTO ls_input DO
        BEGIN
        IF  (m MOD 2) = 1
        THEN
            fieldmode := fieldmode + [  a ] ;
        (*ENDIF*) 
        m := m DIV 2
        END;
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END; (* char_to_ft_52 *)
 
(*------------------------------*) 
 
PROCEDURE
      m95_get_actual_fieldmark( VAR screen : tsp_screenbuf;
            VAR attributes : tsp_screenbuf;
            pos : integer;
            length : integer;
            VAR mark : char);
 
VAR
      found : boolean;
      i : integer;
 
BEGIN
i := pos;
REPEAT
    found := ord(screen [i] ) <= csp_vt_socf;
    IF  NOT found
    THEN
        i := i - 1;
    (*ENDIF*) 
UNTIL
    found OR (i = 0);
(*ENDREPEAT*) 
IF  found
THEN
    BEGIN
    mark := screen [ i ] ;
    IF  ord(mark) = csp_vt_socf
    THEN
        mark := chr(csp_vt_soncf);
    (*ENDIF*) 
    END
ELSE
    BEGIN
    i := 1;
    mark := chr(csp_vt_eof);
    END;
(*ENDIF*) 
FOR i := 1 TO length+1 DO
    IF  ord(screen [pos+i-1] ) <= csp_vt_socf
    THEN
        mark := screen [pos+i-1] ;
    (*ENDIF*) 
(*ENDFOR*) 
END; (* m95_get_actual_fieldmark *)
 
(*------------------------------*) 
 
FUNCTION
      m95_inputfield_changed( VAR vt_att : tsp_screenbuf;
            first_pos : integer;
            length : integer ) : boolean;
 
VAR
      flag : bit;
      changed : boolean;
      att : integer;
      i : integer;
 
BEGIN
changed := false;
i := first_pos;
WHILE (NOT changed) AND  (i < first_pos + length) DO
    BEGIN
    att := ord( vt_att [i]  );
    (* get lowest bit of upper half *)
    att := att DIV 16;
    flag := att MOD 2;
    changed := changed OR (flag <> 0);
    i := i + 1;
    END;
(*ENDWHILE*) 
m95_inputfield_changed := changed;
END; (* m95_inputfield_changed *)
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        113
*-PRETTY-*  lines of code :        412        PRETTY  3.09 
*-PRETTY-*  lines in file :        602         1992-11-23 
.PA 
