← Back to branch summary

~pmdj/ubuntu/trusty/qemu/2.9+applesmc+fadtv3

« back to all changes in this revision

Viewing changes to roms/SLOF/slof/fs/term-io.fs

  • Committer: Phil Dennis-Jordan
  • Date: 2017-07-21 08:03:43 UTC
  • mfrom: (1.1.1)
  • Revision ID: phil@philjordan.eu-20170721080343-2yr2vdj7713czahv
New upstream release 2.9.0.

Show diffs side-by-side

added added

removed removed

Lines of Context:
roms/SLOF/slof/fs/term-io.fs
 
1
\ *****************************************************************************
 
2
\ * Copyright (c) 2004, 2008 IBM Corporation
 
3
\ * All rights reserved.
 
4
\ * This program and the accompanying materials
 
5
\ * are made available under the terms of the BSD License
 
6
\ * which accompanies this distribution, and is available at
 
7
\ * http://www.opensource.org/licenses/bsd-license.php
 
8
\ *
 
9
\ * Contributors:
 
10
\ *     IBM Corporation - initial implementation
 
11
\ ****************************************************************************/
 
12
 
 
13
 
 
14
: input  ( dev-str dev-len -- )
 
15
   open-dev ?dup IF
 
16
      \ Close old stdin:
 
17
      s" stdin" get-chosen IF
 
18
         decode-int nip nip ?dup IF close-dev THEN
 
19
      THEN
 
20
      \ Now set the new stdin:
 
21
      encode-int s" stdin"  set-chosen
 
22
   THEN
 
23
;
 
24
 
 
25
: output  ( dev-str dev-len -- )
 
26
   open-dev ?dup IF
 
27
      \ Close old stdout:
 
28
      s" stdout" get-chosen IF
 
29
         decode-int nip nip ?dup IF close-dev THEN
 
30
      THEN
 
31
      \ Now set the new stdout:
 
32
      encode-int s" stdout" set-chosen
 
33
   THEN
 
34
;
 
35
 
 
36
: io  ( dev-str dev-len -- )
 
37
   2dup input output
 
38
;
 
39
 
 
40
 
 
41
1 BUFFER: (term-io-char-buf)
 
42
 
 
43
: term-io-key  ( -- char )
 
44
   s" stdin" get-chosen IF
 
45
      decode-int nip nip dup 0= IF 0 EXIT THEN
 
46
      >r BEGIN
 
47
         (term-io-char-buf) 1 s" read" r@ $call-method
 
48
         0 >
 
49
      UNTIL
 
50
      (term-io-char-buf) c@
 
51
      r> drop
 
52
   ELSE
 
53
      [ ' key behavior compile, ]
 
54
   THEN
 
55
;
 
56
 
 
57
' term-io-key to key
 
58
 
 
59
\ this word will check what the current chosen input device is:
 
60
\ - if it is a serial device, it will use serial-key? to check for available input
 
61
\ - if it is a keyboard, it will check if the "key-available?" method is implemented (i.e. for usb-keyboard) and use that
 
62
\ - if it's an hv console, use hvterm-key?
 
63
\ otherwise it will always return false
 
64
: term-io-key?  ( -- true|false )
 
65
   s" stdin" get-chosen IF
 
66
      decode-int nip nip dup 0= IF drop 0 EXIT THEN \ return false and exit if no stdin set
 
67
      >r \ store ihandle on return stack
 
68
      s" device_type" r@ ihandle>phandle ( propstr len phandle )
 
69
      get-property ( true | data dlen false )
 
70
      IF
 
71
         \ device_type not found, return false and exit
 
72
         false
 
73
      ELSE
 
74
         1 - \ remove 1 from length to ignore null-termination char
 
75
         \ device_type found, check wether it is serial or keyboard
 
76
         2dup s" serial" str= IF
 
77
            2drop serial-key? r> drop EXIT
 
78
         THEN \ call serial-key, cleanup return-stack, exit
 
79
         2dup s" keyboard" str= IF 
 
80
            2drop ( )
 
81
            \ keyboard found, check for key-available? method, execute it or return false 
 
82
            s" key-available?" r@ ihandle>phandle find-method IF 
 
83
               drop s" key-available?" r@ $call-method  
 
84
            ELSE 
 
85
               false 
 
86
            THEN
 
87
            r> drop EXIT \ cleanup return-stack, exit
 
88
         THEN
 
89
         2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false
 
90
      THEN
 
91
   ELSE
 
92
      \ stdin not set, return false
 
93
      false
 
94
   THEN
 
95
;
 
96
 
 
97
' term-io-key? to key?