.ad 8
.bm 8
.fm 4
.bt $Copyright (c) 1994-2005 SAP AG$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VEN04$
.tt 2 $$$
.tt 3 $$                                       $1998-08-11$
***********************************************************
.nf

.nf

.nf

    ========== licence begin  GPL
    Copyright (c) 1994-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  :       virtual_terminal_mapper
=========
.sp
Purpose :       Wrapper from Pascal to C (virtual terminal)
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :

&ifdef  REL30
        PROCEDURE
	    sqlton    (     multi_task      : boolean ;
			VAR term_ref        : tsp00_Int4 ;
			VAR desc            : tsp00_TerminalDescription ;
			VAR ok              : boolean ) ;

        PROCEDURE
	    sqltoff   (     term_ref        : tsp00_Int4 ;
			VAR screen_buf      : tsp00_ScreenBufAddr ;
			VAR attribute_buf   : tsp00_ScreenBufAddr ;
			VAR msg             : tsp00_C80 );

        PROCEDURE
	    sqltio    (     term_ref        : tsp00_Int4 ;
			VAR screen_buf      : tsp00_ScreenBufAddr ;
			VAR attribute_buf   : tsp00_ScreenBufAddr ;
			    refresh         : boolean ;
			VAR cursorline      : tsp00_Int2 ;
			VAR cursorcolumn    : tsp00_Int2 ;
			VAR hif             : tsp00_HifParms ;
			VAR options         : tsp00_VtOptions ;
			VAR result          : tsp00_VtResult ;
			VAR ok              : boolean ) ;

	PROCEDURE
	    sqlttable (     i               : tsp00_Int2 ;
			    att             : tsp00_VtAttrib ;
			    foreground      : tsp00_VtColor ;
			    background      : tsp00_VtColor ) ;

	PROCEDURE
	    sqltgtable (    i               : tsp00_Int2 ;
			VAR att             : tsp00_VtAttrib ;
			VAR foreground      : tsp00_VtColor ;
			VAR background      : tsp00_VtColor ) ;

        PROCEDURE
	    sqlwindow (     parent_ref      : tsp00_Int4 ;
			VAR position        : tsp00_VtRectangle ;
			VAR desc            : tsp00_TerminalDescription;
			VAR ok              : boolean ) ;

        PROCEDURE
	    sqlwsplit (     term_ref        : tsp00_Int4 ;
			    nr_screens      : tsp00_Int2 ;
			VAR desc            : tsp00_TerminalDescription;
			VAR offset          : tsp00_Int2 ;
			VAR ok              : boolean ) ;

	PROCEDURE
	    sqlwoff   (     term_ref        : tsp00_Int4 ;
			VAR screen_buf      : tsp00_ScreenBufAddr ;
			VAR attribute_buf   : tsp00_ScreenBufAddr ;
			VAR color_buf       : tsp00_ScreenBufAddr ) ;

	PROCEDURE
	    sqlwdgswitch (  box_id          : tsp00_Int2 ;
			    trigger         : tsp00_VtKeys ;
			    retrn           : tsp00_VtKey ;
			VAR ok              : boolean ) ;

	PROCEDURE
	    sqlwdgclear (   box_id          : tsp00_Int2 ) ;

	PROCEDURE
	    sqlwdgset (     box_id          : tsp00_Int2 ;
			    item_id         : tsp00_Int2 ;
			VAR text            : tsp00_Line ;
			    text_len        : tsp00_Int2 ;
			VAR ok              : boolean ) ;

	PROCEDURE
	    sqlwdgget (     box_id          : tsp00_Int2 ;
			    item_id         : tsp00_Int2 ;
			VAR text            : tsp00_Line ;
			VAR text_len        : tsp00_Int2 ;
			VAR ok              : boolean ) ;

	PROCEDURE
	    sqlwtitle (     term_ref        : tsp00_Int4 ;
			    screen_nr       : tsp00_Int2 ;
			VAR text            : tsp00_Line ;
			    text_len        : tsp00_Int2 ;
			VAR ok              : boolean ) ;

	PROCEDURE
	    sqlwscroll (    term_ref        : tsp00_Int4 ;
			VAR rect            : tsp00_VtRectangle ;
			    displ_x         : tsp00_Int2 ;
			    displ_y         : tsp00_Int2 ;
			VAR ok              : boolean ) ;

	PROCEDURE
	    sqlwcsbar (     term_ref        : tsp00_Int4 ;
			    screen_nr       : tsp00_Int2 ;
			    t               : tsp00_VtScroll ;
			    range_beg       : tsp00_Int2 ;
			    range_end       : tsp00_Int2 ;
			    pos             : tsp00_Int2 ;
			VAR ok              : boolean ) ;

&else
        VAR
              pdebug                          : text ;
 
        PROCEDURE
              vton    ( VAR desc              : terminal_description ;
			VAR ok                : boolean ) ;
 
        PROCEDURE
              vtinout ( VAR   screen          : screenbuffer ;
			VAR   attributes      : screenbuffer ;
			VAR   colors          : screenbuffer ;
			VAR   cursorline      : int2 ;
			VAR   cursorcolumn    : int2 ;
			VAR   hif             : hif_parms ;
			VAR   options         : vt_options ;
			VAR   screen_changed  : boolean ;
			VAR   keystroke       : vt_keystroke ) ;
 
        PROCEDURE
              vtoff   ( VAR msg               : c80 ) ;
 
&endif

.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :

