home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume34 / vms_rtl_kbd / part01 / kbd$routines.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-19  |  21.2 KB  |  800 lines
  1. (*
  2. ------------------ Distribution and Copyright -----------------
  3. --
  4. -- This software is copyright by the CENA/DGAC/FRANCE
  5. -- All rights reserved.
  6. --
  7. -- No part of the material protected by this copyright notice
  8. -- may be reproduced or utilized for commercial use in any form
  9. -- without written permission of the copyright owner.
  10. --
  11. -- It may be reproduced or utilized for R&D use in Non Profit
  12. -- Organization
  13. --
  14. ---------------------------------------------------------------
  15.  
  16.  
  17. ------------------ Disclaimer ---------------------------------
  18. --
  19. -- This software and its documentation are provided "AS IS" and
  20. -- without any expressed or implied warranties whatsoever.
  21. -- No warranties as to performance, merchantability, or fitness
  22. -- for a particular purpose exist.
  23. --
  24. -- Because of the diversity of conditions and hardware under
  25. -- which this software may be used, no warranty of fitness for
  26. -- a particular purpose is offered.  The user is advised to
  27. -- test the software thoroughly before relying on it.  The user
  28. -- must assume the entire risk and liability of using this
  29. -- software.
  30. --
  31. -- In no event shall any person or organization of people be
  32. -- held responsible for any direct, indirect, consequential
  33. -- or inconsequential damages or lost profits.
  34. --                                                           
  35. -------------------END-PROLOGUE--------------------------------
  36. *)
  37.  
  38.  
  39.  
  40.  
  41. (*****************************************************************************)
  42. (*****************************************************************************)
  43. (**                                        **)
  44. (**                K B D $ R O U T I N E S   Implementation                 **)
  45. (**                                            **)
  46. (******* Copyright (C) 1992 Centre d'Etudes de la Navigation Aerienne ********)
  47. (*****************************************************************************)
  48.  
  49.  
  50.  
  51.  
  52. (*
  53.  * Titre:       KBD$ROUTINES Implementation
  54.  *
  55.  * Sujet:       Implementation des routines KBD$xxx ("Keyboard Routines").
  56.  *
  57.  * Version:       1.0
  58.  *
  59.  * Description:           Ce module contient l'implementation de la fonction
  60.  *                 KBD$READ_KEYSTROKE permettant d'attendre une action au
  61.  *           clavier et renvoyant la sequence ANSI correspondant a la
  62.  *           touche actionnee.
  63.  *
  64.  *                     Le module repose sur l'algorithme producteur-
  65.  *                 consommateur, l'utilisation de primitives de VAX/VMS (System
  66.  *                 Services: $GETDVI, $QIO, etc), d'un sous-programme
  67.  *                 d'interruption (AST) et de la librairie PASCAL$PPL_ROUTINES.
  68.  *
  69.  *                     Le producteur est un sous-programme d'interruption
  70.  *                 active par une action au clavier, alimentant une memoire
  71.  *                 tampon. Le consommateur est la fonction KBD$READ_KEYSTROKE
  72.  *           qui preleve a chaque appel une sequence ANSI de la memoire
  73.  *                 tampon.
  74.  *
  75.  *                     Lorsque le tampon est plein, l'utilisateur est prevenu
  76.  *                 par un beep sonore emit par le sous-programme d'IT.
  77.  *
  78.  *               La fonction KBD$FLUSH_KEYBOARD permet de vider le
  79.  *           tampon clavier.
  80.  *
  81.  *                    Afin de pouvoir recuperer les codes emis par CTRL/C,
  82.  *                 CTRL/O, CTRL/Q, CTRL/S, CTRL/T, CTRL/X, CTRL/Y et F6, il est
  83.  *                 necessaire d'entrer la commande DCL "SET TERMINAL/PASTHRU
  84.  *                 /NOTTSYNC".
  85.  *
  86.  *                     Pour utiliser KBD$READ_KEYSTROKE, il necessaire
  87.  *           d'appeler au prealable la fonction KBD$OPEN_KEYBOARD et de
  88.  *           terminer par KBD$CLOSE_KEYBOARD.
  89.  *                 La routine KBD$OPEN_KEYBOARD permet, entre autres, de ne
  90.  *           creer la zone tampon que si l'on desire reellement utiliser
  91.  *                 KBD$READ_KEYSTROKE.
  92.  *
  93.  * Langage:       PASCAL NON STANDARD
  94.  *
  95.  * Fichier:       KBD$ROUTINES.PAS
  96.  *
  97.  * Environnement:  Machine cible:          VAX
  98.  *           Systeme d'exploitation: VAX/VMS Version 5.4-3
  99.  *           Compilateur:            VAX Pascal Version 4.3
  100.  *
  101.  * Auteur:       Martin VICENTE (DGAC/CENA/SID)
  102.  *
  103.  *           E-mail: vicente@cenaath.cena.dgac.fr
  104.  *
  105.  *           Mail:   C.E.N.A.
  106.  *               Div. Support Informatique & Developpement
  107.  *               Orly Sud 205
  108.  *               94 542 ORLY AEROGARE CEDEX, FRANCE
  109.  *
  110.  * Creation:       19/05/92
  111.  *
  112.  * Modification:   26/05/92
  113.  *
  114.  *)
  115.  
  116.  
  117.  
  118.  
  119. [INHERIT( 'sys$library:starlet',
  120.           'sys$library:pascal$lib_routines',
  121.           'sys$library:pascal$ppl_routines',
  122.           'vic$library:pascal$kbd_routines'  )]
  123.  
  124.  
  125. MODULE  kbd$routines (G_screen);
  126.  
  127.  
  128.  
  129.  
  130. (*================================================================= 19/05/92 *)
  131.     [HIDDEN] CONST
  132. (*===========================================================================*)
  133.  
  134.  
  135.     NUL = Chr ( 0);
  136.     BEL = Chr ( 7);
  137.     ESC = Chr (27);
  138.  
  139.  
  140. (*================================================================= 19/05/92 *)
  141.     [HIDDEN] TYPE
  142. (*===========================================================================*)
  143.  
  144.  
  145.     $WORD  = [WORD] -32768..32767;
  146.     $UWORD = [WORD] 0..65535;
  147.  
  148.  
  149.     T_item_list_cell = PACKED RECORD
  150.                           CASE INTEGER OF
  151.               1: ( (* Normal Cell -----*)
  152.                           bufferLength  : $UWORD;
  153.               itemCode      : $UWORD;
  154.               bufferAddress : UNSIGNED;
  155.               returnAddress : UNSIGNED  );
  156.                           2: ( (* Terminator Cell -*)
  157.               terminator    : UNSIGNED  )
  158.                        END;
  159.  
  160.     T_item_list_template (count : INTEGER) = PACKED ARRAY [1..count] OF
  161.                                                 T_item_list_cell;
  162.  
  163.  
  164.     T_IOSB = RECORD
  165.                 ioStatus   : $UWORD;
  166.         transCount : $UWORD;
  167.             deviceInfo : UNSIGNED
  168.              END;
  169.  
  170.     T_device_name = PACKED ARRAY [1..64] OF CHAR;
  171.  
  172.  
  173. (*================================================================= 19/05/92 *)
  174.     [HIDDEN] CONST
  175. (*===========================================================================*)
  176.  
  177.  
  178.     C_ESCOVERBUF_EMPTY = kbd$t_escape_overflow_buffer [1..4 : Chr (0)];
  179.  
  180.  
  181. (*================================================================= 20/05/92 *)
  182.     [HIDDEN] VAR
  183. (*===========================================================================*)
  184.  
  185.  
  186.     G_keyboard_open : BOOLEAN VALUE FALSE;
  187.     G_screen        : [VOLATILE] TEXT;    { Pour emettre le caractere BEL    }
  188.     G_channel       : [VOLATILE] $UWORD;  { Canal d'E/S affecte a SYS$INPUT  }
  189.     G_iosb          : [VOLATILE] T_IOSB;  { Bloc de status rempli par la QIO }
  190.     G_qio_buffer    : [VOLATILE] kbd$t_ansi_sequence;
  191.  
  192.  
  193. (*================================================================= 19/05/92 *)
  194. (*           DEFINITIONS POUR L'ALGORITHME PRODUCTEUR/CONSOMMATEUR           *)
  195. (*===========================================================================*)
  196.  
  197.  
  198. [HIDDEN] CONST
  199.  
  200.    C_TAILLE_MAX = 32;  { taille maximale du tampon clavier }
  201.  
  202. [HIDDEN] TYPE
  203.  
  204.    T_tampon_clavier = ARRAY [0..C_TAILLE_MAX-1] OF kbd$t_ansi_sequence;
  205.  
  206. [HIDDEN] VAR
  207.  
  208.    G_TAMPON_CLAVIER      : [VOLATILE] ^T_tampon_clavier;
  209.    G_NB_A_CONSOMMER      : [VOLATILE] UNSIGNED;
  210.    G_NB_PLACE_DISPONIBLE : [VOLATILE] 0 .. C_TAILLE_MAX;
  211.    G_INDICE_PRODUCTEUR   : [VOLATILE] 0 .. C_TAILLE_MAX - 1;
  212.    G_INDICE_CONSOMMATEUR : 0 .. C_TAILLE_MAX - 1;
  213.  
  214.  
  215.  
  216.  
  217. (*****************************************************************************)
  218. (*****************************************************************************)
  219. (**                     S O U S  -  P R O G R A M M E S                     **)
  220. (*****************************************************************************)
  221. (*****************************************************************************)
  222.  
  223.  
  224.  
  225.  
  226. (****************************************************************** 22/05/92 *)
  227. (*    perform                                     *)
  228. (*****************************************************************************)
  229.  
  230. [HIDDEN,ASYNCHRONOUS,UNBOUND] PROCEDURE  perform (cond_value : UNSIGNED);
  231.  
  232. BEGIN
  233.  
  234.    IF NOT Odd (cond_value) THEN LIB$STOP (cond_value)
  235.  
  236. END (* perform *);
  237.  
  238.  
  239. (****************************************************************** 19/05/92 *)
  240. (*    SS_get_device_name                             *)
  241. (*****************************************************************************)
  242.  
  243. [HIDDEN] FUNCTION  SS_get_device_name (
  244.  
  245.    device   : PACKED ARRAY [l..u:INTEGER] OF CHAR;
  246.    VAR name : T_device_name ) : UNSIGNED;
  247.  
  248. VAR
  249.  
  250.    item_list   : T_item_list_template (2);
  251.    device_name : T_device_name;
  252.    cond_value  : UNSIGNED;
  253.  
  254. BEGIN
  255.  
  256.    WITH item_list[1] DO BEGIN
  257.  
  258.       itemCode      := DVI$_ALLDEVNAM;
  259.       bufferLength  := size     (device_name);
  260.       bufferAddress := iAddress (device_name);
  261.       returnAddress := 0
  262.  
  263.    END {WITH};
  264.  
  265.    item_list [2].terminator := 0;
  266.  
  267.    cond_value := $GETDVI (itmlst := item_list, devnam := device);
  268.  
  269.    IF cond_value = SS$_NORMAL THEN name := device_name;
  270.  
  271.    SS_get_device_name := cond_value
  272.  
  273. END (* SS_get_device_name *);
  274.  
  275.  
  276. (****************************************************************** 22/05/92 *)
  277.   [HIDDEN,ASYNCHRONOUS,UNBOUND] FUNCTION  SS_qio_read : UNSIGNED;  FORWARD;
  278. (*****************************************************************************)
  279.  
  280.  
  281. (****************************************************************** 22/05/92 *)
  282. (*    SS_interrupt_keyboard                             *)
  283. (*****************************************************************************)
  284.  
  285. [HIDDEN,ASYNCHRONOUS,UNBOUND] PROCEDURE  interrupt_keyboard;
  286.  
  287. VAR
  288.  
  289.    cond_value : UNSIGNED;
  290.  
  291. BEGIN
  292.  
  293.    (***************************)
  294.    (* DEBUT BOUCLE PRODUCTEUR *)
  295.    (***************************)
  296.  
  297.    IF (G_iosb.ioStatus = SS$_NORMAL)    OR
  298.       (G_iosb.ioStatus = SS$_BADESCAPE) THEN BEGIN
  299.  
  300.       {+}
  301.       { La condition BADESCAPE permet de traiter la touche F10 (ESC).
  302.       {-}
  303.  
  304.       IF G_NB_PLACE_DISPONIBLE = 0 THEN
  305.  
  306.          Writeln (G_screen, BEL)  { Le tampon clavier est plein ! }
  307.  
  308.       ELSE BEGIN
  309.  
  310.          G_NB_PLACE_DISPONIBLE := G_NB_PLACE_DISPONIBLE - 1;
  311.  
  312.          G_TAMPON_CLAVIER^ [G_INDICE_PRODUCTEUR] := G_qio_buffer;
  313.  
  314.          IF G_INDICE_PRODUCTEUR = C_TAILLE_MAX - 1
  315.             THEN G_INDICE_PRODUCTEUR := 0
  316.         ELSE G_INDICE_PRODUCTEUR := G_INDICE_PRODUCTEUR + 1;
  317.  
  318.          perform (PPL$INCREMENT_SEMAPHORE (G_NB_A_CONSOMMER))
  319.  
  320.       END {IF};
  321.  
  322.       perform (SS_qio_read)
  323.  
  324.    END
  325.    ELSE IF G_iosb.ioStatus <> SS$_ABORT THEN BEGIN
  326.  
  327.       LIB$STOP (G_iosb.ioStatus)
  328.  
  329.    END {IF}
  330.  
  331.    (*************************)
  332.    (* FIN BOUCLE PRODUCTEUR *)
  333.    (*************************)
  334.  
  335. END (* interrupt_keyboard *);
  336.  
  337.  
  338. (****************************************************************** 22/05/92 *)
  339. (*    SS_qio_read                                 *)
  340. (*****************************************************************************)
  341.  
  342. FUNCTION  SS_qio_read;
  343.  
  344. CONST
  345.  
  346.    IO_FUNCTION_CODE = IO$_READVBLK + IO$M_EXTEND;
  347.  
  348. VAR
  349.  
  350.    item_list : T_item_list_template (2);
  351.  
  352. BEGIN
  353.  
  354.    WITH item_list[1] DO BEGIN
  355.  
  356.       itemCode      := TRM$_ESCTRMOVR;
  357.       bufferLength  := 0;
  358.       bufferAddress := size (G_qio_buffer.escOverBuffer);
  359.       returnAddress := 0
  360.  
  361.    END {WITH};
  362.  
  363.    WITH item_list[2] DO BEGIN
  364.  
  365.       itemCode      := TRM$_MODIFIERS;
  366.       bufferLength  := 0;
  367.       bufferAddress := uOR (uOR ( TRM$M_TM_ESCAPE,
  368.                   TRM$M_TM_NOECHO ),
  369.                   TRM$M_TM_NOFILTR );
  370.       returnAddress := 0
  371.  
  372.    END {WITH};
  373.  
  374.    G_qio_buffer.escOverBuffer := C_ESCOVERBUF_EMPTY;
  375.  
  376.    SS_QIO_read := $QIO ( chan   := G_channel,
  377.              func   := IO_FUNCTION_CODE,
  378.              iosb   := G_iosb,
  379.              astadr := interrupt_keyboard,
  380.              p1     := G_qio_buffer,
  381.              p2     := size (G_qio_buffer),
  382.              p5     := iAddress (item_list),
  383.              p6     := size (item_list) )
  384.  
  385. END (* SS_qio_read *);
  386.  
  387.  
  388. (****************************************************************** 19/05/92 *)
  389. (*    KBD$OPEN_KEYBOARD                             *)
  390. (*****************************************************************************)
  391.  
  392. [GLOBAL] FUNCTION  kbd$open_keyboard : UNSIGNED;
  393.  
  394. VAR
  395.  
  396.    cond_value : UNSIGNED;
  397.    device     : T_device_name;
  398.  
  399. BEGIN
  400.  
  401.    IF G_keyboard_open THEN kbd$open_keyboard := KBD$_ALREADYOPEN
  402.    ELSE BEGIN
  403.  
  404.       (********************************)
  405.       (* DEBUT INITIALISATION COMMUNE *)
  406.       (********************************)
  407.  
  408.       {+}
  409.       { Creation du tampon AVANT l'installation du S/P d'IT.
  410.       {-}
  411.       
  412.       New (G_TAMPON_CLAVIER);
  413.  
  414.       cond_value := PPL$CREATE_SEMAPHORE (
  415.                semaphore_id      := G_NB_A_CONSOMMER,
  416.                semaphore_maximum := C_TAILLE_MAX,
  417.                semaphore_initial := 0 );
  418.  
  419.       IF NOT Odd (cond_value) THEN kbd$open_keyboard := KBD$_OPENERROR
  420.       ELSE BEGIN
  421.  
  422.      G_NB_PLACE_DISPONIBLE := C_TAILLE_MAX;
  423.  
  424.      (******************************)
  425.      (* FIN INITIALISATION COMMUNE *)
  426.      (******************************)
  427.  
  428.      (***********************************)
  429.      (* DEBUT INITIALISATION PRODUCTEUR *)
  430.      (***********************************)
  431.  
  432.      {+}
  433.      { Pour emettre le caractere BEL lorsque le tampon sera plein.
  434.      {-}
  435.  
  436.      open (G_screen, 'SYS$OUTPUT', carriage_control := NONE);
  437.  
  438.      Rewrite (G_screen);
  439.  
  440.          G_INDICE_PRODUCTEUR := 0;
  441.  
  442.      cond_value := SS_get_device_name ('SYS$INPUT', device);
  443.  
  444.      IF NOT Odd (cond_value) THEN kbd$open_keyboard := KBD$_OPENERROR
  445.      ELSE BEGIN
  446.  
  447.         cond_value := $ASSIGN (devnam := device, chan := G_channel);
  448.  
  449.         IF NOT Odd (cond_value) THEN kbd$open_keyboard := KBD$_OPENERROR
  450.         ELSE BEGIN
  451.  
  452.                {+}
  453.                { Premiere mise en place du S/P d'interruption.
  454.                {-}
  455.  
  456.                cond_value := SS_qio_read;
  457.  
  458.            IF NOT Odd (cond_value) THEN kbd$open_keyboard := KBD$_OPENERROR
  459.            ELSE BEGIN
  460.  
  461.               (*********************************)
  462.               (* FIN INITIALISATION PRODUCTEUR *)
  463.               (*********************************)
  464.  
  465.                            (*******************************)
  466.               G_INDICE_CONSOMMATEUR := 0;  (* INITIALISATION CONSOMMATEUR *)
  467.                            (*******************************)
  468.  
  469.               G_keyboard_open := TRUE;
  470.  
  471.               kbd$open_keyboard := KBD$_NORMAL
  472.  
  473.            END {IF}
  474.  
  475.         END {IF}
  476.  
  477.      END {IF}
  478.  
  479.       END {IF}
  480.  
  481.    END {IF}
  482.  
  483. END (* KBD$OPEN_KEYBOARD *);
  484.  
  485.  
  486. (****************************************************************** 26/05/92 *)
  487. (*    KBD$FLUSH_KEYBOARD                             *)
  488. (*****************************************************************************)
  489.  
  490. [GLOBAL] FUNCTION  kbd$flush_keyboard : UNSIGNED;
  491.  
  492. VAR
  493.  
  494.    cond_value : UNSIGNED;
  495.  
  496. BEGIN
  497.  
  498.    IF NOT G_keyboard_open THEN kbd$flush_keyboard := KBD$_NOTOPEN
  499.    ELSE BEGIN
  500.  
  501.       cond_value := PPL$CREATE_SEMAPHORE (
  502.                semaphore_id      := G_NB_A_CONSOMMER,
  503.                semaphore_maximum := C_TAILLE_MAX,
  504.                semaphore_initial := 0 );
  505.  
  506.       IF NOT Odd (cond_value) THEN kbd$flush_keyboard := KBD$_FLUSHERROR
  507.       ELSE BEGIN
  508.  
  509.      G_NB_PLACE_DISPONIBLE := C_TAILLE_MAX;
  510.  
  511.          G_INDICE_PRODUCTEUR   := 0;
  512.      G_INDICE_CONSOMMATEUR := 0;
  513.  
  514.      kbd$flush_keyboard := KBD$_NORMAL
  515.  
  516.       END {IF}
  517.  
  518.    END {IF}
  519.  
  520. END (* KBD$FLUSH_KEYBOARD *);
  521.  
  522.  
  523. (****************************************************************** 19/05/92 *)
  524. (*    KBD$CLOSE_KEYBOARD                             *)
  525. (*****************************************************************************)
  526.  
  527. [GLOBAL] FUNCTION  kbd$close_keyboard : UNSIGNED;
  528.  
  529. VAR
  530.  
  531.    cond_value : UNSIGNED;
  532.  
  533. BEGIN
  534.  
  535.    IF NOT G_keyboard_open THEN kbd$close_keyboard := KBD$_ALREADYCLOSE
  536.    ELSE BEGIN
  537.  
  538.       G_keyboard_open := FALSE;
  539.  
  540.       cond_value := $CANCEL (chan := G_channel);
  541.  
  542.       IF NOT Odd (cond_value) THEN kbd$close_keyboard := KBD$_CLOSEERROR
  543.       ELSE BEGIN
  544.  
  545.          Close (G_screen);
  546.  
  547.          Dispose (G_TAMPON_CLAVIER);
  548.  
  549.          kbd$close_keyboard := KBD$_NORMAL
  550.  
  551.       END {IF}
  552.  
  553.    END {IF}
  554.  
  555. END (* KBD$CLOSE_KEYBOARD *);
  556.  
  557.  
  558. (****************************************************************** 19/05/92 *)
  559. (*    KBD$READ_KEYSTROKE                             *)
  560. (*****************************************************************************)
  561.  
  562. [GLOBAL] FUNCTION  kbd$read_keystroke (
  563.  
  564.    VAR key : kbd$t_ansi_sequence) : UNSIGNED;
  565.  
  566. {+}
  567. { Cette fonction se met en attente d'une action au clavier et renvoie la
  568. { sequence ANSI de la touche qui vient d'etre actionnee.
  569. {-}
  570.  
  571. VAR
  572.  
  573.    cond_value : UNSIGNED;
  574.  
  575. BEGIN
  576.  
  577.    IF NOT G_keyboard_open THEN kbd$read_keystroke := KBD$_NOTOPEN
  578.    ELSE BEGIN
  579.  
  580.       (*****************************)
  581.       (* DEBUT BOUCLE CONSOMMATEUR *)
  582.       (*****************************)
  583.  
  584.       cond_value := PPL$DECREMENT_SEMAPHORE (G_NB_A_CONSOMMER);
  585.  
  586.       IF NOT Odd (cond_value) THEN kbd$read_keystroke := KBD$_READERROR
  587.       ELSE BEGIN
  588.  
  589.          key := G_TAMPON_CLAVIER^ [G_INDICE_CONSOMMATEUR];
  590.  
  591.          IF G_INDICE_CONSOMMATEUR = C_TAILLE_MAX - 1
  592.             THEN G_INDICE_CONSOMMATEUR := 0
  593.             ELSE G_INDICE_CONSOMMATEUR := G_INDICE_CONSOMMATEUR + 1;
  594.  
  595.          G_NB_PLACE_DISPONIBLE := G_NB_PLACE_DISPONIBLE + 1;
  596.  
  597.          kbd$read_keystroke := KBD$_NORMAL
  598.  
  599.          (***************************)
  600.          (* FIN BOUCLE CONSOMMATEUR *)
  601.          (***************************)
  602.  
  603.       END {IF}
  604.  
  605.    END {IF}
  606.  
  607. END (* KBD$READ_KEYSTROKE *);
  608.  
  609.  
  610. (****************************************************************** 25/05/92 *)
  611. (*    KBD$KEY_PRESSED                                 *)
  612. (*****************************************************************************)
  613.  
  614. [GLOBAL] FUNCTION  kbd$key_pressed (VAR yes : BOOLEAN) : UNSIGNED;
  615.  
  616. VAR
  617.  
  618.    nombre     : $WORD;
  619.    cond_value : UNSIGNED;
  620.  
  621. BEGIN
  622.  
  623.    IF NOT G_keyboard_open THEN kbd$key_pressed := KBD$_NOTOPEN
  624.    ELSE BEGIN
  625.  
  626.       cond_value := PPL$READ_SEMAPHORE (G_NB_A_CONSOMMER, nombre);
  627.  
  628.       IF NOT Odd (cond_value) THEN kbd$key_pressed := KBD$_KEYPRESERROR
  629.       ELSE BEGIN
  630.  
  631.          yes := nombre <> 0;
  632.  
  633.          kbd$key_pressed := KBD$_NORMAL
  634.  
  635.       END {IF}
  636.  
  637.    END {IF}
  638.  
  639. END (* KBD$KEY_PRESSED *);
  640.  
  641.  
  642. (****************************************************************** 19/05/92 *)
  643. (*    KBD$CVT_ANSI_SMG                             *)
  644. (*****************************************************************************)
  645.  
  646. [GLOBAL] FUNCTION  kbd$cvt_ansi_smg (sequence : kbd$t_ansi_sequence) : $UWORD;
  647.  
  648. BEGIN
  649.  
  650.    WITH sequence DO BEGIN
  651.  
  652.       IF escOverBuffer = C_ESCOVERBUF_EMPTY THEN BEGIN
  653.  
  654.          (********************)
  655.      (* ASCII Characters *)
  656.          (********************)
  657.  
  658.          kbd$cvt_ansi_smg := Ord (ascii)
  659.  
  660.       END
  661.       ELSE IF ascii = ESC THEN BEGIN
  662.  
  663.          (********************)
  664.      (* Escape Sequences *)
  665.          (********************)
  666.  
  667.      IF escOverBuffer [1] = 'O' THEN BEGIN  (* SS3 *)
  668.  
  669.         CASE escOverBuffer [2] OF
  670.  
  671.            (* Arrow Keys - Application *)
  672.  
  673.            'A' : kbd$cvt_ansi_smg := SMG$K_TRM_UP;
  674.            'B' : kbd$cvt_ansi_smg := SMG$K_TRM_DOWN;
  675.            'C' : kbd$cvt_ansi_smg := SMG$K_TRM_RIGHT;
  676.            'D' : kbd$cvt_ansi_smg := SMG$K_TRM_LEFT;
  677.  
  678.            (* Numeric Keypad Keys - Application *)
  679.  
  680.            'M' : kbd$cvt_ansi_smg := SMG$K_TRM_ENTER;
  681.            'P' : kbd$cvt_ansi_smg := SMG$K_TRM_PF1;
  682.            'Q' : kbd$cvt_ansi_smg := SMG$K_TRM_PF2;
  683.            'R' : kbd$cvt_ansi_smg := SMG$K_TRM_PF3;
  684.            'S' : kbd$cvt_ansi_smg := SMG$K_TRM_PF4;
  685.            'l' : kbd$cvt_ansi_smg := SMG$K_TRM_COMMA;
  686.            'm' : kbd$cvt_ansi_smg := SMG$K_TRM_MINUS;
  687.            'n' : kbd$cvt_ansi_smg := SMG$K_TRM_PERIOD;
  688.            'p' : kbd$cvt_ansi_smg := SMG$K_TRM_KP0;
  689.            'q' : kbd$cvt_ansi_smg := SMG$K_TRM_KP1;
  690.            'r' : kbd$cvt_ansi_smg := SMG$K_TRM_KP2;
  691.            's' : kbd$cvt_ansi_smg := SMG$K_TRM_KP3;
  692.            't' : kbd$cvt_ansi_smg := SMG$K_TRM_KP4;
  693.            'u' : kbd$cvt_ansi_smg := SMG$K_TRM_KP5;
  694.            'v' : kbd$cvt_ansi_smg := SMG$K_TRM_KP6;
  695.            'w' : kbd$cvt_ansi_smg := SMG$K_TRM_KP7;
  696.            'x' : kbd$cvt_ansi_smg := SMG$K_TRM_KP8;
  697.            'y' : kbd$cvt_ansi_smg := SMG$K_TRM_KP9
  698.  
  699.            OTHERWISE kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  700.  
  701.         END {CASE}
  702.  
  703.      END
  704.      ELSE IF escOverBuffer [1] = '[' THEN BEGIN  (* CSI *)
  705.  
  706.         IF escOverBuffer [3] = '~' THEN BEGIN
  707.  
  708.            CASE escOverBuffer [2] OF
  709.  
  710.           (* Editing Keys *)
  711.  
  712.           '1' : kbd$cvt_ansi_smg := SMG$K_TRM_FIND;
  713.           '2' : kbd$cvt_ansi_smg := SMG$K_TRM_INSERT_HERE;
  714.           '3' : kbd$cvt_ansi_smg := SMG$K_TRM_REMOVE;
  715.           '4' : kbd$cvt_ansi_smg := SMG$K_TRM_SELECT;
  716.           '5' : kbd$cvt_ansi_smg := SMG$K_TRM_PREV_SCREEN;
  717.           '6' : kbd$cvt_ansi_smg := SMG$K_TRM_NEXT_SCREEN
  718.  
  719.           OTHERWISE kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  720.  
  721.            END {CASE}
  722.  
  723.         END
  724.         ELSE IF escOverBuffer [4] = '~' THEN BEGIN
  725.  
  726.            CASE escOverBuffer [2] OF
  727.  
  728.           '1' : CASE escOverBuffer [3] OF
  729.                '7' : kbd$cvt_ansi_smg := SMG$K_TRM_F6;
  730.                '8' : kbd$cvt_ansi_smg := SMG$K_TRM_F7;
  731.                '9' : kbd$cvt_ansi_smg := SMG$K_TRM_F8
  732.                OTHERWISE kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  733.             END {CASE};
  734.           '2' : CASE escOverBuffer [3] OF
  735.                '0' : kbd$cvt_ansi_smg := SMG$K_TRM_F9;
  736.                '1' : kbd$cvt_ansi_smg := SMG$K_TRM_F10;
  737.                '3' : kbd$cvt_ansi_smg := SMG$K_TRM_F11;
  738.                '4' : kbd$cvt_ansi_smg := SMG$K_TRM_F12;
  739.                '5' : kbd$cvt_ansi_smg := SMG$K_TRM_F13;
  740.                '6' : kbd$cvt_ansi_smg := SMG$K_TRM_F14;
  741.                '8' : kbd$cvt_ansi_smg := SMG$K_TRM_HELP;
  742.                '9' : kbd$cvt_ansi_smg := SMG$K_TRM_DO
  743.                OTHERWISE kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  744.             END {CASE};
  745.           '3' : CASE escOverBuffer [3] OF
  746.                '1' : kbd$cvt_ansi_smg := SMG$K_TRM_F17;
  747.                '2' : kbd$cvt_ansi_smg := SMG$K_TRM_F18;
  748.                '3' : kbd$cvt_ansi_smg := SMG$K_TRM_F19;
  749.                '4' : kbd$cvt_ansi_smg := SMG$K_TRM_F20
  750.                OTHERWISE kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  751.             END {CASE}
  752.  
  753.           OTHERWISE kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  754.  
  755.            END {CASE}
  756.  
  757.         END
  758.         ELSE BEGIN
  759.  
  760.            CASE escOverBuffer [2] OF
  761.  
  762.           (* Arrow Keys - Normal *)
  763.  
  764.           'A' : kbd$cvt_ansi_smg := SMG$K_TRM_UP;
  765.           'B' : kbd$cvt_ansi_smg := SMG$K_TRM_DOWN;
  766.           'C' : kbd$cvt_ansi_smg := SMG$K_TRM_RIGHT;
  767.           'D' : kbd$cvt_ansi_smg := SMG$K_TRM_LEFT
  768.  
  769.           OTHERWISE kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  770.  
  771.            END {CASE}
  772.  
  773.         END {IF}
  774.  
  775.      END
  776.      ELSE BEGIN
  777.  
  778.         kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  779.  
  780.      END {IF}
  781.  
  782.       END
  783.       ELSE BEGIN
  784.  
  785.      kbd$cvt_ansi_smg := SMG$K_TRM_UNKNOWN
  786.  
  787.       END {IF}
  788.  
  789.    END {WITH}
  790.  
  791. END (* KBD$CVT_ANSI_SMG *);
  792.  
  793.  
  794.  
  795.  
  796. (*****************************************************************************)
  797.  
  798. END (* KBD$ROUTINES Implementation *).
  799.  
  800.