Patch title: Release 94 bulk changes
Abstract:
File: /pliant/language/ui/ansi_terminal.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# 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
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/install/ring2.pli"
submodule "console1.pli"


#------------------------------------------------------------------
#  input


public
  constant keyboard_break  3
  constant keyboard_rubout 8
  constant keyboard_enter  13
  constant keyboard_insert 126
  constant keyboard_delete 5B337Eh
  constant keyboard_up     5B41h
  constant keyboard_down   5B42h
  constant keyboard_left   5B44h
  constant keyboard_right  5B43h
  constant keyboard_page_up   5B357Eh
  constant keyboard_page_down 5B367Eh


if os_api="linux" and (constant (os_extra_info search "static" -1)<>(-1))

  function keyboard_raw_readchar -> c
    arg Int c
    os_read 0 addressof:c 1

eif os_api="linux" or os_api="posix"

  type os_TermIOs
    field uInt c_iflag c_oflag c_cflag c_lflag
    field uInt8 c_line
    field (Array uInt8 32) c_cc
    field uInt c_ispeed c_ospeed
    field (Array Byte 16) pliant_padding

  function os_tcgetattr fd ios
    arg Int fd ; arg_w os_TermIOs ios
    external os_libc_filename "tcgetattr"

  function os_tcsetattr fd when ios
    arg Int fd ; arg Int when ; arg os_TermIOs ios
    external os_libc_filename "tcsetattr"

  function os_cfmakeraw ios
    arg_w os_TermIOs ios
    external os_libc_filename "cfmakeraw"

  function keyboard_raw_readchar -> c
    arg Int c
  function keyboard_raw_readchar timeout -> c
    arg Float timeout ; arg Int c
    var os_TermIOs current wished
    os_tcgetattr 0 current
    memory_copy addressof:current addressof:wished os_TermIOs:size
    os_cfmakeraw wished
    os_tcsetattr 0 0 wished
    c := 0 ; os_read 0 addressof:c 1
    if timeout<>undefined
      var os_pollfd fd
      fd fd := 0
      fd events := os_POLLIN
      if (os_poll addressof:fd 1 (cast timeout*1000 Int))<1
        os_tcsetattr 0 0 current
        return undefined
    c := 0
    if (os_read 0 addressof:c 1)<>1
      c := undefined
    if c=current:c_cc:2
      c := keyboard_rubout
    os_tcsetattr 0 0 current

  function keyboard_raw_readchar -> c
    arg Int c
    c := keyboard_raw_readchar undefined

eif os_api="win32"

  gvar Int handle := -1

  function keyboard_raw_readchar -> c
    arg Int c
    if handle=-1
      var uInt access := os_GENERIC_READ
      var uInt share :=  os_FILE_SHARE_READ .or. os_FILE_SHARE_WRITE
      var uInt creation := os_OPEN_EXISTING
      var uInt wflags := os_FILE_ATTRIBUTE_NORMAL .or. os_FILE_FLAG_SEQUENTIAL_SCAN
      handle := os_CreateFile "con" access share null creation wflags null
    os_GetConsoleMode handle (var uInt mode)
    os_SetConsoleMode handle mode .and. .not. os_ENABLE_LINE_INPUT+os_ENABLE_ECHO_INPUT
    os_ReadFile handle addressof:(var uInt8 ch) 1 (var Int red) null
    os_SetConsoleMode handle mode
    c := shunt ch<>10 ch keyboard_raw_readchar

eif os_api="os2"

  function keyboard_raw_readchar -> c
    arg Int c
    os_DosRead 0 addressof:(var uInt8 ch) 1 (var Int red)
    c := shunt ch<>10 ch keyboard_raw_readchar

doc
  [Under Win32, 'keyboard_raw_readchar' works sadely because 'SetConsoleMode' fails.]


gvar Int keyboard_buffer := undefined

function keyboard_readchar -> c
  arg Int c
  if keyboard_buffer<>undefined
    c := keyboard_buffer
    keyboard_buffer := undefined
    return
  c := keyboard_raw_readchar
  if c=27
    c := keyboard_raw_readchar
    if c=5Bh
      while true
        var Int d := keyboard_raw_readchar
        c := c*2^8+d
        if d<30h or d>=40h
          return
    else
      keyboard_buffer := c
      c := 27
  eif os_api="linux" and c=keyboard_break
    os_kill os_getpid os_SIGINT


function keyboard_input m -> s
  arg Str m s
  console m
  s := ""
  while true
    var Int c := keyboard_readchar
    if c=keyboard_rubout
      if s:len>0
        s := s 0 s:len-1
        console character:keyboard_rubout+" "+character:keyboard_rubout
    eif c=keyboard_enter
      console "[lf]"
      return
    eif c<256
      s := s+character:c
      console character:c

function keyboard_input_password m -> s
  arg Str m s
  console m
  s := ""
  while true
    var Int c := keyboard_readchar
    if c=keyboard_rubout
      if s:len>0
        s := s 0 s:len-1
        console character:keyboard_rubout+" "+character:keyboard_rubout
    eif c=keyboard_enter
      console "[lf]"
      return
    eif c<256
      s := s+character:c
      console "."


export keyboard_readchar keyboard_raw_readchar keyboard_input keyboard_input_password


#------------------------------------------------------------------
#  output


function console_move x y
  arg Int x y
  console character:27 "[lb]" y+1 ";" x+1 "H"

export console_move