&ifdef  REL30
        FROM
              RTE_driver : VEN102 ;

        PROCEDURE
	      sqlcton ( VAR returnkeys_array    : vt_key_string ;
			VAR size_returnkeys     : tsp00_Int2 ;
			VAR attributes_array    : attrib_string ;
			VAR size_attributes     : tsp00_Int2 ;
			VAR colors_array        : color_string ;
			VAR size_colors         : tsp00_Int2 ;
			VAR c_has_sysline       : boolean ;
			VAR c_label             : char ;
			VAR maxlines            : tsp00_Int2 ;
			VAR maxcols             : tsp00_Int2 ;
			VAR cscreen_buf         : tsp00_ScreenBufAddr ;
			VAR cattribute_buf      : tsp00_ScreenBufAddr ;
			VAR cgraphic            : boolean ;
			VAR cmark               : boolean ;
			VAR cwindows            : boolean ;
			VAR sqlcton_ok          : boolean );

        PROCEDURE
	      sqlctoff ( VAR cscreen_buf         : tsp00_ScreenBufAddr ;
			 VAR cattribute_buf      : tsp00_ScreenBufAddr ;
			 VAR c_msg               : tsp00_C80 );

        PROCEDURE
	      sqlctio ( VAR screen              : tsp00_ScreenBufAddr ;
			VAR attributes          : tsp00_ScreenBufAddr ;
			VAR cursorline          : tsp00_Int2 ;
			VAR cursorcolumn        : tsp00_Int2 ;
			VAR c_sk_text           : c200 ;
			VAR c_sys_text          : tsp00_Line ;
			VAR c_sys_attr          : tsp00_Line ;
			VAR insert_text         : tsp00_VtLabel ;
			VAR insert_pos          : i2_2 ;
			VAR insert_opt          : tsp00_C2 ;
			VAR c_vt_options        : option_string ;
			VAR c_returnkeys        : vt_key_string ;
			VAR c_rejectkeys        : vt_key_string ;
			VAR num_of_lines        : tsp00_Int2 ;
			VAR num_of_cols         : tsp00_Int2 ;
			VAR mark_begin          : tsp00_Int2 ;
			VAR mark_end            : tsp00_Int2 ;
			VAR screen_changed      : boolean ;
			VAR c_keystroke         : tsp00_C2 ;
			    c_refresh           : boolean ;
			VAR c_ok                : boolean );

	PROCEDURE
	      sqlcttable (     elem                : tsp00_Int2 ;
			   VAR att_array           : attrib_string ;
			       foreground          : tsp00_VtColor ;
			       background          : tsp00_VtColor );

	PROCEDURE
	      sqlctgtable (    elem                : tsp00_Int2 ;
			   VAR att_array           : attrib_string ;
			   VAR foreground          : tsp00_VtColor ;
			   VAR background          : tsp00_VtColor );

&else
        FROM
              VEN102 : VEN102 ;
 
        PROCEDURE
              cvton (
		    VAR returnkeys_array    : c100 ;
                    VAR size_returnkeys     : int2 ;
                    VAR attributes_array    : c100;
                    VAR size_attributes     : int2 ;
                    VAR color_array         : c20 ;
                    VAR size_colors         : int2 ;
                    VAR c_has_sysline       : char ;
                    VAR c_label             : char ;
                    VAR maxlines            : int2 ;
                    VAR maxcols             : int2 ;
			screen_ch           : int4 ;
                    VAR cvton_ok            : int2 ) ;
 
        PROCEDURE
              cvtinout (
                    VAR  screen             : screenbuffer ;
                    VAR  attributes         : screenbuffer ;
                    VAR  cursorline         : int2 ;
                    VAR  cursorcolumn       : int2 ;
                    VAR  c_sk_text          : c200 ;
                    VAR  c_sys_text         : line ;
                    VAR  c_sys_attr         : line ;
                    VAR  hif_changed        : c2 ;
                    VAR  insert_text        : vt_label ;
                    VAR  insert_pos         : i2_2 ;
                    VAR  insert_opt         : c2 ;
                    VAR  c_vt_options       : option_string ;
                    VAR  c_returnkeys       : vt_key_string ;
                    VAR  c_rejectkeys       : vt_key_string ;
                    VAR  screen_changed     : char ;
                    VAR  c_keystroke        : c2 ) ;
 
        PROCEDURE
              cvtoff ( VAR c_msg : c80 ) ;
 
&endif

.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :

.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : 
.sp
.cp 3
Created : 1987-12-01
.sp
.cp 3
Version : 1994-04-19
.sp
.cp 3
Release :      Date : 1998-08-11
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Specification:
.sp
Die Routinen des virtuellen Terminals sind im Papier "Laufzeitumgebung"
spezifiziert.
.sp
Dieser Modul wird sowohl fuer Release 2.4.xx als auch fuer 3.y.zz
benutzt, die jeweils richtige Version wird ueber die Definition
des Symbols REL24 bzw. REL30 erzeugt.
.CM *-END-* specification -------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:

Das virtuelle Terminal ist eine Schnittstelle zwischen den betriebssystem-
unabhaengigen DDB4-/SQL-DB-Komponenten und der betriebssystemabhaengigen
physikalischen Terminal.
.sp
Es ermoeglicht die Ausgabe eines kompletten Bildschirminhalts, der in
einem Bildschirmpuffer uebergeben wurde, das Einlesen von druckbaren
Zeichen von der Tastatur sowie die Reaktion auf die Betaetigung
bestimmter Tasten. Die Art der Ausgabe von Zeichen auf dem Bildschirm
(blinkend, unsichtbar ... ) wird ueber Attribute gesteuert.
.sp
Da sowohl die UNIX-Bildschirmbibliothek "libcurses" als auch
die Nixdorf-UNIX-Bildschirmbibliothek "screenlib" nur schlecht von Pascal
aus angesprochen werden koennen, erfolgt zunaechst ein Mapping zwischen
den vom Anwenderprogramm angelieferten Datenstrukturen, wie sie im
Dokument "Laufzeitumgebung" spezifiziert wurden, und Datenstrukturen,
die problemlos an ein C-Programm uebergeben werden koennen. Insbesondere
ist es notwendig, Pascal-Records, Pascal-Sets und Pascal-Aufzaehlungsvariable
umzuwandeln, da die interne Darstellung dieser Datentypen stark vom
verwendeten Pascal-Compiler abhaengig ist.
.sp
Nach dem Mapping der Datenstrukturen erfolgt eine Verzweigung in eine
C-Prozedur, in der die eigentlichen Aufgaben der virtuellen Terminals
erfuellt werden. Nach dem Verlassen dieser Prozedur muessen die hoch-
gereichten Datenstrukturen zunaechst wieder in die spezifizierten
Pascal-Datenstrukturen umgewandelt werden, bevor die Kontrolle an die
DDB4-/SQL-DB-Komponente zurueckgegeben werden kann.

.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    :

&ifdef  REL30
(*==========================================================================*)
(*======== REL30 ===========================================================*)
(*==========================================================================*)
CONST
      vtkey_number            = 100 ;
      vtattrib_number         = 20 ;
      vtcolor_number          = 20 ;
      vtoption_number         = 20 ;

TYPE
      i2_2          = ARRAY        [ 1 .. 2 ]                OF tsp00_Int2 ;
      vt_key_string = PACKED ARRAY [ 1 .. vtkey_number ]     OF char ;
      attrib_string = PACKED ARRAY [ 1 .. vtattrib_number ]  OF char ;
      color_string  = PACKED ARRAY [ 1 .. vtcolor_number  ]  OF char ;
      option_string = PACKED ARRAY [ 1 .. vtoption_number ]  OF char ;
      c200          = PACKED ARRAY [ 1 .. 200 ]              OF char ;

VAR
      sql04_vt_record : RECORD
			returnkeys_old    : tsp00_VtKeys ;
			rejectkeys_old    : tsp00_VtKeys ;
			sk_label_kind     : tsp00_SkLabel ;
			insert_text       : tsp00_VtLabel ;
			insert_pos        : i2_2 ;
			insert_opt        : tsp00_C2 ;
			c_vt_options      : option_string ;
			c_returnkeys      : vt_key_string ;
			c_rejectkeys      : vt_key_string ;
			c_sk_text         : c200 ;
      END ;

(*------------------------------*) 

PROCEDURE
      sql04_init_old_records ;

VAR
      i : integer ;

BEGIN
WITH sql04_vt_record DO
    BEGIN
    returnkeys_old := [] ;
    rejectkeys_old := [] ;

    FOR i := 1 TO vtkey_number DO
	BEGIN
	c_returnkeys [i] := chr(0);
	c_rejectkeys [i] := chr(0);
	END ;
    (*ENDFOR*)
    END ;
(*ENDWITH*)
END ;

(*------------------------------*) 

(*
 *  knack_hif zerlegt den hif-Record des sqltinout in Typen,
 *  die ohne Probleme an ein c-Modul uebergeben werden koennen.
 *)

PROCEDURE
      sql04_knack_hif ( VAR hif : tsp00_HifParms ) ;

VAR
      i , l   : integer ;

BEGIN
WITH sql04_vt_record DO
    BEGIN
    WITH hif DO
	BEGIN
	    BEGIN
	    (* Setzen der Position und der Attribute fuer das
		  INSERT-Label *)
	    insert_pos [1] := insert_label.lno ;
	    insert_pos [2] := insert_label.colnr ;
	    insert_opt [1] := insert_label.att [1];
	    END ;
	(* Speichern der Softkey-Beschriftungen in einem char-Array *)
	IF  sk_label_kind <> no_sk_labels
	THEN
	    BEGIN
	    FOR i := 1 TO csp_sk_number * 2 * VTLABEL_MXSP00 DO
		c_sk_text [i] := ' ' ;
	    (*ENDFOR*)
	    IF  sk_label_kind = short_sk_labels
	    THEN
		BEGIN
		(* kurze Softkey-Labels *)
		FOR l := 1 TO csp_sk_number DO
		    FOR i := 1 TO 8 DO
			c_sk_text[(l-1)*2*VTLABEL_MXSP00+i] := slabels[l][i];
		    (*ENDFOR*)
		(*ENDFOR*)
		END
	    ELSE
		BEGIN
		(* lange Softkey-Labels *)
		FOR l := 1 TO csp_sk_number DO
		    BEGIN
		    FOR i := 1 TO 8 DO
			c_sk_text[(l-1)*2*VTLABEL_MXSP00+i] := llabels[l][1][i];
		    (*ENDFOR*)
		    FOR i := 9 TO 16 DO
			c_sk_text[(l-1)*2*VTLABEL_MXSP00+i] := llabels[l][2][i-8];
		    (*ENDFOR*)
		    END ;
		(*ENDFOR*)
		END ;
	    (*ENDIF*)
	    END ;
	(*ENDIF*)
	END ;
    (*ENDWITH*)
    END ;
(*ENDWITH*)
END ;

(*------------------------------*) 

(*
 *  Aufbereiten der Optionen fuer sqltinout, d.h. umspeichern in
 *  eine fuer ein c-Modul problemlos verarbeitbare Form.
 *)

PROCEDURE
      sql04_knack_options ( VAR options : tsp00_VtOptions ) ;

VAR
      k : tsp00_VtKey ;
      returnkeys_vt : tsp00_VtKeys ;

BEGIN
WITH sql04_vt_record DO
    WITH options DO
	BEGIN
	c_vt_options [1] := chr ( ord ( wait_for_input  ) ) ;
	c_vt_options [2] := chr ( ord ( usage_mode      ) ) ;
	c_vt_options [3] := chr ( ord ( return_on_last  ) ) ;
	c_vt_options [4] := chr ( ord ( return_on_first ) ) ;
	c_vt_options [5] := chr ( ord ( bell            ) ) ;
	c_vt_options [6] := chr ( ord ( mark            ) ) ;

	(*
	 *  Ist vt_character_key in dem returnkeys-Set enthalten,
	 *  wird bei dem ersten druckbaren Zeichen
	 *  die Kontrolle an das aufrufende Modul zurueckgegeben
	 *)
	IF  vt_character_key in returnkeys
	THEN
	    c_vt_options [7] := chr (1)
	ELSE
	    c_vt_options [7] := chr (0) ;
	(*ENDIF*)

	(*
	 *  First/last_line_changed: low byte, high byte.
	 *)
	c_vt_options [8]  := chr ( first_line_changed MOD 256 );
	c_vt_options [9]  := chr ( first_line_changed DIV 256 );
	c_vt_options [10] := chr (  last_line_changed MOD 256 );
	c_vt_options [11] := chr (  last_line_changed DIV 256 );

	(*
	 *  Ist vt_control_key in dem returnkeys-Set enthalten,
	 *  wird bei dem ersten druckbaren Zeichen
	 *  die Kontrolle an das aufrufende Modul zurueckgegeben
	 *)
	IF  vt_control_key in returnkeys
	THEN
	    c_vt_options [12] := chr (1)
	ELSE
	    c_vt_options [12] := chr (0) ;
	(*ENDIF*)

	(*
	 *  Umspeichern des returnkey-Sets in ein character-Array.
	 *)
	IF  returnkeys <> returnkeys_old
	THEN
	    BEGIN
	    returnkeys_vt := returnkeys - [vt_unknown] ;
	    (*returnkeys_vt := returnkeys - [vt_character_key] ;*)
	    (*returnkeys_vt := returnkeys - [vt_control_key] ;*)
	    FOR k := vt_character_key TO vt_last_key DO
		BEGIN
		(* one array slot is reserved for key_unknown *)
		IF  k IN returnkeys_vt
		THEN
		    c_returnkeys [ ord(k) + 1 ] := chr(1)
		ELSE
		    c_returnkeys [ ord(k) + 1 ] := chr(0)
		(*ENDIF*)
		END ;
	    (*ENDFOR*)
	    END ;
	(*ENDIF*)

	(*
	 *  Umspeichern des rejectkey-Sets in ein character-Array.
	 *)
	IF  reject_keys <> rejectkeys_old
	THEN
	    BEGIN
	    FOR k := vt_character_key TO vt_last_key DO
		BEGIN
		(* one array slot is reserved for key_unknown *)
		IF  k IN reject_keys
		THEN
		    c_rejectkeys [ ord(k) + 1 ] := chr(1)
		ELSE
		    c_rejectkeys [ ord(k) + 1 ] := chr(0)
		(*ENDIF*)
		END ;
	    (*ENDFOR*)
	    END ;
	(*ENDIF*)
	END ;
    (*ENDWITH*)
(*ENDWITH*)
END ;

(*------------------------------*) 

(*
 *  In sqlton wird das virtuelle Terminal initialisiert und dem
 *  aufrufenden Programm mitgeteilt, welche Eigenschaften das
 *  Terminal (z.B. dap4x, vt220 ...  ) hat.
 *  Folgende Eigenschaften werden im Record 'desc' von sqlton
 *  zurueckgeliefert :
 *  - Anzahl Zeilen auf dem Bildschirm
 *  - Anzahl Spalten pro Bildschirmzeile
 *  - Tastenbelegung ( welche Tasten gibt es ? )
 *  - Attributmoeglichkeiten ( welche Attribute gibt es ? )
 *  - gibt es Softkeys auf dem Terminal ?
 *  - hat das Terminal eine Status-Zeile ?
 *  Da die Benutzung der Bildschirm-Bibliotheken libcurses und
 *  screenlib von Pascal aus schlecht moeglich ist, dient sqlton vor
 *  allem als Schnittstelle zwischen Pascal und dem in c geschriebenen
 *  Unterprogramm sqlcton. sqlton wandelt die von sqlcton hochgereichten
 *  Arrays in die Komponenten des Types 'terminal_description' um.
 *)

PROCEDURE
      sqlton    ( multi_task    : boolean ;
	    VAR term_ref : tsp00_Int4 ;
	    VAR desc : tsp00_TerminalDescription ;
	    VAR ok   : boolean ) ;

VAR
      x1                      : tsp00_VtKey ;
      x2                      : tsp00_VtMode ;
      x3                      : tsp00_VtColor ;
      size_returnkeys         : tsp00_Int2 ;
      size_attributes         : tsp00_Int2 ;
      size_colors             : tsp00_Int2 ;
      returnkeys_array        : vt_key_string ;
      attributes_array        : attrib_string ;
      colors_array            : color_string ;
      c_has_sysline           : boolean ;
      clabel                  : char ;
      cmaxlines               : tsp00_Int2 ;
      cmaxcols                : tsp00_Int2 ;
      cscreen_buf             : tsp00_ScreenBufAddr;
      cattribute_buf          : tsp00_ScreenBufAddr;
      cgraphic                : boolean ;
      cmark                   : boolean ;
      cwindows                : boolean ;
      cok                     : boolean ;
      i                       : integer ;

BEGIN
WITH sql04_vt_record DO
    BEGIN
    size_returnkeys   := ord ( vt_last_key   ) - ord ( vt_unknown       );
    size_attributes   := ord ( vt_last_mode  ) - ord ( vt_bright        );
    size_colors       := ord ( vt_last_color ) - ord ( vt_default_color );

    (* wenn map strings nicht ausreichen: Fehlermeldung provozieren *)
    IF ( size_returnkeys >= vtkey_number    )
    THEN size_returnkeys := -11000 ;
    IF ( size_attributes >= vtattrib_number )
    THEN size_attributes := -11000 ;
    IF ( size_colors     >= vtcolor_number  )
    THEN size_colors     := -11000 ;

    (* Initialisierung des Return-Parameters *)
    ok := false ;

    (* Aufruf der c-Prozedur sqlcton, die die eigentliche Initialisierung
	  des Terminals vornimmt *)
    sqlcton ( returnkeys_array , size_returnkeys , attributes_array ,
	  size_attributes , colors_array , size_colors , c_has_sysline ,
	  clabel , cmaxlines , cmaxcols , cscreen_buf , cattribute_buf ,
	  cgraphic , cmark , cwindows , cok ) ;

    (* Es folgt nun die Umwandlung der von sqlcton hochgereichten Arrays
	  in die entsprechenden Komponenten des Records desc *)
    IF  cok
    THEN
	BEGIN
	sql04_init_old_records ;      (* Backups initialisieren *)
	ok := true ;
	WITH desc DO
	    BEGIN
	    content_buf   := cscreen_buf ;
	    attribute_buf := cattribute_buf ;
	    num_of_lines  := cmaxlines ;
	    num_of_cols   := cmaxcols  ;
	    graphic_chars := cgraphic ;
	    mark          := cmark ;
	    windows       := cwindows ;
	    has_sysline   := c_has_sysline ;

	    (* Fuellen des Sets mit den auf dem aktuellen
		  Terminal vorhandenen Tasten *)
	    returnkeys := [] ;
	    FOR x1 := vt_unknown TO vt_last_key DO
		BEGIN
		IF  returnkeys_array [ ord(x1) - ord ( vt_unknown ) + 1] =
								    chr (1)
		THEN
		    BEGIN
		    returnkeys   := returnkeys + [x1] ;
		    END;
		(*ENDIF*) 
		END ;
	    (*ENDFOR*) 

	    (* Fuellen des Sets mit den auf dem aktuellen
		  Terminal vorhandenen Attributen *)
	    attributes := [] ;
	    FOR x2 := vt_bright TO vt_last_mode DO
		BEGIN
		IF  attributes_array[ ord(x2) - ord ( vt_bright ) + 1 ] =
								    chr (1)
		THEN
		    BEGIN
		    attributes   := attributes   + [x2] ;
		    END;
		(*ENDIF*) 
		END ;
	    (*ENDFOR*) 

	    (* Fuellen des Sets mit den auf dem aktuellen
		  Terminal vorhandenen Farben *)
	    colors     := [] ;
	    FOR x3 := vt_default_color TO vt_last_color DO
		BEGIN
		IF  colors_array [ ord (x3) - ord ( vt_default_color ) + 1 ] =
								    chr (1)
		THEN
		    BEGIN
		    colors  := colors + [x3] ;
		    END;
		(*ENDIF*) 
		END ;
	    (*ENDFOR*) 

	    (* Die Aufzaehlungsvariable sk_label_kind gibt an, ob
		  das Terminal Softkeys besitzt und wie lang gegebenen-
		  falls der Softkey-Text ist *)
	    CASE ord (clabel) OF
		0 : labels := no_sk_labels ;
		1 : labels := short_sk_labels ;
		2 : labels := long_sk_labels ;
		OTHERWISE : ok := false ;
		END;
	    (*ENDCASE*) 
	    sk_label_kind := labels ;

	    END;
	(*ENDWITH*) 
	END
    ELSE
	BEGIN
	(* bool auf false ; *)
	ok := false ;
	END ;
    (*ENDIF*) 

    sqlttable ( 0 , [              ] , vt_black , vt_white ) ;
    sqlttable ( 1 , [ vt_bright    ] , vt_black , vt_white ) ;
    sqlttable ( 2 , [ vt_invisible ] , vt_black , vt_white ) ;
    FOR i := 3 TO 15 DO
	sqlttable ( i , [            ] , vt_black , vt_white ) ;
    END;
END;

(*------------------------------*) 

PROCEDURE
      sqltoff (     term_ref        : tsp00_Int4 ;
		VAR screen_buf      : tsp00_ScreenBufAddr ;
		VAR attribute_buf   : tsp00_ScreenBufAddr ;
		VAR msg             : tsp00_C80 ) ;
BEGIN
sqlctoff ( screen_buf , attribute_buf , msg );
END;

(*------------------------------*) 

(*
 *  sqltio  beschreibt die eigentliche Aufgabe des virtuellen Terminals.
 *  Da die Bildschirmbibliotheken libcurses und screenlib von Pascal aus
 *  schlecht angesprochen werden koennen,
 *  erschoepft sich die Aufgabe von sqltio vor allem im
 *  Umspeichern von Pascal-Records in Datenstrukturen, die die
 *  c-Prozedur sqlctio problemlos verarbeiten kann.
 *)

PROCEDURE
      sqltio (     term_ref        : tsp00_Int4 ;
	       VAR screen_buf      : tsp00_ScreenBufAddr ;
	       VAR attribute_buf   : tsp00_ScreenBufAddr ;
	           refresh         : boolean ;
	       VAR cursorline      : tsp00_Int2 ;
	       VAR cursorcolumn    : tsp00_Int2 ;
	       VAR hif             : tsp00_HifParms ;
	       VAR options         : tsp00_VtOptions ;
	       VAR result          : tsp00_VtResult ;
	       VAR ok              : boolean ) ;

VAR
      i           : integer ;
      c_keystroke : tsp00_C2 ;
      x1          : tsp00_VtKey ;

BEGIN
WITH sql04_vt_record DO
    BEGIN
    sql04_knack_hif ( hif ) ;
    sql04_knack_options ( options ) ;

    sqlctio ( screen_buf , attribute_buf , cursorline, cursorcolumn, 
	c_sk_text,
	hif.sys_text, hif.sys_attr, hif.insert_label.text, insert_pos,
	insert_opt, c_vt_options, c_returnkeys, c_rejectkeys,
	result.num_of_lines, result.num_of_cols , result.mark_begin,
	result.mark_end, result.screen_changed, c_keystroke,
	refresh, ok ) ;

    (* Belegen des Records mit der zuletzt gedrueckten Taste oder dem 
       letzten Zeichen *)
    result.keystroke.key := vt_unknown ;
    FOR x1 := vt_unknown TO vt_last_key
    DO
	IF c_keystroke [1] = chr ( ord (x1) - ord ( vt_unknown ) )
	THEN
	    result.keystroke.key := x1 ;
	(*ENDIF*)
    (*ENDFOR*) 
    result.keystroke.ch := c_keystroke [2] ;
    END;
END ;

(*------------------------------*) 

PROCEDURE
      sqlttable (     i               : tsp00_Int2 ;
		      att             : tsp00_VtAttrib ;
		      foreground      : tsp00_VtColor ;
		      background      : tsp00_VtColor ) ;

VAR
	att_array       : attrib_string ;

BEGIN
WITH sql04_vt_record DO
    BEGIN
    att_array [1] := chr ( ord ( vt_bright      IN att ) );
    att_array [2] := chr ( ord ( vt_inverse     IN att ) );
    att_array [3] := chr ( ord ( vt_underline   IN att ) );
    att_array [4] := chr ( ord ( vt_blink       IN att ) );
    att_array [5] := chr ( ord ( vt_invisible   IN att ) );

    sqlcttable ( i , att_array , foreground , background );
    END;
END ;

(*------------------------------*) 

PROCEDURE
      sqltgtable (    i               : tsp00_Int2 ;
		  VAR att             : tsp00_VtAttrib ;
		  VAR foreground      : tsp00_VtColor ;
		  VAR background      : tsp00_VtColor ) ;

VAR
	att_array       : attrib_string ;

BEGIN
WITH sql04_vt_record DO
    BEGIN
    sqlctgtable ( i , att_array , foreground , background );
    att := [];

    IF ord(att_array [1]) <> 0
    THEN att := att + [ vt_bright      ];

    IF ord(att_array [2]) <> 0
    THEN att := att + [ vt_inverse     ];

    IF ord(att_array [3]) <> 0
    THEN att := att + [ vt_underline   ];

    IF ord(att_array [4]) <> 0
    THEN att := att + [ vt_blink       ];

    IF ord(att_array [5]) <> 0
    THEN att := att + [ vt_invisible   ];

    END;
END ;

(*------------------------------*) 

PROCEDURE
	sqlwindow
	( parent_ref    : tsp00_Int4 ;
	VAR position    : tsp00_VtRectangle ;
	VAR desc        : tsp00_TerminalDescription;
	VAR ok          : boolean ) ;

BEGIN
ok := false ;
END ;

(*------------------------------*) 

PROCEDURE
	sqlwsplit (
	term_ref        : tsp00_Int4 ;
	nr_screens      : tsp00_Int2 ;
	VAR desc        : tsp00_TerminalDescription;
	VAR offset      : tsp00_Int2 ;
	VAR ok          : boolean ) ;
BEGIN
ok := false ;
END ;

(*------------------------------*) 

PROCEDURE
	sqlwoff (
	term_ref        : tsp00_Int4 ;
	VAR screen_buf  : tsp00_ScreenBufAddr ;
	VAR attribute_buf : tsp00_ScreenBufAddr ;
	VAR color_buf   : tsp00_ScreenBufAddr ) ;
BEGIN
END ;

(*------------------------------*) 

PROCEDURE
	sqlwdgswitch (
	box_id          : tsp00_Int2 ;
	trigger         : tsp00_VtKeys ;
	retrn           : tsp00_VtKey ;
	VAR ok          : boolean ) ;
BEGIN
ok := false ;
END ;

(*------------------------------*) 

PROCEDURE
	sqlwdgclear (
	box_id          : tsp00_Int2 ) ;
BEGIN
END ;

(*------------------------------*) 

PROCEDURE
	sqlwdgset (
	box_id          : tsp00_Int2 ;
	item_id         : tsp00_Int2 ;
	VAR text        : tsp00_Line ;
	text_len        : tsp00_Int2 ;
	VAR ok          : boolean ) ;
BEGIN
ok := false ;
END ;

(*------------------------------*) 

PROCEDURE
	sqlwdgget (
	box_id          : tsp00_Int2 ;
	item_id         : tsp00_Int2 ;
	VAR text        : tsp00_Line ;
	VAR text_len    : tsp00_Int2 ;
	VAR ok          : boolean ) ;
BEGIN
ok := false ;
END ;

(*------------------------------*) 

PROCEDURE
	sqlwtitle (
	term_ref        : tsp00_Int4 ;
	screen_nr       : tsp00_Int2 ;
	VAR text        : tsp00_Line ;
	text_len        : tsp00_Int2 ;
	VAR ok          : boolean ) ;
BEGIN
ok := false ;
END ;

(*------------------------------*) 

PROCEDURE
	sqlwscroll (
	term_ref        : tsp00_Int4 ;
	VAR rect        : tsp00_VtRectangle ;
	displ_x         : tsp00_Int2 ;
	displ_y         : tsp00_Int2 ;
	VAR ok          : boolean ) ;
BEGIN
ok := false ;
END ;

(*------------------------------*) 

PROCEDURE
	sqlwcsbar (
	term_ref        : tsp00_Int4 ;
	screen_nr       : tsp00_Int2 ;
	t               : tsp00_VtScroll ;
	range_beg       : tsp00_Int2 ;
	range_end       : tsp00_Int2 ;
	pos             : tsp00_Int2 ;
	VAR ok          : boolean ) ;
BEGIN
ok := false ;
END ;

(*------------------------------*) 

(*==========================================================================*)
(*======== REL30 ===========================================================*)
(*==========================================================================*)
&else
(*==========================================================================*)
(*======== REL24 ===========================================================*)
(*==========================================================================*)
CONST
      vtkey_number            = 70 ;
      vtoption_number         = 6 ;
 
TYPE
      c200    = PACKED ARRAY [ 1 .. 200 ] OF char ;
      c100    = PACKED ARRAY [ 1 .. 100 ] OF char ;
      i2_2    = ARRAY [ 1 .. 2 ] OF int2 ;
      option_string = PACKED ARRAY [ 1 .. vtoption_number ]  OF char ;
      vt_key_string = PACKED ARRAY [ 1 .. vtkey_number ]     OF char ;
 
VAR
      returnkeys_old  : vt_keys ;
      rejectkeys_old  : vt_keys ;
      sk_label_kind   : sk_label_type ;
      insert_text     : vt_label ;
      insert_pos      : i2_2 ;
      insert_opt      : c2 ;
      (*c_sys_text      : line ;*)
      (*c_sys_attr      : line ;*)
      (*c_sys_color     : line ;*)
      c_vt_options    : option_string ;
      c_returnkeys    : vt_key_string ;
      c_rejectkeys    : vt_key_string ;
      c_sk_text       : c200 ;
 
 
(*------------------------------*) 
 
PROCEDURE
      init_old_records ;
 
VAR
      i : integer ;
 
BEGIN
returnkeys_old := [] ;
rejectkeys_old := [] ;
END ;
 
(*------------------------------*) 
 
(* knack_hif zerlegt den hif-Record des vtinout in Typen, die ohne
Probleme an ein c-Modul uebergeben werden koennen *)

PROCEDURE
      knack_hif ( hif : hif_parms ) ;
 
VAR
      i , l   : integer ;
 
BEGIN
WITH hif DO
    BEGIN
    (* Setzen der Position und der Attribute fuer das
	  INSERT-Label *)
    insert_pos [1] := insert_label.lno ;
    insert_pos [2] := insert_label.colnr ;
    insert_opt [1] := insert_label.att ;
    insert_opt [2] := insert_label.color ;

    (* Speichern der Softkey-Beschriftungen in einem char-Array *)
    (*ENDIF*) 
    IF  sk_label_kind <> no_sk_labels
    THEN
        BEGIN
        FOR i := 1 TO sk_number * 2 * vt_label_size DO
            c_sk_text [i] := ' ' ;
        (*ENDFOR*) 
        IF  sk_label_kind = short_sk_labels
        THEN
            BEGIN
            (* kurze Softkey-Labels *)
            FOR l := 1 TO sk_number DO
                FOR i := 1 TO 8 DO
                    c_sk_text[(l-1)*2*vt_label_size+i] := slabels [l][i] ;
                (*ENDFOR*) 
            (*ENDFOR*) 
            END
        ELSE
            BEGIN
            (* lange Softkey-Labels *)
            FOR l := 1 TO sk_number DO
                BEGIN
                FOR i := 1 TO 8 DO
                    c_sk_text[(l-1)*2*vt_label_size+i] := llabels [l][1][i] ;
                (*ENDFOR*) 
                FOR i := 9 TO 16 DO
                    c_sk_text[(l-1)*2*vt_label_size+i] := llabels [l][2][i-8] ;
                (*ENDFOR*) 
                END ;
            (*ENDFOR*) 
            END ;
        (*ENDIF*) 
        END ;
    (*ENDIF*) 
    END ;
(*ENDWITH*) 
END ;
 
(*------------------------------*) 
 
(* Aufbereiten der Optionen fuer cvtinout, d.h. umspeichern in
eine fuer ein c-Modul problemlos verarbeitbare Form *)

PROCEDURE
      knack_options ( options : vt_options ) ;
 
VAR
      i : integer ;
      k : vt_key ;
      returnkeys_vt : vt_keys ;
 
BEGIN
WITH options DO
    BEGIN
    c_vt_options [1] := chr ( ord ( wait_for_input  ) ) ;
    c_vt_options [2] := chr ( ord ( usage_mode      ) ) ;
    c_vt_options [3] := chr ( ord ( return_on_last  ) ) ;
    c_vt_options [4] := chr ( ord ( return_on_first ) ) ;
    c_vt_options [5] := chr ( ord ( bell            ) ) ;

    (*
     *  Ist vt_character_key in dem returnkeys-Set enthalten,
     *  wird bei dem ersten druckbaren Zeichen
     *  die Kontrolle an das aufrufende Modul zurueckgegeben
     *)
    IF  vt_character_key in returnkeys
    THEN
        c_vt_options [6] := chr (1)
    ELSE
        c_vt_options [6] := chr (0) ;
    (*ENDIF*) 

    IF  returnkeys <> returnkeys_old
    THEN
        BEGIN
        (* Umspeicher des returnkey-Sets in ein character-Array;
              das Ende des Arrays wird durch eine binaere Null
              gekennzeichnet.*)
        returnkeys_vt := returnkeys - [vt_character_key] ;
        i := 1 ;
	FOR k := vt_character_key TO vt_del_eof DO
            BEGIN
            IF  k IN returnkeys_vt
            THEN
                BEGIN
                c_returnkeys [i] := chr ( ord (k) - ord (vt_character_key) ) ;
                i := succ (i) ;
                END ;
            (*ENDIF*) 
            END ;
        (*ENDFOR*) 
        c_returnkeys [i] := chr ( 0 ) ;
        END ;
    (*ENDIF*) 

    IF  rejectkeys <> rejectkeys_old
    THEN
        BEGIN
        i := 1 ;
        (* Umspeicher des rejectkey-Sets in ein character-Array;
              das Ende des Arrays wird durch eine binaere Null
              gekennzeichnet.*)
	FOR k := vt_character_key TO vt_del_eof DO
            BEGIN
            IF  k IN rejectkeys
            THEN
                BEGIN
                c_rejectkeys [i] := chr ( ord (k) - ord (vt_character_key) ) ;
                i := succ (i) ;
                END ;
            (*ENDIF*) 
            END ;
        (*ENDFOR*) 
        c_rejectkeys [i] := chr ( 0 ) ;
        END ;
    (*ENDIF*) 
    END ;
(*ENDWITH*) 
END ;
 
(*------------------------------*) 
 
(* In vton wird das virtuelle Terminal initialisiert und dem
aufrufenden Programm mitgeteilt, welche Eigenschaften das
Terminal (z.B. dap4x, vt220 ...  ) hat.
Folgende Eigenschaften werden im Record 'desc' von vton
zurueckgeliefert :
- Anzahl Zeilen auf dem Bildschirm
- Anzahl Spalten pro Bildschirmzeile
- Tastenbelegung ( welche Tasten gibt es ? )
- Attributmoeglichkeiten ( welche Attribute gibt es ? )
- gibt es Softkeys auf dem Terminal ?
- hat das Terminal eine Status-Zeile ?
Da die Benutzung der Bildschirm-Bibliotheken libcurses und
screenlib von Pascal aus schlecht moeglich ist, dient vton vor
allem als Schnittstelle zwischen Pascal und dem in c geschriebenen
Unterprogramm cvton. vton wandelt die von cvton hochgereichten
Arrays in die Komponenten des Types 'terminal_description' um.
*)

PROCEDURE
      vton( VAR desc : terminal_description ; VAR ok : boolean ) ;
 
VAR
      x1                      : vt_key ;
      x2                      : vt_mode ;
      x3                      : 0 .. 15 ;
      size_returnkeys         : int2 ;
      size_attributes         : int2 ;
      size_colors             : int2 ;
      returnkeys_array        : c100 ;
      attributes_array        : c100 ;
      color_array             : c20 ;
      c_has_sysline           : char ;
      c_label                 : char ;
      cmaxlines               : int2 ;
      cmaxcols                : int2 ;
      cvton_ok                : int2 ;
 
BEGIN
size_returnkeys := ord ( vt_del_eof ) - ord ( vt_character_key ) ;
size_attributes := ord ( vt_mixed ) - ord ( vt_bright ) ;
size_colors     := 15 ;

(* Initialisierung des Return-Parameters *)
ok := false ;

(* Aufruf der c-Prozedur cvton, die die eigentliche Initialisierung
      des Terminals vornimmt *)
cvton ( returnkeys_array , size_returnkeys ,
      attributes_array , size_attributes ,
      color_array , size_colors ,
      c_has_sysline ,
      c_label ,
      cmaxlines ,
      cmaxcols  ,
      screen_chars ,
      cvton_ok ) ;

(* Es folgt nun die Umwandlung der von cvton hochgereichten Arrays
      in die entsprechenden Komponenten des Records desc *)
IF  cvton_ok = 1
THEN
    BEGIN
    init_old_records ;      (* Backups initialisieren *)
    ok := true ;
    WITH desc DO
        BEGIN
        (* Fuellen des Sets mit den auf dem aktuellen
              Terminal vorhandenen Tasten *)
        returnkeys := [] ;
	FOR x1 := vt_character_key TO vt_del_eof DO
            BEGIN
            IF  returnkeys_array [ ord(x1) - ord ( vt_character_key ) + 1] =
								chr (1)
            THEN
                BEGIN
                returnkeys   := returnkeys + [x1] ;
                END;
            (*ENDIF*) 
            END ;
        (*ENDFOR*) 

        (* Fuellen des Sets mit den auf dem aktuellen
              Terminal vorhandenen Attributen *)
        attributes := [] ;
        FOR x2 := vt_bright TO vt_mixed  DO
            BEGIN
            IF  attributes_array[ ord(x2) - ord ( vt_character_key ) + 1 ] =
								chr (1)
            THEN
                BEGIN
                attributes   := attributes   + [x2] ;
                END;
            (*ENDIF*) 
            END ;
        (*ENDFOR*) 

        (* Fuellen des Sets mit den auf dem aktuellen
              Terminal vorhandenen Farbenn *)
        colors     := [] ;
        FOR x3 := 0 TO 15 DO
            BEGIN
            IF  color_array [ ord (x3) - ord ( vt_character_key ) + 1 ] =
								chr (1)
            THEN
                BEGIN
                colors  := colors + [x3] ;
                END;
            (*ENDIF*) 
            END ;
        (*ENDFOR*) 

        (* has_sysline wird true, wenn das Terminal
              eine Statuszeile besitzt *)
        IF  c_has_sysline = chr(1)
        THEN
            has_sysline := true
        ELSE
            has_sysline := false ;
        (*ENDIF*) 

        (* Die Aufzaehlungsvariable sk_label_kind gibt an, ob
              das Terminal Softkeys besitzt und wie lang gegebenen-
              falls der Softkey-Text ist *)
        CASE ord (c_label) OF
            0 : labels := no_sk_labels ;
            1 : labels := short_sk_labels ;
            2 : labels := long_sk_labels ;
            OTHERWISE : ok := false ;
            END;
        (*ENDCASE*) 
        sk_label_kind := labels ;

        (* Anzahl Zeilen auf dem Bildschirm *)
        maxlines := cmaxlines ;
        (* Anzahl Spalten pro Zeile *)
        maxcols  := cmaxcols ;
        END;
    (*ENDWITH*) 
    END
ELSE
    BEGIN
    (* bool auf false ; *)
    END ;
(*ENDIF*) 
END;
 
(*------------------------------*) 

(*
vtinout beschreibt die eigentliche Aufgabe des virtuellen Terminals.
Da die Bildschirmbibliothek libcurses und screenlib von Pascal aus 
schlecht angesprochen werden koennen,
erschoepft sich die Aufgabe von vtinout vor allem im
Umspeichern von Pascal-Records in Datenstrukturen, die die
c-Prozedur cvtinout problemlos verarbeiten kann.
*)
 
PROCEDURE
      vtinout ( VAR   screen          : screenbuffer ;
            VAR   attributes      : screenbuffer ;
            VAR   colors          : screenbuffer ;
            VAR   cursorline      : int2 ;
            VAR   cursorcolumn    : int2 ;
            VAR   hif             : hif_parms ;
            VAR   options         : vt_options ;
            VAR   screen_changed  : boolean ;
            VAR   keystroke       : vt_keystroke ) ;
 
CONST
      softk = 1 ;
      messl = 2 ;
 
VAR
      i                : integer ;
      c_screen_changed : char ;
      c_keystroke      : c2 ;
      x1               : vt_key ;
      hif_changed      : c2 ;
 
BEGIN
knack_hif ( hif ) ;
hif_changed [ softk ] := chr (1) ; (* vorlauefig *)
hif_changed [ messl ] := chr (1) ; (* vorlauefig *)
knack_options ( options ) ;

cvtinout (
      screen         ,
      attributes     ,
      cursorline     ,
      cursorcolumn   ,
      c_sk_text      ,
      hif.sys_text     ,
      hif.sys_attr     ,
      hif_changed ,
      hif.insert_label.text    ,
      insert_pos     ,
      insert_opt     ,
      c_vt_options   ,
      c_returnkeys   ,
      c_rejectkeys   ,
      c_screen_changed ,
      c_keystroke  ) ;

IF  c_screen_changed = chr ( 1 )
THEN
    screen_changed := true
ELSE
    screen_changed := false ;
(*ENDIF*) 

(* Belegen des Records mit der zuletzt gedrueckten Taste oder dem letzten
      Zeichen *)
keystroke.key := vt_unknown ;
FOR x1 := vt_character_key TO vtkey_del_eof
DO
    IF c_keystroke [1] = chr ( ord (x1) - ord ( vt_character_key ) )
    THEN
	keystroke.key := x1 ;
    (*ENDIF*)
(*ENDFOR*) 
keystroke.ch := c_keystroke [2] ;
END ;
 
(*------------------------------*) 
 
PROCEDURE
      vtoff ( VAR msg : c80 ) ;
 
BEGIN
cvtoff ( msg ) ;
END ;
 
(*==========================================================================*)
(*======== REL24 ===========================================================*)
(*==========================================================================*)
&endif

.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        115
*-PRETTY-*  lines of code :        478        PRETTY  1.07 
*-PRETTY-*  lines in file :        654         1989-01-20 
.PA 
